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 if ( $acctstoptime ) {
745 $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )";
747 $acctstoptime = 'AcctStopTime IS NULL';
750 push @where, $acctstoptime;
752 if ( $opt->{starttime_start} ) {
753 push @where, "$str2time AcctStartTime ) >= ?";
754 push @param, $opt->{starttime_start};
756 if ( $opt->{starttime_end} ) {
757 push @where, "$str2time AcctStartTime ) <= ?";
758 push @param, $opt->{starttime_end};
761 my $where = join(' AND ', @where);
762 $where = "WHERE $where" if $where;
765 $groupby = 'GROUP BY username' if $summarize;
767 my $orderby = 'ORDER BY AcctStartTime DESC';
768 $orderby = '' if $summarize;
770 my $sql = 'SELECT '. join(', ', @fields).
771 " FROM radacct $where $groupby $orderby";
774 warn join(',', @param);
776 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
777 $sth->execute(@param) or die $sth->errstr;
779 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
790 my $conf = new FS::Conf;
793 my $dbh = sqlradius_connect( map $self->option($_),
794 qw( datasrc username password ) );
796 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
797 my @fields = qw( radacctid username realm acctsessiontime );
802 my $sth = $dbh->prepare("
803 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
804 $str2time AcctStartTime), $str2time AcctStopTime),
805 AcctInputOctets, AcctOutputOctets
807 WHERE FreesideStatus IS NULL
808 AND AcctStopTime IS NOT NULL
809 ") or die $dbh->errstr;
810 $sth->execute() or die $sth->errstr;
812 while ( my $row = $sth->fetchrow_arrayref ) {
813 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
814 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
815 warn "processing record: ".
816 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
819 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
821 #my %search = ( 'username' => $UserName );
824 if ( ref($self) =~ /withdomain/ ) { #well...
825 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
826 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
829 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
830 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
832 my $status = 'skipped';
833 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
834 "(UserName $UserName, Realm $Realm)";
836 if ( $self->option('process_single_realm')
837 && $self->option('realm') ne $Realm )
839 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
842 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
843 'svcpart' => $_->cust_svc->svcpart, } )
846 { 'username' => $UserName },
852 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
853 } elsif ( scalar(@svc_acct) > 1 ) {
854 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
857 my $svc_acct = $svc_acct[0];
858 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
860 $svc_acct->last_login($AcctStartTime);
861 $svc_acct->last_logout($AcctStopTime);
863 my $session_time = $AcctStopTime;
864 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
866 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
867 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
868 || $cust_pkg->setup ) ) {
869 $status = 'skipped (too old)';
872 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
873 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
874 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
875 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
876 + $AcctOutputOctets);
877 $status=join(' ', @st);
882 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
883 my $psth = $dbh->prepare("UPDATE radacct
884 SET FreesideStatus = ?
886 ) or die $dbh->errstr;
887 $psth->execute($status, $RadAcctId) or die $psth->errstr;
889 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
896 my ($svc_acct, $column, $amount) = @_;
897 if ( $svc_acct->$column !~ /^$/ ) {
898 warn " svc_acct.$column found (". $svc_acct->$column.
901 my $method = 'decrement_' . $column;
902 my $error = $svc_acct->$method($amount);
903 die $error if $error;
906 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
911 =item export_nas_insert NAS
913 =item export_nas_delete NAS
915 =item export_nas_replace NEW_NAS OLD_NAS
917 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
918 server. Currently requires the table to be named 'nas' and to follow
919 the stock schema (/etc/freeradius/nas.sql).
923 sub export_nas_insert { shift->export_nas_action('insert', @_); }
924 sub export_nas_delete { shift->export_nas_action('delete', @_); }
925 sub export_nas_replace { shift->export_nas_action('replace', @_); }
927 sub export_nas_action {
929 my ($action, $new, $old) = @_;
930 # find the NAS in the target table by its name
931 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
932 my $nasnum = $new->nasnum;
934 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
938 return $err_or_queue unless ref $err_or_queue;
942 sub sqlradius_nas_insert {
943 my $dbh = sqlradius_connect(shift, shift, shift);
945 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
946 or die "nasnum ".$opt{'nasnum'}.' not found';
947 # insert actual NULLs where FS::Record has translated to empty strings
948 my @values = map { length($nas->$_) ? $nas->$_ : undef }
949 qw( nasname shortname type secret server community description );
950 my $sth = $dbh->prepare('INSERT INTO nas
951 (nasname, shortname, type, secret, server, community, description)
952 VALUES (?, ?, ?, ?, ?, ?, ?)');
953 $sth->execute(@values) or die $dbh->errstr;
956 sub sqlradius_nas_delete {
957 my $dbh = sqlradius_connect(shift, shift, shift);
959 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
960 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
963 sub sqlradius_nas_replace {
964 my $dbh = sqlradius_connect(shift, shift, shift);
966 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
967 or die "nasnum ".$opt{'nasnum'}.' not found';
968 my @values = map {$nas->$_}
969 qw( nasname shortname type secret server community description );
970 my $sth = $dbh->prepare('UPDATE nas SET
971 nasname = ?, shortname = ?, type = ?, secret = ?,
972 server = ?, community = ?, description = ?
974 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
977 =item export_attr_insert RADIUS_ATTR
979 =item export_attr_delete RADIUS_ATTR
981 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
983 Update the group attribute tables (radgroupcheck and radgroupreply) on
984 the RADIUS server. In delete and replace actions, the existing records
985 are identified by the combination of group name and attribute name.
987 In the special case where attributes are being replaced because a group
988 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
989 'groupname' must be set in OLD_RADIUS_ATTR.
993 # some false laziness with NAS export stuff...
995 sub export_attr_insert { shift->export_attr_action('insert', @_); }
997 sub export_attr_delete { shift->export_attr_action('delete', @_); }
999 sub export_attr_replace { shift->export_attr_action('replace', @_); }
1001 sub export_attr_action {
1003 my ($action, $new, $old) = @_;
1006 if ( $action eq 'delete' ) {
1009 if ( $action eq 'delete' or $action eq 'replace' ) {
1010 # delete based on an exact match
1012 attrname => $old->attrname,
1013 attrtype => $old->attrtype,
1014 groupname => $old->groupname || $old->radius_group->groupname,
1016 value => $old->value,
1018 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1019 return $err_or_queue unless ref $err_or_queue;
1021 # this probably doesn't matter, but just to be safe...
1022 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1023 if ( $action eq 'replace' or $action eq 'insert' ) {
1025 attrname => $new->attrname,
1026 attrtype => $new->attrtype,
1027 groupname => $new->radius_group->groupname,
1029 value => $new->value,
1031 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1032 $err_or_queue->depend_insert($jobnum) if $jobnum;
1033 return $err_or_queue unless ref $err_or_queue;
1038 sub sqlradius_attr_insert {
1039 my $dbh = sqlradius_connect(shift, shift, shift);
1043 # make sure $table is completely safe
1044 if ( $opt{'attrtype'} eq 'C' ) {
1045 $table = 'radgroupcheck';
1047 elsif ( $opt{'attrtype'} eq 'R' ) {
1048 $table = 'radgroupreply';
1051 die "unknown attribute type '$opt{attrtype}'";
1054 my @values = @opt{ qw(groupname attrname op value) };
1055 my $sth = $dbh->prepare(
1056 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1058 $sth->execute(@values) or die $dbh->errstr;
1061 sub sqlradius_attr_delete {
1062 my $dbh = sqlradius_connect(shift, shift, shift);
1066 if ( $opt{'attrtype'} eq 'C' ) {
1067 $table = 'radgroupcheck';
1069 elsif ( $opt{'attrtype'} eq 'R' ) {
1070 $table = 'radgroupreply';
1073 die "unknown attribute type '".$opt{'attrtype'}."'";
1076 my @values = @opt{ qw(groupname attrname op value) };
1077 my $sth = $dbh->prepare(
1078 'DELETE FROM '.$table.
1079 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1082 $sth->execute(@values) or die $dbh->errstr;
1085 #sub sqlradius_attr_replace { no longer needed
1087 =item export_group_replace NEW OLD
1089 Replace the L<FS::radius_group> object OLD with NEW. This will change
1090 the group name and priority in all radusergroup records, and the group
1091 name in radgroupcheck and radgroupreply.
1095 sub export_group_replace {
1097 my ($new, $old) = @_;
1098 return '' if $new->groupname eq $old->groupname
1099 and $new->priority == $old->priority;
1101 my $err_or_queue = $self->sqlradius_queue(
1104 ($self->option('usergroup') || 'usergroup'),
1108 return $err_or_queue unless ref $err_or_queue;
1112 sub sqlradius_group_replace {
1113 my $dbh = sqlradius_connect(shift, shift, shift);
1114 my $usergroup = shift;
1115 $usergroup =~ /^(rad)?usergroup$/
1116 or die "bad usergroup table name: $usergroup";
1117 my ($new, $old) = (shift, shift);
1118 # apply renames to check/reply attribute tables
1119 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1120 foreach my $table (qw(radgroupcheck radgroupreply)) {
1121 my $sth = $dbh->prepare(
1122 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1124 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1125 or die $dbh->errstr;
1128 # apply renames and priority changes to usergroup table
1129 my $sth = $dbh->prepare(
1130 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1132 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1133 or die $dbh->errstr;
1137 # class method to fetch groups/attributes from the sqlradius install on upgrade
1140 sub _upgrade_exporttype {
1141 # do this only if the radius_attr table is empty
1142 local $FS::radius_attr::noexport_hack = 1;
1144 return if qsearch('radius_attr', {});
1146 foreach my $self ($class->all_sqlradius) {
1147 my $error = $self->import_attrs;
1148 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1155 my $dbh = DBI->connect( map $self->option($_),
1156 qw( datasrc username password ) );
1158 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1162 my $usergroup = $self->option('usergroup') || 'usergroup';
1164 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1167 # map out existing groups and attrs
1170 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1171 $attrs_of{$radius_group->groupname} = +{
1172 map { $_->attrname => $_ } $radius_group->radius_attr
1174 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1177 # get groupnames from radgroupcheck and radgroupreply
1179 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1181 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1182 my @fixes; # things that need to be changed on the radius db
1183 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1184 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1185 warn "$groupname.$attrname\n";
1186 if ( !exists($groupnum_of{$groupname}) ) {
1187 my $radius_group = new FS::radius_group {
1188 'groupname' => $groupname,
1191 $error = $radius_group->insert;
1193 warn "error inserting group $groupname: $error";
1194 next;#don't continue trying to insert the attribute
1196 $attrs_of{$groupname} = {};
1197 $groupnum_of{$groupname} = $radius_group->groupnum;
1200 my $a = $attrs_of{$groupname};
1201 my $old = $a->{$attrname};
1204 if ( $attrtype eq 'R' ) {
1205 # Freeradius tolerates illegal operators in reply attributes. We don't.
1206 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1207 warn "$groupname.$attrname: changing $op to +=\n";
1208 # Make a note to change it in the db
1210 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1211 $groupname, $attrname, $op, $value
1213 # and import it correctly.
1218 if ( defined $old ) {
1220 $new = new FS::radius_attr {
1225 $error = $new->replace($old);
1227 warn "error modifying attr $attrname: $error";
1232 $new = new FS::radius_attr {
1233 'groupnum' => $groupnum_of{$groupname},
1234 'attrname' => $attrname,
1235 'attrtype' => $attrtype,
1239 $error = $new->insert;
1241 warn "error inserting attr $attrname: $error" if $error;
1245 $attrs_of{$groupname}->{$attrname} = $new;
1249 my ($sql, @args) = @$_;
1250 my $sth = $dbh->prepare($sql);
1251 $sth->execute(@args) or warn $sth->errstr;
1264 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1265 # (radiator is supposed to be setup with a radacct table)
1266 #i suppose it would be more slick to look for things that inherit from us..
1268 my @part_export = ();
1269 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1270 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1271 broadband_sqlradius );
1275 sub all_sqlradius_withaccounting {
1277 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;