1 package FS::part_export::sqlradius;
4 use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
7 use FS::Record qw( dbh qsearch qsearchs str2time_sql );
13 @ISA = qw(FS::part_export);
14 @EXPORT_OK = qw( sqlradius_connect );
19 tie %options, 'Tie::IxHash',
20 'datasrc' => { label=>'DBI data source ' },
21 'username' => { label=>'Database username' },
22 'password' => { label=>'Database password' },
23 'usergroup' => { label => 'Group table',
25 options => [qw( usergroup radusergroup ) ],
27 'ignore_accounting' => {
29 label => 'Ignore accounting records from this database'
31 'process_single_realm' => {
33 label => 'Only process one realm of accounting records',
35 'realm' => { label => 'The realm of of accounting records to be processed' },
36 'ignore_long_sessions' => {
38 label => 'Ignore sessions which span billing periods',
42 label => 'Hide IP address information on session reports',
46 label => 'Hide download/upload information on session reports',
48 'show_called_station' => {
50 label => 'Show the Called-Station-ID on session reports',
52 'overlimit_groups' => {
53 label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)',
59 option_values => sub {
61 map { $_->groupnum, $_->long_description }
62 qsearch('radius_group', {}),
67 'groups_susp_reason' => { label =>
68 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
73 label => 'Export RADIUS group attributes to this database',
78 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
79 tables to any SQL database for
80 <a href="http://www.freeradius.org/">FreeRADIUS</a>
81 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
85 An existing RADIUS database will be updated in realtime, but you can use
86 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
87 to delete the entire RADIUS database and repopulate the tables from the
88 Freeside database. See the
89 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
91 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
92 for the exact syntax of a DBI data source.
94 <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.
95 <li>Using ICRADIUS, add a dummy "op" column to your database:
97 ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
98 ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
99 ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
100 ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
102 <li>Using Radiator, see the
103 <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
104 for configuration information.
110 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
111 'options' => \%options,
114 'nas' => 'Y', # show export_nas selection in UI
115 'default_svc_class' => 'Internet',
117 'This export does not export RADIUS realms (see also '.
118 'sqlradius_withdomain). '.
122 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
123 split( "\n", shift->option('groups_susp_reason'));
126 sub rebless { shift; }
128 sub export_username { # override for other svcdb
129 my($self, $svc_acct) = (shift, shift);
130 warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
134 sub radius_reply { #override for other svcdb
135 my($self, $svc_acct) = (shift, shift);
136 $svc_acct->radius_reply;
139 sub radius_check { #override for other svcdb
140 my($self, $svc_acct) = (shift, shift);
141 $svc_acct->radius_check;
145 my($self, $svc_x) = (shift, shift);
147 foreach my $table (qw(reply check)) {
148 my $method = "radius_$table";
149 my %attrib = $self->$method($svc_x);
150 next unless keys %attrib;
151 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
152 $table, $self->export_username($svc_x), %attrib );
153 return $err_or_queue unless ref($err_or_queue);
155 my @groups = $svc_x->radius_groups('hashref');
157 cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
158 " (". $self->export_username($svc_x). " with ". join(", ", @groups)
160 my $usergroup = $self->option('usergroup') || 'usergroup';
161 my $err_or_queue = $self->sqlradius_queue(
162 $svc_x->svcnum, 'usergroup_insert',
163 $self->export_username($svc_x), $usergroup, @groups );
164 return $err_or_queue unless ref($err_or_queue);
169 sub _export_replace {
170 my( $self, $new, $old ) = (shift, shift, shift);
172 local $SIG{HUP} = 'IGNORE';
173 local $SIG{INT} = 'IGNORE';
174 local $SIG{QUIT} = 'IGNORE';
175 local $SIG{TERM} = 'IGNORE';
176 local $SIG{TSTP} = 'IGNORE';
177 local $SIG{PIPE} = 'IGNORE';
179 my $oldAutoCommit = $FS::UID::AutoCommit;
180 local $FS::UID::AutoCommit = 0;
184 if ( $self->export_username($old) ne $self->export_username($new) ) {
185 my $usergroup = $self->option('usergroup') || 'usergroup';
186 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
187 $self->export_username($new), $self->export_username($old), $usergroup );
188 unless ( ref($err_or_queue) ) {
189 $dbh->rollback if $oldAutoCommit;
190 return $err_or_queue;
192 $jobnum = $err_or_queue->jobnum;
195 foreach my $table (qw(reply check)) {
196 my $method = "radius_$table";
197 my %new = $new->$method();
198 my %old = $old->$method();
199 if ( grep { !exists $old{$_} #new attributes
200 || $new{$_} ne $old{$_} #changed
203 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
204 $table, $self->export_username($new), %new );
205 unless ( ref($err_or_queue) ) {
206 $dbh->rollback if $oldAutoCommit;
207 return $err_or_queue;
210 my $error = $err_or_queue->depend_insert( $jobnum );
212 $dbh->rollback if $oldAutoCommit;
216 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
219 my @del = grep { !exists $new{$_} } keys %old;
221 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
222 $table, $self->export_username($new), @del );
223 unless ( ref($err_or_queue) ) {
224 $dbh->rollback if $oldAutoCommit;
225 return $err_or_queue;
228 my $error = $err_or_queue->depend_insert( $jobnum );
230 $dbh->rollback if $oldAutoCommit;
234 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
239 my (@oldgroups) = $old->radius_groups('hashref');
240 my (@newgroups) = $new->radius_groups('hashref');
241 $error = $self->sqlreplace_usergroups( $new->svcnum,
242 $self->export_username($new),
243 $jobnum ? $jobnum : '',
248 $dbh->rollback if $oldAutoCommit;
252 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
257 #false laziness w/broadband_sqlradius.pm
258 sub _export_suspend {
259 my( $self, $svc_acct ) = (shift, shift);
261 my $new = $svc_acct->clone_suspended;
263 local $SIG{HUP} = 'IGNORE';
264 local $SIG{INT} = 'IGNORE';
265 local $SIG{QUIT} = 'IGNORE';
266 local $SIG{TERM} = 'IGNORE';
267 local $SIG{TSTP} = 'IGNORE';
268 local $SIG{PIPE} = 'IGNORE';
270 my $oldAutoCommit = $FS::UID::AutoCommit;
271 local $FS::UID::AutoCommit = 0;
274 my @newgroups = $self->suspended_usergroups($svc_acct);
276 unless (@newgroups) { #don't change password if assigning to a suspended group
278 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
279 'check', $self->export_username($new), $new->radius_check );
280 unless ( ref($err_or_queue) ) {
281 $dbh->rollback if $oldAutoCommit;
282 return $err_or_queue;
288 $self->sqlreplace_usergroups(
290 $self->export_username($new),
292 [ $svc_acct->radius_groups('hashref') ],
296 $dbh->rollback if $oldAutoCommit;
299 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
304 sub _export_unsuspend {
305 my( $self, $svc_x ) = (shift, shift);
307 local $SIG{HUP} = 'IGNORE';
308 local $SIG{INT} = 'IGNORE';
309 local $SIG{QUIT} = 'IGNORE';
310 local $SIG{TERM} = 'IGNORE';
311 local $SIG{TSTP} = 'IGNORE';
312 local $SIG{PIPE} = 'IGNORE';
314 my $oldAutoCommit = $FS::UID::AutoCommit;
315 local $FS::UID::AutoCommit = 0;
318 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
319 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
320 unless ( ref($err_or_queue) ) {
321 $dbh->rollback if $oldAutoCommit;
322 return $err_or_queue;
326 my (@oldgroups) = $self->suspended_usergroups($svc_x);
327 $error = $self->sqlreplace_usergroups(
329 $self->export_username($svc_x),
332 [ $svc_x->radius_groups('hashref') ],
335 $dbh->rollback if $oldAutoCommit;
338 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
344 my( $self, $svc_x ) = (shift, shift);
345 my $usergroup = $self->option('usergroup') || 'usergroup';
346 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
347 $self->export_username($svc_x), $usergroup );
348 ref($err_or_queue) ? '' : $err_or_queue;
351 sub sqlradius_queue {
352 my( $self, $svcnum, $method ) = (shift, shift, shift);
354 my $queue = new FS::queue {
356 'job' => "FS::part_export::sqlradius::sqlradius_$method",
359 $self->option('datasrc'),
360 $self->option('username'),
361 $self->option('password'),
366 sub suspended_usergroups {
367 my ($self, $svc_x) = (shift, shift);
369 return () unless $svc_x;
371 my $svc_table = $svc_x->table;
373 #false laziness with FS::part_export::shellcommands
374 #subclass part_export?
376 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
377 my %reasonmap = $self->_groups_susp_reason_map;
380 $userspec = $reasonmap{$r->reasonnum}
381 if exists($reasonmap{$r->reasonnum});
382 $userspec = $reasonmap{$r->reason}
383 if (!$userspec && exists($reasonmap{$r->reason}));
386 if ( $userspec =~ /^\d+$/ ){
387 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
388 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
389 my ($username,$domain) = split(/\@/, $userspec);
390 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
391 $suspend_svc = $user if $userspec eq $user->email;
393 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
394 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
397 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
401 sub sqlradius_insert { #subroutine, not method
402 my $dbh = sqlradius_connect(shift, shift, shift);
403 my( $table, $username, %attributes ) = @_;
405 foreach my $attribute ( keys %attributes ) {
407 my $s_sth = $dbh->prepare(
408 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
409 ) or die $dbh->errstr;
410 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
412 if ( $s_sth->fetchrow_arrayref->[0] ) {
414 my $u_sth = $dbh->prepare(
415 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
416 ) or die $dbh->errstr;
417 $u_sth->execute($attributes{$attribute}, $username, $attribute)
418 or die $u_sth->errstr;
422 my $i_sth = $dbh->prepare(
423 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
424 "VALUES ( ?, ?, ?, ? )"
425 ) or die $dbh->errstr;
429 ( $attribute eq 'Password' ? '==' : ':=' ),
430 $attributes{$attribute},
431 ) or die $i_sth->errstr;
439 sub sqlradius_usergroup_insert { #subroutine, not method
440 my $dbh = sqlradius_connect(shift, shift, shift);
441 my $username = shift;
442 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
445 my $s_sth = $dbh->prepare(
446 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
447 ) or die $dbh->errstr;
449 my $sth = $dbh->prepare(
450 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
451 ) or die $dbh->errstr;
453 foreach ( @groups ) {
454 my $group = $_->{'groupname'};
455 my $priority = $_->{'priority'};
456 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
457 if ($s_sth->fetchrow_arrayref->[0]) {
458 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
459 "$group for $username\n"
463 $sth->execute( $username, $group, $priority )
464 or die "can't insert into groupname table: ". $sth->errstr;
466 if ( $s_sth->{Active} ) {
467 warn "sqlradius s_sth still active; calling ->finish()";
470 if ( $sth->{Active} ) {
471 warn "sqlradius sth still active; calling ->finish()";
477 sub sqlradius_usergroup_delete { #subroutine, not method
478 my $dbh = sqlradius_connect(shift, shift, shift);
479 my $username = shift;
480 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
483 my $sth = $dbh->prepare(
484 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
485 ) or die $dbh->errstr;
486 foreach ( @groups ) {
487 my $group = $_->{'groupname'};
488 $sth->execute( $username, $group )
489 or die "can't delete from groupname table: ". $sth->errstr;
494 sub sqlradius_rename { #subroutine, not method
495 my $dbh = sqlradius_connect(shift, shift, shift);
496 my($new_username, $old_username) = (shift, shift);
497 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
498 foreach my $table (qw(radreply radcheck), $usergroup ) {
499 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
501 $sth->execute($new_username, $old_username)
502 or die "can't update $table: ". $sth->errstr;
507 sub sqlradius_attrib_delete { #subroutine, not method
508 my $dbh = sqlradius_connect(shift, shift, shift);
509 my( $table, $username, @attrib ) = @_;
511 foreach my $attribute ( @attrib ) {
512 my $sth = $dbh->prepare(
513 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
515 $sth->execute($username,$attribute)
516 or die "can't delete from rad$table table: ". $sth->errstr;
521 sub sqlradius_delete { #subroutine, not method
522 my $dbh = sqlradius_connect(shift, shift, shift);
523 my $username = shift;
524 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
526 foreach my $table (qw( radcheck radreply), $usergroup ) {
527 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
528 $sth->execute($username)
529 or die "can't delete from $table table: ". $sth->errstr;
534 sub sqlradius_connect {
535 #my($datasrc, $username, $password) = @_;
536 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
537 DBI->connect(@_) or die $DBI::errstr;
540 sub sqlreplace_usergroups {
541 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
543 # (sorta) false laziness with FS::svc_acct::replace
544 my @oldgroups = @$old;
545 my @newgroups = @$new;
547 foreach my $oldgroup ( @oldgroups ) {
548 if ( grep { $oldgroup eq $_ } @newgroups ) {
549 @newgroups = grep { $oldgroup ne $_ } @newgroups;
552 push @delgroups, $oldgroup;
555 my $usergroup = $self->option('usergroup') || 'usergroup';
558 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
559 $username, $usergroup, @delgroups );
561 unless ref($err_or_queue);
563 my $error = $err_or_queue->depend_insert( $jobnum );
564 return $error if $error;
566 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
570 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
571 "with ". join(", ", @newgroups)
573 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
574 $username, $usergroup, @newgroups );
576 unless ref($err_or_queue);
578 my $error = $err_or_queue->depend_insert( $jobnum );
579 return $error if $error;
588 =item usage_sessions HASHREF
590 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
592 New-style: pass a hashref with the following keys:
596 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
598 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
600 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
602 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
604 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
616 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
617 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
620 SVC_ACCT, if specified, limits the results to the specified account.
622 IP, if specified, limits the results to the specified IP address.
624 PREFIX, if specified, limits the results to records with a matching
627 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
628 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
630 Returns an arrayref of hashrefs with the following fields:
636 =item framedipaddress
642 =item acctsessiontime
644 =item acctinputoctets
646 =item acctoutputoctets
648 =item calledstationid
654 #some false laziness w/cust_svc::seconds_since_sqlradacct
660 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
664 $start = $opt->{stoptime_start};
665 $end = $opt->{stoptime_end};
666 $svc_acct = $opt->{svc_acct};
668 $prefix = $opt->{prefix};
669 $summarize = $opt->{summarize};
671 ( $start, $end ) = splice(@_, 0, 2);
672 $svc_acct = @_ ? shift : '';
673 $ip = @_ ? shift : '';
674 $prefix = @_ ? shift : '';
675 #my $select = @_ ? shift : '*';
680 return [] if $self->option('ignore_accounting');
682 my $dbh = sqlradius_connect( map $self->option($_),
683 qw( datasrc username password ) );
685 #select a unix time conversion function based on database type
686 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
689 qw( username realm framedipaddress
690 acctsessiontime acctinputoctets acctoutputoctets
693 "$str2time acctstarttime ) as acctstarttime",
694 "$str2time acctstoptime ) as acctstoptime",
697 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
698 'sum(acctoutputoctets) as acctoutputoctets',
705 my $username = $self->export_username($svc_acct);
706 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
707 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
708 push @param, $username, $1, $2;
710 push @where, 'UserName = ?';
711 push @param, $username;
715 if ($self->option('process_single_realm')) {
716 push @where, 'Realm = ?';
717 push @param, $self->option('realm');
721 push @where, ' FramedIPAddress = ?';
725 if ( length($prefix) ) {
726 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
727 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
730 if ( $opt->{open_sessions} ) {
731 push @where, 'AcctStopTime IS NULL';
735 push @where, "$str2time AcctStopTime ) >= ?";
739 push @where, "$str2time AcctStopTime ) <= ?";
745 if ( $opt->{starttime_start} ) {
746 push @where, "$str2time AcctStartTime ) >= ?";
747 push @param, $opt->{starttime_start};
749 if ( $opt->{starttime_end} ) {
750 push @where, "$str2time AcctStartTime ) <= ?";
751 push @param, $opt->{starttime_end};
754 my $where = join(' AND ', @where);
755 $where = "WHERE $where" if $where;
758 $groupby = 'GROUP BY username' if $summarize;
760 my $orderby = 'ORDER BY AcctStartTime DESC';
761 $orderby = '' if $summarize;
763 my $sql = 'SELECT '. join(', ', @fields).
764 " FROM radacct $where $groupby $orderby";
767 warn join(',', @param);
769 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
770 $sth->execute(@param) or die $sth->errstr;
772 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
783 my $conf = new FS::Conf;
786 my $dbh = sqlradius_connect( map $self->option($_),
787 qw( datasrc username password ) );
789 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
790 my @fields = qw( radacctid username realm acctsessiontime );
795 my $sth = $dbh->prepare("
796 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
797 $str2time AcctStartTime), $str2time AcctStopTime),
798 AcctInputOctets, AcctOutputOctets
800 WHERE FreesideStatus IS NULL
801 AND AcctStopTime IS NOT NULL
802 ") or die $dbh->errstr;
803 $sth->execute() or die $sth->errstr;
805 while ( my $row = $sth->fetchrow_arrayref ) {
806 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
807 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
808 warn "processing record: ".
809 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
812 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
814 #my %search = ( 'username' => $UserName );
817 if ( ref($self) =~ /withdomain/ ) { #well...
818 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
819 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
822 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
823 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
825 my $status = 'skipped';
826 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
827 "(UserName $UserName, Realm $Realm)";
829 if ( $self->option('process_single_realm')
830 && $self->option('realm') ne $Realm )
832 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
835 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
836 'svcpart' => $_->cust_svc->svcpart, } )
839 { 'username' => $UserName },
845 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
846 } elsif ( scalar(@svc_acct) > 1 ) {
847 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
850 my $svc_acct = $svc_acct[0];
851 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
853 $svc_acct->last_login($AcctStartTime);
854 $svc_acct->last_logout($AcctStopTime);
856 my $session_time = $AcctStopTime;
857 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
859 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
860 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
861 || $cust_pkg->setup ) ) {
862 $status = 'skipped (too old)';
865 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
866 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
867 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
868 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
869 + $AcctOutputOctets);
870 $status=join(' ', @st);
875 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
876 my $psth = $dbh->prepare("UPDATE radacct
877 SET FreesideStatus = ?
879 ) or die $dbh->errstr;
880 $psth->execute($status, $RadAcctId) or die $psth->errstr;
882 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
889 my ($svc_acct, $column, $amount) = @_;
890 if ( $svc_acct->$column !~ /^$/ ) {
891 warn " svc_acct.$column found (". $svc_acct->$column.
894 my $method = 'decrement_' . $column;
895 my $error = $svc_acct->$method($amount);
896 die $error if $error;
899 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
904 =item export_nas_insert NAS
906 =item export_nas_delete NAS
908 =item export_nas_replace NEW_NAS OLD_NAS
910 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
911 server. Currently requires the table to be named 'nas' and to follow
912 the stock schema (/etc/freeradius/nas.sql).
916 sub export_nas_insert { shift->export_nas_action('insert', @_); }
917 sub export_nas_delete { shift->export_nas_action('delete', @_); }
918 sub export_nas_replace { shift->export_nas_action('replace', @_); }
920 sub export_nas_action {
922 my ($action, $new, $old) = @_;
923 # find the NAS in the target table by its name
924 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
925 my $nasnum = $new->nasnum;
927 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
931 return $err_or_queue unless ref $err_or_queue;
935 sub sqlradius_nas_insert {
936 my $dbh = sqlradius_connect(shift, shift, shift);
938 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
939 or die "nasnum ".$opt{'nasnum'}.' not found';
940 # insert actual NULLs where FS::Record has translated to empty strings
941 my @values = map { length($nas->$_) ? $nas->$_ : undef }
942 qw( nasname shortname type secret server community description );
943 my $sth = $dbh->prepare('INSERT INTO nas
944 (nasname, shortname, type, secret, server, community, description)
945 VALUES (?, ?, ?, ?, ?, ?, ?)');
946 $sth->execute(@values) or die $dbh->errstr;
949 sub sqlradius_nas_delete {
950 my $dbh = sqlradius_connect(shift, shift, shift);
952 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
953 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
956 sub sqlradius_nas_replace {
957 my $dbh = sqlradius_connect(shift, shift, shift);
959 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
960 or die "nasnum ".$opt{'nasnum'}.' not found';
961 my @values = map {$nas->$_}
962 qw( nasname shortname type secret server community description );
963 my $sth = $dbh->prepare('UPDATE nas SET
964 nasname = ?, shortname = ?, type = ?, secret = ?,
965 server = ?, community = ?, description = ?
967 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
970 =item export_attr_insert RADIUS_ATTR
972 =item export_attr_delete RADIUS_ATTR
974 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
976 Update the group attribute tables (radgroupcheck and radgroupreply) on
977 the RADIUS server. In delete and replace actions, the existing records
978 are identified by the combination of group name and attribute name.
980 In the special case where attributes are being replaced because a group
981 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
982 'groupname' must be set in OLD_RADIUS_ATTR.
986 # some false laziness with NAS export stuff...
988 sub export_attr_insert { shift->export_attr_action('insert', @_); }
990 sub export_attr_delete { shift->export_attr_action('delete', @_); }
992 sub export_attr_replace { shift->export_attr_action('replace', @_); }
994 sub export_attr_action {
996 my ($action, $new, $old) = @_;
999 if ( $action eq 'delete' ) {
1002 if ( $action eq 'delete' or $action eq 'replace' ) {
1003 # delete based on an exact match
1005 attrname => $old->attrname,
1006 attrtype => $old->attrtype,
1007 groupname => $old->groupname || $old->radius_group->groupname,
1009 value => $old->value,
1011 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1012 return $err_or_queue unless ref $err_or_queue;
1014 # this probably doesn't matter, but just to be safe...
1015 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1016 if ( $action eq 'replace' or $action eq 'insert' ) {
1018 attrname => $new->attrname,
1019 attrtype => $new->attrtype,
1020 groupname => $new->radius_group->groupname,
1022 value => $new->value,
1024 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1025 $err_or_queue->depend_insert($jobnum) if $jobnum;
1026 return $err_or_queue unless ref $err_or_queue;
1031 sub sqlradius_attr_insert {
1032 my $dbh = sqlradius_connect(shift, shift, shift);
1036 # make sure $table is completely safe
1037 if ( $opt{'attrtype'} eq 'C' ) {
1038 $table = 'radgroupcheck';
1040 elsif ( $opt{'attrtype'} eq 'R' ) {
1041 $table = 'radgroupreply';
1044 die "unknown attribute type '$opt{attrtype}'";
1047 my @values = @opt{ qw(groupname attrname op value) };
1048 my $sth = $dbh->prepare(
1049 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1051 $sth->execute(@values) or die $dbh->errstr;
1054 sub sqlradius_attr_delete {
1055 my $dbh = sqlradius_connect(shift, shift, shift);
1059 if ( $opt{'attrtype'} eq 'C' ) {
1060 $table = 'radgroupcheck';
1062 elsif ( $opt{'attrtype'} eq 'R' ) {
1063 $table = 'radgroupreply';
1066 die "unknown attribute type '".$opt{'attrtype'}."'";
1069 my @values = @opt{ qw(groupname attrname op value) };
1070 my $sth = $dbh->prepare(
1071 'DELETE FROM '.$table.
1072 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1075 $sth->execute(@values) or die $dbh->errstr;
1078 #sub sqlradius_attr_replace { no longer needed
1080 =item export_group_replace NEW OLD
1082 Replace the L<FS::radius_group> object OLD with NEW. This will change
1083 the group name and priority in all radusergroup records, and the group
1084 name in radgroupcheck and radgroupreply.
1088 sub export_group_replace {
1090 my ($new, $old) = @_;
1091 return '' if $new->groupname eq $old->groupname
1092 and $new->priority == $old->priority;
1094 my $err_or_queue = $self->sqlradius_queue(
1097 ($self->option('usergroup') || 'usergroup'),
1101 return $err_or_queue unless ref $err_or_queue;
1105 sub sqlradius_group_replace {
1106 my $dbh = sqlradius_connect(shift, shift, shift);
1107 my $usergroup = shift;
1108 $usergroup =~ /^(rad)?usergroup$/
1109 or die "bad usergroup table name: $usergroup";
1110 my ($new, $old) = (shift, shift);
1111 # apply renames to check/reply attribute tables
1112 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1113 foreach my $table (qw(radgroupcheck radgroupreply)) {
1114 my $sth = $dbh->prepare(
1115 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1117 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1118 or die $dbh->errstr;
1121 # apply renames and priority changes to usergroup table
1122 my $sth = $dbh->prepare(
1123 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1125 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1126 or die $dbh->errstr;
1130 # class method to fetch groups/attributes from the sqlradius install on upgrade
1133 sub _upgrade_exporttype {
1134 # do this only if the radius_attr table is empty
1135 local $FS::radius_attr::noexport_hack = 1;
1137 return if qsearch('radius_attr', {});
1139 foreach my $self ($class->all_sqlradius) {
1140 my $error = $self->import_attrs;
1141 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1148 my $dbh = DBI->connect( map $self->option($_),
1149 qw( datasrc username password ) );
1151 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1155 my $usergroup = $self->option('usergroup') || 'usergroup';
1157 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1160 # map out existing groups and attrs
1163 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1164 $attrs_of{$radius_group->groupname} = +{
1165 map { $_->attrname => $_ } $radius_group->radius_attr
1167 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1170 # get groupnames from radgroupcheck and radgroupreply
1172 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1174 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1175 my @fixes; # things that need to be changed on the radius db
1176 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1177 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1178 warn "$groupname.$attrname\n";
1179 if ( !exists($groupnum_of{$groupname}) ) {
1180 my $radius_group = new FS::radius_group {
1181 'groupname' => $groupname,
1184 $error = $radius_group->insert;
1186 warn "error inserting group $groupname: $error";
1187 next;#don't continue trying to insert the attribute
1189 $attrs_of{$groupname} = {};
1190 $groupnum_of{$groupname} = $radius_group->groupnum;
1193 my $a = $attrs_of{$groupname};
1194 my $old = $a->{$attrname};
1197 if ( $attrtype eq 'R' ) {
1198 # Freeradius tolerates illegal operators in reply attributes. We don't.
1199 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1200 warn "$groupname.$attrname: changing $op to +=\n";
1201 # Make a note to change it in the db
1203 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1204 $groupname, $attrname, $op, $value
1206 # and import it correctly.
1211 if ( defined $old ) {
1213 $new = new FS::radius_attr {
1218 $error = $new->replace($old);
1220 warn "error modifying attr $attrname: $error";
1225 $new = new FS::radius_attr {
1226 'groupnum' => $groupnum_of{$groupname},
1227 'attrname' => $attrname,
1228 'attrtype' => $attrtype,
1232 $error = $new->insert;
1234 warn "error inserting attr $attrname: $error" if $error;
1238 $attrs_of{$groupname}->{$attrname} = $new;
1242 my ($sql, @args) = @$_;
1243 my $sth = $dbh->prepare($sql);
1244 $sth->execute(@args) or warn $sth->errstr;
1257 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1258 # (radiator is supposed to be setup with a radacct table)
1259 #i suppose it would be more slick to look for things that inherit from us..
1261 my @part_export = ();
1262 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1263 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1264 broadband_sqlradius );
1268 sub all_sqlradius_withaccounting {
1270 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;