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 );
13 @ISA = qw(FS::part_export);
14 @EXPORT_OK = qw( sqlradius_connect );
19 tie %options, 'Tie::IxHash',
20 'datasrc' => { label=>'DBI data source ' },
21 'username' => { label=>'Database username' },
22 'password' => { label=>'Database password' },
23 'usergroup' => { label => 'Group table',
25 options => [qw( usergroup radusergroup ) ],
27 'ignore_accounting' => {
29 label => 'Ignore accounting records from this database'
31 'process_single_realm' => {
33 label => 'Only process one realm of accounting records',
35 'realm' => { label => 'The realm of of accounting records to be processed' },
36 'ignore_long_sessions' => {
38 label => 'Ignore sessions which span billing periods',
42 label => 'Hide IP address information on session reports',
46 label => 'Hide download/upload information on session reports',
48 'show_called_station' => {
50 label => 'Show the Called-Station-ID on session reports',
52 'overlimit_groups' => {
53 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)',
59 option_values => sub {
61 map { $_->groupnum, $_->long_description }
62 qsearch('radius_group', {}),
67 'groups_susp_reason' => { label =>
68 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
73 label => 'Export RADIUS group attributes to this database',
78 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
79 tables to any SQL database for
80 <a href="http://www.freeradius.org/">FreeRADIUS</a>
81 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
85 An existing RADIUS database will be updated in realtime, but you can use
86 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
87 to delete the entire RADIUS database and repopulate the tables from the
88 Freeside database. See the
89 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
91 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
92 for the exact syntax of a DBI data source.
94 <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.
95 <li>Using ICRADIUS, add a dummy "op" column to your database:
97 ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
98 ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
99 ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
100 ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
102 <li>Using Radiator, see the
103 <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
104 for configuration information.
110 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
111 'options' => \%options,
114 'nas' => 'Y', # show export_nas selection in UI
115 'default_svc_class' => 'Internet',
117 'This export does not export RADIUS realms (see also '.
118 'sqlradius_withdomain). '.
122 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
123 split( "\n", shift->option('groups_susp_reason'));
126 sub rebless { shift; }
128 sub export_username { # override for other svcdb
129 my($self, $svc_acct) = (shift, shift);
130 warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
134 sub radius_reply { #override for other svcdb
135 my($self, $svc_acct) = (shift, shift);
136 $svc_acct->radius_reply;
139 sub radius_check { #override for other svcdb
140 my($self, $svc_acct) = (shift, shift);
141 $svc_acct->radius_check;
145 my($self, $svc_x) = (shift, shift);
147 foreach my $table (qw(reply check)) {
148 my $method = "radius_$table";
149 my %attrib = $self->$method($svc_x);
150 next unless keys %attrib;
151 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
152 $table, $self->export_username($svc_x), %attrib );
153 return $err_or_queue unless ref($err_or_queue);
155 my @groups = $svc_x->radius_groups('hashref');
157 cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
158 " (". $self->export_username($svc_x). " with ". join(", ", @groups)
160 my $usergroup = $self->option('usergroup') || 'usergroup';
161 my $err_or_queue = $self->sqlradius_queue(
162 $svc_x->svcnum, 'usergroup_insert',
163 $self->export_username($svc_x), $usergroup, @groups );
164 return $err_or_queue unless ref($err_or_queue);
169 sub _export_replace {
170 my( $self, $new, $old ) = (shift, shift, shift);
172 local $SIG{HUP} = 'IGNORE';
173 local $SIG{INT} = 'IGNORE';
174 local $SIG{QUIT} = 'IGNORE';
175 local $SIG{TERM} = 'IGNORE';
176 local $SIG{TSTP} = 'IGNORE';
177 local $SIG{PIPE} = 'IGNORE';
179 my $oldAutoCommit = $FS::UID::AutoCommit;
180 local $FS::UID::AutoCommit = 0;
184 if ( $self->export_username($old) ne $self->export_username($new) ) {
185 my $usergroup = $self->option('usergroup') || 'usergroup';
186 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
187 $self->export_username($new), $self->export_username($old), $usergroup );
188 unless ( ref($err_or_queue) ) {
189 $dbh->rollback if $oldAutoCommit;
190 return $err_or_queue;
192 $jobnum = $err_or_queue->jobnum;
195 foreach my $table (qw(reply check)) {
196 my $method = "radius_$table";
197 my %new = $new->$method();
198 my %old = $old->$method();
199 if ( grep { !exists $old{$_} #new attributes
200 || $new{$_} ne $old{$_} #changed
203 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
204 $table, $self->export_username($new), %new );
205 unless ( ref($err_or_queue) ) {
206 $dbh->rollback if $oldAutoCommit;
207 return $err_or_queue;
210 my $error = $err_or_queue->depend_insert( $jobnum );
212 $dbh->rollback if $oldAutoCommit;
218 my @del = grep { !exists $new{$_} } keys %old;
220 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
221 $table, $self->export_username($new), @del );
222 unless ( ref($err_or_queue) ) {
223 $dbh->rollback if $oldAutoCommit;
224 return $err_or_queue;
227 my $error = $err_or_queue->depend_insert( $jobnum );
229 $dbh->rollback if $oldAutoCommit;
237 my (@oldgroups) = $old->radius_groups('hashref');
238 my (@newgroups) = $new->radius_groups('hashref');
239 $error = $self->sqlreplace_usergroups( $new->svcnum,
240 $self->export_username($new),
241 $jobnum ? $jobnum : '',
246 $dbh->rollback if $oldAutoCommit;
250 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
255 #false laziness w/broadband_sqlradius.pm
256 sub _export_suspend {
257 my( $self, $svc_acct ) = (shift, shift);
259 my $new = $svc_acct->clone_suspended;
261 local $SIG{HUP} = 'IGNORE';
262 local $SIG{INT} = 'IGNORE';
263 local $SIG{QUIT} = 'IGNORE';
264 local $SIG{TERM} = 'IGNORE';
265 local $SIG{TSTP} = 'IGNORE';
266 local $SIG{PIPE} = 'IGNORE';
268 my $oldAutoCommit = $FS::UID::AutoCommit;
269 local $FS::UID::AutoCommit = 0;
272 my @newgroups = $self->suspended_usergroups($svc_acct);
274 unless (@newgroups) { #don't change password if assigning to a suspended group
276 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
277 'check', $self->export_username($new), $new->radius_check );
278 unless ( ref($err_or_queue) ) {
279 $dbh->rollback if $oldAutoCommit;
280 return $err_or_queue;
286 $self->sqlreplace_usergroups(
288 $self->export_username($new),
290 [ $svc_acct->radius_groups('hashref') ],
294 $dbh->rollback if $oldAutoCommit;
297 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
302 sub _export_unsuspend {
303 my( $self, $svc_x ) = (shift, shift);
305 local $SIG{HUP} = 'IGNORE';
306 local $SIG{INT} = 'IGNORE';
307 local $SIG{QUIT} = 'IGNORE';
308 local $SIG{TERM} = 'IGNORE';
309 local $SIG{TSTP} = 'IGNORE';
310 local $SIG{PIPE} = 'IGNORE';
312 my $oldAutoCommit = $FS::UID::AutoCommit;
313 local $FS::UID::AutoCommit = 0;
316 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
317 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
318 unless ( ref($err_or_queue) ) {
319 $dbh->rollback if $oldAutoCommit;
320 return $err_or_queue;
324 my (@oldgroups) = $self->suspended_usergroups($svc_x);
325 $error = $self->sqlreplace_usergroups(
327 $self->export_username($svc_x),
330 [ $svc_x->radius_groups('hashref') ],
333 $dbh->rollback if $oldAutoCommit;
336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
342 my( $self, $svc_x ) = (shift, shift);
343 my $usergroup = $self->option('usergroup') || 'usergroup';
344 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
345 $self->export_username($svc_x), $usergroup );
346 ref($err_or_queue) ? '' : $err_or_queue;
349 sub sqlradius_queue {
350 my( $self, $svcnum, $method ) = (shift, shift, shift);
352 my $queue = new FS::queue {
354 'job' => "FS::part_export::sqlradius::sqlradius_$method",
357 $self->option('datasrc'),
358 $self->option('username'),
359 $self->option('password'),
364 sub suspended_usergroups {
365 my ($self, $svc_x) = (shift, shift);
367 return () unless $svc_x;
369 my $svc_table = $svc_x->table;
371 #false laziness with FS::part_export::shellcommands
372 #subclass part_export?
374 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
375 my %reasonmap = $self->_groups_susp_reason_map;
378 $userspec = $reasonmap{$r->reasonnum}
379 if exists($reasonmap{$r->reasonnum});
380 $userspec = $reasonmap{$r->reason}
381 if (!$userspec && exists($reasonmap{$r->reason}));
384 if ( $userspec =~ /^\d+$/ ){
385 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
386 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
387 my ($username,$domain) = split(/\@/, $userspec);
388 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
389 $suspend_svc = $user if $userspec eq $user->email;
391 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
392 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
395 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
399 sub sqlradius_insert { #subroutine, not method
400 my $dbh = sqlradius_connect(shift, shift, shift);
401 my( $table, $username, %attributes ) = @_;
403 foreach my $attribute ( keys %attributes ) {
405 my $s_sth = $dbh->prepare(
406 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
407 ) or die $dbh->errstr;
408 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
410 if ( $s_sth->fetchrow_arrayref->[0] ) {
412 my $u_sth = $dbh->prepare(
413 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
414 ) or die $dbh->errstr;
415 $u_sth->execute($attributes{$attribute}, $username, $attribute)
416 or die $u_sth->errstr;
420 my $i_sth = $dbh->prepare(
421 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
422 "VALUES ( ?, ?, ?, ? )"
423 ) or die $dbh->errstr;
427 ( $attribute eq 'Password' ? '==' : ':=' ),
428 $attributes{$attribute},
429 ) or die $i_sth->errstr;
437 sub sqlradius_usergroup_insert { #subroutine, not method
438 my $dbh = sqlradius_connect(shift, shift, shift);
439 my $username = shift;
440 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
443 my $s_sth = $dbh->prepare(
444 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
445 ) or die $dbh->errstr;
447 my $sth = $dbh->prepare(
448 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
449 ) or die $dbh->errstr;
451 foreach ( @groups ) {
452 my $group = $_->{'groupname'};
453 my $priority = $_->{'priority'};
454 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
455 if ($s_sth->fetchrow_arrayref->[0]) {
456 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
457 "$group for $username\n"
461 $sth->execute( $username, $group, $priority )
462 or die "can't insert into groupname table: ". $sth->errstr;
464 if ( $s_sth->{Active} ) {
465 warn "sqlradius s_sth still active; calling ->finish()";
468 if ( $sth->{Active} ) {
469 warn "sqlradius sth still active; calling ->finish()";
475 sub sqlradius_usergroup_delete { #subroutine, not method
476 my $dbh = sqlradius_connect(shift, shift, shift);
477 my $username = shift;
478 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
481 my $sth = $dbh->prepare(
482 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
483 ) or die $dbh->errstr;
484 foreach ( @groups ) {
485 my $group = $_->{'groupname'};
486 $sth->execute( $username, $group )
487 or die "can't delete from groupname table: ". $sth->errstr;
492 sub sqlradius_rename { #subroutine, not method
493 my $dbh = sqlradius_connect(shift, shift, shift);
494 my($new_username, $old_username) = (shift, shift);
495 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
496 foreach my $table (qw(radreply radcheck), $usergroup ) {
497 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
499 $sth->execute($new_username, $old_username)
500 or die "can't update $table: ". $sth->errstr;
505 sub sqlradius_attrib_delete { #subroutine, not method
506 my $dbh = sqlradius_connect(shift, shift, shift);
507 my( $table, $username, @attrib ) = @_;
509 foreach my $attribute ( @attrib ) {
510 my $sth = $dbh->prepare(
511 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
513 $sth->execute($username,$attribute)
514 or die "can't delete from rad$table table: ". $sth->errstr;
519 sub sqlradius_delete { #subroutine, not method
520 my $dbh = sqlradius_connect(shift, shift, shift);
521 my $username = shift;
522 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
524 foreach my $table (qw( radcheck radreply), $usergroup ) {
525 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
526 $sth->execute($username)
527 or die "can't delete from $table table: ". $sth->errstr;
532 sub sqlradius_connect {
533 #my($datasrc, $username, $password) = @_;
534 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
535 DBI->connect(@_) or die $DBI::errstr;
538 sub sqlreplace_usergroups {
539 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
541 # (sorta) false laziness with FS::svc_acct::replace
542 my @oldgroups = @$old;
543 my @newgroups = @$new;
545 foreach my $oldgroup ( @oldgroups ) {
546 if ( grep { $oldgroup eq $_ } @newgroups ) {
547 @newgroups = grep { $oldgroup ne $_ } @newgroups;
550 push @delgroups, $oldgroup;
553 my $usergroup = $self->option('usergroup') || 'usergroup';
556 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
557 $username, $usergroup, @delgroups );
559 unless ref($err_or_queue);
561 my $error = $err_or_queue->depend_insert( $jobnum );
562 return $error if $error;
567 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
568 "with ". join(", ", @newgroups)
570 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
571 $username, $usergroup, @newgroups );
573 unless ref($err_or_queue);
575 my $error = $err_or_queue->depend_insert( $jobnum );
576 return $error if $error;
585 =item usage_sessions HASHREF
587 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
589 New-style: pass a hashref with the following keys:
593 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
595 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
597 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
599 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
601 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
613 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
614 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
617 SVC_ACCT, if specified, limits the results to the specified account.
619 IP, if specified, limits the results to the specified IP address.
621 PREFIX, if specified, limits the results to records with a matching
624 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
625 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
627 Returns an arrayref of hashrefs with the following fields:
633 =item framedipaddress
639 =item acctsessiontime
641 =item acctinputoctets
643 =item acctoutputoctets
645 =item calledstationid
651 #some false laziness w/cust_svc::seconds_since_sqlradacct
657 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
661 $start = $opt->{stoptime_start};
662 $end = $opt->{stoptime_end};
663 $svc_acct = $opt->{svc_acct};
665 $prefix = $opt->{prefix};
666 $summarize = $opt->{summarize};
668 ( $start, $end ) = splice(@_, 0, 2);
669 $svc_acct = @_ ? shift : '';
670 $ip = @_ ? shift : '';
671 $prefix = @_ ? shift : '';
672 #my $select = @_ ? shift : '*';
677 return [] if $self->option('ignore_accounting');
679 my $dbh = sqlradius_connect( map $self->option($_),
680 qw( datasrc username password ) );
682 #select a unix time conversion function based on database type
683 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
686 qw( username realm framedipaddress
687 acctsessiontime acctinputoctets acctoutputoctets
690 "$str2time acctstarttime ) as acctstarttime",
691 "$str2time acctstoptime ) as acctstoptime",
694 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
695 'sum(acctoutputoctets) as acctoutputoctets',
702 my $username = $self->export_username($svc_acct);
703 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
704 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
705 push @param, $username, $1, $2;
707 push @where, 'UserName = ?';
708 push @param, $username;
712 if ($self->option('process_single_realm')) {
713 push @where, 'Realm = ?';
714 push @param, $self->option('realm');
718 push @where, ' FramedIPAddress = ?';
722 if ( length($prefix) ) {
723 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
724 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
728 push @where, "$str2time AcctStopTime ) >= ?";
732 push @where, "$str2time AcctStopTime ) <= ?";
735 if ( $opt->{open_sessions} ) {
736 push @where, 'AcctStopTime IS NULL';
738 if ( $opt->{starttime_start} ) {
739 push @where, "$str2time AcctStartTime ) >= ?";
740 push @param, $opt->{starttime_start};
742 if ( $opt->{starttime_end} ) {
743 push @where, "$str2time AcctStartTime ) <= ?";
744 push @param, $opt->{starttime_end};
747 my $where = join(' AND ', @where);
748 $where = "WHERE $where" if $where;
751 $groupby = 'GROUP BY username' if $summarize;
753 my $orderby = 'ORDER BY AcctStartTime DESC';
754 $orderby = '' if $summarize;
756 my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
757 " FROM radacct $where $groupby $orderby
758 ") or die $dbh->errstr;
759 $sth->execute(@param) or die $sth->errstr;
761 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
772 my $conf = new FS::Conf;
775 my $dbh = sqlradius_connect( map $self->option($_),
776 qw( datasrc username password ) );
778 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
779 my @fields = qw( radacctid username realm acctsessiontime );
784 my $sth = $dbh->prepare("
785 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
786 $str2time AcctStartTime), $str2time AcctStopTime),
787 AcctInputOctets, AcctOutputOctets
789 WHERE FreesideStatus IS NULL
790 AND AcctStopTime IS NOT NULL
791 ") or die $dbh->errstr;
792 $sth->execute() or die $sth->errstr;
794 while ( my $row = $sth->fetchrow_arrayref ) {
795 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
796 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
797 warn "processing record: ".
798 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
801 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
803 #my %search = ( 'username' => $UserName );
806 if ( ref($self) =~ /withdomain/ ) { #well...
807 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
808 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
811 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
812 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
814 my $status = 'skipped';
815 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
816 "(UserName $UserName, Realm $Realm)";
818 if ( $self->option('process_single_realm')
819 && $self->option('realm') ne $Realm )
821 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
824 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
825 'svcpart' => $_->cust_svc->svcpart, } )
828 { 'username' => $UserName },
834 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
835 } elsif ( scalar(@svc_acct) > 1 ) {
836 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
839 my $svc_acct = $svc_acct[0];
840 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
842 $svc_acct->last_login($AcctStartTime);
843 $svc_acct->last_logout($AcctStopTime);
845 my $session_time = $AcctStopTime;
846 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
848 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
849 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
850 || $cust_pkg->setup ) ) {
851 $status = 'skipped (too old)';
854 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
855 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
856 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
857 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
858 + $AcctOutputOctets);
859 $status=join(' ', @st);
864 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
865 my $psth = $dbh->prepare("UPDATE radacct
866 SET FreesideStatus = ?
868 ) or die $dbh->errstr;
869 $psth->execute($status, $RadAcctId) or die $psth->errstr;
871 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
878 my ($svc_acct, $column, $amount) = @_;
879 if ( $svc_acct->$column !~ /^$/ ) {
880 warn " svc_acct.$column found (". $svc_acct->$column.
883 my $method = 'decrement_' . $column;
884 my $error = $svc_acct->$method($amount);
885 die $error if $error;
888 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
893 =item export_nas_insert NAS
895 =item export_nas_delete NAS
897 =item export_nas_replace NEW_NAS OLD_NAS
899 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
900 server. Currently requires the table to be named 'nas' and to follow
901 the stock schema (/etc/freeradius/nas.sql).
905 sub export_nas_insert { shift->export_nas_action('insert', @_); }
906 sub export_nas_delete { shift->export_nas_action('delete', @_); }
907 sub export_nas_replace { shift->export_nas_action('replace', @_); }
909 sub export_nas_action {
911 my ($action, $new, $old) = @_;
912 # find the NAS in the target table by its name
913 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
914 my $nasnum = $new->nasnum;
916 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
920 return $err_or_queue unless ref $err_or_queue;
924 sub sqlradius_nas_insert {
925 my $dbh = sqlradius_connect(shift, shift, shift);
927 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
928 or die "nasnum ".$opt{'nasnum'}.' not found';
929 # insert actual NULLs where FS::Record has translated to empty strings
930 my @values = map { length($nas->$_) ? $nas->$_ : undef }
931 qw( nasname shortname type secret server community description );
932 my $sth = $dbh->prepare('INSERT INTO nas
933 (nasname, shortname, type, secret, server, community, description)
934 VALUES (?, ?, ?, ?, ?, ?, ?)');
935 $sth->execute(@values) or die $dbh->errstr;
938 sub sqlradius_nas_delete {
939 my $dbh = sqlradius_connect(shift, shift, shift);
941 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
942 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
945 sub sqlradius_nas_replace {
946 my $dbh = sqlradius_connect(shift, shift, shift);
948 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
949 or die "nasnum ".$opt{'nasnum'}.' not found';
950 my @values = map {$nas->$_}
951 qw( nasname shortname type secret server community description );
952 my $sth = $dbh->prepare('UPDATE nas SET
953 nasname = ?, shortname = ?, type = ?, secret = ?,
954 server = ?, community = ?, description = ?
956 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
959 =item export_attr_insert RADIUS_ATTR
961 =item export_attr_delete RADIUS_ATTR
963 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
965 Update the group attribute tables (radgroupcheck and radgroupreply) on
966 the RADIUS server. In delete and replace actions, the existing records
967 are identified by the combination of group name and attribute name.
969 In the special case where attributes are being replaced because a group
970 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
971 'groupname' must be set in OLD_RADIUS_ATTR.
975 # some false laziness with NAS export stuff...
977 sub export_attr_insert { shift->export_attr_action('insert', @_); }
979 sub export_attr_delete { shift->export_attr_action('delete', @_); }
981 sub export_attr_replace { shift->export_attr_action('replace', @_); }
983 sub export_attr_action {
985 my ($action, $new, $old) = @_;
988 if ( $action eq 'delete' ) {
991 if ( $action eq 'delete' or $action eq 'replace' ) {
992 # delete based on an exact match
994 attrname => $old->attrname,
995 attrtype => $old->attrtype,
996 groupname => $old->groupname || $old->radius_group->groupname,
998 value => $old->value,
1000 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1001 return $err_or_queue unless ref $err_or_queue;
1003 # this probably doesn't matter, but just to be safe...
1004 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1005 if ( $action eq 'replace' or $action eq 'insert' ) {
1007 attrname => $new->attrname,
1008 attrtype => $new->attrtype,
1009 groupname => $new->radius_group->groupname,
1011 value => $new->value,
1013 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1014 $err_or_queue->depend_insert($jobnum) if $jobnum;
1015 return $err_or_queue unless ref $err_or_queue;
1020 sub sqlradius_attr_insert {
1021 my $dbh = sqlradius_connect(shift, shift, shift);
1025 # make sure $table is completely safe
1026 if ( $opt{'attrtype'} eq 'C' ) {
1027 $table = 'radgroupcheck';
1029 elsif ( $opt{'attrtype'} eq 'R' ) {
1030 $table = 'radgroupreply';
1033 die "unknown attribute type '$opt{attrtype}'";
1036 my @values = @opt{ qw(groupname attrname op value) };
1037 my $sth = $dbh->prepare(
1038 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1040 $sth->execute(@values) or die $dbh->errstr;
1043 sub sqlradius_attr_delete {
1044 my $dbh = sqlradius_connect(shift, shift, shift);
1048 if ( $opt{'attrtype'} eq 'C' ) {
1049 $table = 'radgroupcheck';
1051 elsif ( $opt{'attrtype'} eq 'R' ) {
1052 $table = 'radgroupreply';
1055 die "unknown attribute type '".$opt{'attrtype'}."'";
1058 my @values = @opt{ qw(groupname attrname op value) };
1059 my $sth = $dbh->prepare(
1060 'DELETE FROM '.$table.
1061 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1064 $sth->execute(@values) or die $dbh->errstr;
1067 #sub sqlradius_attr_replace { no longer needed
1069 =item export_group_replace NEW OLD
1071 Replace the L<FS::radius_group> object OLD with NEW. This will change
1072 the group name and priority in all radusergroup records, and the group
1073 name in radgroupcheck and radgroupreply.
1077 sub export_group_replace {
1079 my ($new, $old) = @_;
1080 return '' if $new->groupname eq $old->groupname
1081 and $new->priority == $old->priority;
1083 my $err_or_queue = $self->sqlradius_queue(
1086 ($self->option('usergroup') || 'usergroup'),
1090 return $err_or_queue unless ref $err_or_queue;
1094 sub sqlradius_group_replace {
1095 my $dbh = sqlradius_connect(shift, shift, shift);
1096 my $usergroup = shift;
1097 $usergroup =~ /^(rad)?usergroup$/
1098 or die "bad usergroup table name: $usergroup";
1099 my ($new, $old) = (shift, shift);
1100 # apply renames to check/reply attribute tables
1101 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1102 foreach my $table (qw(radgroupcheck radgroupreply)) {
1103 my $sth = $dbh->prepare(
1104 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1106 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1107 or die $dbh->errstr;
1110 # apply renames and priority changes to usergroup table
1111 my $sth = $dbh->prepare(
1112 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1114 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1115 or die $dbh->errstr;
1119 # class method to fetch groups/attributes from the sqlradius install on upgrade
1122 sub _upgrade_exporttype {
1123 # do this only if the radius_attr table is empty
1124 local $FS::radius_attr::noexport_hack = 1;
1126 return if qsearch('radius_attr', {});
1128 foreach my $self ($class->all_sqlradius) {
1129 my $error = $self->import_attrs;
1130 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1137 my $dbh = DBI->connect( map $self->option($_),
1138 qw( datasrc username password ) );
1140 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1144 my $usergroup = $self->option('usergroup') || 'usergroup';
1146 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1149 # map out existing groups and attrs
1152 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1153 $attrs_of{$radius_group->groupname} = +{
1154 map { $_->attrname => $_ } $radius_group->radius_attr
1156 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1159 # get groupnames from radgroupcheck and radgroupreply
1161 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1163 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1164 my @fixes; # things that need to be changed on the radius db
1165 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1166 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1167 warn "$groupname.$attrname\n";
1168 if ( !exists($groupnum_of{$groupname}) ) {
1169 my $radius_group = new FS::radius_group {
1170 'groupname' => $groupname,
1173 $error = $radius_group->insert;
1175 warn "error inserting group $groupname: $error";
1176 next;#don't continue trying to insert the attribute
1178 $attrs_of{$groupname} = {};
1179 $groupnum_of{$groupname} = $radius_group->groupnum;
1182 my $a = $attrs_of{$groupname};
1183 my $old = $a->{$attrname};
1186 if ( $attrtype eq 'R' ) {
1187 # Freeradius tolerates illegal operators in reply attributes. We don't.
1188 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1189 warn "$groupname.$attrname: changing $op to +=\n";
1190 # Make a note to change it in the db
1192 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1193 $groupname, $attrname, $op, $value
1195 # and import it correctly.
1200 if ( defined $old ) {
1202 $new = new FS::radius_attr {
1207 $error = $new->replace($old);
1209 warn "error modifying attr $attrname: $error";
1214 $new = new FS::radius_attr {
1215 'groupnum' => $groupnum_of{$groupname},
1216 'attrname' => $attrname,
1217 'attrtype' => $attrtype,
1221 $error = $new->insert;
1223 warn "error inserting attr $attrname: $error" if $error;
1227 $attrs_of{$groupname}->{$attrname} = $new;
1231 my ($sql, @args) = @$_;
1232 my $sth = $dbh->prepare($sql);
1233 $sth->execute(@args) or warn $sth->errstr;
1246 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1247 # (radiator is supposed to be setup with a radacct table)
1248 #i suppose it would be more slick to look for things that inherit from us..
1250 my @part_export = ();
1251 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1252 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1253 broadband_sqlradius );
1257 sub all_sqlradius_withaccounting {
1259 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;