1 package FS::part_export::sqlradius;
4 use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
7 use FS::Record qw( dbh qsearch qsearchs str2time_sql str2time_sql_closing );
14 @ISA = qw(FS::part_export);
15 @EXPORT_OK = qw( sqlradius_connect );
20 tie %options, 'Tie::IxHash',
21 'datasrc' => { label=>'DBI data source ' },
22 'username' => { label=>'Database username' },
23 'password' => { label=>'Database password' },
24 'usergroup' => { label => 'Group table',
26 options => [qw( usergroup radusergroup ) ],
28 'ignore_accounting' => {
30 label => 'Ignore accounting records from this database'
32 'process_single_realm' => {
34 label => 'Only process one realm of accounting records',
36 'realm' => { label => 'The realm of of accounting records to be processed' },
37 'ignore_long_sessions' => {
39 label => 'Ignore sessions which span billing periods',
43 label => 'Hide IP address information on session reports',
47 label => 'Hide download/upload information on session reports',
49 'show_called_station' => {
51 label => 'Show the Called-Station-ID on session reports', #as a phone number
53 'overlimit_groups' => {
54 label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)',
60 option_values => sub {
62 map { $_->groupnum, $_->long_description }
63 qsearch('radius_group', {}),
68 'groups_susp_reason' => { label =>
69 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
74 label => 'Export RADIUS group attributes to this database',
79 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
80 tables to any SQL database for
81 <a href="http://www.freeradius.org/">FreeRADIUS</a>
82 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
86 An existing RADIUS database will be updated in realtime, but you can use
87 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
88 to delete the entire RADIUS database and repopulate the tables from the
89 Freeside database. See the
90 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
92 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
93 for the exact syntax of a DBI data source.
95 <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.
96 <li>Using ICRADIUS, add a dummy "op" column to your database:
98 ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
99 ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
100 ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
101 ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
103 <li>Using Radiator, see the
104 <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
105 for configuration information.
111 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
112 'options' => \%options,
115 'nas' => 'Y', # show export_nas selection in UI
116 'default_svc_class' => 'Internet',
118 'This export does not export RADIUS realms (see also '.
119 'sqlradius_withdomain). '.
123 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
124 split( "\n", shift->option('groups_susp_reason'));
127 sub rebless { shift; }
129 sub export_username { # override for other svcdb
130 my($self, $svc_acct) = (shift, shift);
131 warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
135 sub radius_reply { #override for other svcdb
136 my($self, $svc_acct) = (shift, shift);
137 my %every = $svc_acct->EVERY::radius_reply;
138 map { @$_ } values %every;
141 sub radius_check { #override for other svcdb
142 my($self, $svc_acct) = (shift, shift);
143 my %every = $svc_acct->EVERY::radius_check;
144 map { @$_ } values %every;
148 my($self, $svc_x) = (shift, shift);
150 foreach my $table (qw(reply check)) {
151 my $method = "radius_$table";
152 my %attrib = $self->$method($svc_x);
153 next unless keys %attrib;
154 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
155 $table, $self->export_username($svc_x), %attrib );
156 return $err_or_queue unless ref($err_or_queue);
158 my @groups = $svc_x->radius_groups('hashref');
160 cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
161 " (". $self->export_username($svc_x). " with ". join(", ", @groups)
163 my $usergroup = $self->option('usergroup') || 'usergroup';
164 my $err_or_queue = $self->sqlradius_queue(
165 $svc_x->svcnum, 'usergroup_insert',
166 $self->export_username($svc_x), $usergroup, @groups );
167 return $err_or_queue unless ref($err_or_queue);
172 sub _export_replace {
173 my( $self, $new, $old ) = (shift, shift, shift);
175 local $SIG{HUP} = 'IGNORE';
176 local $SIG{INT} = 'IGNORE';
177 local $SIG{QUIT} = 'IGNORE';
178 local $SIG{TERM} = 'IGNORE';
179 local $SIG{TSTP} = 'IGNORE';
180 local $SIG{PIPE} = 'IGNORE';
182 my $oldAutoCommit = $FS::UID::AutoCommit;
183 local $FS::UID::AutoCommit = 0;
187 if ( $self->export_username($old) ne $self->export_username($new) ) {
188 my $usergroup = $self->option('usergroup') || 'usergroup';
189 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
190 $self->export_username($new), $self->export_username($old), $usergroup );
191 unless ( ref($err_or_queue) ) {
192 $dbh->rollback if $oldAutoCommit;
193 return $err_or_queue;
195 $jobnum = $err_or_queue->jobnum;
198 foreach my $table (qw(reply check)) {
199 my $method = "radius_$table";
200 my %new = $self->$method($new);
201 my %old = $self->$method($old);
202 if ( grep { !exists $old{$_} #new attributes
203 || $new{$_} ne $old{$_} #changed
206 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
207 $table, $self->export_username($new), %new );
208 unless ( ref($err_or_queue) ) {
209 $dbh->rollback if $oldAutoCommit;
210 return $err_or_queue;
213 my $error = $err_or_queue->depend_insert( $jobnum );
215 $dbh->rollback if $oldAutoCommit;
219 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
222 my @del = grep { !exists $new{$_} } keys %old;
224 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
225 $table, $self->export_username($new), @del );
226 unless ( ref($err_or_queue) ) {
227 $dbh->rollback if $oldAutoCommit;
228 return $err_or_queue;
231 my $error = $err_or_queue->depend_insert( $jobnum );
233 $dbh->rollback if $oldAutoCommit;
237 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
242 my (@oldgroups) = $old->radius_groups('hashref');
243 my (@newgroups) = $new->radius_groups('hashref');
244 $error = $self->sqlreplace_usergroups( $new->svcnum,
245 $self->export_username($new),
246 $jobnum ? $jobnum : '',
251 $dbh->rollback if $oldAutoCommit;
255 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
260 #false laziness w/broadband_sqlradius.pm
261 sub _export_suspend {
262 my( $self, $svc_acct ) = (shift, shift);
264 my $new = $svc_acct->clone_suspended;
266 local $SIG{HUP} = 'IGNORE';
267 local $SIG{INT} = 'IGNORE';
268 local $SIG{QUIT} = 'IGNORE';
269 local $SIG{TERM} = 'IGNORE';
270 local $SIG{TSTP} = 'IGNORE';
271 local $SIG{PIPE} = 'IGNORE';
273 my $oldAutoCommit = $FS::UID::AutoCommit;
274 local $FS::UID::AutoCommit = 0;
277 my @newgroups = $self->suspended_usergroups($svc_acct);
279 unless (@newgroups) { #don't change password if assigning to a suspended group
281 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
282 'check', $self->export_username($new), $new->radius_check );
283 unless ( ref($err_or_queue) ) {
284 $dbh->rollback if $oldAutoCommit;
285 return $err_or_queue;
291 $self->sqlreplace_usergroups(
293 $self->export_username($new),
295 [ $svc_acct->radius_groups('hashref') ],
299 $dbh->rollback if $oldAutoCommit;
302 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
307 sub _export_unsuspend {
308 my( $self, $svc_x ) = (shift, shift);
310 local $SIG{HUP} = 'IGNORE';
311 local $SIG{INT} = 'IGNORE';
312 local $SIG{QUIT} = 'IGNORE';
313 local $SIG{TERM} = 'IGNORE';
314 local $SIG{TSTP} = 'IGNORE';
315 local $SIG{PIPE} = 'IGNORE';
317 my $oldAutoCommit = $FS::UID::AutoCommit;
318 local $FS::UID::AutoCommit = 0;
321 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
322 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
323 unless ( ref($err_or_queue) ) {
324 $dbh->rollback if $oldAutoCommit;
325 return $err_or_queue;
329 my (@oldgroups) = $self->suspended_usergroups($svc_x);
330 $error = $self->sqlreplace_usergroups(
332 $self->export_username($svc_x),
335 [ $svc_x->radius_groups('hashref') ],
338 $dbh->rollback if $oldAutoCommit;
341 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
347 my( $self, $svc_x ) = (shift, shift);
348 my $usergroup = $self->option('usergroup') || 'usergroup';
349 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
350 $self->export_username($svc_x), $usergroup );
351 ref($err_or_queue) ? '' : $err_or_queue;
354 sub sqlradius_queue {
355 my( $self, $svcnum, $method ) = (shift, shift, shift);
357 my $queue = new FS::queue {
359 'job' => "FS::part_export::sqlradius::sqlradius_$method",
362 $self->option('datasrc'),
363 $self->option('username'),
364 $self->option('password'),
369 sub suspended_usergroups {
370 my ($self, $svc_x) = (shift, shift);
372 return () unless $svc_x;
374 my $svc_table = $svc_x->table;
376 #false laziness with FS::part_export::shellcommands
377 #subclass part_export?
379 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
380 my %reasonmap = $self->_groups_susp_reason_map;
383 $userspec = $reasonmap{$r->reasonnum}
384 if exists($reasonmap{$r->reasonnum});
385 $userspec = $reasonmap{$r->reason}
386 if (!$userspec && exists($reasonmap{$r->reason}));
389 if ( $userspec =~ /^\d+$/ ){
390 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
391 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
392 my ($username,$domain) = split(/\@/, $userspec);
393 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
394 $suspend_svc = $user if $userspec eq $user->email;
396 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
397 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
400 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
404 sub sqlradius_insert { #subroutine, not method
405 my $dbh = sqlradius_connect(shift, shift, shift);
406 my( $table, $username, %attributes ) = @_;
408 foreach my $attribute ( keys %attributes ) {
410 my $s_sth = $dbh->prepare(
411 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
412 ) or die $dbh->errstr;
413 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
415 if ( $s_sth->fetchrow_arrayref->[0] ) {
417 my $u_sth = $dbh->prepare(
418 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
419 ) or die $dbh->errstr;
420 $u_sth->execute($attributes{$attribute}, $username, $attribute)
421 or die $u_sth->errstr;
425 my $i_sth = $dbh->prepare(
426 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
427 "VALUES ( ?, ?, ?, ? )"
428 ) or die $dbh->errstr;
432 ( $attribute eq 'Password' ? '==' : ':=' ),
433 $attributes{$attribute},
434 ) or die $i_sth->errstr;
442 sub sqlradius_usergroup_insert { #subroutine, not method
443 my $dbh = sqlradius_connect(shift, shift, shift);
444 my $username = shift;
445 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
448 my $s_sth = $dbh->prepare(
449 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
450 ) or die $dbh->errstr;
452 my $sth = $dbh->prepare(
453 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
454 ) or die $dbh->errstr;
456 foreach ( @groups ) {
457 my $group = $_->{'groupname'};
458 my $priority = $_->{'priority'};
459 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
460 if ($s_sth->fetchrow_arrayref->[0]) {
461 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
462 "$group for $username\n"
466 $sth->execute( $username, $group, $priority )
467 or die "can't insert into groupname table: ". $sth->errstr;
469 if ( $s_sth->{Active} ) {
470 warn "sqlradius s_sth still active; calling ->finish()";
473 if ( $sth->{Active} ) {
474 warn "sqlradius sth still active; calling ->finish()";
480 sub sqlradius_usergroup_delete { #subroutine, not method
481 my $dbh = sqlradius_connect(shift, shift, shift);
482 my $username = shift;
483 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
486 my $sth = $dbh->prepare(
487 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
488 ) or die $dbh->errstr;
489 foreach ( @groups ) {
490 my $group = $_->{'groupname'};
491 $sth->execute( $username, $group )
492 or die "can't delete from groupname table: ". $sth->errstr;
497 sub sqlradius_rename { #subroutine, not method
498 my $dbh = sqlradius_connect(shift, shift, shift);
499 my($new_username, $old_username) = (shift, shift);
500 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
501 foreach my $table (qw(radreply radcheck), $usergroup ) {
502 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
504 $sth->execute($new_username, $old_username)
505 or die "can't update $table: ". $sth->errstr;
510 sub sqlradius_attrib_delete { #subroutine, not method
511 my $dbh = sqlradius_connect(shift, shift, shift);
512 my( $table, $username, @attrib ) = @_;
514 foreach my $attribute ( @attrib ) {
515 my $sth = $dbh->prepare(
516 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
518 $sth->execute($username,$attribute)
519 or die "can't delete from rad$table table: ". $sth->errstr;
524 sub sqlradius_delete { #subroutine, not method
525 my $dbh = sqlradius_connect(shift, shift, shift);
526 my $username = shift;
527 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
529 foreach my $table (qw( radcheck radreply), $usergroup ) {
530 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
531 $sth->execute($username)
532 or die "can't delete from $table table: ". $sth->errstr;
537 sub sqlradius_connect {
538 #my($datasrc, $username, $password) = @_;
539 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
540 DBI->connect(@_) or die $DBI::errstr;
543 sub sqlreplace_usergroups {
544 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
546 # (sorta) false laziness with FS::svc_acct::replace
547 my @oldgroups = @$old;
548 my @newgroups = @$new;
550 foreach my $oldgroup ( @oldgroups ) {
551 if ( grep { $oldgroup eq $_ } @newgroups ) {
552 @newgroups = grep { $oldgroup ne $_ } @newgroups;
555 push @delgroups, $oldgroup;
558 my $usergroup = $self->option('usergroup') || 'usergroup';
561 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
562 $username, $usergroup, @delgroups );
564 unless ref($err_or_queue);
566 my $error = $err_or_queue->depend_insert( $jobnum );
567 return $error if $error;
569 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
573 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
574 "with ". join(", ", @newgroups)
576 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
577 $username, $usergroup, @newgroups );
579 unless ref($err_or_queue);
581 my $error = $err_or_queue->depend_insert( $jobnum );
582 return $error if $error;
591 =item usage_sessions HASHREF
593 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
595 New-style: pass a hashref with the following keys:
599 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
601 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
603 =item session_status - 'closed' to only show records with AcctStopTime,
604 'open' to only show records I<without> AcctStopTime, empty to show both.
606 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
608 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
620 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
621 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
624 SVC_ACCT, if specified, limits the results to the specified account.
626 IP, if specified, limits the results to the specified IP address.
628 PREFIX, if specified, limits the results to records with a matching
631 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
632 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
634 Returns an arrayref of hashrefs with the following fields:
640 =item framedipaddress
646 =item acctsessiontime
648 =item acctinputoctets
650 =item acctoutputoctets
652 =item callingstationid
654 =item calledstationid
660 #some false laziness w/cust_svc::seconds_since_sqlradacct
666 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
670 $start = $opt->{stoptime_start};
671 $end = $opt->{stoptime_end};
672 $svc_acct = $opt->{svc} || $opt->{svc_acct};
674 $prefix = $opt->{prefix};
675 $summarize = $opt->{summarize};
677 ( $start, $end ) = splice(@_, 0, 2);
678 $svc_acct = @_ ? shift : '';
679 $ip = @_ ? shift : '';
680 $prefix = @_ ? shift : '';
681 #my $select = @_ ? shift : '*';
686 return [] if $self->option('ignore_accounting');
688 my $dbh = sqlradius_connect( map $self->option($_),
689 qw( datasrc username password ) );
691 #select a unix time conversion function based on database type
692 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
693 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
696 qw( username realm framedipaddress
697 acctsessiontime acctinputoctets acctoutputoctets
698 callingstationid calledstationid
700 "$str2time acctstarttime $closing as acctstarttime",
701 "$str2time acctstoptime $closing as acctstoptime",
704 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
705 'sum(acctoutputoctets) as acctoutputoctets',
712 my $username = $self->export_username($svc_acct);
713 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
714 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
715 push @param, $username, $1, $2;
717 push @where, 'UserName = ?';
718 push @param, $username;
722 if ($self->option('process_single_realm')) {
723 push @where, 'Realm = ?';
724 push @param, $self->option('realm');
728 push @where, ' FramedIPAddress = ?';
732 if ( length($prefix) ) {
733 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
734 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
737 my $acctstoptime = '';
738 if ( $opt->{session_status} ne 'open' ) {
740 $acctstoptime .= "$str2time AcctStopTime $closing >= ?";
742 $acctstoptime .= ' AND ' if $end;
745 $acctstoptime .= "$str2time AcctStopTime $closing <= ?";
749 if ( $opt->{session_status} ne 'closed' ) {
750 if ( $acctstoptime ) {
751 $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )";
753 $acctstoptime = 'AcctStopTime IS NULL';
756 push @where, $acctstoptime;
758 if ( $opt->{starttime_start} ) {
759 push @where, "$str2time AcctStartTime $closing >= ?";
760 push @param, $opt->{starttime_start};
762 if ( $opt->{starttime_end} ) {
763 push @where, "$str2time AcctStartTime $closing <= ?";
764 push @param, $opt->{starttime_end};
767 my $where = join(' AND ', @where);
768 $where = "WHERE $where" if $where;
771 $groupby = 'GROUP BY username' if $summarize;
773 my $orderby = 'ORDER BY AcctStartTime DESC';
774 $orderby = '' if $summarize;
776 my $sql = 'SELECT '. join(', ', @fields).
777 " FROM radacct $where $groupby $orderby";
780 warn join(',', @param);
782 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
783 $sth->execute(@param) or die $sth->errstr;
785 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
796 my $conf = new FS::Conf;
799 my $dbh = sqlradius_connect( map $self->option($_),
800 qw( datasrc username password ) );
802 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
803 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
805 my @fields = qw( radacctid username realm acctsessiontime );
810 my $sth = $dbh->prepare("
811 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
812 $str2time AcctStartTime $closing, $str2time AcctStopTime $closing,
813 AcctInputOctets, AcctOutputOctets
815 WHERE FreesideStatus IS NULL
816 AND AcctStopTime IS NOT NULL
817 ") or die $dbh->errstr;
818 $sth->execute() or die $sth->errstr;
820 while ( my $row = $sth->fetchrow_arrayref ) {
821 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
822 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
823 warn "processing record: ".
824 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
827 my $fs_username = $UserName;
829 $fs_username = lc($fs_username) unless $conf->exists('username-uppercase');
831 #my %search = ( 'username' => $fs_username );
834 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
835 "(UserName $UserName, Realm $Realm)";
838 if ( ref($self) =~ /withdomain/ ) { #well, should be a callback to that
843 } elsif ( $fs_username =~ /\@/ ) {
844 ($fs_username, $domain) = split('@', $fs_username);
846 warn 'WARNING: nothing Realm column and no @realm in UserName column '.
847 "$errinfo -- skipping\n" if $DEBUG;
848 $status = 'skipped (no realm)';
851 $extra_sql = " AND '$domain' = ( SELECT domain FROM svc_domain
852 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
855 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
856 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
862 if ( $self->option('process_single_realm')
863 && $self->option('realm') ne $Realm )
865 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
868 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
869 'svcpart' => $_->cust_svc->svcpart,
874 { 'username' => $fs_username },
880 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
881 } elsif ( scalar(@svc_acct) > 1 ) {
882 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
885 my $svc_acct = $svc_acct[0];
886 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
888 $svc_acct->last_login($AcctStartTime);
889 $svc_acct->last_logout($AcctStopTime);
891 my $session_time = $AcctStopTime;
892 $session_time = $AcctStartTime
893 if $self->option('ignore_long_sessions');
895 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
896 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
897 || $cust_pkg->setup ) ) {
898 $status = 'skipped (too old)';
901 push @st, _try_decrement($svc_acct,'seconds', $AcctSessionTime);
902 push @st, _try_decrement($svc_acct,'upbytes', $AcctInputOctets);
903 push @st, _try_decrement($svc_acct,'downbytes', $AcctOutputOctets);
904 push @st, _try_decrement($svc_acct,'totalbytes', $AcctInputOctets
905 + $AcctOutputOctets);
906 $status=join(' ', @st);
913 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
914 my $psth = $dbh->prepare("UPDATE radacct
915 SET FreesideStatus = ?
917 ) or die $dbh->errstr;
918 $psth->execute($status, $RadAcctId) or die $psth->errstr;
920 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
927 my ($svc_acct, $column, $amount) = @_;
928 if ( $svc_acct->$column !~ /^$/ ) {
929 warn " svc_acct.$column found (". $svc_acct->$column.
932 my $method = 'decrement_' . $column;
933 my $error = $svc_acct->$method($amount);
934 die $error if $error;
937 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
942 =item export_nas_insert NAS
944 =item export_nas_delete NAS
946 =item export_nas_replace NEW_NAS OLD_NAS
948 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
949 server. Currently requires the table to be named 'nas' and to follow
950 the stock schema (/etc/freeradius/nas.sql).
954 sub export_nas_insert { shift->export_nas_action('insert', @_); }
955 sub export_nas_delete { shift->export_nas_action('delete', @_); }
956 sub export_nas_replace { shift->export_nas_action('replace', @_); }
958 sub export_nas_action {
960 my ($action, $new, $old) = @_;
961 # find the NAS in the target table by its name
962 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
963 my $nasnum = $new->nasnum;
965 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
969 return $err_or_queue unless ref $err_or_queue;
973 sub sqlradius_nas_insert {
974 my $dbh = sqlradius_connect(shift, shift, shift);
976 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
977 or die "nasnum ".$opt{'nasnum'}.' not found';
978 # insert actual NULLs where FS::Record has translated to empty strings
979 my @values = map { length($nas->$_) ? $nas->$_ : undef }
980 qw( nasname shortname type secret server community description );
981 my $sth = $dbh->prepare('INSERT INTO nas
982 (nasname, shortname, type, secret, server, community, description)
983 VALUES (?, ?, ?, ?, ?, ?, ?)');
984 $sth->execute(@values) or die $dbh->errstr;
987 sub sqlradius_nas_delete {
988 my $dbh = sqlradius_connect(shift, shift, shift);
990 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
991 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
994 sub sqlradius_nas_replace {
995 my $dbh = sqlradius_connect(shift, shift, shift);
997 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
998 or die "nasnum ".$opt{'nasnum'}.' not found';
999 my @values = map {$nas->$_}
1000 qw( nasname shortname type secret server community description );
1001 my $sth = $dbh->prepare('UPDATE nas SET
1002 nasname = ?, shortname = ?, type = ?, secret = ?,
1003 server = ?, community = ?, description = ?
1004 WHERE nasname = ?');
1005 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
1008 =item export_attr_insert RADIUS_ATTR
1010 =item export_attr_delete RADIUS_ATTR
1012 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
1014 Update the group attribute tables (radgroupcheck and radgroupreply) on
1015 the RADIUS server. In delete and replace actions, the existing records
1016 are identified by the combination of group name and attribute name.
1018 In the special case where attributes are being replaced because a group
1019 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
1020 'groupname' must be set in OLD_RADIUS_ATTR.
1024 # some false laziness with NAS export stuff...
1026 sub export_attr_insert { shift->export_attr_action('insert', @_); }
1028 sub export_attr_delete { shift->export_attr_action('delete', @_); }
1030 sub export_attr_replace { shift->export_attr_action('replace', @_); }
1032 sub export_attr_action {
1034 my ($action, $new, $old) = @_;
1037 if ( $action eq 'delete' ) {
1040 if ( $action eq 'delete' or $action eq 'replace' ) {
1041 # delete based on an exact match
1043 attrname => $old->attrname,
1044 attrtype => $old->attrtype,
1045 groupname => $old->groupname || $old->radius_group->groupname,
1047 value => $old->value,
1049 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1050 return $err_or_queue unless ref $err_or_queue;
1052 # this probably doesn't matter, but just to be safe...
1053 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1054 if ( $action eq 'replace' or $action eq 'insert' ) {
1056 attrname => $new->attrname,
1057 attrtype => $new->attrtype,
1058 groupname => $new->radius_group->groupname,
1060 value => $new->value,
1062 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1063 $err_or_queue->depend_insert($jobnum) if $jobnum;
1064 return $err_or_queue unless ref $err_or_queue;
1069 sub sqlradius_attr_insert {
1070 my $dbh = sqlradius_connect(shift, shift, shift);
1074 # make sure $table is completely safe
1075 if ( $opt{'attrtype'} eq 'C' ) {
1076 $table = 'radgroupcheck';
1078 elsif ( $opt{'attrtype'} eq 'R' ) {
1079 $table = 'radgroupreply';
1082 die "unknown attribute type '$opt{attrtype}'";
1085 my @values = @opt{ qw(groupname attrname op value) };
1086 my $sth = $dbh->prepare(
1087 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1089 $sth->execute(@values) or die $dbh->errstr;
1092 sub sqlradius_attr_delete {
1093 my $dbh = sqlradius_connect(shift, shift, shift);
1097 if ( $opt{'attrtype'} eq 'C' ) {
1098 $table = 'radgroupcheck';
1100 elsif ( $opt{'attrtype'} eq 'R' ) {
1101 $table = 'radgroupreply';
1104 die "unknown attribute type '".$opt{'attrtype'}."'";
1107 my @values = @opt{ qw(groupname attrname op value) };
1108 my $sth = $dbh->prepare(
1109 'DELETE FROM '.$table.
1110 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1113 $sth->execute(@values) or die $dbh->errstr;
1116 #sub sqlradius_attr_replace { no longer needed
1118 =item export_group_replace NEW OLD
1120 Replace the L<FS::radius_group> object OLD with NEW. This will change
1121 the group name and priority in all radusergroup records, and the group
1122 name in radgroupcheck and radgroupreply.
1126 sub export_group_replace {
1128 my ($new, $old) = @_;
1129 return '' if $new->groupname eq $old->groupname
1130 and $new->priority == $old->priority;
1132 my $err_or_queue = $self->sqlradius_queue(
1135 ($self->option('usergroup') || 'usergroup'),
1139 return $err_or_queue unless ref $err_or_queue;
1143 sub sqlradius_group_replace {
1144 my $dbh = sqlradius_connect(shift, shift, shift);
1145 my $usergroup = shift;
1146 $usergroup =~ /^(rad)?usergroup$/
1147 or die "bad usergroup table name: $usergroup";
1148 my ($new, $old) = (shift, shift);
1149 # apply renames to check/reply attribute tables
1150 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1151 foreach my $table (qw(radgroupcheck radgroupreply)) {
1152 my $sth = $dbh->prepare(
1153 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1155 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1156 or die $dbh->errstr;
1159 # apply renames and priority changes to usergroup table
1160 my $sth = $dbh->prepare(
1161 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1163 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1164 or die $dbh->errstr;
1168 # class method to fetch groups/attributes from the sqlradius install on upgrade
1171 sub _upgrade_exporttype {
1172 # do this only if the radius_attr table is empty
1173 local $FS::radius_attr::noexport_hack = 1;
1175 return if qsearch('radius_attr', {});
1177 foreach my $self ($class->all_sqlradius) {
1178 my $error = $self->import_attrs;
1179 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1186 my $dbh = DBI->connect( map $self->option($_),
1187 qw( datasrc username password ) );
1189 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1193 my $usergroup = $self->option('usergroup') || 'usergroup';
1195 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1198 # map out existing groups and attrs
1201 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1202 $attrs_of{$radius_group->groupname} = +{
1203 map { $_->attrname => $_ } $radius_group->radius_attr
1205 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1208 # get groupnames from radgroupcheck and radgroupreply
1210 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1212 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1213 my @fixes; # things that need to be changed on the radius db
1214 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1215 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1216 warn "$groupname.$attrname\n";
1217 if ( !exists($groupnum_of{$groupname}) ) {
1218 my $radius_group = new FS::radius_group {
1219 'groupname' => $groupname,
1222 $error = $radius_group->insert;
1224 warn "error inserting group $groupname: $error";
1225 next;#don't continue trying to insert the attribute
1227 $attrs_of{$groupname} = {};
1228 $groupnum_of{$groupname} = $radius_group->groupnum;
1231 my $a = $attrs_of{$groupname};
1232 my $old = $a->{$attrname};
1235 if ( $attrtype eq 'R' ) {
1236 # Freeradius tolerates illegal operators in reply attributes. We don't.
1237 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1238 warn "$groupname.$attrname: changing $op to +=\n";
1239 # Make a note to change it in the db
1241 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1242 $groupname, $attrname, $op, $value
1244 # and import it correctly.
1249 if ( defined $old ) {
1251 $new = new FS::radius_attr {
1256 $error = $new->replace($old);
1258 warn "error modifying attr $attrname: $error";
1263 $new = new FS::radius_attr {
1264 'groupnum' => $groupnum_of{$groupname},
1265 'attrname' => $attrname,
1266 'attrtype' => $attrtype,
1270 $error = $new->insert;
1272 warn "error inserting attr $attrname: $error" if $error;
1276 $attrs_of{$groupname}->{$attrname} = $new;
1280 my ($sql, @args) = @$_;
1281 my $sth = $dbh->prepare($sql);
1282 $sth->execute(@args) or warn $sth->errstr;
1295 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1296 # (radiator is supposed to be setup with a radacct table)
1297 #i suppose it would be more slick to look for things that inherit from us..
1299 my @part_export = ();
1300 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1301 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1302 broadband_sqlradius );
1306 sub all_sqlradius_withaccounting {
1308 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;