1 package FS::part_export::sqlradius;
4 use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
7 use FS::Record qw( dbh qsearch qsearchs str2time_sql );
14 @ISA = qw(FS::part_export);
15 @EXPORT_OK = qw( sqlradius_connect );
20 tie %options, 'Tie::IxHash',
21 'datasrc' => { label=>'DBI data source ' },
22 'username' => { label=>'Database username' },
23 'password' => { label=>'Database password' },
24 'usergroup' => { label => 'Group table',
26 options => [qw( usergroup radusergroup ) ],
28 'ignore_accounting' => {
30 label => 'Ignore accounting records from this database'
32 'process_single_realm' => {
34 label => 'Only process one realm of accounting records',
36 'realm' => { label => 'The realm of of accounting records to be processed' },
37 'ignore_long_sessions' => {
39 label => 'Ignore sessions which span billing periods',
43 label => 'Hide IP address information on session reports',
47 label => 'Hide download/upload information on session reports',
49 'show_called_station' => {
51 label => 'Show the Called-Station-ID on session reports',
53 'overlimit_groups' => {
54 label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)',
60 option_values => sub {
62 map { $_->groupnum, $_->long_description }
63 qsearch('radius_group', {}),
68 'groups_susp_reason' => { label =>
69 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
74 label => 'Export RADIUS group attributes to this database',
79 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
80 tables to any SQL database for
81 <a href="http://www.freeradius.org/">FreeRADIUS</a>
82 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
86 An existing RADIUS database will be updated in realtime, but you can use
87 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
88 to delete the entire RADIUS database and repopulate the tables from the
89 Freeside database. See the
90 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
92 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
93 for the exact syntax of a DBI data source.
95 <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.
96 <li>Using ICRADIUS, add a dummy "op" column to your database:
98 ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
99 ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
100 ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
101 ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
103 <li>Using Radiator, see the
104 <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
105 for configuration information.
111 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
112 'options' => \%options,
115 'nas' => 'Y', # show export_nas selection in UI
116 'default_svc_class' => 'Internet',
118 'This export does not export RADIUS realms (see also '.
119 'sqlradius_withdomain). '.
123 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
124 split( "\n", shift->option('groups_susp_reason'));
127 sub rebless { shift; }
129 sub export_username { # override for other svcdb
130 my($self, $svc_acct) = (shift, shift);
131 warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
135 sub radius_reply { #override for other svcdb
136 my($self, $svc_acct) = (shift, shift);
137 my %every = $svc_acct->EVERY::radius_reply;
138 map { @$_ } values %every;
141 sub radius_check { #override for other svcdb
142 my($self, $svc_acct) = (shift, shift);
143 my %every = $svc_acct->EVERY::radius_check;
144 map { @$_ } values %every;
148 my($self, $svc_x) = (shift, shift);
150 foreach my $table (qw(reply check)) {
151 my $method = "radius_$table";
152 my %attrib = $self->$method($svc_x);
153 next unless keys %attrib;
154 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
155 $table, $self->export_username($svc_x), %attrib );
156 return $err_or_queue unless ref($err_or_queue);
158 my @groups = $svc_x->radius_groups('hashref');
160 cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
161 " (". $self->export_username($svc_x). " with ". join(", ", @groups)
163 my $usergroup = $self->option('usergroup') || 'usergroup';
164 my $err_or_queue = $self->sqlradius_queue(
165 $svc_x->svcnum, 'usergroup_insert',
166 $self->export_username($svc_x), $usergroup, @groups );
167 return $err_or_queue unless ref($err_or_queue);
172 sub _export_replace {
173 my( $self, $new, $old ) = (shift, shift, shift);
175 local $SIG{HUP} = 'IGNORE';
176 local $SIG{INT} = 'IGNORE';
177 local $SIG{QUIT} = 'IGNORE';
178 local $SIG{TERM} = 'IGNORE';
179 local $SIG{TSTP} = 'IGNORE';
180 local $SIG{PIPE} = 'IGNORE';
182 my $oldAutoCommit = $FS::UID::AutoCommit;
183 local $FS::UID::AutoCommit = 0;
187 if ( $self->export_username($old) ne $self->export_username($new) ) {
188 my $usergroup = $self->option('usergroup') || 'usergroup';
189 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
190 $self->export_username($new), $self->export_username($old), $usergroup );
191 unless ( ref($err_or_queue) ) {
192 $dbh->rollback if $oldAutoCommit;
193 return $err_or_queue;
195 $jobnum = $err_or_queue->jobnum;
198 foreach my $table (qw(reply check)) {
199 my $method = "radius_$table";
200 my %new = $self->$method($new);
201 my %old = $self->$method($old);
202 if ( grep { !exists $old{$_} #new attributes
203 || $new{$_} ne $old{$_} #changed
206 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
207 $table, $self->export_username($new), %new );
208 unless ( ref($err_or_queue) ) {
209 $dbh->rollback if $oldAutoCommit;
210 return $err_or_queue;
213 my $error = $err_or_queue->depend_insert( $jobnum );
215 $dbh->rollback if $oldAutoCommit;
219 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
222 my @del = grep { !exists $new{$_} } keys %old;
224 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
225 $table, $self->export_username($new), @del );
226 unless ( ref($err_or_queue) ) {
227 $dbh->rollback if $oldAutoCommit;
228 return $err_or_queue;
231 my $error = $err_or_queue->depend_insert( $jobnum );
233 $dbh->rollback if $oldAutoCommit;
237 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
242 my (@oldgroups) = $old->radius_groups('hashref');
243 my (@newgroups) = $new->radius_groups('hashref');
244 $error = $self->sqlreplace_usergroups( $new->svcnum,
245 $self->export_username($new),
246 $jobnum ? $jobnum : '',
251 $dbh->rollback if $oldAutoCommit;
255 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
260 #false laziness w/broadband_sqlradius.pm
261 sub _export_suspend {
262 my( $self, $svc_acct ) = (shift, shift);
264 my $new = $svc_acct->clone_suspended;
266 local $SIG{HUP} = 'IGNORE';
267 local $SIG{INT} = 'IGNORE';
268 local $SIG{QUIT} = 'IGNORE';
269 local $SIG{TERM} = 'IGNORE';
270 local $SIG{TSTP} = 'IGNORE';
271 local $SIG{PIPE} = 'IGNORE';
273 my $oldAutoCommit = $FS::UID::AutoCommit;
274 local $FS::UID::AutoCommit = 0;
277 my @newgroups = $self->suspended_usergroups($svc_acct);
279 unless (@newgroups) { #don't change password if assigning to a suspended group
281 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
282 'check', $self->export_username($new), $new->radius_check );
283 unless ( ref($err_or_queue) ) {
284 $dbh->rollback if $oldAutoCommit;
285 return $err_or_queue;
291 $self->sqlreplace_usergroups(
293 $self->export_username($new),
295 [ $svc_acct->radius_groups('hashref') ],
299 $dbh->rollback if $oldAutoCommit;
302 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
307 sub _export_unsuspend {
308 my( $self, $svc_x ) = (shift, shift);
310 local $SIG{HUP} = 'IGNORE';
311 local $SIG{INT} = 'IGNORE';
312 local $SIG{QUIT} = 'IGNORE';
313 local $SIG{TERM} = 'IGNORE';
314 local $SIG{TSTP} = 'IGNORE';
315 local $SIG{PIPE} = 'IGNORE';
317 my $oldAutoCommit = $FS::UID::AutoCommit;
318 local $FS::UID::AutoCommit = 0;
321 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
322 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
323 unless ( ref($err_or_queue) ) {
324 $dbh->rollback if $oldAutoCommit;
325 return $err_or_queue;
329 my (@oldgroups) = $self->suspended_usergroups($svc_x);
330 $error = $self->sqlreplace_usergroups(
332 $self->export_username($svc_x),
335 [ $svc_x->radius_groups('hashref') ],
338 $dbh->rollback if $oldAutoCommit;
341 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
347 my( $self, $svc_x ) = (shift, shift);
348 my $usergroup = $self->option('usergroup') || 'usergroup';
349 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
350 $self->export_username($svc_x), $usergroup );
351 ref($err_or_queue) ? '' : $err_or_queue;
354 sub sqlradius_queue {
355 my( $self, $svcnum, $method ) = (shift, shift, shift);
357 my $queue = new FS::queue {
359 'job' => "FS::part_export::sqlradius::sqlradius_$method",
362 $self->option('datasrc'),
363 $self->option('username'),
364 $self->option('password'),
369 sub suspended_usergroups {
370 my ($self, $svc_x) = (shift, shift);
372 return () unless $svc_x;
374 my $svc_table = $svc_x->table;
376 #false laziness with FS::part_export::shellcommands
377 #subclass part_export?
379 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
380 my %reasonmap = $self->_groups_susp_reason_map;
383 $userspec = $reasonmap{$r->reasonnum}
384 if exists($reasonmap{$r->reasonnum});
385 $userspec = $reasonmap{$r->reason}
386 if (!$userspec && exists($reasonmap{$r->reason}));
389 if ( $userspec =~ /^\d+$/ ){
390 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
391 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
392 my ($username,$domain) = split(/\@/, $userspec);
393 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
394 $suspend_svc = $user if $userspec eq $user->email;
396 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
397 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
400 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
404 sub sqlradius_insert { #subroutine, not method
405 my $dbh = sqlradius_connect(shift, shift, shift);
406 my( $table, $username, %attributes ) = @_;
408 foreach my $attribute ( keys %attributes ) {
410 my $s_sth = $dbh->prepare(
411 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
412 ) or die $dbh->errstr;
413 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
415 if ( $s_sth->fetchrow_arrayref->[0] ) {
417 my $u_sth = $dbh->prepare(
418 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
419 ) or die $dbh->errstr;
420 $u_sth->execute($attributes{$attribute}, $username, $attribute)
421 or die $u_sth->errstr;
425 my $i_sth = $dbh->prepare(
426 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
427 "VALUES ( ?, ?, ?, ? )"
428 ) or die $dbh->errstr;
432 ( $attribute eq 'Password' ? '==' : ':=' ),
433 $attributes{$attribute},
434 ) or die $i_sth->errstr;
442 sub sqlradius_usergroup_insert { #subroutine, not method
443 my $dbh = sqlradius_connect(shift, shift, shift);
444 my $username = shift;
445 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
448 my $s_sth = $dbh->prepare(
449 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
450 ) or die $dbh->errstr;
452 my $sth = $dbh->prepare(
453 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
454 ) or die $dbh->errstr;
456 foreach ( @groups ) {
457 my $group = $_->{'groupname'};
458 my $priority = $_->{'priority'};
459 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
460 if ($s_sth->fetchrow_arrayref->[0]) {
461 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
462 "$group for $username\n"
466 $sth->execute( $username, $group, $priority )
467 or die "can't insert into groupname table: ". $sth->errstr;
469 if ( $s_sth->{Active} ) {
470 warn "sqlradius s_sth still active; calling ->finish()";
473 if ( $sth->{Active} ) {
474 warn "sqlradius sth still active; calling ->finish()";
480 sub sqlradius_usergroup_delete { #subroutine, not method
481 my $dbh = sqlradius_connect(shift, shift, shift);
482 my $username = shift;
483 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
486 my $sth = $dbh->prepare(
487 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
488 ) or die $dbh->errstr;
489 foreach ( @groups ) {
490 my $group = $_->{'groupname'};
491 $sth->execute( $username, $group )
492 or die "can't delete from groupname table: ". $sth->errstr;
497 sub sqlradius_rename { #subroutine, not method
498 my $dbh = sqlradius_connect(shift, shift, shift);
499 my($new_username, $old_username) = (shift, shift);
500 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
501 foreach my $table (qw(radreply radcheck), $usergroup ) {
502 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
504 $sth->execute($new_username, $old_username)
505 or die "can't update $table: ". $sth->errstr;
510 sub sqlradius_attrib_delete { #subroutine, not method
511 my $dbh = sqlradius_connect(shift, shift, shift);
512 my( $table, $username, @attrib ) = @_;
514 foreach my $attribute ( @attrib ) {
515 my $sth = $dbh->prepare(
516 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
518 $sth->execute($username,$attribute)
519 or die "can't delete from rad$table table: ". $sth->errstr;
524 sub sqlradius_delete { #subroutine, not method
525 my $dbh = sqlradius_connect(shift, shift, shift);
526 my $username = shift;
527 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
529 foreach my $table (qw( radcheck radreply), $usergroup ) {
530 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
531 $sth->execute($username)
532 or die "can't delete from $table table: ". $sth->errstr;
537 sub sqlradius_connect {
538 #my($datasrc, $username, $password) = @_;
539 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
540 DBI->connect(@_) or die $DBI::errstr;
543 sub sqlreplace_usergroups {
544 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
546 # (sorta) false laziness with FS::svc_acct::replace
547 my @oldgroups = @$old;
548 my @newgroups = @$new;
550 foreach my $oldgroup ( @oldgroups ) {
551 if ( grep { $oldgroup eq $_ } @newgroups ) {
552 @newgroups = grep { $oldgroup ne $_ } @newgroups;
555 push @delgroups, $oldgroup;
558 my $usergroup = $self->option('usergroup') || 'usergroup';
561 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
562 $username, $usergroup, @delgroups );
564 unless ref($err_or_queue);
566 my $error = $err_or_queue->depend_insert( $jobnum );
567 return $error if $error;
569 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
573 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
574 "with ". join(", ", @newgroups)
576 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
577 $username, $usergroup, @newgroups );
579 unless ref($err_or_queue);
581 my $error = $err_or_queue->depend_insert( $jobnum );
582 return $error if $error;
591 =item usage_sessions HASHREF
593 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
595 New-style: pass a hashref with the following keys:
599 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
601 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
603 =item session_status - 'closed' to only show records with AcctStopTime,
604 'open' to only show records I<without> AcctStopTime, empty to show both.
606 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
608 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
620 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
621 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
624 SVC_ACCT, if specified, limits the results to the specified account.
626 IP, if specified, limits the results to the specified IP address.
628 PREFIX, if specified, limits the results to records with a matching
631 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
632 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
634 Returns an arrayref of hashrefs with the following fields:
640 =item framedipaddress
646 =item acctsessiontime
648 =item acctinputoctets
650 =item acctoutputoctets
652 =item calledstationid
658 #some false laziness w/cust_svc::seconds_since_sqlradacct
664 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
668 $start = $opt->{stoptime_start};
669 $end = $opt->{stoptime_end};
670 $svc_acct = $opt->{svc_acct};
672 $prefix = $opt->{prefix};
673 $summarize = $opt->{summarize};
675 ( $start, $end ) = splice(@_, 0, 2);
676 $svc_acct = @_ ? shift : '';
677 $ip = @_ ? shift : '';
678 $prefix = @_ ? shift : '';
679 #my $select = @_ ? shift : '*';
684 return [] if $self->option('ignore_accounting');
686 my $dbh = sqlradius_connect( map $self->option($_),
687 qw( datasrc username password ) );
689 #select a unix time conversion function based on database type
690 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
693 qw( username realm framedipaddress
694 acctsessiontime acctinputoctets acctoutputoctets
697 "$str2time acctstarttime ) as acctstarttime",
698 "$str2time acctstoptime ) as acctstoptime",
701 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
702 'sum(acctoutputoctets) as acctoutputoctets',
709 my $username = $self->export_username($svc_acct);
710 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
711 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
712 push @param, $username, $1, $2;
714 push @where, 'UserName = ?';
715 push @param, $username;
719 if ($self->option('process_single_realm')) {
720 push @where, 'Realm = ?';
721 push @param, $self->option('realm');
725 push @where, ' FramedIPAddress = ?';
729 if ( length($prefix) ) {
730 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
731 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
734 my $acctstoptime = '';
735 if ( $opt->{session_status} ne 'open' ) {
737 $acctstoptime .= "$str2time AcctStopTime ) >= ?";
739 $acctstoptime .= ' AND ' if $end;
742 $acctstoptime .= "$str2time AcctStopTime ) <= ?";
746 if ( $opt->{session_status} ne 'closed' ) {
747 if ( $acctstoptime ) {
748 $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )";
750 $acctstoptime = 'AcctStopTime IS NULL';
753 push @where, $acctstoptime;
755 if ( $opt->{starttime_start} ) {
756 push @where, "$str2time AcctStartTime ) >= ?";
757 push @param, $opt->{starttime_start};
759 if ( $opt->{starttime_end} ) {
760 push @where, "$str2time AcctStartTime ) <= ?";
761 push @param, $opt->{starttime_end};
764 my $where = join(' AND ', @where);
765 $where = "WHERE $where" if $where;
768 $groupby = 'GROUP BY username' if $summarize;
770 my $orderby = 'ORDER BY AcctStartTime DESC';
771 $orderby = '' if $summarize;
773 my $sql = 'SELECT '. join(', ', @fields).
774 " FROM radacct $where $groupby $orderby";
777 warn join(',', @param);
779 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
780 $sth->execute(@param) or die $sth->errstr;
782 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
793 my $conf = new FS::Conf;
796 my $dbh = sqlradius_connect( map $self->option($_),
797 qw( datasrc username password ) );
799 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
800 my @fields = qw( radacctid username realm acctsessiontime );
805 my $sth = $dbh->prepare("
806 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
807 $str2time AcctStartTime), $str2time AcctStopTime),
808 AcctInputOctets, AcctOutputOctets
810 WHERE FreesideStatus IS NULL
811 AND AcctStopTime IS NOT NULL
812 ") or die $dbh->errstr;
813 $sth->execute() or die $sth->errstr;
815 while ( my $row = $sth->fetchrow_arrayref ) {
816 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
817 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
818 warn "processing record: ".
819 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
822 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
824 #my %search = ( 'username' => $UserName );
827 if ( ref($self) =~ /withdomain/ ) { #well...
828 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
829 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
832 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
833 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
835 my $status = 'skipped';
836 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
837 "(UserName $UserName, Realm $Realm)";
839 if ( $self->option('process_single_realm')
840 && $self->option('realm') ne $Realm )
842 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
845 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
846 'svcpart' => $_->cust_svc->svcpart, } )
849 { 'username' => $UserName },
855 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
856 } elsif ( scalar(@svc_acct) > 1 ) {
857 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
860 my $svc_acct = $svc_acct[0];
861 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
863 $svc_acct->last_login($AcctStartTime);
864 $svc_acct->last_logout($AcctStopTime);
866 my $session_time = $AcctStopTime;
867 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
869 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
870 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
871 || $cust_pkg->setup ) ) {
872 $status = 'skipped (too old)';
875 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
876 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
877 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
878 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
879 + $AcctOutputOctets);
880 $status=join(' ', @st);
885 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
886 my $psth = $dbh->prepare("UPDATE radacct
887 SET FreesideStatus = ?
889 ) or die $dbh->errstr;
890 $psth->execute($status, $RadAcctId) or die $psth->errstr;
892 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
899 my ($svc_acct, $column, $amount) = @_;
900 if ( $svc_acct->$column !~ /^$/ ) {
901 warn " svc_acct.$column found (". $svc_acct->$column.
904 my $method = 'decrement_' . $column;
905 my $error = $svc_acct->$method($amount);
906 die $error if $error;
909 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
914 =item export_nas_insert NAS
916 =item export_nas_delete NAS
918 =item export_nas_replace NEW_NAS OLD_NAS
920 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
921 server. Currently requires the table to be named 'nas' and to follow
922 the stock schema (/etc/freeradius/nas.sql).
926 sub export_nas_insert { shift->export_nas_action('insert', @_); }
927 sub export_nas_delete { shift->export_nas_action('delete', @_); }
928 sub export_nas_replace { shift->export_nas_action('replace', @_); }
930 sub export_nas_action {
932 my ($action, $new, $old) = @_;
933 # find the NAS in the target table by its name
934 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
935 my $nasnum = $new->nasnum;
937 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
941 return $err_or_queue unless ref $err_or_queue;
945 sub sqlradius_nas_insert {
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 # insert actual NULLs where FS::Record has translated to empty strings
951 my @values = map { length($nas->$_) ? $nas->$_ : undef }
952 qw( nasname shortname type secret server community description );
953 my $sth = $dbh->prepare('INSERT INTO nas
954 (nasname, shortname, type, secret, server, community, description)
955 VALUES (?, ?, ?, ?, ?, ?, ?)');
956 $sth->execute(@values) or die $dbh->errstr;
959 sub sqlradius_nas_delete {
960 my $dbh = sqlradius_connect(shift, shift, shift);
962 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
963 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
966 sub sqlradius_nas_replace {
967 my $dbh = sqlradius_connect(shift, shift, shift);
969 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
970 or die "nasnum ".$opt{'nasnum'}.' not found';
971 my @values = map {$nas->$_}
972 qw( nasname shortname type secret server community description );
973 my $sth = $dbh->prepare('UPDATE nas SET
974 nasname = ?, shortname = ?, type = ?, secret = ?,
975 server = ?, community = ?, description = ?
977 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
980 =item export_attr_insert RADIUS_ATTR
982 =item export_attr_delete RADIUS_ATTR
984 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
986 Update the group attribute tables (radgroupcheck and radgroupreply) on
987 the RADIUS server. In delete and replace actions, the existing records
988 are identified by the combination of group name and attribute name.
990 In the special case where attributes are being replaced because a group
991 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
992 'groupname' must be set in OLD_RADIUS_ATTR.
996 # some false laziness with NAS export stuff...
998 sub export_attr_insert { shift->export_attr_action('insert', @_); }
1000 sub export_attr_delete { shift->export_attr_action('delete', @_); }
1002 sub export_attr_replace { shift->export_attr_action('replace', @_); }
1004 sub export_attr_action {
1006 my ($action, $new, $old) = @_;
1009 if ( $action eq 'delete' ) {
1012 if ( $action eq 'delete' or $action eq 'replace' ) {
1013 # delete based on an exact match
1015 attrname => $old->attrname,
1016 attrtype => $old->attrtype,
1017 groupname => $old->groupname || $old->radius_group->groupname,
1019 value => $old->value,
1021 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1022 return $err_or_queue unless ref $err_or_queue;
1024 # this probably doesn't matter, but just to be safe...
1025 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1026 if ( $action eq 'replace' or $action eq 'insert' ) {
1028 attrname => $new->attrname,
1029 attrtype => $new->attrtype,
1030 groupname => $new->radius_group->groupname,
1032 value => $new->value,
1034 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1035 $err_or_queue->depend_insert($jobnum) if $jobnum;
1036 return $err_or_queue unless ref $err_or_queue;
1041 sub sqlradius_attr_insert {
1042 my $dbh = sqlradius_connect(shift, shift, shift);
1046 # make sure $table is completely safe
1047 if ( $opt{'attrtype'} eq 'C' ) {
1048 $table = 'radgroupcheck';
1050 elsif ( $opt{'attrtype'} eq 'R' ) {
1051 $table = 'radgroupreply';
1054 die "unknown attribute type '$opt{attrtype}'";
1057 my @values = @opt{ qw(groupname attrname op value) };
1058 my $sth = $dbh->prepare(
1059 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1061 $sth->execute(@values) or die $dbh->errstr;
1064 sub sqlradius_attr_delete {
1065 my $dbh = sqlradius_connect(shift, shift, shift);
1069 if ( $opt{'attrtype'} eq 'C' ) {
1070 $table = 'radgroupcheck';
1072 elsif ( $opt{'attrtype'} eq 'R' ) {
1073 $table = 'radgroupreply';
1076 die "unknown attribute type '".$opt{'attrtype'}."'";
1079 my @values = @opt{ qw(groupname attrname op value) };
1080 my $sth = $dbh->prepare(
1081 'DELETE FROM '.$table.
1082 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1085 $sth->execute(@values) or die $dbh->errstr;
1088 #sub sqlradius_attr_replace { no longer needed
1090 =item export_group_replace NEW OLD
1092 Replace the L<FS::radius_group> object OLD with NEW. This will change
1093 the group name and priority in all radusergroup records, and the group
1094 name in radgroupcheck and radgroupreply.
1098 sub export_group_replace {
1100 my ($new, $old) = @_;
1101 return '' if $new->groupname eq $old->groupname
1102 and $new->priority == $old->priority;
1104 my $err_or_queue = $self->sqlradius_queue(
1107 ($self->option('usergroup') || 'usergroup'),
1111 return $err_or_queue unless ref $err_or_queue;
1115 sub sqlradius_group_replace {
1116 my $dbh = sqlradius_connect(shift, shift, shift);
1117 my $usergroup = shift;
1118 $usergroup =~ /^(rad)?usergroup$/
1119 or die "bad usergroup table name: $usergroup";
1120 my ($new, $old) = (shift, shift);
1121 # apply renames to check/reply attribute tables
1122 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1123 foreach my $table (qw(radgroupcheck radgroupreply)) {
1124 my $sth = $dbh->prepare(
1125 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1127 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1128 or die $dbh->errstr;
1131 # apply renames and priority changes to usergroup table
1132 my $sth = $dbh->prepare(
1133 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1135 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1136 or die $dbh->errstr;
1140 # class method to fetch groups/attributes from the sqlradius install on upgrade
1143 sub _upgrade_exporttype {
1144 # do this only if the radius_attr table is empty
1145 local $FS::radius_attr::noexport_hack = 1;
1147 return if qsearch('radius_attr', {});
1149 foreach my $self ($class->all_sqlradius) {
1150 my $error = $self->import_attrs;
1151 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1158 my $dbh = DBI->connect( map $self->option($_),
1159 qw( datasrc username password ) );
1161 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1165 my $usergroup = $self->option('usergroup') || 'usergroup';
1167 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1170 # map out existing groups and attrs
1173 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1174 $attrs_of{$radius_group->groupname} = +{
1175 map { $_->attrname => $_ } $radius_group->radius_attr
1177 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1180 # get groupnames from radgroupcheck and radgroupreply
1182 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1184 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1185 my @fixes; # things that need to be changed on the radius db
1186 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1187 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1188 warn "$groupname.$attrname\n";
1189 if ( !exists($groupnum_of{$groupname}) ) {
1190 my $radius_group = new FS::radius_group {
1191 'groupname' => $groupname,
1194 $error = $radius_group->insert;
1196 warn "error inserting group $groupname: $error";
1197 next;#don't continue trying to insert the attribute
1199 $attrs_of{$groupname} = {};
1200 $groupnum_of{$groupname} = $radius_group->groupnum;
1203 my $a = $attrs_of{$groupname};
1204 my $old = $a->{$attrname};
1207 if ( $attrtype eq 'R' ) {
1208 # Freeradius tolerates illegal operators in reply attributes. We don't.
1209 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1210 warn "$groupname.$attrname: changing $op to +=\n";
1211 # Make a note to change it in the db
1213 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1214 $groupname, $attrname, $op, $value
1216 # and import it correctly.
1221 if ( defined $old ) {
1223 $new = new FS::radius_attr {
1228 $error = $new->replace($old);
1230 warn "error modifying attr $attrname: $error";
1235 $new = new FS::radius_attr {
1236 'groupnum' => $groupnum_of{$groupname},
1237 'attrname' => $attrname,
1238 'attrtype' => $attrtype,
1242 $error = $new->insert;
1244 warn "error inserting attr $attrname: $error" if $error;
1248 $attrs_of{$groupname}->{$attrname} = $new;
1252 my ($sql, @args) = @$_;
1253 my $sth = $dbh->prepare($sql);
1254 $sth->execute(@args) or warn $sth->errstr;
1267 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1268 # (radiator is supposed to be setup with a radacct table)
1269 #i suppose it would be more slick to look for things that inherit from us..
1271 my @part_export = ();
1272 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1273 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1274 broadband_sqlradius );
1278 sub all_sqlradius_withaccounting {
1280 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;