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 );
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 calledstationid
658 #some false laziness w/cust_svc::seconds_since_sqlradacct
664 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
668 $start = $opt->{stoptime_start};
669 $end = $opt->{stoptime_end};
670 $svc_acct = $opt->{svc} || $opt->{svc_acct};
672 $prefix = $opt->{prefix};
673 $summarize = $opt->{summarize};
675 ( $start, $end ) = splice(@_, 0, 2);
676 $svc_acct = @_ ? shift : '';
677 $ip = @_ ? shift : '';
678 $prefix = @_ ? shift : '';
679 #my $select = @_ ? shift : '*';
684 return [] if $self->option('ignore_accounting');
686 my $dbh = sqlradius_connect( map $self->option($_),
687 qw( datasrc username password ) );
689 #select a unix time conversion function based on database type
690 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
693 qw( username realm framedipaddress
694 acctsessiontime acctinputoctets acctoutputoctets
697 "$str2time acctstarttime ) as acctstarttime",
698 "$str2time acctstoptime ) as acctstoptime",
701 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
702 'sum(acctoutputoctets) as acctoutputoctets',
709 my $username = $self->export_username($svc_acct);
710 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
711 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
712 push @param, $username, $1, $2;
714 push @where, 'UserName = ?';
715 push @param, $username;
719 if ($self->option('process_single_realm')) {
720 push @where, 'Realm = ?';
721 push @param, $self->option('realm');
725 push @where, ' FramedIPAddress = ?';
729 if ( length($prefix) ) {
730 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
731 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
734 my $acctstoptime = '';
735 if ( $opt->{session_status} ne 'open' ) {
737 $acctstoptime .= "$str2time AcctStopTime ) >= ?";
739 $acctstoptime .= ' AND ' if $end;
742 $acctstoptime .= "$str2time AcctStopTime ) <= ?";
746 if ( $opt->{session_status} ne 'closed' ) {
747 if ( $acctstoptime ) {
748 $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )";
750 $acctstoptime = 'AcctStopTime IS NULL';
753 push @where, $acctstoptime;
755 if ( $opt->{starttime_start} ) {
756 push @where, "$str2time AcctStartTime ) >= ?";
757 push @param, $opt->{starttime_start};
759 if ( $opt->{starttime_end} ) {
760 push @where, "$str2time AcctStartTime ) <= ?";
761 push @param, $opt->{starttime_end};
764 my $where = join(' AND ', @where);
765 $where = "WHERE $where" if $where;
768 $groupby = 'GROUP BY username' if $summarize;
770 my $orderby = 'ORDER BY AcctStartTime DESC';
771 $orderby = '' if $summarize;
773 my $sql = 'SELECT '. join(', ', @fields).
774 " FROM radacct $where $groupby $orderby";
777 warn join(',', @param);
779 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
780 $sth->execute(@param) or die $sth->errstr;
782 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
793 my $conf = new FS::Conf;
796 my $dbh = sqlradius_connect( map $self->option($_),
797 qw( datasrc username password ) );
799 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
800 my @fields = qw( radacctid username realm acctsessiontime );
805 my $sth = $dbh->prepare("
806 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
807 $str2time AcctStartTime), $str2time AcctStopTime),
808 AcctInputOctets, AcctOutputOctets
810 WHERE FreesideStatus IS NULL
811 AND AcctStopTime IS NOT NULL
812 ") or die $dbh->errstr;
813 $sth->execute() or die $sth->errstr;
815 while ( my $row = $sth->fetchrow_arrayref ) {
816 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
817 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
818 warn "processing record: ".
819 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
822 my $fs_username = $UserName;
824 $fs_username = lc($fs_username) unless $conf->exists('username-uppercase');
826 #my %search = ( 'username' => $fs_username );
829 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
830 "(UserName $UserName, Realm $Realm)";
833 if ( ref($self) =~ /withdomain/ ) { #well, should be a callback to that
838 } elsif ( $fs_username =~ /\@/ ) {
839 ($fs_username, $domain) = split('@', $fs_username);
841 warn 'WARNING: nothing Realm column and no @realm in UserName column '.
842 "$errinfo -- skipping\n" if $DEBUG;
843 $status = 'skipped (no realm)';
846 $extra_sql = " AND '$domain' = ( SELECT domain FROM svc_domain
847 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
850 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
851 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
857 if ( $self->option('process_single_realm')
858 && $self->option('realm') ne $Realm )
860 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
863 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
864 'svcpart' => $_->cust_svc->svcpart,
869 { 'username' => $fs_username },
875 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
876 } elsif ( scalar(@svc_acct) > 1 ) {
877 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
880 my $svc_acct = $svc_acct[0];
881 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
883 $svc_acct->last_login($AcctStartTime);
884 $svc_acct->last_logout($AcctStopTime);
886 my $session_time = $AcctStopTime;
887 $session_time = $AcctStartTime
888 if $self->option('ignore_long_sessions');
890 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
891 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
892 || $cust_pkg->setup ) ) {
893 $status = 'skipped (too old)';
896 push @st, _try_decrement($svc_acct,'seconds', $AcctSessionTime);
897 push @st, _try_decrement($svc_acct,'upbytes', $AcctInputOctets);
898 push @st, _try_decrement($svc_acct,'downbytes', $AcctOutputOctets);
899 push @st, _try_decrement($svc_acct,'totalbytes', $AcctInputOctets
900 + $AcctOutputOctets);
901 $status=join(' ', @st);
908 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
909 my $psth = $dbh->prepare("UPDATE radacct
910 SET FreesideStatus = ?
912 ) or die $dbh->errstr;
913 $psth->execute($status, $RadAcctId) or die $psth->errstr;
915 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
922 my ($svc_acct, $column, $amount) = @_;
923 if ( $svc_acct->$column !~ /^$/ ) {
924 warn " svc_acct.$column found (". $svc_acct->$column.
927 my $method = 'decrement_' . $column;
928 my $error = $svc_acct->$method($amount);
929 die $error if $error;
932 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
937 =item export_nas_insert NAS
939 =item export_nas_delete NAS
941 =item export_nas_replace NEW_NAS OLD_NAS
943 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
944 server. Currently requires the table to be named 'nas' and to follow
945 the stock schema (/etc/freeradius/nas.sql).
949 sub export_nas_insert { shift->export_nas_action('insert', @_); }
950 sub export_nas_delete { shift->export_nas_action('delete', @_); }
951 sub export_nas_replace { shift->export_nas_action('replace', @_); }
953 sub export_nas_action {
955 my ($action, $new, $old) = @_;
956 # find the NAS in the target table by its name
957 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
958 my $nasnum = $new->nasnum;
960 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
964 return $err_or_queue unless ref $err_or_queue;
968 sub sqlradius_nas_insert {
969 my $dbh = sqlradius_connect(shift, shift, shift);
971 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
972 or die "nasnum ".$opt{'nasnum'}.' not found';
973 # insert actual NULLs where FS::Record has translated to empty strings
974 my @values = map { length($nas->$_) ? $nas->$_ : undef }
975 qw( nasname shortname type secret server community description );
976 my $sth = $dbh->prepare('INSERT INTO nas
977 (nasname, shortname, type, secret, server, community, description)
978 VALUES (?, ?, ?, ?, ?, ?, ?)');
979 $sth->execute(@values) or die $dbh->errstr;
982 sub sqlradius_nas_delete {
983 my $dbh = sqlradius_connect(shift, shift, shift);
985 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
986 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
989 sub sqlradius_nas_replace {
990 my $dbh = sqlradius_connect(shift, shift, shift);
992 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
993 or die "nasnum ".$opt{'nasnum'}.' not found';
994 my @values = map {$nas->$_}
995 qw( nasname shortname type secret server community description );
996 my $sth = $dbh->prepare('UPDATE nas SET
997 nasname = ?, shortname = ?, type = ?, secret = ?,
998 server = ?, community = ?, description = ?
1000 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
1003 =item export_attr_insert RADIUS_ATTR
1005 =item export_attr_delete RADIUS_ATTR
1007 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
1009 Update the group attribute tables (radgroupcheck and radgroupreply) on
1010 the RADIUS server. In delete and replace actions, the existing records
1011 are identified by the combination of group name and attribute name.
1013 In the special case where attributes are being replaced because a group
1014 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
1015 'groupname' must be set in OLD_RADIUS_ATTR.
1019 # some false laziness with NAS export stuff...
1021 sub export_attr_insert { shift->export_attr_action('insert', @_); }
1023 sub export_attr_delete { shift->export_attr_action('delete', @_); }
1025 sub export_attr_replace { shift->export_attr_action('replace', @_); }
1027 sub export_attr_action {
1029 my ($action, $new, $old) = @_;
1032 if ( $action eq 'delete' ) {
1035 if ( $action eq 'delete' or $action eq 'replace' ) {
1036 # delete based on an exact match
1038 attrname => $old->attrname,
1039 attrtype => $old->attrtype,
1040 groupname => $old->groupname || $old->radius_group->groupname,
1042 value => $old->value,
1044 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1045 return $err_or_queue unless ref $err_or_queue;
1047 # this probably doesn't matter, but just to be safe...
1048 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1049 if ( $action eq 'replace' or $action eq 'insert' ) {
1051 attrname => $new->attrname,
1052 attrtype => $new->attrtype,
1053 groupname => $new->radius_group->groupname,
1055 value => $new->value,
1057 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1058 $err_or_queue->depend_insert($jobnum) if $jobnum;
1059 return $err_or_queue unless ref $err_or_queue;
1064 sub sqlradius_attr_insert {
1065 my $dbh = sqlradius_connect(shift, shift, shift);
1069 # make sure $table is completely safe
1070 if ( $opt{'attrtype'} eq 'C' ) {
1071 $table = 'radgroupcheck';
1073 elsif ( $opt{'attrtype'} eq 'R' ) {
1074 $table = 'radgroupreply';
1077 die "unknown attribute type '$opt{attrtype}'";
1080 my @values = @opt{ qw(groupname attrname op value) };
1081 my $sth = $dbh->prepare(
1082 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1084 $sth->execute(@values) or die $dbh->errstr;
1087 sub sqlradius_attr_delete {
1088 my $dbh = sqlradius_connect(shift, shift, shift);
1092 if ( $opt{'attrtype'} eq 'C' ) {
1093 $table = 'radgroupcheck';
1095 elsif ( $opt{'attrtype'} eq 'R' ) {
1096 $table = 'radgroupreply';
1099 die "unknown attribute type '".$opt{'attrtype'}."'";
1102 my @values = @opt{ qw(groupname attrname op value) };
1103 my $sth = $dbh->prepare(
1104 'DELETE FROM '.$table.
1105 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1108 $sth->execute(@values) or die $dbh->errstr;
1111 #sub sqlradius_attr_replace { no longer needed
1113 =item export_group_replace NEW OLD
1115 Replace the L<FS::radius_group> object OLD with NEW. This will change
1116 the group name and priority in all radusergroup records, and the group
1117 name in radgroupcheck and radgroupreply.
1121 sub export_group_replace {
1123 my ($new, $old) = @_;
1124 return '' if $new->groupname eq $old->groupname
1125 and $new->priority == $old->priority;
1127 my $err_or_queue = $self->sqlradius_queue(
1130 ($self->option('usergroup') || 'usergroup'),
1134 return $err_or_queue unless ref $err_or_queue;
1138 sub sqlradius_group_replace {
1139 my $dbh = sqlradius_connect(shift, shift, shift);
1140 my $usergroup = shift;
1141 $usergroup =~ /^(rad)?usergroup$/
1142 or die "bad usergroup table name: $usergroup";
1143 my ($new, $old) = (shift, shift);
1144 # apply renames to check/reply attribute tables
1145 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1146 foreach my $table (qw(radgroupcheck radgroupreply)) {
1147 my $sth = $dbh->prepare(
1148 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1150 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1151 or die $dbh->errstr;
1154 # apply renames and priority changes to usergroup table
1155 my $sth = $dbh->prepare(
1156 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1158 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1159 or die $dbh->errstr;
1163 # class method to fetch groups/attributes from the sqlradius install on upgrade
1166 sub _upgrade_exporttype {
1167 # do this only if the radius_attr table is empty
1168 local $FS::radius_attr::noexport_hack = 1;
1170 return if qsearch('radius_attr', {});
1172 foreach my $self ($class->all_sqlradius) {
1173 my $error = $self->import_attrs;
1174 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1181 my $dbh = DBI->connect( map $self->option($_),
1182 qw( datasrc username password ) );
1184 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1188 my $usergroup = $self->option('usergroup') || 'usergroup';
1190 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1193 # map out existing groups and attrs
1196 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1197 $attrs_of{$radius_group->groupname} = +{
1198 map { $_->attrname => $_ } $radius_group->radius_attr
1200 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1203 # get groupnames from radgroupcheck and radgroupreply
1205 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1207 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1208 my @fixes; # things that need to be changed on the radius db
1209 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1210 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1211 warn "$groupname.$attrname\n";
1212 if ( !exists($groupnum_of{$groupname}) ) {
1213 my $radius_group = new FS::radius_group {
1214 'groupname' => $groupname,
1217 $error = $radius_group->insert;
1219 warn "error inserting group $groupname: $error";
1220 next;#don't continue trying to insert the attribute
1222 $attrs_of{$groupname} = {};
1223 $groupnum_of{$groupname} = $radius_group->groupnum;
1226 my $a = $attrs_of{$groupname};
1227 my $old = $a->{$attrname};
1230 if ( $attrtype eq 'R' ) {
1231 # Freeradius tolerates illegal operators in reply attributes. We don't.
1232 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1233 warn "$groupname.$attrname: changing $op to +=\n";
1234 # Make a note to change it in the db
1236 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1237 $groupname, $attrname, $op, $value
1239 # and import it correctly.
1244 if ( defined $old ) {
1246 $new = new FS::radius_attr {
1251 $error = $new->replace($old);
1253 warn "error modifying attr $attrname: $error";
1258 $new = new FS::radius_attr {
1259 'groupnum' => $groupnum_of{$groupname},
1260 'attrname' => $attrname,
1261 'attrtype' => $attrtype,
1265 $error = $new->insert;
1267 warn "error inserting attr $attrname: $error" if $error;
1271 $attrs_of{$groupname}->{$attrname} = $new;
1275 my ($sql, @args) = @$_;
1276 my $sth = $dbh->prepare($sql);
1277 $sth->execute(@args) or warn $sth->errstr;
1290 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1291 # (radiator is supposed to be setup with a radacct table)
1292 #i suppose it would be more slick to look for things that inherit from us..
1294 my @part_export = ();
1295 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1296 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1297 broadband_sqlradius );
1301 sub all_sqlradius_withaccounting {
1303 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;