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;
215 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
218 my @del = grep { !exists $new{$_} } keys %old;
220 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
221 $table, $self->export_username($new), @del );
222 unless ( ref($err_or_queue) ) {
223 $dbh->rollback if $oldAutoCommit;
224 return $err_or_queue;
227 my $error = $err_or_queue->depend_insert( $jobnum );
229 $dbh->rollback if $oldAutoCommit;
233 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
238 my (@oldgroups) = $old->radius_groups('hashref');
239 my (@newgroups) = $new->radius_groups('hashref');
240 $error = $self->sqlreplace_usergroups( $new->svcnum,
241 $self->export_username($new),
242 $jobnum ? $jobnum : '',
247 $dbh->rollback if $oldAutoCommit;
251 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
256 #false laziness w/broadband_sqlradius.pm
257 sub _export_suspend {
258 my( $self, $svc_acct ) = (shift, shift);
260 my $new = $svc_acct->clone_suspended;
262 local $SIG{HUP} = 'IGNORE';
263 local $SIG{INT} = 'IGNORE';
264 local $SIG{QUIT} = 'IGNORE';
265 local $SIG{TERM} = 'IGNORE';
266 local $SIG{TSTP} = 'IGNORE';
267 local $SIG{PIPE} = 'IGNORE';
269 my $oldAutoCommit = $FS::UID::AutoCommit;
270 local $FS::UID::AutoCommit = 0;
273 my @newgroups = $self->suspended_usergroups($svc_acct);
275 unless (@newgroups) { #don't change password if assigning to a suspended group
277 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
278 'check', $self->export_username($new), $new->radius_check );
279 unless ( ref($err_or_queue) ) {
280 $dbh->rollback if $oldAutoCommit;
281 return $err_or_queue;
287 $self->sqlreplace_usergroups(
289 $self->export_username($new),
291 [ $svc_acct->radius_groups('hashref') ],
295 $dbh->rollback if $oldAutoCommit;
298 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
303 sub _export_unsuspend {
304 my( $self, $svc_x ) = (shift, shift);
306 local $SIG{HUP} = 'IGNORE';
307 local $SIG{INT} = 'IGNORE';
308 local $SIG{QUIT} = 'IGNORE';
309 local $SIG{TERM} = 'IGNORE';
310 local $SIG{TSTP} = 'IGNORE';
311 local $SIG{PIPE} = 'IGNORE';
313 my $oldAutoCommit = $FS::UID::AutoCommit;
314 local $FS::UID::AutoCommit = 0;
317 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
318 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
319 unless ( ref($err_or_queue) ) {
320 $dbh->rollback if $oldAutoCommit;
321 return $err_or_queue;
325 my (@oldgroups) = $self->suspended_usergroups($svc_x);
326 $error = $self->sqlreplace_usergroups(
328 $self->export_username($svc_x),
331 [ $svc_x->radius_groups('hashref') ],
334 $dbh->rollback if $oldAutoCommit;
337 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
343 my( $self, $svc_x ) = (shift, shift);
344 my $usergroup = $self->option('usergroup') || 'usergroup';
345 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
346 $self->export_username($svc_x), $usergroup );
347 ref($err_or_queue) ? '' : $err_or_queue;
350 sub sqlradius_queue {
351 my( $self, $svcnum, $method ) = (shift, shift, shift);
353 my $queue = new FS::queue {
355 'job' => "FS::part_export::sqlradius::sqlradius_$method",
358 $self->option('datasrc'),
359 $self->option('username'),
360 $self->option('password'),
365 sub suspended_usergroups {
366 my ($self, $svc_x) = (shift, shift);
368 return () unless $svc_x;
370 my $svc_table = $svc_x->table;
372 #false laziness with FS::part_export::shellcommands
373 #subclass part_export?
375 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
376 my %reasonmap = $self->_groups_susp_reason_map;
379 $userspec = $reasonmap{$r->reasonnum}
380 if exists($reasonmap{$r->reasonnum});
381 $userspec = $reasonmap{$r->reason}
382 if (!$userspec && exists($reasonmap{$r->reason}));
385 if ( $userspec =~ /^\d+$/ ){
386 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
387 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
388 my ($username,$domain) = split(/\@/, $userspec);
389 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
390 $suspend_svc = $user if $userspec eq $user->email;
392 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
393 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
396 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
400 sub sqlradius_insert { #subroutine, not method
401 my $dbh = sqlradius_connect(shift, shift, shift);
402 my( $table, $username, %attributes ) = @_;
404 foreach my $attribute ( keys %attributes ) {
406 my $s_sth = $dbh->prepare(
407 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
408 ) or die $dbh->errstr;
409 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
411 if ( $s_sth->fetchrow_arrayref->[0] ) {
413 my $u_sth = $dbh->prepare(
414 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
415 ) or die $dbh->errstr;
416 $u_sth->execute($attributes{$attribute}, $username, $attribute)
417 or die $u_sth->errstr;
421 my $i_sth = $dbh->prepare(
422 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
423 "VALUES ( ?, ?, ?, ? )"
424 ) or die $dbh->errstr;
428 ( $attribute eq 'Password' ? '==' : ':=' ),
429 $attributes{$attribute},
430 ) or die $i_sth->errstr;
438 sub sqlradius_usergroup_insert { #subroutine, not method
439 my $dbh = sqlradius_connect(shift, shift, shift);
440 my $username = shift;
441 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
444 my $s_sth = $dbh->prepare(
445 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
446 ) or die $dbh->errstr;
448 my $sth = $dbh->prepare(
449 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
450 ) or die $dbh->errstr;
452 foreach ( @groups ) {
453 my $group = $_->{'groupname'};
454 my $priority = $_->{'priority'};
455 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
456 if ($s_sth->fetchrow_arrayref->[0]) {
457 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
458 "$group for $username\n"
462 $sth->execute( $username, $group, $priority )
463 or die "can't insert into groupname table: ". $sth->errstr;
465 if ( $s_sth->{Active} ) {
466 warn "sqlradius s_sth still active; calling ->finish()";
469 if ( $sth->{Active} ) {
470 warn "sqlradius sth still active; calling ->finish()";
476 sub sqlradius_usergroup_delete { #subroutine, not method
477 my $dbh = sqlradius_connect(shift, shift, shift);
478 my $username = shift;
479 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
482 my $sth = $dbh->prepare(
483 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
484 ) or die $dbh->errstr;
485 foreach ( @groups ) {
486 my $group = $_->{'groupname'};
487 $sth->execute( $username, $group )
488 or die "can't delete from groupname table: ". $sth->errstr;
493 sub sqlradius_rename { #subroutine, not method
494 my $dbh = sqlradius_connect(shift, shift, shift);
495 my($new_username, $old_username) = (shift, shift);
496 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
497 foreach my $table (qw(radreply radcheck), $usergroup ) {
498 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
500 $sth->execute($new_username, $old_username)
501 or die "can't update $table: ". $sth->errstr;
506 sub sqlradius_attrib_delete { #subroutine, not method
507 my $dbh = sqlradius_connect(shift, shift, shift);
508 my( $table, $username, @attrib ) = @_;
510 foreach my $attribute ( @attrib ) {
511 my $sth = $dbh->prepare(
512 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
514 $sth->execute($username,$attribute)
515 or die "can't delete from rad$table table: ". $sth->errstr;
520 sub sqlradius_delete { #subroutine, not method
521 my $dbh = sqlradius_connect(shift, shift, shift);
522 my $username = shift;
523 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
525 foreach my $table (qw( radcheck radreply), $usergroup ) {
526 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
527 $sth->execute($username)
528 or die "can't delete from $table table: ". $sth->errstr;
533 sub sqlradius_connect {
534 #my($datasrc, $username, $password) = @_;
535 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
536 DBI->connect(@_) or die $DBI::errstr;
539 sub sqlreplace_usergroups {
540 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
542 # (sorta) false laziness with FS::svc_acct::replace
543 my @oldgroups = @$old;
544 my @newgroups = @$new;
546 foreach my $oldgroup ( @oldgroups ) {
547 if ( grep { $oldgroup eq $_ } @newgroups ) {
548 @newgroups = grep { $oldgroup ne $_ } @newgroups;
551 push @delgroups, $oldgroup;
554 my $usergroup = $self->option('usergroup') || 'usergroup';
557 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
558 $username, $usergroup, @delgroups );
560 unless ref($err_or_queue);
562 my $error = $err_or_queue->depend_insert( $jobnum );
563 return $error if $error;
565 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
569 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
570 "with ". join(", ", @newgroups)
572 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
573 $username, $usergroup, @newgroups );
575 unless ref($err_or_queue);
577 my $error = $err_or_queue->depend_insert( $jobnum );
578 return $error if $error;
587 =item usage_sessions HASHREF
589 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
591 New-style: pass a hashref with the following keys:
595 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
597 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
599 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
601 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
603 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
615 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
616 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
619 SVC_ACCT, if specified, limits the results to the specified account.
621 IP, if specified, limits the results to the specified IP address.
623 PREFIX, if specified, limits the results to records with a matching
626 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
627 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
629 Returns an arrayref of hashrefs with the following fields:
635 =item framedipaddress
641 =item acctsessiontime
643 =item acctinputoctets
645 =item acctoutputoctets
647 =item calledstationid
653 #some false laziness w/cust_svc::seconds_since_sqlradacct
659 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
663 $start = $opt->{stoptime_start};
664 $end = $opt->{stoptime_end};
665 $svc_acct = $opt->{svc_acct};
667 $prefix = $opt->{prefix};
668 $summarize = $opt->{summarize};
670 ( $start, $end ) = splice(@_, 0, 2);
671 $svc_acct = @_ ? shift : '';
672 $ip = @_ ? shift : '';
673 $prefix = @_ ? shift : '';
674 #my $select = @_ ? shift : '*';
679 return [] if $self->option('ignore_accounting');
681 my $dbh = sqlradius_connect( map $self->option($_),
682 qw( datasrc username password ) );
684 #select a unix time conversion function based on database type
685 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
688 qw( username realm framedipaddress
689 acctsessiontime acctinputoctets acctoutputoctets
692 "$str2time acctstarttime ) as acctstarttime",
693 "$str2time acctstoptime ) as acctstoptime",
696 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
697 'sum(acctoutputoctets) as acctoutputoctets',
704 my $username = $self->export_username($svc_acct);
705 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
706 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
707 push @param, $username, $1, $2;
709 push @where, 'UserName = ?';
710 push @param, $username;
714 if ($self->option('process_single_realm')) {
715 push @where, 'Realm = ?';
716 push @param, $self->option('realm');
720 push @where, ' FramedIPAddress = ?';
724 if ( length($prefix) ) {
725 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
726 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
729 if ( $opt->{open_sessions} ) {
730 push @where, 'AcctStopTime IS NULL';
734 push @where, "$str2time AcctStopTime ) >= ?";
738 push @where, "$str2time AcctStopTime ) <= ?";
744 if ( $opt->{starttime_start} ) {
745 push @where, "$str2time AcctStartTime ) >= ?";
746 push @param, $opt->{starttime_start};
748 if ( $opt->{starttime_end} ) {
749 push @where, "$str2time AcctStartTime ) <= ?";
750 push @param, $opt->{starttime_end};
753 my $where = join(' AND ', @where);
754 $where = "WHERE $where" if $where;
757 $groupby = 'GROUP BY username' if $summarize;
759 my $orderby = 'ORDER BY AcctStartTime DESC';
760 $orderby = '' if $summarize;
762 my $sql = 'SELECT '. join(', ', @fields).
763 " FROM radacct $where $groupby $orderby";
766 warn join(',', @param);
768 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
769 $sth->execute(@param) or die $sth->errstr;
771 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
782 my $conf = new FS::Conf;
785 my $dbh = sqlradius_connect( map $self->option($_),
786 qw( datasrc username password ) );
788 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
789 my @fields = qw( radacctid username realm acctsessiontime );
794 my $sth = $dbh->prepare("
795 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
796 $str2time AcctStartTime), $str2time AcctStopTime),
797 AcctInputOctets, AcctOutputOctets
799 WHERE FreesideStatus IS NULL
800 AND AcctStopTime IS NOT NULL
801 ") or die $dbh->errstr;
802 $sth->execute() or die $sth->errstr;
804 while ( my $row = $sth->fetchrow_arrayref ) {
805 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
806 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
807 warn "processing record: ".
808 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
811 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
813 #my %search = ( 'username' => $UserName );
816 if ( ref($self) =~ /withdomain/ ) { #well...
817 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
818 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
821 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
822 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
824 my $status = 'skipped';
825 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
826 "(UserName $UserName, Realm $Realm)";
828 if ( $self->option('process_single_realm')
829 && $self->option('realm') ne $Realm )
831 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
834 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
835 'svcpart' => $_->cust_svc->svcpart, } )
838 { 'username' => $UserName },
844 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
845 } elsif ( scalar(@svc_acct) > 1 ) {
846 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
849 my $svc_acct = $svc_acct[0];
850 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
852 $svc_acct->last_login($AcctStartTime);
853 $svc_acct->last_logout($AcctStopTime);
855 my $session_time = $AcctStopTime;
856 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
858 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
859 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
860 || $cust_pkg->setup ) ) {
861 $status = 'skipped (too old)';
864 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
865 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
866 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
867 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
868 + $AcctOutputOctets);
869 $status=join(' ', @st);
874 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
875 my $psth = $dbh->prepare("UPDATE radacct
876 SET FreesideStatus = ?
878 ) or die $dbh->errstr;
879 $psth->execute($status, $RadAcctId) or die $psth->errstr;
881 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
888 my ($svc_acct, $column, $amount) = @_;
889 if ( $svc_acct->$column !~ /^$/ ) {
890 warn " svc_acct.$column found (". $svc_acct->$column.
893 my $method = 'decrement_' . $column;
894 my $error = $svc_acct->$method($amount);
895 die $error if $error;
898 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
903 =item export_nas_insert NAS
905 =item export_nas_delete NAS
907 =item export_nas_replace NEW_NAS OLD_NAS
909 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
910 server. Currently requires the table to be named 'nas' and to follow
911 the stock schema (/etc/freeradius/nas.sql).
915 sub export_nas_insert { shift->export_nas_action('insert', @_); }
916 sub export_nas_delete { shift->export_nas_action('delete', @_); }
917 sub export_nas_replace { shift->export_nas_action('replace', @_); }
919 sub export_nas_action {
921 my ($action, $new, $old) = @_;
922 # find the NAS in the target table by its name
923 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
924 my $nasnum = $new->nasnum;
926 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
930 return $err_or_queue unless ref $err_or_queue;
934 sub sqlradius_nas_insert {
935 my $dbh = sqlradius_connect(shift, shift, shift);
937 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
938 or die "nasnum ".$opt{'nasnum'}.' not found';
939 # insert actual NULLs where FS::Record has translated to empty strings
940 my @values = map { length($nas->$_) ? $nas->$_ : undef }
941 qw( nasname shortname type secret server community description );
942 my $sth = $dbh->prepare('INSERT INTO nas
943 (nasname, shortname, type, secret, server, community, description)
944 VALUES (?, ?, ?, ?, ?, ?, ?)');
945 $sth->execute(@values) or die $dbh->errstr;
948 sub sqlradius_nas_delete {
949 my $dbh = sqlradius_connect(shift, shift, shift);
951 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
952 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
955 sub sqlradius_nas_replace {
956 my $dbh = sqlradius_connect(shift, shift, shift);
958 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
959 or die "nasnum ".$opt{'nasnum'}.' not found';
960 my @values = map {$nas->$_}
961 qw( nasname shortname type secret server community description );
962 my $sth = $dbh->prepare('UPDATE nas SET
963 nasname = ?, shortname = ?, type = ?, secret = ?,
964 server = ?, community = ?, description = ?
966 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
969 =item export_attr_insert RADIUS_ATTR
971 =item export_attr_delete RADIUS_ATTR
973 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
975 Update the group attribute tables (radgroupcheck and radgroupreply) on
976 the RADIUS server. In delete and replace actions, the existing records
977 are identified by the combination of group name and attribute name.
979 In the special case where attributes are being replaced because a group
980 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
981 'groupname' must be set in OLD_RADIUS_ATTR.
985 # some false laziness with NAS export stuff...
987 sub export_attr_insert { shift->export_attr_action('insert', @_); }
989 sub export_attr_delete { shift->export_attr_action('delete', @_); }
991 sub export_attr_replace { shift->export_attr_action('replace', @_); }
993 sub export_attr_action {
995 my ($action, $new, $old) = @_;
998 if ( $action eq 'delete' ) {
1001 if ( $action eq 'delete' or $action eq 'replace' ) {
1002 # delete based on an exact match
1004 attrname => $old->attrname,
1005 attrtype => $old->attrtype,
1006 groupname => $old->groupname || $old->radius_group->groupname,
1008 value => $old->value,
1010 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1011 return $err_or_queue unless ref $err_or_queue;
1013 # this probably doesn't matter, but just to be safe...
1014 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1015 if ( $action eq 'replace' or $action eq 'insert' ) {
1017 attrname => $new->attrname,
1018 attrtype => $new->attrtype,
1019 groupname => $new->radius_group->groupname,
1021 value => $new->value,
1023 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1024 $err_or_queue->depend_insert($jobnum) if $jobnum;
1025 return $err_or_queue unless ref $err_or_queue;
1030 sub sqlradius_attr_insert {
1031 my $dbh = sqlradius_connect(shift, shift, shift);
1035 # make sure $table is completely safe
1036 if ( $opt{'attrtype'} eq 'C' ) {
1037 $table = 'radgroupcheck';
1039 elsif ( $opt{'attrtype'} eq 'R' ) {
1040 $table = 'radgroupreply';
1043 die "unknown attribute type '$opt{attrtype}'";
1046 my @values = @opt{ qw(groupname attrname op value) };
1047 my $sth = $dbh->prepare(
1048 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1050 $sth->execute(@values) or die $dbh->errstr;
1053 sub sqlradius_attr_delete {
1054 my $dbh = sqlradius_connect(shift, shift, shift);
1058 if ( $opt{'attrtype'} eq 'C' ) {
1059 $table = 'radgroupcheck';
1061 elsif ( $opt{'attrtype'} eq 'R' ) {
1062 $table = 'radgroupreply';
1065 die "unknown attribute type '".$opt{'attrtype'}."'";
1068 my @values = @opt{ qw(groupname attrname op value) };
1069 my $sth = $dbh->prepare(
1070 'DELETE FROM '.$table.
1071 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1074 $sth->execute(@values) or die $dbh->errstr;
1077 #sub sqlradius_attr_replace { no longer needed
1079 =item export_group_replace NEW OLD
1081 Replace the L<FS::radius_group> object OLD with NEW. This will change
1082 the group name and priority in all radusergroup records, and the group
1083 name in radgroupcheck and radgroupreply.
1087 sub export_group_replace {
1089 my ($new, $old) = @_;
1090 return '' if $new->groupname eq $old->groupname
1091 and $new->priority == $old->priority;
1093 my $err_or_queue = $self->sqlradius_queue(
1096 ($self->option('usergroup') || 'usergroup'),
1100 return $err_or_queue unless ref $err_or_queue;
1104 sub sqlradius_group_replace {
1105 my $dbh = sqlradius_connect(shift, shift, shift);
1106 my $usergroup = shift;
1107 $usergroup =~ /^(rad)?usergroup$/
1108 or die "bad usergroup table name: $usergroup";
1109 my ($new, $old) = (shift, shift);
1110 # apply renames to check/reply attribute tables
1111 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1112 foreach my $table (qw(radgroupcheck radgroupreply)) {
1113 my $sth = $dbh->prepare(
1114 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1116 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1117 or die $dbh->errstr;
1120 # apply renames and priority changes to usergroup table
1121 my $sth = $dbh->prepare(
1122 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1124 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1125 or die $dbh->errstr;
1129 # class method to fetch groups/attributes from the sqlradius install on upgrade
1132 sub _upgrade_exporttype {
1133 # do this only if the radius_attr table is empty
1134 local $FS::radius_attr::noexport_hack = 1;
1136 return if qsearch('radius_attr', {});
1138 foreach my $self ($class->all_sqlradius) {
1139 my $error = $self->import_attrs;
1140 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1147 my $dbh = DBI->connect( map $self->option($_),
1148 qw( datasrc username password ) );
1150 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1154 my $usergroup = $self->option('usergroup') || 'usergroup';
1156 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1159 # map out existing groups and attrs
1162 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1163 $attrs_of{$radius_group->groupname} = +{
1164 map { $_->attrname => $_ } $radius_group->radius_attr
1166 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1169 # get groupnames from radgroupcheck and radgroupreply
1171 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1173 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1174 my @fixes; # things that need to be changed on the radius db
1175 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1176 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1177 warn "$groupname.$attrname\n";
1178 if ( !exists($groupnum_of{$groupname}) ) {
1179 my $radius_group = new FS::radius_group {
1180 'groupname' => $groupname,
1183 $error = $radius_group->insert;
1185 warn "error inserting group $groupname: $error";
1186 next;#don't continue trying to insert the attribute
1188 $attrs_of{$groupname} = {};
1189 $groupnum_of{$groupname} = $radius_group->groupnum;
1192 my $a = $attrs_of{$groupname};
1193 my $old = $a->{$attrname};
1196 if ( $attrtype eq 'R' ) {
1197 # Freeradius tolerates illegal operators in reply attributes. We don't.
1198 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1199 warn "$groupname.$attrname: changing $op to +=\n";
1200 # Make a note to change it in the db
1202 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1203 $groupname, $attrname, $op, $value
1205 # and import it correctly.
1210 if ( defined $old ) {
1212 $new = new FS::radius_attr {
1217 $error = $new->replace($old);
1219 warn "error modifying attr $attrname: $error";
1224 $new = new FS::radius_attr {
1225 'groupnum' => $groupnum_of{$groupname},
1226 'attrname' => $attrname,
1227 'attrtype' => $attrtype,
1231 $error = $new->insert;
1233 warn "error inserting attr $attrname: $error" if $error;
1237 $attrs_of{$groupname}->{$attrname} = $new;
1241 my ($sql, @args) = @$_;
1242 my $sth = $dbh->prepare($sql);
1243 $sth->execute(@args) or warn $sth->errstr;
1256 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1257 # (radiator is supposed to be setup with a radacct table)
1258 #i suppose it would be more slick to look for things that inherit from us..
1260 my @part_export = ();
1261 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1262 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1263 broadband_sqlradius );
1267 sub all_sqlradius_withaccounting {
1269 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;