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 session_status - 'closed' to only show records with AcctStopTime,
601 'open' to only show records I<without> AcctStopTime, empty to show both.
603 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
605 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
617 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
618 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
621 SVC_ACCT, if specified, limits the results to the specified account.
623 IP, if specified, limits the results to the specified IP address.
625 PREFIX, if specified, limits the results to records with a matching
628 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
629 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
631 Returns an arrayref of hashrefs with the following fields:
637 =item framedipaddress
643 =item acctsessiontime
645 =item acctinputoctets
647 =item acctoutputoctets
649 =item calledstationid
655 #some false laziness w/cust_svc::seconds_since_sqlradacct
661 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
665 $start = $opt->{stoptime_start};
666 $end = $opt->{stoptime_end};
667 $svc_acct = $opt->{svc_acct};
669 $prefix = $opt->{prefix};
670 $summarize = $opt->{summarize};
672 ( $start, $end ) = splice(@_, 0, 2);
673 $svc_acct = @_ ? shift : '';
674 $ip = @_ ? shift : '';
675 $prefix = @_ ? shift : '';
676 #my $select = @_ ? shift : '*';
681 return [] if $self->option('ignore_accounting');
683 my $dbh = sqlradius_connect( map $self->option($_),
684 qw( datasrc username password ) );
686 #select a unix time conversion function based on database type
687 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
690 qw( username realm framedipaddress
691 acctsessiontime acctinputoctets acctoutputoctets
694 "$str2time acctstarttime ) as acctstarttime",
695 "$str2time acctstoptime ) as acctstoptime",
698 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
699 'sum(acctoutputoctets) as acctoutputoctets',
706 my $username = $self->export_username($svc_acct);
707 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
708 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
709 push @param, $username, $1, $2;
711 push @where, 'UserName = ?';
712 push @param, $username;
716 if ($self->option('process_single_realm')) {
717 push @where, 'Realm = ?';
718 push @param, $self->option('realm');
722 push @where, ' FramedIPAddress = ?';
726 if ( length($prefix) ) {
727 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
728 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
731 my $acctstoptime = '';
732 if ( $opt->{session_status} ne 'open' ) {
734 $acctstoptime .= "$str2time AcctStopTime ) >= ?";
736 $acctstoptime .= ' AND ' if $end;
739 $acctstoptime .= "$str2time AcctStopTime ) <= ?";
743 if ( $opt->{session_status} ne 'closed' ) {
744 $acctstoptime = "( $acctstoptime ) OR " if $acctstoptime;
745 $acctstoptime .= 'AcctStopTime IS NULL';
747 push @where, $acctstoptime;
749 if ( $opt->{starttime_start} ) {
750 push @where, "$str2time AcctStartTime ) >= ?";
751 push @param, $opt->{starttime_start};
753 if ( $opt->{starttime_end} ) {
754 push @where, "$str2time AcctStartTime ) <= ?";
755 push @param, $opt->{starttime_end};
758 my $where = join(' AND ', @where);
759 $where = "WHERE $where" if $where;
762 $groupby = 'GROUP BY username' if $summarize;
764 my $orderby = 'ORDER BY AcctStartTime DESC';
765 $orderby = '' if $summarize;
767 my $sql = 'SELECT '. join(', ', @fields).
768 " FROM radacct $where $groupby $orderby";
771 warn join(',', @param);
773 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
774 $sth->execute(@param) or die $sth->errstr;
776 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
787 my $conf = new FS::Conf;
790 my $dbh = sqlradius_connect( map $self->option($_),
791 qw( datasrc username password ) );
793 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
794 my @fields = qw( radacctid username realm acctsessiontime );
799 my $sth = $dbh->prepare("
800 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
801 $str2time AcctStartTime), $str2time AcctStopTime),
802 AcctInputOctets, AcctOutputOctets
804 WHERE FreesideStatus IS NULL
805 AND AcctStopTime IS NOT NULL
806 ") or die $dbh->errstr;
807 $sth->execute() or die $sth->errstr;
809 while ( my $row = $sth->fetchrow_arrayref ) {
810 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
811 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
812 warn "processing record: ".
813 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
816 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
818 #my %search = ( 'username' => $UserName );
821 if ( ref($self) =~ /withdomain/ ) { #well...
822 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
823 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
826 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
827 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
829 my $status = 'skipped';
830 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
831 "(UserName $UserName, Realm $Realm)";
833 if ( $self->option('process_single_realm')
834 && $self->option('realm') ne $Realm )
836 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
839 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
840 'svcpart' => $_->cust_svc->svcpart, } )
843 { 'username' => $UserName },
849 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
850 } elsif ( scalar(@svc_acct) > 1 ) {
851 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
854 my $svc_acct = $svc_acct[0];
855 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
857 $svc_acct->last_login($AcctStartTime);
858 $svc_acct->last_logout($AcctStopTime);
860 my $session_time = $AcctStopTime;
861 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
863 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
864 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
865 || $cust_pkg->setup ) ) {
866 $status = 'skipped (too old)';
869 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
870 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
871 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
872 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
873 + $AcctOutputOctets);
874 $status=join(' ', @st);
879 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
880 my $psth = $dbh->prepare("UPDATE radacct
881 SET FreesideStatus = ?
883 ) or die $dbh->errstr;
884 $psth->execute($status, $RadAcctId) or die $psth->errstr;
886 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
893 my ($svc_acct, $column, $amount) = @_;
894 if ( $svc_acct->$column !~ /^$/ ) {
895 warn " svc_acct.$column found (". $svc_acct->$column.
898 my $method = 'decrement_' . $column;
899 my $error = $svc_acct->$method($amount);
900 die $error if $error;
903 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
908 =item export_nas_insert NAS
910 =item export_nas_delete NAS
912 =item export_nas_replace NEW_NAS OLD_NAS
914 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
915 server. Currently requires the table to be named 'nas' and to follow
916 the stock schema (/etc/freeradius/nas.sql).
920 sub export_nas_insert { shift->export_nas_action('insert', @_); }
921 sub export_nas_delete { shift->export_nas_action('delete', @_); }
922 sub export_nas_replace { shift->export_nas_action('replace', @_); }
924 sub export_nas_action {
926 my ($action, $new, $old) = @_;
927 # find the NAS in the target table by its name
928 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
929 my $nasnum = $new->nasnum;
931 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
935 return $err_or_queue unless ref $err_or_queue;
939 sub sqlradius_nas_insert {
940 my $dbh = sqlradius_connect(shift, shift, shift);
942 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
943 or die "nasnum ".$opt{'nasnum'}.' not found';
944 # insert actual NULLs where FS::Record has translated to empty strings
945 my @values = map { length($nas->$_) ? $nas->$_ : undef }
946 qw( nasname shortname type secret server community description );
947 my $sth = $dbh->prepare('INSERT INTO nas
948 (nasname, shortname, type, secret, server, community, description)
949 VALUES (?, ?, ?, ?, ?, ?, ?)');
950 $sth->execute(@values) or die $dbh->errstr;
953 sub sqlradius_nas_delete {
954 my $dbh = sqlradius_connect(shift, shift, shift);
956 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
957 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
960 sub sqlradius_nas_replace {
961 my $dbh = sqlradius_connect(shift, shift, shift);
963 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
964 or die "nasnum ".$opt{'nasnum'}.' not found';
965 my @values = map {$nas->$_}
966 qw( nasname shortname type secret server community description );
967 my $sth = $dbh->prepare('UPDATE nas SET
968 nasname = ?, shortname = ?, type = ?, secret = ?,
969 server = ?, community = ?, description = ?
971 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
974 =item export_attr_insert RADIUS_ATTR
976 =item export_attr_delete RADIUS_ATTR
978 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
980 Update the group attribute tables (radgroupcheck and radgroupreply) on
981 the RADIUS server. In delete and replace actions, the existing records
982 are identified by the combination of group name and attribute name.
984 In the special case where attributes are being replaced because a group
985 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
986 'groupname' must be set in OLD_RADIUS_ATTR.
990 # some false laziness with NAS export stuff...
992 sub export_attr_insert { shift->export_attr_action('insert', @_); }
994 sub export_attr_delete { shift->export_attr_action('delete', @_); }
996 sub export_attr_replace { shift->export_attr_action('replace', @_); }
998 sub export_attr_action {
1000 my ($action, $new, $old) = @_;
1003 if ( $action eq 'delete' ) {
1006 if ( $action eq 'delete' or $action eq 'replace' ) {
1007 # delete based on an exact match
1009 attrname => $old->attrname,
1010 attrtype => $old->attrtype,
1011 groupname => $old->groupname || $old->radius_group->groupname,
1013 value => $old->value,
1015 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1016 return $err_or_queue unless ref $err_or_queue;
1018 # this probably doesn't matter, but just to be safe...
1019 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1020 if ( $action eq 'replace' or $action eq 'insert' ) {
1022 attrname => $new->attrname,
1023 attrtype => $new->attrtype,
1024 groupname => $new->radius_group->groupname,
1026 value => $new->value,
1028 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1029 $err_or_queue->depend_insert($jobnum) if $jobnum;
1030 return $err_or_queue unless ref $err_or_queue;
1035 sub sqlradius_attr_insert {
1036 my $dbh = sqlradius_connect(shift, shift, shift);
1040 # make sure $table is completely safe
1041 if ( $opt{'attrtype'} eq 'C' ) {
1042 $table = 'radgroupcheck';
1044 elsif ( $opt{'attrtype'} eq 'R' ) {
1045 $table = 'radgroupreply';
1048 die "unknown attribute type '$opt{attrtype}'";
1051 my @values = @opt{ qw(groupname attrname op value) };
1052 my $sth = $dbh->prepare(
1053 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1055 $sth->execute(@values) or die $dbh->errstr;
1058 sub sqlradius_attr_delete {
1059 my $dbh = sqlradius_connect(shift, shift, shift);
1063 if ( $opt{'attrtype'} eq 'C' ) {
1064 $table = 'radgroupcheck';
1066 elsif ( $opt{'attrtype'} eq 'R' ) {
1067 $table = 'radgroupreply';
1070 die "unknown attribute type '".$opt{'attrtype'}."'";
1073 my @values = @opt{ qw(groupname attrname op value) };
1074 my $sth = $dbh->prepare(
1075 'DELETE FROM '.$table.
1076 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1079 $sth->execute(@values) or die $dbh->errstr;
1082 #sub sqlradius_attr_replace { no longer needed
1084 =item export_group_replace NEW OLD
1086 Replace the L<FS::radius_group> object OLD with NEW. This will change
1087 the group name and priority in all radusergroup records, and the group
1088 name in radgroupcheck and radgroupreply.
1092 sub export_group_replace {
1094 my ($new, $old) = @_;
1095 return '' if $new->groupname eq $old->groupname
1096 and $new->priority == $old->priority;
1098 my $err_or_queue = $self->sqlradius_queue(
1101 ($self->option('usergroup') || 'usergroup'),
1105 return $err_or_queue unless ref $err_or_queue;
1109 sub sqlradius_group_replace {
1110 my $dbh = sqlradius_connect(shift, shift, shift);
1111 my $usergroup = shift;
1112 $usergroup =~ /^(rad)?usergroup$/
1113 or die "bad usergroup table name: $usergroup";
1114 my ($new, $old) = (shift, shift);
1115 # apply renames to check/reply attribute tables
1116 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1117 foreach my $table (qw(radgroupcheck radgroupreply)) {
1118 my $sth = $dbh->prepare(
1119 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1121 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1122 or die $dbh->errstr;
1125 # apply renames and priority changes to usergroup table
1126 my $sth = $dbh->prepare(
1127 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1129 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1130 or die $dbh->errstr;
1134 # class method to fetch groups/attributes from the sqlradius install on upgrade
1137 sub _upgrade_exporttype {
1138 # do this only if the radius_attr table is empty
1139 local $FS::radius_attr::noexport_hack = 1;
1141 return if qsearch('radius_attr', {});
1143 foreach my $self ($class->all_sqlradius) {
1144 my $error = $self->import_attrs;
1145 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1152 my $dbh = DBI->connect( map $self->option($_),
1153 qw( datasrc username password ) );
1155 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1159 my $usergroup = $self->option('usergroup') || 'usergroup';
1161 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1164 # map out existing groups and attrs
1167 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1168 $attrs_of{$radius_group->groupname} = +{
1169 map { $_->attrname => $_ } $radius_group->radius_attr
1171 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1174 # get groupnames from radgroupcheck and radgroupreply
1176 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1178 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1179 my @fixes; # things that need to be changed on the radius db
1180 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1181 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1182 warn "$groupname.$attrname\n";
1183 if ( !exists($groupnum_of{$groupname}) ) {
1184 my $radius_group = new FS::radius_group {
1185 'groupname' => $groupname,
1188 $error = $radius_group->insert;
1190 warn "error inserting group $groupname: $error";
1191 next;#don't continue trying to insert the attribute
1193 $attrs_of{$groupname} = {};
1194 $groupnum_of{$groupname} = $radius_group->groupnum;
1197 my $a = $attrs_of{$groupname};
1198 my $old = $a->{$attrname};
1201 if ( $attrtype eq 'R' ) {
1202 # Freeradius tolerates illegal operators in reply attributes. We don't.
1203 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1204 warn "$groupname.$attrname: changing $op to +=\n";
1205 # Make a note to change it in the db
1207 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1208 $groupname, $attrname, $op, $value
1210 # and import it correctly.
1215 if ( defined $old ) {
1217 $new = new FS::radius_attr {
1222 $error = $new->replace($old);
1224 warn "error modifying attr $attrname: $error";
1229 $new = new FS::radius_attr {
1230 'groupnum' => $groupnum_of{$groupname},
1231 'attrname' => $attrname,
1232 'attrtype' => $attrtype,
1236 $error = $new->insert;
1238 warn "error inserting attr $attrname: $error" if $error;
1242 $attrs_of{$groupname}->{$attrname} = $new;
1246 my ($sql, @args) = @$_;
1247 my $sth = $dbh->prepare($sql);
1248 $sth->execute(@args) or warn $sth->errstr;
1261 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1262 # (radiator is supposed to be setup with a radacct table)
1263 #i suppose it would be more slick to look for things that inherit from us..
1265 my @part_export = ();
1266 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1267 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1268 broadband_sqlradius );
1272 sub all_sqlradius_withaccounting {
1274 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;