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,
113 'nas' => 'Y', # show export_nas selection in UI
114 'default_svc_class' => 'Internet',
116 'This export does not export RADIUS realms (see also '.
117 'sqlradius_withdomain). '.
121 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
122 split( "\n", shift->option('groups_susp_reason'));
125 sub rebless { shift; }
127 sub export_username { # override for other svcdb
128 my($self, $svc_acct) = (shift, shift);
129 warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
133 sub radius_reply { #override for other svcdb
134 my($self, $svc_acct) = (shift, shift);
135 $svc_acct->radius_reply;
138 sub radius_check { #override for other svcdb
139 my($self, $svc_acct) = (shift, shift);
140 $svc_acct->radius_check;
144 my($self, $svc_x) = (shift, shift);
146 foreach my $table (qw(reply check)) {
147 my $method = "radius_$table";
148 my %attrib = $self->$method($svc_x);
149 next unless keys %attrib;
150 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
151 $table, $self->export_username($svc_x), %attrib );
152 return $err_or_queue unless ref($err_or_queue);
154 my @groups = $svc_x->radius_groups('hashref');
156 cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
157 " (". $self->export_username($svc_x). " with ". join(", ", @groups)
159 my $usergroup = $self->option('usergroup') || 'usergroup';
160 my $err_or_queue = $self->sqlradius_queue(
161 $svc_x->svcnum, 'usergroup_insert',
162 $self->export_username($svc_x), $usergroup, @groups );
163 return $err_or_queue unless ref($err_or_queue);
168 sub _export_replace {
169 my( $self, $new, $old ) = (shift, shift, shift);
171 local $SIG{HUP} = 'IGNORE';
172 local $SIG{INT} = 'IGNORE';
173 local $SIG{QUIT} = 'IGNORE';
174 local $SIG{TERM} = 'IGNORE';
175 local $SIG{TSTP} = 'IGNORE';
176 local $SIG{PIPE} = 'IGNORE';
178 my $oldAutoCommit = $FS::UID::AutoCommit;
179 local $FS::UID::AutoCommit = 0;
183 if ( $self->export_username($old) ne $self->export_username($new) ) {
184 my $usergroup = $self->option('usergroup') || 'usergroup';
185 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
186 $self->export_username($new), $self->export_username($old), $usergroup );
187 unless ( ref($err_or_queue) ) {
188 $dbh->rollback if $oldAutoCommit;
189 return $err_or_queue;
191 $jobnum = $err_or_queue->jobnum;
194 foreach my $table (qw(reply check)) {
195 my $method = "radius_$table";
196 my %new = $new->$method();
197 my %old = $old->$method();
198 if ( grep { !exists $old{$_} #new attributes
199 || $new{$_} ne $old{$_} #changed
202 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
203 $table, $self->export_username($new), %new );
204 unless ( ref($err_or_queue) ) {
205 $dbh->rollback if $oldAutoCommit;
206 return $err_or_queue;
209 my $error = $err_or_queue->depend_insert( $jobnum );
211 $dbh->rollback if $oldAutoCommit;
217 my @del = grep { !exists $new{$_} } keys %old;
219 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
220 $table, $self->export_username($new), @del );
221 unless ( ref($err_or_queue) ) {
222 $dbh->rollback if $oldAutoCommit;
223 return $err_or_queue;
226 my $error = $err_or_queue->depend_insert( $jobnum );
228 $dbh->rollback if $oldAutoCommit;
236 my (@oldgroups) = $old->radius_groups('hashref');
237 my (@newgroups) = $new->radius_groups('hashref');
238 $error = $self->sqlreplace_usergroups( $new->svcnum,
239 $self->export_username($new),
240 $jobnum ? $jobnum : '',
245 $dbh->rollback if $oldAutoCommit;
249 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
254 #false laziness w/broadband_sqlradius.pm
255 sub _export_suspend {
256 my( $self, $svc_acct ) = (shift, shift);
258 my $new = $svc_acct->clone_suspended;
260 local $SIG{HUP} = 'IGNORE';
261 local $SIG{INT} = 'IGNORE';
262 local $SIG{QUIT} = 'IGNORE';
263 local $SIG{TERM} = 'IGNORE';
264 local $SIG{TSTP} = 'IGNORE';
265 local $SIG{PIPE} = 'IGNORE';
267 my $oldAutoCommit = $FS::UID::AutoCommit;
268 local $FS::UID::AutoCommit = 0;
271 my @newgroups = $self->suspended_usergroups($svc_acct);
273 unless (@newgroups) { #don't change password if assigning to a suspended group
275 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
276 'check', $self->export_username($new), $new->radius_check );
277 unless ( ref($err_or_queue) ) {
278 $dbh->rollback if $oldAutoCommit;
279 return $err_or_queue;
285 $self->sqlreplace_usergroups(
287 $self->export_username($new),
289 [ $svc_acct->radius_groups('hashref') ],
293 $dbh->rollback if $oldAutoCommit;
296 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
301 sub _export_unsuspend {
302 my( $self, $svc_x ) = (shift, shift);
304 local $SIG{HUP} = 'IGNORE';
305 local $SIG{INT} = 'IGNORE';
306 local $SIG{QUIT} = 'IGNORE';
307 local $SIG{TERM} = 'IGNORE';
308 local $SIG{TSTP} = 'IGNORE';
309 local $SIG{PIPE} = 'IGNORE';
311 my $oldAutoCommit = $FS::UID::AutoCommit;
312 local $FS::UID::AutoCommit = 0;
315 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
316 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
317 unless ( ref($err_or_queue) ) {
318 $dbh->rollback if $oldAutoCommit;
319 return $err_or_queue;
323 my (@oldgroups) = $self->suspended_usergroups($svc_x);
324 $error = $self->sqlreplace_usergroups(
326 $self->export_username($svc_x),
329 [ $svc_x->radius_groups('hashref') ],
332 $dbh->rollback if $oldAutoCommit;
335 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
341 my( $self, $svc_x ) = (shift, shift);
342 my $usergroup = $self->option('usergroup') || 'usergroup';
343 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
344 $self->export_username($svc_x), $usergroup );
345 ref($err_or_queue) ? '' : $err_or_queue;
348 sub sqlradius_queue {
349 my( $self, $svcnum, $method ) = (shift, shift, shift);
351 my $queue = new FS::queue {
353 'job' => "FS::part_export::sqlradius::sqlradius_$method",
356 $self->option('datasrc'),
357 $self->option('username'),
358 $self->option('password'),
363 sub suspended_usergroups {
364 my ($self, $svc_x) = (shift, shift);
366 return () unless $svc_x;
368 my $svc_table = $svc_x->table;
370 #false laziness with FS::part_export::shellcommands
371 #subclass part_export?
373 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
374 my %reasonmap = $self->_groups_susp_reason_map;
377 $userspec = $reasonmap{$r->reasonnum}
378 if exists($reasonmap{$r->reasonnum});
379 $userspec = $reasonmap{$r->reason}
380 if (!$userspec && exists($reasonmap{$r->reason}));
383 if ( $userspec =~ /^\d+$/ ){
384 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
385 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
386 my ($username,$domain) = split(/\@/, $userspec);
387 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
388 $suspend_svc = $user if $userspec eq $user->email;
390 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
391 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
394 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
398 sub sqlradius_insert { #subroutine, not method
399 my $dbh = sqlradius_connect(shift, shift, shift);
400 my( $table, $username, %attributes ) = @_;
402 foreach my $attribute ( keys %attributes ) {
404 my $s_sth = $dbh->prepare(
405 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
406 ) or die $dbh->errstr;
407 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
409 if ( $s_sth->fetchrow_arrayref->[0] ) {
411 my $u_sth = $dbh->prepare(
412 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
413 ) or die $dbh->errstr;
414 $u_sth->execute($attributes{$attribute}, $username, $attribute)
415 or die $u_sth->errstr;
419 my $i_sth = $dbh->prepare(
420 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
421 "VALUES ( ?, ?, ?, ? )"
422 ) or die $dbh->errstr;
426 ( $attribute eq 'Password' ? '==' : ':=' ),
427 $attributes{$attribute},
428 ) or die $i_sth->errstr;
436 sub sqlradius_usergroup_insert { #subroutine, not method
437 my $dbh = sqlradius_connect(shift, shift, shift);
438 my $username = shift;
439 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
442 my $s_sth = $dbh->prepare(
443 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
444 ) or die $dbh->errstr;
446 my $sth = $dbh->prepare(
447 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
448 ) or die $dbh->errstr;
450 foreach ( @groups ) {
451 my $group = $_->{'groupname'};
452 my $priority = $_->{'priority'};
453 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
454 if ($s_sth->fetchrow_arrayref->[0]) {
455 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
456 "$group for $username\n"
460 $sth->execute( $username, $group, $priority )
461 or die "can't insert into groupname table: ". $sth->errstr;
463 if ( $s_sth->{Active} ) {
464 warn "sqlradius s_sth still active; calling ->finish()";
467 if ( $sth->{Active} ) {
468 warn "sqlradius sth still active; calling ->finish()";
474 sub sqlradius_usergroup_delete { #subroutine, not method
475 my $dbh = sqlradius_connect(shift, shift, shift);
476 my $username = shift;
477 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
480 my $sth = $dbh->prepare(
481 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
482 ) or die $dbh->errstr;
483 foreach ( @groups ) {
484 my $group = $_->{'groupname'};
485 $sth->execute( $username, $group )
486 or die "can't delete from groupname table: ". $sth->errstr;
491 sub sqlradius_rename { #subroutine, not method
492 my $dbh = sqlradius_connect(shift, shift, shift);
493 my($new_username, $old_username) = (shift, shift);
494 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
495 foreach my $table (qw(radreply radcheck), $usergroup ) {
496 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
498 $sth->execute($new_username, $old_username)
499 or die "can't update $table: ". $sth->errstr;
504 sub sqlradius_attrib_delete { #subroutine, not method
505 my $dbh = sqlradius_connect(shift, shift, shift);
506 my( $table, $username, @attrib ) = @_;
508 foreach my $attribute ( @attrib ) {
509 my $sth = $dbh->prepare(
510 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
512 $sth->execute($username,$attribute)
513 or die "can't delete from rad$table table: ". $sth->errstr;
518 sub sqlradius_delete { #subroutine, not method
519 my $dbh = sqlradius_connect(shift, shift, shift);
520 my $username = shift;
521 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
523 foreach my $table (qw( radcheck radreply), $usergroup ) {
524 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
525 $sth->execute($username)
526 or die "can't delete from $table table: ". $sth->errstr;
531 sub sqlradius_connect {
532 #my($datasrc, $username, $password) = @_;
533 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
534 DBI->connect(@_) or die $DBI::errstr;
537 sub sqlreplace_usergroups {
538 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
540 # (sorta) false laziness with FS::svc_acct::replace
541 my @oldgroups = @$old;
542 my @newgroups = @$new;
544 foreach my $oldgroup ( @oldgroups ) {
545 if ( grep { $oldgroup eq $_ } @newgroups ) {
546 @newgroups = grep { $oldgroup ne $_ } @newgroups;
549 push @delgroups, $oldgroup;
552 my $usergroup = $self->option('usergroup') || 'usergroup';
555 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
556 $username, $usergroup, @delgroups );
558 unless ref($err_or_queue);
560 my $error = $err_or_queue->depend_insert( $jobnum );
561 return $error if $error;
566 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
567 "with ". join(", ", @newgroups)
569 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
570 $username, $usergroup, @newgroups );
572 unless ref($err_or_queue);
574 my $error = $err_or_queue->depend_insert( $jobnum );
575 return $error if $error;
584 =item usage_sessions HASHREF
586 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
588 New-style: pass a hashref with the following keys:
592 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
594 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
596 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
598 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
600 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
612 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
613 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
616 SVC_ACCT, if specified, limits the results to the specified account.
618 IP, if specified, limits the results to the specified IP address.
620 PREFIX, if specified, limits the results to records with a matching
623 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
624 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
626 Returns an arrayref of hashrefs with the following fields:
632 =item framedipaddress
638 =item acctsessiontime
640 =item acctinputoctets
642 =item acctoutputoctets
644 =item calledstationid
650 #some false laziness w/cust_svc::seconds_since_sqlradacct
656 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
660 $start = $opt->{stoptime_start};
661 $end = $opt->{stoptime_end};
662 $svc_acct = $opt->{svc_acct};
664 $prefix = $opt->{prefix};
665 $summarize = $opt->{summarize};
667 ( $start, $end ) = splice(@_, 0, 2);
668 $svc_acct = @_ ? shift : '';
669 $ip = @_ ? shift : '';
670 $prefix = @_ ? shift : '';
671 #my $select = @_ ? shift : '*';
676 return [] if $self->option('ignore_accounting');
678 my $dbh = sqlradius_connect( map $self->option($_),
679 qw( datasrc username password ) );
681 #select a unix time conversion function based on database type
682 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
685 qw( username realm framedipaddress
686 acctsessiontime acctinputoctets acctoutputoctets
689 "$str2time acctstarttime ) as acctstarttime",
690 "$str2time acctstoptime ) as acctstoptime",
693 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
694 'sum(acctoutputoctets) as acctoutputoctets',
701 my $username = $self->export_username($svc_acct);
702 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
703 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
704 push @param, $username, $1, $2;
706 push @where, 'UserName = ?';
707 push @param, $username;
711 if ($self->option('process_single_realm')) {
712 push @where, 'Realm = ?';
713 push @param, $self->option('realm');
717 push @where, ' FramedIPAddress = ?';
721 if ( length($prefix) ) {
722 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
723 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
727 push @where, "$str2time AcctStopTime ) >= ?";
731 push @where, "$str2time AcctStopTime ) <= ?";
734 if ( $opt->{open_sessions} ) {
735 push @where, 'AcctStopTime IS NULL';
737 if ( $opt->{starttime_start} ) {
738 push @where, "$str2time AcctStartTime ) >= ?";
739 push @param, $opt->{starttime_start};
741 if ( $opt->{starttime_end} ) {
742 push @where, "$str2time AcctStartTime ) <= ?";
743 push @param, $opt->{starttime_end};
746 my $where = join(' AND ', @where);
747 $where = "WHERE $where" if $where;
750 $groupby = 'GROUP BY username' if $summarize;
752 my $orderby = 'ORDER BY AcctStartTime DESC';
753 $orderby = '' if $summarize;
755 my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
756 " FROM radacct $where $groupby $orderby
757 ") or die $dbh->errstr;
758 $sth->execute(@param) or die $sth->errstr;
760 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
771 my $conf = new FS::Conf;
774 my $dbh = sqlradius_connect( map $self->option($_),
775 qw( datasrc username password ) );
777 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
778 my @fields = qw( radacctid username realm acctsessiontime );
783 my $sth = $dbh->prepare("
784 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
785 $str2time AcctStartTime), $str2time AcctStopTime),
786 AcctInputOctets, AcctOutputOctets
788 WHERE FreesideStatus IS NULL
789 AND AcctStopTime IS NOT NULL
790 ") or die $dbh->errstr;
791 $sth->execute() or die $sth->errstr;
793 while ( my $row = $sth->fetchrow_arrayref ) {
794 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
795 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
796 warn "processing record: ".
797 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
800 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
802 #my %search = ( 'username' => $UserName );
805 if ( ref($self) =~ /withdomain/ ) { #well...
806 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
807 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
810 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
811 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
813 my $status = 'skipped';
814 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
815 "(UserName $UserName, Realm $Realm)";
817 if ( $self->option('process_single_realm')
818 && $self->option('realm') ne $Realm )
820 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
823 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
824 'svcpart' => $_->cust_svc->svcpart, } )
827 { 'username' => $UserName },
833 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
834 } elsif ( scalar(@svc_acct) > 1 ) {
835 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
838 my $svc_acct = $svc_acct[0];
839 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
841 $svc_acct->last_login($AcctStartTime);
842 $svc_acct->last_logout($AcctStopTime);
844 my $session_time = $AcctStopTime;
845 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
847 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
848 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
849 || $cust_pkg->setup ) ) {
850 $status = 'skipped (too old)';
853 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
854 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
855 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
856 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
857 + $AcctOutputOctets);
858 $status=join(' ', @st);
863 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
864 my $psth = $dbh->prepare("UPDATE radacct
865 SET FreesideStatus = ?
867 ) or die $dbh->errstr;
868 $psth->execute($status, $RadAcctId) or die $psth->errstr;
870 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
877 my ($svc_acct, $column, $amount) = @_;
878 if ( $svc_acct->$column !~ /^$/ ) {
879 warn " svc_acct.$column found (". $svc_acct->$column.
882 my $method = 'decrement_' . $column;
883 my $error = $svc_acct->$method($amount);
884 die $error if $error;
887 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
892 =item export_nas_insert NAS
894 =item export_nas_delete NAS
896 =item export_nas_replace NEW_NAS OLD_NAS
898 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
899 server. Currently requires the table to be named 'nas' and to follow
900 the stock schema (/etc/freeradius/nas.sql).
904 sub export_nas_insert { shift->export_nas_action('insert', @_); }
905 sub export_nas_delete { shift->export_nas_action('delete', @_); }
906 sub export_nas_replace { shift->export_nas_action('replace', @_); }
908 sub export_nas_action {
910 my ($action, $new, $old) = @_;
911 # find the NAS in the target table by its name
912 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
913 my $nasnum = $new->nasnum;
915 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
919 return $err_or_queue unless ref $err_or_queue;
923 sub sqlradius_nas_insert {
924 my $dbh = sqlradius_connect(shift, shift, shift);
926 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
927 or die "nasnum ".$opt{'nasnum'}.' not found';
928 # insert actual NULLs where FS::Record has translated to empty strings
929 my @values = map { length($nas->$_) ? $nas->$_ : undef }
930 qw( nasname shortname type secret server community description );
931 my $sth = $dbh->prepare('INSERT INTO nas
932 (nasname, shortname, type, secret, server, community, description)
933 VALUES (?, ?, ?, ?, ?, ?, ?)');
934 $sth->execute(@values) or die $dbh->errstr;
937 sub sqlradius_nas_delete {
938 my $dbh = sqlradius_connect(shift, shift, shift);
940 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
941 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
944 sub sqlradius_nas_replace {
945 my $dbh = sqlradius_connect(shift, shift, shift);
947 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
948 or die "nasnum ".$opt{'nasnum'}.' not found';
949 my @values = map {$nas->$_}
950 qw( nasname shortname type secret server community description );
951 my $sth = $dbh->prepare('UPDATE nas SET
952 nasname = ?, shortname = ?, type = ?, secret = ?,
953 server = ?, community = ?, description = ?
955 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
958 =item export_attr_insert RADIUS_ATTR
960 =item export_attr_delete RADIUS_ATTR
962 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
964 Update the group attribute tables (radgroupcheck and radgroupreply) on
965 the RADIUS server. In delete and replace actions, the existing records
966 are identified by the combination of group name and attribute name.
968 In the special case where attributes are being replaced because a group
969 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
970 'groupname' must be set in OLD_RADIUS_ATTR.
974 # some false laziness with NAS export stuff...
976 sub export_attr_insert { shift->export_attr_action('insert', @_); }
978 sub export_attr_delete { shift->export_attr_action('delete', @_); }
980 sub export_attr_replace { shift->export_attr_action('replace', @_); }
982 sub export_attr_action {
984 my ($action, $new, $old) = @_;
987 if ( $action eq 'delete' ) {
990 if ( $action eq 'delete' or $action eq 'replace' ) {
991 # delete based on an exact match
993 attrname => $old->attrname,
994 attrtype => $old->attrtype,
995 groupname => $old->groupname || $old->radius_group->groupname,
997 value => $old->value,
999 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1000 return $err_or_queue unless ref $err_or_queue;
1002 # this probably doesn't matter, but just to be safe...
1003 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1004 if ( $action eq 'replace' or $action eq 'insert' ) {
1006 attrname => $new->attrname,
1007 attrtype => $new->attrtype,
1008 groupname => $new->radius_group->groupname,
1010 value => $new->value,
1012 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1013 $err_or_queue->depend_insert($jobnum) if $jobnum;
1014 return $err_or_queue unless ref $err_or_queue;
1019 sub sqlradius_attr_insert {
1020 my $dbh = sqlradius_connect(shift, shift, shift);
1024 # make sure $table is completely safe
1025 if ( $opt{'attrtype'} eq 'C' ) {
1026 $table = 'radgroupcheck';
1028 elsif ( $opt{'attrtype'} eq 'R' ) {
1029 $table = 'radgroupreply';
1032 die "unknown attribute type '$opt{attrtype}'";
1035 my @values = @opt{ qw(groupname attrname op value) };
1036 my $sth = $dbh->prepare(
1037 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1039 $sth->execute(@values) or die $dbh->errstr;
1042 sub sqlradius_attr_delete {
1043 my $dbh = sqlradius_connect(shift, shift, shift);
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 'DELETE FROM '.$table.
1060 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1063 $sth->execute(@values) or die $dbh->errstr;
1066 #sub sqlradius_attr_replace { no longer needed
1068 =item export_group_replace NEW OLD
1070 Replace the L<FS::radius_group> object OLD with NEW. This will change
1071 the group name and priority in all radusergroup records, and the group
1072 name in radgroupcheck and radgroupreply.
1076 sub export_group_replace {
1078 my ($new, $old) = @_;
1079 return '' if $new->groupname eq $old->groupname
1080 and $new->priority == $old->priority;
1082 my $err_or_queue = $self->sqlradius_queue(
1085 ($self->option('usergroup') || 'usergroup'),
1089 return $err_or_queue unless ref $err_or_queue;
1093 sub sqlradius_group_replace {
1094 my $dbh = sqlradius_connect(shift, shift, shift);
1095 my $usergroup = shift;
1096 $usergroup =~ /^(rad)?usergroup$/
1097 or die "bad usergroup table name: $usergroup";
1098 my ($new, $old) = (shift, shift);
1099 # apply renames to check/reply attribute tables
1100 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1101 foreach my $table (qw(radgroupcheck radgroupreply)) {
1102 my $sth = $dbh->prepare(
1103 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1105 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1106 or die $dbh->errstr;
1109 # apply renames and priority changes to usergroup table
1110 my $sth = $dbh->prepare(
1111 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1113 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1114 or die $dbh->errstr;
1118 # class method to fetch groups/attributes from the sqlradius install on upgrade
1121 sub _upgrade_exporttype {
1122 # do this only if the radius_attr table is empty
1123 local $FS::radius_attr::noexport_hack = 1;
1125 return if qsearch('radius_attr', {});
1127 foreach my $self ($class->all_sqlradius) {
1128 my $error = $self->import_attrs;
1129 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1136 my $dbh = DBI->connect( map $self->option($_),
1137 qw( datasrc username password ) );
1139 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1143 my $usergroup = $self->option('usergroup') || 'usergroup';
1145 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1148 # map out existing groups and attrs
1151 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1152 $attrs_of{$radius_group->groupname} = +{
1153 map { $_->attrname => $_ } $radius_group->radius_attr
1155 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1158 # get groupnames from radgroupcheck and radgroupreply
1160 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1162 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1163 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1164 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1165 warn "$groupname.$attrname\n";
1166 if ( !exists($groupnum_of{$groupname}) ) {
1167 my $radius_group = new FS::radius_group {
1168 'groupname' => $groupname,
1171 $error = $radius_group->insert;
1173 warn "error inserting group $groupname: $error";
1174 next;#don't continue trying to insert the attribute
1176 $attrs_of{$groupname} = {};
1177 $groupnum_of{$groupname} = $radius_group->groupnum;
1180 my $a = $attrs_of{$groupname};
1181 my $old = $a->{$attrname};
1184 if ( defined $old ) {
1186 $new = new FS::radius_attr {
1191 $error = $new->replace($old);
1193 warn "error modifying attr $attrname: $error";
1198 $new = new FS::radius_attr {
1199 'groupnum' => $groupnum_of{$groupname},
1200 'attrname' => $attrname,
1201 'attrtype' => $attrtype,
1205 $error = $new->insert;
1207 warn "error inserting attr $attrname: $error" if $error;
1211 $attrs_of{$groupname}->{$attrname} = $new;
1223 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1224 # (radiator is supposed to be setup with a radacct table)
1225 #i suppose it would be more slick to look for things that inherit from us..
1227 my @part_export = ();
1228 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1229 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1230 broadband_sqlradius );
1234 sub all_sqlradius_withaccounting {
1236 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;