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 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} );
695 qw( username realm framedipaddress
696 acctsessiontime acctinputoctets acctoutputoctets
697 callingstationid calledstationid
699 "$str2time acctstarttime ) as acctstarttime",
700 "$str2time acctstoptime ) as acctstoptime",
703 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
704 'sum(acctoutputoctets) as acctoutputoctets',
711 my $username = $self->export_username($svc_acct);
712 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
713 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
714 push @param, $username, $1, $2;
716 push @where, 'UserName = ?';
717 push @param, $username;
721 if ($self->option('process_single_realm')) {
722 push @where, 'Realm = ?';
723 push @param, $self->option('realm');
727 push @where, ' FramedIPAddress = ?';
731 if ( length($prefix) ) {
732 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
733 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
736 my $acctstoptime = '';
737 if ( $opt->{session_status} ne 'open' ) {
739 $acctstoptime .= "$str2time AcctStopTime ) >= ?";
741 $acctstoptime .= ' AND ' if $end;
744 $acctstoptime .= "$str2time AcctStopTime ) <= ?";
748 if ( $opt->{session_status} ne 'closed' ) {
749 if ( $acctstoptime ) {
750 $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )";
752 $acctstoptime = 'AcctStopTime IS NULL';
755 push @where, $acctstoptime;
757 if ( $opt->{starttime_start} ) {
758 push @where, "$str2time AcctStartTime ) >= ?";
759 push @param, $opt->{starttime_start};
761 if ( $opt->{starttime_end} ) {
762 push @where, "$str2time AcctStartTime ) <= ?";
763 push @param, $opt->{starttime_end};
766 my $where = join(' AND ', @where);
767 $where = "WHERE $where" if $where;
770 $groupby = 'GROUP BY username' if $summarize;
772 my $orderby = 'ORDER BY AcctStartTime DESC';
773 $orderby = '' if $summarize;
775 my $sql = 'SELECT '. join(', ', @fields).
776 " FROM radacct $where $groupby $orderby";
779 warn join(',', @param);
781 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
782 $sth->execute(@param) or die $sth->errstr;
784 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
795 my $conf = new FS::Conf;
798 my $dbh = sqlradius_connect( map $self->option($_),
799 qw( datasrc username password ) );
801 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
802 my @fields = qw( radacctid username realm acctsessiontime );
807 my $sth = $dbh->prepare("
808 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
809 $str2time AcctStartTime), $str2time AcctStopTime),
810 AcctInputOctets, AcctOutputOctets
812 WHERE FreesideStatus IS NULL
813 AND AcctStopTime IS NOT NULL
814 ") or die $dbh->errstr;
815 $sth->execute() or die $sth->errstr;
817 while ( my $row = $sth->fetchrow_arrayref ) {
818 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
819 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
820 warn "processing record: ".
821 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
824 my $fs_username = $UserName;
826 $fs_username = lc($fs_username) unless $conf->exists('username-uppercase');
828 #my %search = ( 'username' => $fs_username );
831 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
832 "(UserName $UserName, Realm $Realm)";
835 if ( ref($self) =~ /withdomain/ ) { #well, should be a callback to that
840 } elsif ( $fs_username =~ /\@/ ) {
841 ($fs_username, $domain) = split('@', $fs_username);
843 warn 'WARNING: nothing Realm column and no @realm in UserName column '.
844 "$errinfo -- skipping\n" if $DEBUG;
845 $status = 'skipped (no realm)';
848 $extra_sql = " AND '$domain' = ( SELECT domain FROM svc_domain
849 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
852 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
853 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
859 if ( $self->option('process_single_realm')
860 && $self->option('realm') ne $Realm )
862 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
865 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
866 'svcpart' => $_->cust_svc->svcpart,
871 { 'username' => $fs_username },
877 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
878 } elsif ( scalar(@svc_acct) > 1 ) {
879 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
882 my $svc_acct = $svc_acct[0];
883 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
885 $svc_acct->last_login($AcctStartTime);
886 $svc_acct->last_logout($AcctStopTime);
888 my $session_time = $AcctStopTime;
889 $session_time = $AcctStartTime
890 if $self->option('ignore_long_sessions');
892 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
893 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
894 || $cust_pkg->setup ) ) {
895 $status = 'skipped (too old)';
898 push @st, _try_decrement($svc_acct,'seconds', $AcctSessionTime);
899 push @st, _try_decrement($svc_acct,'upbytes', $AcctInputOctets);
900 push @st, _try_decrement($svc_acct,'downbytes', $AcctOutputOctets);
901 push @st, _try_decrement($svc_acct,'totalbytes', $AcctInputOctets
902 + $AcctOutputOctets);
903 $status=join(' ', @st);
910 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
911 my $psth = $dbh->prepare("UPDATE radacct
912 SET FreesideStatus = ?
914 ) or die $dbh->errstr;
915 $psth->execute($status, $RadAcctId) or die $psth->errstr;
917 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
924 my ($svc_acct, $column, $amount) = @_;
925 if ( $svc_acct->$column !~ /^$/ ) {
926 warn " svc_acct.$column found (". $svc_acct->$column.
929 my $method = 'decrement_' . $column;
930 my $error = $svc_acct->$method($amount);
931 die $error if $error;
934 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
939 =item export_nas_insert NAS
941 =item export_nas_delete NAS
943 =item export_nas_replace NEW_NAS OLD_NAS
945 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
946 server. Currently requires the table to be named 'nas' and to follow
947 the stock schema (/etc/freeradius/nas.sql).
951 sub export_nas_insert { shift->export_nas_action('insert', @_); }
952 sub export_nas_delete { shift->export_nas_action('delete', @_); }
953 sub export_nas_replace { shift->export_nas_action('replace', @_); }
955 sub export_nas_action {
957 my ($action, $new, $old) = @_;
958 # find the NAS in the target table by its name
959 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
960 my $nasnum = $new->nasnum;
962 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
966 return $err_or_queue unless ref $err_or_queue;
970 sub sqlradius_nas_insert {
971 my $dbh = sqlradius_connect(shift, shift, shift);
973 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
974 or die "nasnum ".$opt{'nasnum'}.' not found';
975 # insert actual NULLs where FS::Record has translated to empty strings
976 my @values = map { length($nas->$_) ? $nas->$_ : undef }
977 qw( nasname shortname type secret server community description );
978 my $sth = $dbh->prepare('INSERT INTO nas
979 (nasname, shortname, type, secret, server, community, description)
980 VALUES (?, ?, ?, ?, ?, ?, ?)');
981 $sth->execute(@values) or die $dbh->errstr;
984 sub sqlradius_nas_delete {
985 my $dbh = sqlradius_connect(shift, shift, shift);
987 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
988 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
991 sub sqlradius_nas_replace {
992 my $dbh = sqlradius_connect(shift, shift, shift);
994 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
995 or die "nasnum ".$opt{'nasnum'}.' not found';
996 my @values = map {$nas->$_}
997 qw( nasname shortname type secret server community description );
998 my $sth = $dbh->prepare('UPDATE nas SET
999 nasname = ?, shortname = ?, type = ?, secret = ?,
1000 server = ?, community = ?, description = ?
1001 WHERE nasname = ?');
1002 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
1005 =item export_attr_insert RADIUS_ATTR
1007 =item export_attr_delete RADIUS_ATTR
1009 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
1011 Update the group attribute tables (radgroupcheck and radgroupreply) on
1012 the RADIUS server. In delete and replace actions, the existing records
1013 are identified by the combination of group name and attribute name.
1015 In the special case where attributes are being replaced because a group
1016 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
1017 'groupname' must be set in OLD_RADIUS_ATTR.
1021 # some false laziness with NAS export stuff...
1023 sub export_attr_insert { shift->export_attr_action('insert', @_); }
1025 sub export_attr_delete { shift->export_attr_action('delete', @_); }
1027 sub export_attr_replace { shift->export_attr_action('replace', @_); }
1029 sub export_attr_action {
1031 my ($action, $new, $old) = @_;
1034 if ( $action eq 'delete' ) {
1037 if ( $action eq 'delete' or $action eq 'replace' ) {
1038 # delete based on an exact match
1040 attrname => $old->attrname,
1041 attrtype => $old->attrtype,
1042 groupname => $old->groupname || $old->radius_group->groupname,
1044 value => $old->value,
1046 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1047 return $err_or_queue unless ref $err_or_queue;
1049 # this probably doesn't matter, but just to be safe...
1050 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1051 if ( $action eq 'replace' or $action eq 'insert' ) {
1053 attrname => $new->attrname,
1054 attrtype => $new->attrtype,
1055 groupname => $new->radius_group->groupname,
1057 value => $new->value,
1059 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1060 $err_or_queue->depend_insert($jobnum) if $jobnum;
1061 return $err_or_queue unless ref $err_or_queue;
1066 sub sqlradius_attr_insert {
1067 my $dbh = sqlradius_connect(shift, shift, shift);
1071 # make sure $table is completely safe
1072 if ( $opt{'attrtype'} eq 'C' ) {
1073 $table = 'radgroupcheck';
1075 elsif ( $opt{'attrtype'} eq 'R' ) {
1076 $table = 'radgroupreply';
1079 die "unknown attribute type '$opt{attrtype}'";
1082 my @values = @opt{ qw(groupname attrname op value) };
1083 my $sth = $dbh->prepare(
1084 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1086 $sth->execute(@values) or die $dbh->errstr;
1089 sub sqlradius_attr_delete {
1090 my $dbh = sqlradius_connect(shift, shift, shift);
1094 if ( $opt{'attrtype'} eq 'C' ) {
1095 $table = 'radgroupcheck';
1097 elsif ( $opt{'attrtype'} eq 'R' ) {
1098 $table = 'radgroupreply';
1101 die "unknown attribute type '".$opt{'attrtype'}."'";
1104 my @values = @opt{ qw(groupname attrname op value) };
1105 my $sth = $dbh->prepare(
1106 'DELETE FROM '.$table.
1107 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1110 $sth->execute(@values) or die $dbh->errstr;
1113 #sub sqlradius_attr_replace { no longer needed
1115 =item export_group_replace NEW OLD
1117 Replace the L<FS::radius_group> object OLD with NEW. This will change
1118 the group name and priority in all radusergroup records, and the group
1119 name in radgroupcheck and radgroupreply.
1123 sub export_group_replace {
1125 my ($new, $old) = @_;
1126 return '' if $new->groupname eq $old->groupname
1127 and $new->priority == $old->priority;
1129 my $err_or_queue = $self->sqlradius_queue(
1132 ($self->option('usergroup') || 'usergroup'),
1136 return $err_or_queue unless ref $err_or_queue;
1140 sub sqlradius_group_replace {
1141 my $dbh = sqlradius_connect(shift, shift, shift);
1142 my $usergroup = shift;
1143 $usergroup =~ /^(rad)?usergroup$/
1144 or die "bad usergroup table name: $usergroup";
1145 my ($new, $old) = (shift, shift);
1146 # apply renames to check/reply attribute tables
1147 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1148 foreach my $table (qw(radgroupcheck radgroupreply)) {
1149 my $sth = $dbh->prepare(
1150 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1152 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1153 or die $dbh->errstr;
1156 # apply renames and priority changes to usergroup table
1157 my $sth = $dbh->prepare(
1158 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1160 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1161 or die $dbh->errstr;
1165 # class method to fetch groups/attributes from the sqlradius install on upgrade
1168 sub _upgrade_exporttype {
1169 # do this only if the radius_attr table is empty
1170 local $FS::radius_attr::noexport_hack = 1;
1172 return if qsearch('radius_attr', {});
1174 foreach my $self ($class->all_sqlradius) {
1175 my $error = $self->import_attrs;
1176 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1183 my $dbh = DBI->connect( map $self->option($_),
1184 qw( datasrc username password ) );
1186 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1190 my $usergroup = $self->option('usergroup') || 'usergroup';
1192 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1195 # map out existing groups and attrs
1198 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1199 $attrs_of{$radius_group->groupname} = +{
1200 map { $_->attrname => $_ } $radius_group->radius_attr
1202 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1205 # get groupnames from radgroupcheck and radgroupreply
1207 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1209 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1210 my @fixes; # things that need to be changed on the radius db
1211 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1212 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1213 warn "$groupname.$attrname\n";
1214 if ( !exists($groupnum_of{$groupname}) ) {
1215 my $radius_group = new FS::radius_group {
1216 'groupname' => $groupname,
1219 $error = $radius_group->insert;
1221 warn "error inserting group $groupname: $error";
1222 next;#don't continue trying to insert the attribute
1224 $attrs_of{$groupname} = {};
1225 $groupnum_of{$groupname} = $radius_group->groupnum;
1228 my $a = $attrs_of{$groupname};
1229 my $old = $a->{$attrname};
1232 if ( $attrtype eq 'R' ) {
1233 # Freeradius tolerates illegal operators in reply attributes. We don't.
1234 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1235 warn "$groupname.$attrname: changing $op to +=\n";
1236 # Make a note to change it in the db
1238 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1239 $groupname, $attrname, $op, $value
1241 # and import it correctly.
1246 if ( defined $old ) {
1248 $new = new FS::radius_attr {
1253 $error = $new->replace($old);
1255 warn "error modifying attr $attrname: $error";
1260 $new = new FS::radius_attr {
1261 'groupnum' => $groupnum_of{$groupname},
1262 'attrname' => $attrname,
1263 'attrtype' => $attrtype,
1267 $error = $new->insert;
1269 warn "error inserting attr $attrname: $error" if $error;
1273 $attrs_of{$groupname}->{$attrname} = $new;
1277 my ($sql, @args) = @$_;
1278 my $sth = $dbh->prepare($sql);
1279 $sth->execute(@args) or warn $sth->errstr;
1292 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1293 # (radiator is supposed to be setup with a radacct table)
1294 #i suppose it would be more slick to look for things that inherit from us..
1296 my @part_export = ();
1297 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1298 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1299 broadband_sqlradius );
1303 sub all_sqlradius_withaccounting {
1305 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;