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;
216 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
219 my @del = grep { !exists $new{$_} } keys %old;
221 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
222 $table, $self->export_username($new), @del );
223 unless ( ref($err_or_queue) ) {
224 $dbh->rollback if $oldAutoCommit;
225 return $err_or_queue;
228 my $error = $err_or_queue->depend_insert( $jobnum );
230 $dbh->rollback if $oldAutoCommit;
234 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
239 my (@oldgroups) = $old->radius_groups('hashref');
240 my (@newgroups) = $new->radius_groups('hashref');
241 $error = $self->sqlreplace_usergroups( $new->svcnum,
242 $self->export_username($new),
243 $jobnum ? $jobnum : '',
248 $dbh->rollback if $oldAutoCommit;
252 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
257 #false laziness w/broadband_sqlradius.pm
258 sub _export_suspend {
259 my( $self, $svc_acct ) = (shift, shift);
261 my $new = $svc_acct->clone_suspended;
263 local $SIG{HUP} = 'IGNORE';
264 local $SIG{INT} = 'IGNORE';
265 local $SIG{QUIT} = 'IGNORE';
266 local $SIG{TERM} = 'IGNORE';
267 local $SIG{TSTP} = 'IGNORE';
268 local $SIG{PIPE} = 'IGNORE';
270 my $oldAutoCommit = $FS::UID::AutoCommit;
271 local $FS::UID::AutoCommit = 0;
274 my @newgroups = $self->suspended_usergroups($svc_acct);
276 unless (@newgroups) { #don't change password if assigning to a suspended group
278 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
279 'check', $self->export_username($new), $new->radius_check );
280 unless ( ref($err_or_queue) ) {
281 $dbh->rollback if $oldAutoCommit;
282 return $err_or_queue;
288 $self->sqlreplace_usergroups(
290 $self->export_username($new),
292 [ $svc_acct->radius_groups('hashref') ],
296 $dbh->rollback if $oldAutoCommit;
299 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
304 sub _export_unsuspend {
305 my( $self, $svc_x ) = (shift, shift);
307 local $SIG{HUP} = 'IGNORE';
308 local $SIG{INT} = 'IGNORE';
309 local $SIG{QUIT} = 'IGNORE';
310 local $SIG{TERM} = 'IGNORE';
311 local $SIG{TSTP} = 'IGNORE';
312 local $SIG{PIPE} = 'IGNORE';
314 my $oldAutoCommit = $FS::UID::AutoCommit;
315 local $FS::UID::AutoCommit = 0;
318 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
319 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
320 unless ( ref($err_or_queue) ) {
321 $dbh->rollback if $oldAutoCommit;
322 return $err_or_queue;
326 my (@oldgroups) = $self->suspended_usergroups($svc_x);
327 $error = $self->sqlreplace_usergroups(
329 $self->export_username($svc_x),
332 [ $svc_x->radius_groups('hashref') ],
335 $dbh->rollback if $oldAutoCommit;
338 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
344 my( $self, $svc_x ) = (shift, shift);
345 my $usergroup = $self->option('usergroup') || 'usergroup';
346 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
347 $self->export_username($svc_x), $usergroup );
348 ref($err_or_queue) ? '' : $err_or_queue;
351 sub sqlradius_queue {
352 my( $self, $svcnum, $method ) = (shift, shift, shift);
354 my $queue = new FS::queue {
356 'job' => "FS::part_export::sqlradius::sqlradius_$method",
359 $self->option('datasrc'),
360 $self->option('username'),
361 $self->option('password'),
366 sub suspended_usergroups {
367 my ($self, $svc_x) = (shift, shift);
369 return () unless $svc_x;
371 my $svc_table = $svc_x->table;
373 #false laziness with FS::part_export::shellcommands
374 #subclass part_export?
376 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
377 my %reasonmap = $self->_groups_susp_reason_map;
380 $userspec = $reasonmap{$r->reasonnum}
381 if exists($reasonmap{$r->reasonnum});
382 $userspec = $reasonmap{$r->reason}
383 if (!$userspec && exists($reasonmap{$r->reason}));
386 if ( $userspec =~ /^\d+$/ ){
387 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
388 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
389 my ($username,$domain) = split(/\@/, $userspec);
390 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
391 $suspend_svc = $user if $userspec eq $user->email;
393 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
394 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
397 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
401 sub sqlradius_insert { #subroutine, not method
402 my $dbh = sqlradius_connect(shift, shift, shift);
403 my( $table, $username, %attributes ) = @_;
405 foreach my $attribute ( keys %attributes ) {
407 my $s_sth = $dbh->prepare(
408 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
409 ) or die $dbh->errstr;
410 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
412 if ( $s_sth->fetchrow_arrayref->[0] ) {
414 my $u_sth = $dbh->prepare(
415 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
416 ) or die $dbh->errstr;
417 $u_sth->execute($attributes{$attribute}, $username, $attribute)
418 or die $u_sth->errstr;
422 my $i_sth = $dbh->prepare(
423 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
424 "VALUES ( ?, ?, ?, ? )"
425 ) or die $dbh->errstr;
429 ( $attribute eq 'Password' ? '==' : ':=' ),
430 $attributes{$attribute},
431 ) or die $i_sth->errstr;
439 sub sqlradius_usergroup_insert { #subroutine, not method
440 my $dbh = sqlradius_connect(shift, shift, shift);
441 my $username = shift;
442 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
445 my $s_sth = $dbh->prepare(
446 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
447 ) or die $dbh->errstr;
449 my $sth = $dbh->prepare(
450 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
451 ) or die $dbh->errstr;
453 foreach ( @groups ) {
454 my $group = $_->{'groupname'};
455 my $priority = $_->{'priority'};
456 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
457 if ($s_sth->fetchrow_arrayref->[0]) {
458 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
459 "$group for $username\n"
463 $sth->execute( $username, $group, $priority )
464 or die "can't insert into groupname table: ". $sth->errstr;
466 if ( $s_sth->{Active} ) {
467 warn "sqlradius s_sth still active; calling ->finish()";
470 if ( $sth->{Active} ) {
471 warn "sqlradius sth still active; calling ->finish()";
477 sub sqlradius_usergroup_delete { #subroutine, not method
478 my $dbh = sqlradius_connect(shift, shift, shift);
479 my $username = shift;
480 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
483 my $sth = $dbh->prepare(
484 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
485 ) or die $dbh->errstr;
486 foreach ( @groups ) {
487 my $group = $_->{'groupname'};
488 $sth->execute( $username, $group )
489 or die "can't delete from groupname table: ". $sth->errstr;
494 sub sqlradius_rename { #subroutine, not method
495 my $dbh = sqlradius_connect(shift, shift, shift);
496 my($new_username, $old_username) = (shift, shift);
497 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
498 foreach my $table (qw(radreply radcheck), $usergroup ) {
499 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
501 $sth->execute($new_username, $old_username)
502 or die "can't update $table: ". $sth->errstr;
507 sub sqlradius_attrib_delete { #subroutine, not method
508 my $dbh = sqlradius_connect(shift, shift, shift);
509 my( $table, $username, @attrib ) = @_;
511 foreach my $attribute ( @attrib ) {
512 my $sth = $dbh->prepare(
513 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
515 $sth->execute($username,$attribute)
516 or die "can't delete from rad$table table: ". $sth->errstr;
521 sub sqlradius_delete { #subroutine, not method
522 my $dbh = sqlradius_connect(shift, shift, shift);
523 my $username = shift;
524 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
526 foreach my $table (qw( radcheck radreply), $usergroup ) {
527 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
528 $sth->execute($username)
529 or die "can't delete from $table table: ". $sth->errstr;
534 sub sqlradius_connect {
535 #my($datasrc, $username, $password) = @_;
536 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
537 DBI->connect(@_) or die $DBI::errstr;
540 sub sqlreplace_usergroups {
541 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
543 # (sorta) false laziness with FS::svc_acct::replace
544 my @oldgroups = @$old;
545 my @newgroups = @$new;
547 foreach my $oldgroup ( @oldgroups ) {
548 if ( grep { $oldgroup eq $_ } @newgroups ) {
549 @newgroups = grep { $oldgroup ne $_ } @newgroups;
552 push @delgroups, $oldgroup;
555 my $usergroup = $self->option('usergroup') || 'usergroup';
558 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
559 $username, $usergroup, @delgroups );
561 unless ref($err_or_queue);
563 my $error = $err_or_queue->depend_insert( $jobnum );
564 return $error if $error;
566 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
570 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
571 "with ". join(", ", @newgroups)
573 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
574 $username, $usergroup, @newgroups );
576 unless ref($err_or_queue);
578 my $error = $err_or_queue->depend_insert( $jobnum );
579 return $error if $error;
588 =item usage_sessions HASHREF
590 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
592 New-style: pass a hashref with the following keys:
596 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
598 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
600 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
602 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
604 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
616 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
617 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
620 SVC_ACCT, if specified, limits the results to the specified account.
622 IP, if specified, limits the results to the specified IP address.
624 PREFIX, if specified, limits the results to records with a matching
627 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
628 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
630 Returns an arrayref of hashrefs with the following fields:
636 =item framedipaddress
642 =item acctsessiontime
644 =item acctinputoctets
646 =item acctoutputoctets
648 =item calledstationid
654 #some false laziness w/cust_svc::seconds_since_sqlradacct
660 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
664 $start = $opt->{stoptime_start};
665 $end = $opt->{stoptime_end};
666 $svc_acct = $opt->{svc_acct};
668 $prefix = $opt->{prefix};
669 $summarize = $opt->{summarize};
671 ( $start, $end ) = splice(@_, 0, 2);
672 $svc_acct = @_ ? shift : '';
673 $ip = @_ ? shift : '';
674 $prefix = @_ ? shift : '';
675 #my $select = @_ ? shift : '*';
680 return [] if $self->option('ignore_accounting');
682 my $dbh = sqlradius_connect( map $self->option($_),
683 qw( datasrc username password ) );
685 #select a unix time conversion function based on database type
686 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
689 qw( username realm framedipaddress
690 acctsessiontime acctinputoctets acctoutputoctets
693 "$str2time acctstarttime ) as acctstarttime",
694 "$str2time acctstoptime ) as acctstoptime",
697 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
698 'sum(acctoutputoctets) as acctoutputoctets',
705 my $username = $self->export_username($svc_acct);
706 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
707 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
708 push @param, $username, $1, $2;
710 push @where, 'UserName = ?';
711 push @param, $username;
715 if ($self->option('process_single_realm')) {
716 push @where, 'Realm = ?';
717 push @param, $self->option('realm');
721 push @where, ' FramedIPAddress = ?';
725 if ( length($prefix) ) {
726 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
727 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
731 push @where, "$str2time AcctStopTime ) >= ?";
735 push @where, "$str2time AcctStopTime ) <= ?";
738 if ( $opt->{open_sessions} ) {
739 push @where, 'AcctStopTime IS NULL';
741 if ( $opt->{starttime_start} ) {
742 push @where, "$str2time AcctStartTime ) >= ?";
743 push @param, $opt->{starttime_start};
745 if ( $opt->{starttime_end} ) {
746 push @where, "$str2time AcctStartTime ) <= ?";
747 push @param, $opt->{starttime_end};
750 my $where = join(' AND ', @where);
751 $where = "WHERE $where" if $where;
754 $groupby = 'GROUP BY username' if $summarize;
756 my $orderby = 'ORDER BY AcctStartTime DESC';
757 $orderby = '' if $summarize;
759 my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
760 " FROM radacct $where $groupby $orderby
761 ") or die $dbh->errstr;
762 $sth->execute(@param) or die $sth->errstr;
764 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
775 my $conf = new FS::Conf;
778 my $dbh = sqlradius_connect( map $self->option($_),
779 qw( datasrc username password ) );
781 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
782 my @fields = qw( radacctid username realm acctsessiontime );
787 my $sth = $dbh->prepare("
788 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
789 $str2time AcctStartTime), $str2time AcctStopTime),
790 AcctInputOctets, AcctOutputOctets
792 WHERE FreesideStatus IS NULL
793 AND AcctStopTime IS NOT NULL
794 ") or die $dbh->errstr;
795 $sth->execute() or die $sth->errstr;
797 while ( my $row = $sth->fetchrow_arrayref ) {
798 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
799 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
800 warn "processing record: ".
801 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
804 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
806 #my %search = ( 'username' => $UserName );
809 if ( ref($self) =~ /withdomain/ ) { #well...
810 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
811 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
814 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
815 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
817 my $status = 'skipped';
818 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
819 "(UserName $UserName, Realm $Realm)";
821 if ( $self->option('process_single_realm')
822 && $self->option('realm') ne $Realm )
824 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
827 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
828 'svcpart' => $_->cust_svc->svcpart, } )
831 { 'username' => $UserName },
837 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
838 } elsif ( scalar(@svc_acct) > 1 ) {
839 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
842 my $svc_acct = $svc_acct[0];
843 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
845 $svc_acct->last_login($AcctStartTime);
846 $svc_acct->last_logout($AcctStopTime);
848 my $session_time = $AcctStopTime;
849 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
851 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
852 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
853 || $cust_pkg->setup ) ) {
854 $status = 'skipped (too old)';
857 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
858 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
859 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
860 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
861 + $AcctOutputOctets);
862 $status=join(' ', @st);
867 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
868 my $psth = $dbh->prepare("UPDATE radacct
869 SET FreesideStatus = ?
871 ) or die $dbh->errstr;
872 $psth->execute($status, $RadAcctId) or die $psth->errstr;
874 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
881 my ($svc_acct, $column, $amount) = @_;
882 if ( $svc_acct->$column !~ /^$/ ) {
883 warn " svc_acct.$column found (". $svc_acct->$column.
886 my $method = 'decrement_' . $column;
887 my $error = $svc_acct->$method($amount);
888 die $error if $error;
891 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
896 =item export_nas_insert NAS
898 =item export_nas_delete NAS
900 =item export_nas_replace NEW_NAS OLD_NAS
902 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
903 server. Currently requires the table to be named 'nas' and to follow
904 the stock schema (/etc/freeradius/nas.sql).
908 sub export_nas_insert { shift->export_nas_action('insert', @_); }
909 sub export_nas_delete { shift->export_nas_action('delete', @_); }
910 sub export_nas_replace { shift->export_nas_action('replace', @_); }
912 sub export_nas_action {
914 my ($action, $new, $old) = @_;
915 # find the NAS in the target table by its name
916 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
917 my $nasnum = $new->nasnum;
919 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
923 return $err_or_queue unless ref $err_or_queue;
927 sub sqlradius_nas_insert {
928 my $dbh = sqlradius_connect(shift, shift, shift);
930 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
931 or die "nasnum ".$opt{'nasnum'}.' not found';
932 # insert actual NULLs where FS::Record has translated to empty strings
933 my @values = map { length($nas->$_) ? $nas->$_ : undef }
934 qw( nasname shortname type secret server community description );
935 my $sth = $dbh->prepare('INSERT INTO nas
936 (nasname, shortname, type, secret, server, community, description)
937 VALUES (?, ?, ?, ?, ?, ?, ?)');
938 $sth->execute(@values) or die $dbh->errstr;
941 sub sqlradius_nas_delete {
942 my $dbh = sqlradius_connect(shift, shift, shift);
944 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
945 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
948 sub sqlradius_nas_replace {
949 my $dbh = sqlradius_connect(shift, shift, shift);
951 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
952 or die "nasnum ".$opt{'nasnum'}.' not found';
953 my @values = map {$nas->$_}
954 qw( nasname shortname type secret server community description );
955 my $sth = $dbh->prepare('UPDATE nas SET
956 nasname = ?, shortname = ?, type = ?, secret = ?,
957 server = ?, community = ?, description = ?
959 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
962 =item export_attr_insert RADIUS_ATTR
964 =item export_attr_delete RADIUS_ATTR
966 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
968 Update the group attribute tables (radgroupcheck and radgroupreply) on
969 the RADIUS server. In delete and replace actions, the existing records
970 are identified by the combination of group name and attribute name.
972 In the special case where attributes are being replaced because a group
973 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
974 'groupname' must be set in OLD_RADIUS_ATTR.
978 # some false laziness with NAS export stuff...
980 sub export_attr_insert { shift->export_attr_action('insert', @_); }
982 sub export_attr_delete { shift->export_attr_action('delete', @_); }
984 sub export_attr_replace { shift->export_attr_action('replace', @_); }
986 sub export_attr_action {
988 my ($action, $new, $old) = @_;
991 if ( $action eq 'delete' ) {
994 if ( $action eq 'delete' or $action eq 'replace' ) {
995 # delete based on an exact match
997 attrname => $old->attrname,
998 attrtype => $old->attrtype,
999 groupname => $old->groupname || $old->radius_group->groupname,
1001 value => $old->value,
1003 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1004 return $err_or_queue unless ref $err_or_queue;
1006 # this probably doesn't matter, but just to be safe...
1007 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1008 if ( $action eq 'replace' or $action eq 'insert' ) {
1010 attrname => $new->attrname,
1011 attrtype => $new->attrtype,
1012 groupname => $new->radius_group->groupname,
1014 value => $new->value,
1016 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1017 $err_or_queue->depend_insert($jobnum) if $jobnum;
1018 return $err_or_queue unless ref $err_or_queue;
1023 sub sqlradius_attr_insert {
1024 my $dbh = sqlradius_connect(shift, shift, shift);
1028 # make sure $table is completely safe
1029 if ( $opt{'attrtype'} eq 'C' ) {
1030 $table = 'radgroupcheck';
1032 elsif ( $opt{'attrtype'} eq 'R' ) {
1033 $table = 'radgroupreply';
1036 die "unknown attribute type '$opt{attrtype}'";
1039 my @values = @opt{ qw(groupname attrname op value) };
1040 my $sth = $dbh->prepare(
1041 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1043 $sth->execute(@values) or die $dbh->errstr;
1046 sub sqlradius_attr_delete {
1047 my $dbh = sqlradius_connect(shift, shift, shift);
1051 if ( $opt{'attrtype'} eq 'C' ) {
1052 $table = 'radgroupcheck';
1054 elsif ( $opt{'attrtype'} eq 'R' ) {
1055 $table = 'radgroupreply';
1058 die "unknown attribute type '".$opt{'attrtype'}."'";
1061 my @values = @opt{ qw(groupname attrname op value) };
1062 my $sth = $dbh->prepare(
1063 'DELETE FROM '.$table.
1064 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1067 $sth->execute(@values) or die $dbh->errstr;
1070 #sub sqlradius_attr_replace { no longer needed
1072 =item export_group_replace NEW OLD
1074 Replace the L<FS::radius_group> object OLD with NEW. This will change
1075 the group name and priority in all radusergroup records, and the group
1076 name in radgroupcheck and radgroupreply.
1080 sub export_group_replace {
1082 my ($new, $old) = @_;
1083 return '' if $new->groupname eq $old->groupname
1084 and $new->priority == $old->priority;
1086 my $err_or_queue = $self->sqlradius_queue(
1089 ($self->option('usergroup') || 'usergroup'),
1093 return $err_or_queue unless ref $err_or_queue;
1097 sub sqlradius_group_replace {
1098 my $dbh = sqlradius_connect(shift, shift, shift);
1099 my $usergroup = shift;
1100 $usergroup =~ /^(rad)?usergroup$/
1101 or die "bad usergroup table name: $usergroup";
1102 my ($new, $old) = (shift, shift);
1103 # apply renames to check/reply attribute tables
1104 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1105 foreach my $table (qw(radgroupcheck radgroupreply)) {
1106 my $sth = $dbh->prepare(
1107 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1109 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1110 or die $dbh->errstr;
1113 # apply renames and priority changes to usergroup table
1114 my $sth = $dbh->prepare(
1115 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1117 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1118 or die $dbh->errstr;
1122 # class method to fetch groups/attributes from the sqlradius install on upgrade
1125 sub _upgrade_exporttype {
1126 # do this only if the radius_attr table is empty
1127 local $FS::radius_attr::noexport_hack = 1;
1129 return if qsearch('radius_attr', {});
1131 foreach my $self ($class->all_sqlradius) {
1132 my $error = $self->import_attrs;
1133 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1140 my $dbh = DBI->connect( map $self->option($_),
1141 qw( datasrc username password ) );
1143 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1147 my $usergroup = $self->option('usergroup') || 'usergroup';
1149 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1152 # map out existing groups and attrs
1155 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1156 $attrs_of{$radius_group->groupname} = +{
1157 map { $_->attrname => $_ } $radius_group->radius_attr
1159 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1162 # get groupnames from radgroupcheck and radgroupreply
1164 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1166 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1167 my @fixes; # things that need to be changed on the radius db
1168 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1169 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1170 warn "$groupname.$attrname\n";
1171 if ( !exists($groupnum_of{$groupname}) ) {
1172 my $radius_group = new FS::radius_group {
1173 'groupname' => $groupname,
1176 $error = $radius_group->insert;
1178 warn "error inserting group $groupname: $error";
1179 next;#don't continue trying to insert the attribute
1181 $attrs_of{$groupname} = {};
1182 $groupnum_of{$groupname} = $radius_group->groupnum;
1185 my $a = $attrs_of{$groupname};
1186 my $old = $a->{$attrname};
1189 if ( $attrtype eq 'R' ) {
1190 # Freeradius tolerates illegal operators in reply attributes. We don't.
1191 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1192 warn "$groupname.$attrname: changing $op to +=\n";
1193 # Make a note to change it in the db
1195 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1196 $groupname, $attrname, $op, $value
1198 # and import it correctly.
1203 if ( defined $old ) {
1205 $new = new FS::radius_attr {
1210 $error = $new->replace($old);
1212 warn "error modifying attr $attrname: $error";
1217 $new = new FS::radius_attr {
1218 'groupnum' => $groupnum_of{$groupname},
1219 'attrname' => $attrname,
1220 'attrtype' => $attrtype,
1224 $error = $new->insert;
1226 warn "error inserting attr $attrname: $error" if $error;
1230 $attrs_of{$groupname}->{$attrname} = $new;
1234 my ($sql, @args) = @$_;
1235 my $sth = $dbh->prepare($sql);
1236 $sth->execute(@args) or warn $sth->errstr;
1249 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1250 # (radiator is supposed to be setup with a radacct table)
1251 #i suppose it would be more slick to look for things that inherit from us..
1253 my @part_export = ();
1254 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1255 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1256 broadband_sqlradius );
1260 sub all_sqlradius_withaccounting {
1262 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;