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);
350 my $queue = new FS::queue {
352 'job' => "FS::part_export::sqlradius::sqlradius_$method",
355 $self->option('datasrc'),
356 $self->option('username'),
357 $self->option('password'),
362 sub suspended_usergroups {
363 my ($self, $svc_x) = (shift, shift);
365 return () unless $svc_x;
367 my $svc_table = $svc_x->table;
369 #false laziness with FS::part_export::shellcommands
370 #subclass part_export?
372 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
373 my %reasonmap = $self->_groups_susp_reason_map;
376 $userspec = $reasonmap{$r->reasonnum}
377 if exists($reasonmap{$r->reasonnum});
378 $userspec = $reasonmap{$r->reason}
379 if (!$userspec && exists($reasonmap{$r->reason}));
382 if ( $userspec =~ /^\d+$/ ){
383 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
384 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
385 my ($username,$domain) = split(/\@/, $userspec);
386 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
387 $suspend_svc = $user if $userspec eq $user->email;
389 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
390 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
393 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
397 sub sqlradius_insert { #subroutine, not method
398 my $dbh = sqlradius_connect(shift, shift, shift);
399 my( $table, $username, %attributes ) = @_;
401 foreach my $attribute ( keys %attributes ) {
403 my $s_sth = $dbh->prepare(
404 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
405 ) or die $dbh->errstr;
406 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
408 if ( $s_sth->fetchrow_arrayref->[0] ) {
410 my $u_sth = $dbh->prepare(
411 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
412 ) or die $dbh->errstr;
413 $u_sth->execute($attributes{$attribute}, $username, $attribute)
414 or die $u_sth->errstr;
418 my $i_sth = $dbh->prepare(
419 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
420 "VALUES ( ?, ?, ?, ? )"
421 ) or die $dbh->errstr;
425 ( $attribute eq 'Password' ? '==' : ':=' ),
426 $attributes{$attribute},
427 ) or die $i_sth->errstr;
435 sub sqlradius_usergroup_insert { #subroutine, not method
436 my $dbh = sqlradius_connect(shift, shift, shift);
437 my $username = shift;
438 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
441 my $s_sth = $dbh->prepare(
442 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
443 ) or die $dbh->errstr;
445 my $sth = $dbh->prepare(
446 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
447 ) or die $dbh->errstr;
449 foreach ( @groups ) {
450 my $group = $_->{'groupname'};
451 my $priority = $_->{'priority'};
452 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
453 if ($s_sth->fetchrow_arrayref->[0]) {
454 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
455 "$group for $username\n"
459 $sth->execute( $username, $group, $priority )
460 or die "can't insert into groupname table: ". $sth->errstr;
462 if ( $s_sth->{Active} ) {
463 warn "sqlradius s_sth still active; calling ->finish()";
466 if ( $sth->{Active} ) {
467 warn "sqlradius sth still active; calling ->finish()";
473 sub sqlradius_usergroup_delete { #subroutine, not method
474 my $dbh = sqlradius_connect(shift, shift, shift);
475 my $username = shift;
476 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
479 my $sth = $dbh->prepare(
480 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
481 ) or die $dbh->errstr;
482 foreach ( @groups ) {
483 my $group = $_->{'groupname'};
484 $sth->execute( $username, $group )
485 or die "can't delete from groupname table: ". $sth->errstr;
490 sub sqlradius_rename { #subroutine, not method
491 my $dbh = sqlradius_connect(shift, shift, shift);
492 my($new_username, $old_username) = (shift, shift);
493 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
494 foreach my $table (qw(radreply radcheck), $usergroup ) {
495 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
497 $sth->execute($new_username, $old_username)
498 or die "can't update $table: ". $sth->errstr;
503 sub sqlradius_attrib_delete { #subroutine, not method
504 my $dbh = sqlradius_connect(shift, shift, shift);
505 my( $table, $username, @attrib ) = @_;
507 foreach my $attribute ( @attrib ) {
508 my $sth = $dbh->prepare(
509 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
511 $sth->execute($username,$attribute)
512 or die "can't delete from rad$table table: ". $sth->errstr;
517 sub sqlradius_delete { #subroutine, not method
518 my $dbh = sqlradius_connect(shift, shift, shift);
519 my $username = shift;
520 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
522 foreach my $table (qw( radcheck radreply), $usergroup ) {
523 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
524 $sth->execute($username)
525 or die "can't delete from $table table: ". $sth->errstr;
530 sub sqlradius_connect {
531 #my($datasrc, $username, $password) = @_;
532 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
533 DBI->connect(@_) or die $DBI::errstr;
536 sub sqlreplace_usergroups {
537 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
539 # (sorta) false laziness with FS::svc_acct::replace
540 my @oldgroups = @$old;
541 my @newgroups = @$new;
543 foreach my $oldgroup ( @oldgroups ) {
544 if ( grep { $oldgroup eq $_ } @newgroups ) {
545 @newgroups = grep { $oldgroup ne $_ } @newgroups;
548 push @delgroups, $oldgroup;
551 my $usergroup = $self->option('usergroup') || 'usergroup';
554 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
555 $username, $usergroup, @delgroups );
557 unless ref($err_or_queue);
559 my $error = $err_or_queue->depend_insert( $jobnum );
560 return $error if $error;
565 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
566 "with ". join(", ", @newgroups)
568 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
569 $username, $usergroup, @newgroups );
571 unless ref($err_or_queue);
573 my $error = $err_or_queue->depend_insert( $jobnum );
574 return $error if $error;
583 =item usage_sessions HASHREF
585 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
587 New-style: pass a hashref with the following keys:
591 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
593 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
595 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
597 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
599 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
611 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
612 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
615 SVC_ACCT, if specified, limits the results to the specified account.
617 IP, if specified, limits the results to the specified IP address.
619 PREFIX, if specified, limits the results to records with a matching
622 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
623 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
625 Returns an arrayref of hashrefs with the following fields:
631 =item framedipaddress
637 =item acctsessiontime
639 =item acctinputoctets
641 =item acctoutputoctets
643 =item calledstationid
649 #some false laziness w/cust_svc::seconds_since_sqlradacct
655 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
659 $start = $opt->{stoptime_start};
660 $end = $opt->{stoptime_end};
661 $svc_acct = $opt->{svc_acct};
663 $prefix = $opt->{prefix};
664 $summarize = $opt->{summarize};
666 ( $start, $end ) = splice(@_, 0, 2);
667 $svc_acct = @_ ? shift : '';
668 $ip = @_ ? shift : '';
669 $prefix = @_ ? shift : '';
670 #my $select = @_ ? shift : '*';
675 return [] if $self->option('ignore_accounting');
677 my $dbh = sqlradius_connect( map $self->option($_),
678 qw( datasrc username password ) );
680 #select a unix time conversion function based on database type
681 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
684 qw( username realm framedipaddress
685 acctsessiontime acctinputoctets acctoutputoctets
688 "$str2time acctstarttime ) as acctstarttime",
689 "$str2time acctstoptime ) as acctstoptime",
692 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
693 'sum(acctoutputoctets) as acctoutputoctets',
700 my $username = $self->export_username($svc_acct);
701 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
702 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
703 push @param, $username, $1, $2;
705 push @where, 'UserName = ?';
706 push @param, $username;
710 if ($self->option('process_single_realm')) {
711 push @where, 'Realm = ?';
712 push @param, $self->option('realm');
716 push @where, ' FramedIPAddress = ?';
720 if ( length($prefix) ) {
721 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
722 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
726 push @where, "$str2time AcctStopTime ) >= ?";
730 push @where, "$str2time AcctStopTime ) <= ?";
733 if ( $opt->{open_sessions} ) {
734 push @where, 'AcctStopTime IS NULL';
736 if ( $opt->{starttime_start} ) {
737 push @where, "$str2time AcctStartTime ) >= ?";
738 push @param, $opt->{starttime_start};
740 if ( $opt->{starttime_end} ) {
741 push @where, "$str2time AcctStartTime ) <= ?";
742 push @param, $opt->{starttime_end};
745 my $where = join(' AND ', @where);
746 $where = "WHERE $where" if $where;
749 $groupby = 'GROUP BY username' if $summarize;
751 my $orderby = 'ORDER BY AcctStartTime DESC';
752 $orderby = '' if $summarize;
754 my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
755 " FROM radacct $where $groupby $orderby
756 ") or die $dbh->errstr;
757 $sth->execute(@param) or die $sth->errstr;
759 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
770 my $conf = new FS::Conf;
773 my $dbh = sqlradius_connect( map $self->option($_),
774 qw( datasrc username password ) );
776 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
777 my @fields = qw( radacctid username realm acctsessiontime );
782 my $sth = $dbh->prepare("
783 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
784 $str2time AcctStartTime), $str2time AcctStopTime),
785 AcctInputOctets, AcctOutputOctets
787 WHERE FreesideStatus IS NULL
788 AND AcctStopTime IS NOT NULL
789 ") or die $dbh->errstr;
790 $sth->execute() or die $sth->errstr;
792 while ( my $row = $sth->fetchrow_arrayref ) {
793 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
794 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
795 warn "processing record: ".
796 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
799 $UserName = lc($UserName) unless $conf->exists('username-uppercase');
801 #my %search = ( 'username' => $UserName );
804 if ( ref($self) =~ /withdomain/ ) { #well...
805 $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
806 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
809 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
810 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
812 my $status = 'skipped';
813 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
814 "(UserName $UserName, Realm $Realm)";
816 if ( $self->option('process_single_realm')
817 && $self->option('realm') ne $Realm )
819 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
822 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
823 'svcpart' => $_->cust_svc->svcpart, } )
826 { 'username' => $UserName },
832 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
833 } elsif ( scalar(@svc_acct) > 1 ) {
834 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
837 my $svc_acct = $svc_acct[0];
838 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
840 $svc_acct->last_login($AcctStartTime);
841 $svc_acct->last_logout($AcctStopTime);
843 my $session_time = $AcctStopTime;
844 $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
846 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
847 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
848 || $cust_pkg->setup ) ) {
849 $status = 'skipped (too old)';
852 push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
853 push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
854 push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
855 push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
856 + $AcctOutputOctets);
857 $status=join(' ', @st);
862 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
863 my $psth = $dbh->prepare("UPDATE radacct
864 SET FreesideStatus = ?
866 ) or die $dbh->errstr;
867 $psth->execute($status, $RadAcctId) or die $psth->errstr;
869 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
876 my ($svc_acct, $column, $amount) = @_;
877 if ( $svc_acct->$column !~ /^$/ ) {
878 warn " svc_acct.$column found (". $svc_acct->$column.
881 my $method = 'decrement_' . $column;
882 my $error = $svc_acct->$method($amount);
883 die $error if $error;
886 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
891 =item export_nas_insert NAS
893 =item export_nas_delete NAS
895 =item export_nas_replace NEW_NAS OLD_NAS
897 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
898 server. Currently requires the table to be named 'nas' and to follow
899 the stock schema (/etc/freeradius/nas.sql).
903 sub export_nas_insert { shift->export_nas_action('insert', @_); }
904 sub export_nas_delete { shift->export_nas_action('delete', @_); }
905 sub export_nas_replace { shift->export_nas_action('replace', @_); }
907 sub export_nas_action {
909 my ($action, $new, $old) = @_;
910 # find the NAS in the target table by its name
911 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
912 my $nasnum = $new->nasnum;
914 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
918 return $err_or_queue unless ref $err_or_queue;
922 sub sqlradius_nas_insert {
923 my $dbh = sqlradius_connect(shift, shift, shift);
925 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
926 or die "nasnum ".$opt{'nasnum'}.' not found';
927 # insert actual NULLs where FS::Record has translated to empty strings
928 my @values = map { length($nas->$_) ? $nas->$_ : undef }
929 qw( nasname shortname type secret server community description );
930 my $sth = $dbh->prepare('INSERT INTO nas
931 (nasname, shortname, type, secret, server, community, description)
932 VALUES (?, ?, ?, ?, ?, ?, ?)');
933 $sth->execute(@values) or die $dbh->errstr;
936 sub sqlradius_nas_delete {
937 my $dbh = sqlradius_connect(shift, shift, shift);
939 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
940 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
943 sub sqlradius_nas_replace {
944 my $dbh = sqlradius_connect(shift, shift, shift);
946 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
947 or die "nasnum ".$opt{'nasnum'}.' not found';
948 my @values = map {$nas->$_}
949 qw( nasname shortname type secret server community description );
950 my $sth = $dbh->prepare('UPDATE nas SET
951 nasname = ?, shortname = ?, type = ?, secret = ?,
952 server = ?, community = ?, description = ?
954 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
957 =item export_attr_insert RADIUS_ATTR
959 =item export_attr_delete RADIUS_ATTR
961 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
963 Update the group attribute tables (radgroupcheck and radgroupreply) on
964 the RADIUS server. In delete and replace actions, the existing records
965 are identified by the combination of group name and attribute name.
967 In the special case where attributes are being replaced because a group
968 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
969 'groupname' must be set in OLD_RADIUS_ATTR. It's probably best to do this
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) = @_;
985 my ($attrname, $attrtype, $groupname) =
986 ($new->attrname, $new->attrtype, $new->radius_group->groupname);
987 if ( $action eq 'replace' ) {
989 if ( $new->attrtype ne $old->attrtype ) {
990 # they're in separate tables in the target
991 return $self->export_attr_action('delete', $old)
992 || $self->export_attr_action('insert', $new)
996 # otherwise, just make sure we know the old attribute/group names
997 # so we can find the existing record
998 $attrname = $old->attrname;
999 $groupname = $old->groupname || $old->radius_group->groupname;
1000 # maybe this should be enforced more strictly
1001 warn "WARNING: attribute replace without 'groupname' set; assuming '$groupname'\n"
1002 if !defined($old->groupname);
1005 my $err_or_queue = $self->sqlradius_queue('', "attr_$action",
1006 attrnum => $new->attrnum,
1007 attrname => $attrname,
1008 attrtype => $attrtype,
1009 groupname => $groupname,
1011 return $err_or_queue unless ref $err_or_queue;
1015 sub sqlradius_attr_insert {
1016 my $dbh = sqlradius_connect(shift, shift, shift);
1018 my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} })
1019 or die 'attrnum '.$opt{'attrnum'}.' not found';
1022 # make sure $table is completely safe
1023 if ( $opt{'attrtype'} eq 'C' ) {
1024 $table = 'radgroupcheck';
1026 elsif ( $opt{'attrtype'} eq 'R' ) {
1027 $table = 'radgroupreply';
1030 die "unknown attribute type '".$radius_attr->attrtype."'";
1034 $opt{'groupname'}, map { $radius_attr->$_ } qw(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 $sth = $dbh->prepare(
1058 'DELETE FROM '.$table.' WHERE groupname = ? AND attribute = ?'
1060 $sth->execute( @opt{'groupname', 'attrname'} ) or die $dbh->errstr;
1063 sub sqlradius_attr_replace {
1064 my $dbh = sqlradius_connect(shift, shift, shift);
1066 my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} })
1067 or die 'attrnum '.$opt{'attrnum'}.' not found';
1070 if ( $opt{'attrtype'} eq 'C' ) {
1071 $table = 'radgroupcheck';
1073 elsif ( $opt{'attrtype'} eq 'R' ) {
1074 $table = 'radgroupreply';
1077 die "unknown attribute type '".$opt{'attrtype'}."'";
1080 my $sth = $dbh->prepare(
1081 'UPDATE '.$table.' SET groupname = ?, attribute = ?, op = ?, value = ?
1082 WHERE groupname = ? AND attribute = ?'
1085 my $new_groupname = $radius_attr->radius_group->groupname;
1087 $new_groupname, map { $radius_attr->$_ } qw(attrname op value)
1089 $sth->execute( @new_values, @opt{'groupname', 'attrname'} )
1090 or die $dbh->errstr;
1093 =item export_group_replace NEW OLD
1095 Replace the L<FS::radius_group> object OLD with NEW. This will change
1096 the group name and priority in all radusergroup records, and the group
1097 name in radgroupcheck and radgroupreply.
1101 sub export_group_replace {
1103 my ($new, $old) = @_;
1104 return '' if $new->groupname eq $old->groupname
1105 and $new->priority == $old->priority;
1107 my $err_or_queue = $self->sqlradius_queue(
1110 ($self->option('usergroup') || 'usergroup'),
1114 return $err_or_queue unless ref $err_or_queue;
1118 sub sqlradius_group_replace {
1119 my $dbh = sqlradius_connect(shift, shift, shift);
1120 my $usergroup = shift;
1121 $usergroup =~ /^(rad)?usergroup$/
1122 or die "bad usergroup table name: $usergroup";
1123 my ($new, $old) = (shift, shift);
1124 # apply renames to check/reply attribute tables
1125 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1126 foreach my $table (qw(radgroupcheck radgroupreply)) {
1127 my $sth = $dbh->prepare(
1128 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1130 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1131 or die $dbh->errstr;
1134 # apply renames and priority changes to usergroup table
1135 my $sth = $dbh->prepare(
1136 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1138 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1139 or die $dbh->errstr;
1143 # class method to fetch groups/attributes from the sqlradius install on upgrade
1146 sub _upgrade_exporttype {
1147 # do this only if the radius_attr table is empty
1148 local $FS::radius_attr::noexport_hack = 1;
1150 return if qsearch('radius_attr', {});
1152 foreach my $self ($class->all_sqlradius) {
1153 my $error = $self->import_attrs;
1154 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1161 my $dbh = DBI->connect( map $self->option($_),
1162 qw( datasrc username password ) );
1164 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1168 my $usergroup = $self->option('usergroup') || 'usergroup';
1170 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1173 # map out existing groups and attrs
1176 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1177 $attrs_of{$radius_group->groupname} = +{
1178 map { $_->attrname => $_ } $radius_group->radius_attr
1180 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1183 # get groupnames from radgroupcheck and radgroupreply
1185 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1187 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1188 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1189 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1190 warn "$groupname.$attrname\n";
1191 if ( !exists($groupnum_of{$groupname}) ) {
1192 my $radius_group = new FS::radius_group {
1193 'groupname' => $groupname,
1196 $error = $radius_group->insert;
1198 warn "error inserting group $groupname: $error";
1199 next;#don't continue trying to insert the attribute
1201 $attrs_of{$groupname} = {};
1202 $groupnum_of{$groupname} = $radius_group->groupnum;
1205 my $a = $attrs_of{$groupname};
1206 my $old = $a->{$attrname};
1209 if ( defined $old ) {
1211 $new = new FS::radius_attr {
1216 $error = $new->replace($old);
1218 warn "error modifying attr $attrname: $error";
1223 $new = new FS::radius_attr {
1224 'groupnum' => $groupnum_of{$groupname},
1225 'attrname' => $attrname,
1226 'attrtype' => $attrtype,
1230 $error = $new->insert;
1232 warn "error inserting attr $attrname: $error" if $error;
1236 $attrs_of{$groupname}->{$attrname} = $new;
1248 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1249 # (radiator is supposed to be setup with a radacct table)
1250 #i suppose it would be more slick to look for things that inherit from us..
1252 my @part_export = ();
1253 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1254 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1255 broadband_sqlradius );
1259 sub all_sqlradius_withaccounting {
1261 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;