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 str2time_sql_closing );
11 use Carp qw( carp cluck );
15 @ISA = qw(FS::part_export);
16 @EXPORT_OK = qw( sqlradius_connect );
21 tie %options, 'Tie::IxHash',
22 'datasrc' => { label=>'DBI data source ' },
23 'username' => { label=>'Database username' },
24 'password' => { label=>'Database password' },
25 'usergroup' => { label => 'Group table',
27 options => [qw( usergroup radusergroup ) ],
29 'skip_provisioning' => {
31 label => 'Skip provisioning records to this database'
33 'ignore_accounting' => {
35 label => 'Ignore accounting records from this database'
37 'process_single_realm' => {
39 label => 'Only process one realm of accounting records',
41 'realm' => { label => 'The realm of of accounting records to be processed' },
42 'ignore_long_sessions' => {
44 label => 'Ignore sessions which span billing periods',
48 label => 'Hide IP address information on session reports',
52 label => 'Hide download/upload information on session reports',
54 'show_called_station' => {
56 label => 'Show the Called-Station-ID on session reports', #as a phone number
58 'overlimit_groups' => {
59 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)',
65 option_values => sub {
67 map { $_->groupnum, $_->long_description }
68 qsearch('radius_group', {}),
73 'groups_susp_reason' => { label =>
74 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
79 label => 'Export RADIUS group attributes to this database',
82 label => 'To send a disconnection request to each RADIUS client when modifying, suspending or deleting an account, enter a ssh connection string (username@host) with access to the radclient program',
84 'disconnect_port' => {
85 label => 'Port to send disconnection requests to, default 1700',
90 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
91 tables to any SQL database for
92 <a href="http://www.freeradius.org/">FreeRADIUS</a>
93 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
97 An existing RADIUS database will be updated in realtime, but you can use
98 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
99 to delete the entire RADIUS database and repopulate the tables from the
100 Freeside database. See the
101 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
103 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
104 for the exact syntax of a DBI data source.
106 <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.
107 <li>Using ICRADIUS, add a dummy "op" column to your database:
109 ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
110 ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
111 ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
112 ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
114 <li>Using Radiator, see the
115 <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
116 for configuration information.
122 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
123 'options' => \%options,
126 'nas' => 'Y', # show export_nas selection in UI
127 'default_svc_class' => 'Internet',
129 'This export does not export RADIUS realms (see also '.
130 'sqlradius_withdomain). '.
134 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
135 split( "\n", shift->option('groups_susp_reason'));
138 sub rebless { shift; }
140 sub export_username { # override for other svcdb
141 my($self, $svc_acct) = (shift, shift);
142 warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
146 sub radius_reply { #override for other svcdb
147 my($self, $svc_acct) = (shift, shift);
148 my %every = $svc_acct->EVERY::radius_reply;
149 map { @$_ } values %every;
152 sub radius_check { #override for other svcdb
153 my($self, $svc_acct) = (shift, shift);
154 my %every = $svc_acct->EVERY::radius_check;
155 map { @$_ } values %every;
159 my($self, $svc_x) = (shift, shift);
161 return '' if $self->option('skip_provisioning');
163 foreach my $table (qw(reply check)) {
164 my $method = "radius_$table";
165 my %attrib = $self->$method($svc_x);
166 next unless keys %attrib;
167 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
168 $table, $self->export_username($svc_x), %attrib );
169 return $err_or_queue unless ref($err_or_queue);
171 my @groups = $svc_x->radius_groups('hashref');
173 cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
174 " (". $self->export_username($svc_x). " with ". join(", ", @groups)
176 my $usergroup = $self->option('usergroup') || 'usergroup';
177 my $err_or_queue = $self->sqlradius_queue(
178 $svc_x->svcnum, 'usergroup_insert',
179 $self->export_username($svc_x), $usergroup, @groups );
180 return $err_or_queue unless ref($err_or_queue);
185 sub _export_replace {
186 my( $self, $new, $old ) = (shift, shift, shift);
188 return '' if $self->option('skip_provisioning');
190 local $SIG{HUP} = 'IGNORE';
191 local $SIG{INT} = 'IGNORE';
192 local $SIG{QUIT} = 'IGNORE';
193 local $SIG{TERM} = 'IGNORE';
194 local $SIG{TSTP} = 'IGNORE';
195 local $SIG{PIPE} = 'IGNORE';
197 my $oldAutoCommit = $FS::UID::AutoCommit;
198 local $FS::UID::AutoCommit = 0;
202 if ( $self->export_username($old) ne $self->export_username($new) ) {
203 my $usergroup = $self->option('usergroup') || 'usergroup';
204 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
205 $self->export_username($new), $self->export_username($old), $usergroup );
206 unless ( ref($err_or_queue) ) {
207 $dbh->rollback if $oldAutoCommit;
208 return $err_or_queue;
210 $jobnum = $err_or_queue->jobnum;
213 foreach my $table (qw(reply check)) {
214 my $method = "radius_$table";
215 my %new = $self->$method($new);
216 my %old = $self->$method($old);
217 if ( grep { !exists $old{$_} #new attributes
218 || $new{$_} ne $old{$_} #changed
221 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
222 $table, $self->export_username($new), %new );
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
237 my @del = grep { !exists $new{$_} } keys %old;
239 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
240 $table, $self->export_username($new), @del );
241 unless ( ref($err_or_queue) ) {
242 $dbh->rollback if $oldAutoCommit;
243 return $err_or_queue;
246 my $error = $err_or_queue->depend_insert( $jobnum );
248 $dbh->rollback if $oldAutoCommit;
252 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
257 my (@oldgroups) = $old->radius_groups('hashref');
258 my (@newgroups) = $new->radius_groups('hashref');
259 ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum,
260 $self->export_username($new),
261 $jobnum ? $jobnum : '',
266 $dbh->rollback if $oldAutoCommit;
270 # radius database is used for authorization, so to avoid users reauthorizing
271 # before the database changes, disconnect users after changing database
272 if ($self->option('disconnect_ssh')) {
273 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect',
274 'disconnect_ssh' => $self->option('disconnect_ssh'),
275 'svc_acct_username' => $old->username,
276 'disconnect_port' => $self->option('disconnect_port'),
278 unless ( ref($err_or_queue) ) {
279 $dbh->rollback if $oldAutoCommit;
280 return $err_or_queue;
283 my $error = $err_or_queue->depend_insert( $jobnum );
285 $dbh->rollback if $oldAutoCommit;
291 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
296 #false laziness w/broadband_sqlradius.pm
297 sub _export_suspend {
298 my( $self, $svc_acct ) = (shift, shift);
300 return '' if $self->option('skip_provisioning');
302 my $new = $svc_acct->clone_suspended;
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;
317 my @newgroups = $self->suspended_usergroups($svc_acct);
319 unless (@newgroups) { #don't change password if assigning to a suspended group
321 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
322 'check', $self->export_username($new), $new->radius_check );
323 unless ( ref($err_or_queue) ) {
324 $dbh->rollback if $oldAutoCommit;
325 return $err_or_queue;
327 $jobnum = $err_or_queue->jobnum;
332 $self->sqlreplace_usergroups(
334 $self->export_username($new),
336 [ $svc_acct->radius_groups('hashref') ],
340 $dbh->rollback if $oldAutoCommit;
344 # radius database is used for authorization, so to avoid users reauthorizing
345 # before the database changes, disconnect users after changing database
346 if ($self->option('disconnect_ssh')) {
347 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect',
348 'disconnect_ssh' => $self->option('disconnect_ssh'),
349 'svc_acct_username' => $svc_acct->username,
350 'disconnect_port' => $self->option('disconnect_port'),
352 unless ( ref($err_or_queue) ) {
353 $dbh->rollback if $oldAutoCommit;
354 return $err_or_queue;
357 my $error = $err_or_queue->depend_insert( $jobnum );
359 $dbh->rollback if $oldAutoCommit;
365 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
370 sub _export_unsuspend {
371 my( $self, $svc_x ) = (shift, shift);
373 return '' if $self->option('skip_provisioning');
375 local $SIG{HUP} = 'IGNORE';
376 local $SIG{INT} = 'IGNORE';
377 local $SIG{QUIT} = 'IGNORE';
378 local $SIG{TERM} = 'IGNORE';
379 local $SIG{TSTP} = 'IGNORE';
380 local $SIG{PIPE} = 'IGNORE';
382 my $oldAutoCommit = $FS::UID::AutoCommit;
383 local $FS::UID::AutoCommit = 0;
386 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
387 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
388 unless ( ref($err_or_queue) ) {
389 $dbh->rollback if $oldAutoCommit;
390 return $err_or_queue;
394 my (@oldgroups) = $self->suspended_usergroups($svc_x);
395 $error = $self->sqlreplace_usergroups(
397 $self->export_username($svc_x),
400 [ $svc_x->radius_groups('hashref') ],
403 $dbh->rollback if $oldAutoCommit;
406 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
412 my( $self, $svc_x ) = (shift, shift);
414 return '' if $self->option('skip_provisioning');
418 my $usergroup = $self->option('usergroup') || 'usergroup';
419 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
420 $self->export_username($svc_x), $usergroup );
421 $jobnum = $err_or_queue->jobnum;
423 # radius database is used for authorization, so to avoid users reauthorizing
424 # before the database changes, disconnect users after changing database
425 if ($self->option('disconnect_ssh')) {
426 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'user_disconnect',
427 'disconnect_ssh' => $self->option('disconnect_ssh'),
428 'svc_acct_username' => $svc_x->username,
429 'disconnect_port' => $self->option('disconnect_port'),
431 return $err_or_queue unless ref($err_or_queue);
433 my $error = $err_or_queue->depend_insert( $jobnum );
434 return $error if $error;
438 ref($err_or_queue) ? '' : $err_or_queue;
441 sub sqlradius_queue {
442 my( $self, $svcnum, $method ) = (shift, shift, shift);
444 my $queue = new FS::queue {
446 'job' => "FS::part_export::sqlradius::sqlradius_$method",
449 $self->option('datasrc'),
450 $self->option('username'),
451 $self->option('password'),
456 sub suspended_usergroups {
457 my ($self, $svc_x) = (shift, shift);
459 return () unless $svc_x;
461 my $svc_table = $svc_x->table;
463 #false laziness with FS::part_export::shellcommands
464 #subclass part_export?
466 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
467 my %reasonmap = $self->_groups_susp_reason_map;
470 $userspec = $reasonmap{$r->reasonnum}
471 if exists($reasonmap{$r->reasonnum});
472 $userspec = $reasonmap{$r->reason}
473 if (!$userspec && exists($reasonmap{$r->reason}));
476 if ( $userspec =~ /^\d+$/ ){
477 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
478 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
479 my ($username,$domain) = split(/\@/, $userspec);
480 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
481 $suspend_svc = $user if $userspec eq $user->email;
483 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
484 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
487 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
491 sub sqlradius_insert { #subroutine, not method
493 if ( $FS::svc_Common::noexport_hack ) {
494 carp 'sqlradius_insert() suppressed by noexport_hack' if $DEBUG;
498 my $dbh = sqlradius_connect(shift, shift, shift);
499 my( $table, $username, %attributes ) = @_;
501 foreach my $attribute ( keys %attributes ) {
503 my $s_sth = $dbh->prepare(
504 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
505 ) or die $dbh->errstr;
506 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
508 if ( $s_sth->fetchrow_arrayref->[0] ) {
510 my $u_sth = $dbh->prepare(
511 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
512 ) or die $dbh->errstr;
513 $u_sth->execute($attributes{$attribute}, $username, $attribute)
514 or die $u_sth->errstr;
518 my $i_sth = $dbh->prepare(
519 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
520 "VALUES ( ?, ?, ?, ? )"
521 ) or die $dbh->errstr;
525 ( $attribute eq 'Password' ? '==' : ':=' ),
526 $attributes{$attribute},
527 ) or die $i_sth->errstr;
535 sub sqlradius_usergroup_insert { #subroutine, not method
537 if ( $FS::svc_Common::noexport_hack ) {
538 carp 'sqlradius_usergroup_insert() suppressed by noexport_hack' if $DEBUG;
542 my $dbh = sqlradius_connect(shift, shift, shift);
543 my $username = shift;
544 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
547 my $s_sth = $dbh->prepare(
548 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
549 ) or die $dbh->errstr;
551 my $sth = $dbh->prepare(
552 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
553 ) or die $dbh->errstr;
555 foreach ( @groups ) {
556 my $group = $_->{'groupname'};
557 my $priority = $_->{'priority'};
558 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
559 if ($s_sth->fetchrow_arrayref->[0]) {
560 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
561 "$group for $username\n"
565 $sth->execute( $username, $group, $priority )
566 or die "can't insert into groupname table: ". $sth->errstr;
568 if ( $s_sth->{Active} ) {
569 warn "sqlradius s_sth still active; calling ->finish()";
572 if ( $sth->{Active} ) {
573 warn "sqlradius sth still active; calling ->finish()";
579 sub sqlradius_usergroup_delete { #subroutine, not method
581 if ( $FS::svc_Common::noexport_hack ) {
582 carp 'sqlradius_usergroup_delete() suppressed by noexport_hack' if $DEBUG;
586 my $dbh = sqlradius_connect(shift, shift, shift);
587 my $username = shift;
588 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
591 my $sth = $dbh->prepare(
592 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
593 ) or die $dbh->errstr;
594 foreach ( @groups ) {
595 my $group = $_->{'groupname'};
596 $sth->execute( $username, $group )
597 or die "can't delete from groupname table: ". $sth->errstr;
602 sub sqlradius_rename { #subroutine, not method
604 if ( $FS::svc_Common::noexport_hack ) {
605 carp 'sqlradius_rename() suppressed by noexport_hack' if $DEBUG;
609 my $dbh = sqlradius_connect(shift, shift, shift);
610 my($new_username, $old_username) = (shift, shift);
611 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
612 foreach my $table (qw(radreply radcheck), $usergroup ) {
613 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
615 $sth->execute($new_username, $old_username)
616 or die "can't update $table: ". $sth->errstr;
621 sub sqlradius_attrib_delete { #subroutine, not method
623 if ( $FS::svc_Common::noexport_hack ) {
624 carp 'sqlradius_attrib_delete() suppressed by noexport_hack' if $DEBUG;
628 my $dbh = sqlradius_connect(shift, shift, shift);
629 my( $table, $username, @attrib ) = @_;
631 foreach my $attribute ( @attrib ) {
632 my $sth = $dbh->prepare(
633 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
635 $sth->execute($username,$attribute)
636 or die "can't delete from rad$table table: ". $sth->errstr;
641 sub sqlradius_delete { #subroutine, not method
643 if ( $FS::svc_Common::noexport_hack ) {
644 carp 'sqlradius_delete() suppressed by noexport_hack' if $DEBUG;
648 my $dbh = sqlradius_connect(shift, shift, shift);
649 my $username = shift;
650 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
652 foreach my $table (qw( radcheck radreply), $usergroup ) {
653 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
654 $sth->execute($username)
655 or die "can't delete from $table table: ". $sth->errstr;
660 sub sqlradius_connect {
661 #my($datasrc, $username, $password) = @_;
662 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
663 DBI->connect(@_) or die $DBI::errstr;
666 # on success, returns '' in scalar context, ('',$jobnum) in list context
667 # on error, always just returns error
668 sub sqlreplace_usergroups {
669 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
671 # (sorta) false laziness with FS::svc_acct::replace
672 my @oldgroups = @$old;
673 my @newgroups = @$new;
675 foreach my $oldgroup ( @oldgroups ) {
676 if ( grep { $oldgroup eq $_ } @newgroups ) {
677 @newgroups = grep { $oldgroup ne $_ } @newgroups;
680 push @delgroups, $oldgroup;
683 my $usergroup = $self->option('usergroup') || 'usergroup';
686 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
687 $username, $usergroup, @delgroups );
689 unless ref($err_or_queue);
691 my $error = $err_or_queue->depend_insert( $jobnum );
692 return $error if $error;
694 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
698 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
699 "with ". join(", ", @newgroups)
701 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
702 $username, $usergroup, @newgroups );
704 unless ref($err_or_queue);
706 my $error = $err_or_queue->depend_insert( $jobnum );
707 return $error if $error;
709 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
711 wantarray ? ('',$jobnum) : '';
717 =item usage_sessions HASHREF
719 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
721 New-style: pass a hashref with the following keys:
725 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
727 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
729 =item session_status - 'closed' to only show records with AcctStopTime,
730 'open' to only show records I<without> AcctStopTime, empty to show both.
732 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
734 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
746 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
747 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
750 SVC_ACCT, if specified, limits the results to the specified account.
752 IP, if specified, limits the results to the specified IP address.
754 PREFIX, if specified, limits the results to records with a matching
757 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
758 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
760 Returns an arrayref of hashrefs with the following fields:
766 =item framedipaddress
772 =item acctsessiontime
774 =item acctinputoctets
776 =item acctoutputoctets
778 =item callingstationid
780 =item calledstationid
786 #some false laziness w/cust_svc::seconds_since_sqlradacct
792 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
796 $start = $opt->{stoptime_start};
797 $end = $opt->{stoptime_end};
798 $svc_acct = $opt->{svc} || $opt->{svc_acct};
800 $prefix = $opt->{prefix};
801 $summarize = $opt->{summarize};
803 ( $start, $end ) = splice(@_, 0, 2);
804 $svc_acct = @_ ? shift : '';
805 $ip = @_ ? shift : '';
806 $prefix = @_ ? shift : '';
807 #my $select = @_ ? shift : '*';
812 return [] if $self->option('ignore_accounting');
814 my $dbh = sqlradius_connect( map $self->option($_),
815 qw( datasrc username password ) );
817 #select a unix time conversion function based on database type
818 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
819 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
822 qw( username realm framedipaddress
823 acctsessiontime acctinputoctets acctoutputoctets
824 callingstationid calledstationid
826 "$str2time acctstarttime $closing as acctstarttime",
827 "$str2time acctstoptime $closing as acctstoptime",
830 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
831 'sum(acctoutputoctets) as acctoutputoctets',
838 my $username = $self->export_username($svc_acct);
839 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
840 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
841 push @param, $username, $1, $2;
843 push @where, 'UserName = ?';
844 push @param, $username;
848 if ($self->option('process_single_realm')) {
849 push @where, 'Realm = ?';
850 push @param, $self->option('realm');
854 push @where, ' FramedIPAddress = ?';
858 if ( length($prefix) ) {
859 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
860 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
863 my $acctstoptime = '';
864 if ( $opt->{session_status} ne 'open' ) {
866 $acctstoptime .= "$str2time AcctStopTime $closing >= ?";
868 $acctstoptime .= ' AND ' if $end;
871 $acctstoptime .= "$str2time AcctStopTime $closing <= ?";
875 if ( $opt->{session_status} ne 'closed' ) {
876 if ( $acctstoptime ) {
877 $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )";
879 $acctstoptime = 'AcctStopTime IS NULL';
882 push @where, $acctstoptime;
884 if ( $opt->{starttime_start} ) {
885 push @where, "$str2time AcctStartTime $closing >= ?";
886 push @param, $opt->{starttime_start};
888 if ( $opt->{starttime_end} ) {
889 push @where, "$str2time AcctStartTime $closing <= ?";
890 push @param, $opt->{starttime_end};
893 my $where = join(' AND ', @where);
894 $where = "WHERE $where" if $where;
897 $groupby = 'GROUP BY username' if $summarize;
899 my $orderby = 'ORDER BY AcctStartTime DESC';
900 $orderby = '' if $summarize;
902 my $sql = 'SELECT '. join(', ', @fields).
903 " FROM radacct $where $groupby $orderby";
906 warn join(',', @param);
908 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
909 $sth->execute(@param) or die $sth->errstr;
911 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
922 if ( $FS::svc_Common::noexport_hack ) {
923 carp 'update_svc() suppressed by noexport_hack'
924 if $self->option('debug') || $DEBUG;
928 my $conf = new FS::Conf;
931 my $dbh = sqlradius_connect( map $self->option($_),
932 qw( datasrc username password ) );
934 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
935 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
937 my @fields = qw( radacctid username realm acctsessiontime );
942 my $sth = $dbh->prepare("
943 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
944 $str2time AcctStartTime $closing, $str2time AcctStopTime $closing,
945 AcctInputOctets, AcctOutputOctets
947 WHERE FreesideStatus IS NULL
948 AND AcctStopTime IS NOT NULL
949 ") or die $dbh->errstr;
950 $sth->execute() or die $sth->errstr;
952 while ( my $row = $sth->fetchrow_arrayref ) {
953 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
954 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
955 warn "processing record: ".
956 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
959 my $fs_username = $UserName;
961 $fs_username = lc($fs_username) unless $conf->exists('username-uppercase');
963 #my %search = ( 'username' => $fs_username );
966 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
967 "(UserName $UserName, Realm $Realm)";
970 if ( ref($self) =~ /withdomain/ ) { #well, should be a callback to that
975 } elsif ( $fs_username =~ /\@/ ) {
976 ($fs_username, $domain) = split('@', $fs_username);
978 warn 'WARNING: nothing Realm column and no @realm in UserName column '.
979 "$errinfo -- skipping\n" if $DEBUG;
980 $status = 'skipped (no realm)';
983 $extra_sql = " AND '$domain' = ( SELECT domain FROM svc_domain
984 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
987 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
988 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
994 if ( $self->option('process_single_realm')
995 && $self->option('realm') ne $Realm )
997 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
1000 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
1001 'svcpart' => $_->cust_svc->svcpart,
1005 qsearch( 'svc_acct',
1006 { 'username' => $fs_username },
1012 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
1013 } elsif ( scalar(@svc_acct) > 1 ) {
1014 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
1017 my $svc_acct = $svc_acct[0];
1018 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
1020 $svc_acct->last_login($AcctStartTime);
1021 $svc_acct->last_logout($AcctStopTime);
1023 my $session_time = $AcctStopTime;
1024 $session_time = $AcctStartTime
1025 if $self->option('ignore_long_sessions');
1027 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
1028 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
1029 || $cust_pkg->setup ) ) {
1030 $status = 'skipped (too old)';
1033 push @st, _try_decrement($svc_acct,'seconds', $AcctSessionTime);
1034 push @st, _try_decrement($svc_acct,'upbytes', $AcctInputOctets);
1035 push @st, _try_decrement($svc_acct,'downbytes', $AcctOutputOctets);
1036 push @st, _try_decrement($svc_acct,'totalbytes', $AcctInputOctets
1037 + $AcctOutputOctets);
1038 $status=join(' ', @st);
1045 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
1046 my $psth = $dbh->prepare("UPDATE radacct
1047 SET FreesideStatus = ?
1048 WHERE RadAcctId = ?"
1049 ) or die $dbh->errstr;
1050 $psth->execute($status, $RadAcctId) or die $psth->errstr;
1052 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
1058 sub _try_decrement {
1059 my ($svc_acct, $column, $amount) = @_;
1060 if ( $svc_acct->$column !~ /^$/ ) {
1061 warn " svc_acct.$column found (". $svc_acct->$column.
1062 ") - decrementing\n"
1064 my $method = 'decrement_' . $column;
1065 my $error = $svc_acct->$method($amount);
1066 die $error if $error;
1069 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
1074 =item export_nas_insert NAS
1076 =item export_nas_delete NAS
1078 =item export_nas_replace NEW_NAS OLD_NAS
1080 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
1081 server. Currently requires the table to be named 'nas' and to follow
1082 the stock schema (/etc/freeradius/nas.sql).
1086 sub export_nas_insert { shift->export_nas_action('insert', @_); }
1087 sub export_nas_delete { shift->export_nas_action('delete', @_); }
1088 sub export_nas_replace { shift->export_nas_action('replace', @_); }
1090 sub export_nas_action {
1092 my ($action, $new, $old) = @_;
1094 if ( $FS::svc_Common::noexport_hack ) {
1095 carp "export_nas_action($action) suppressed by noexport_hack"
1096 if $self->option('debug') || $DEBUG;
1100 # find the NAS in the target table by its name
1101 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
1102 my $nasnum = $new->nasnum;
1104 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
1105 nasname => $nasname,
1108 return $err_or_queue unless ref $err_or_queue;
1112 sub sqlradius_nas_insert {
1114 if ( $FS::svc_Common::noexport_hack ) {
1115 carp 'sqlradius_nas_insert() suppressed by noexport_hack' if $DEBUG;
1119 my $dbh = sqlradius_connect(shift, shift, shift);
1121 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
1122 or die "nasnum ".$opt{'nasnum'}.' not found';
1123 # insert actual NULLs where FS::Record has translated to empty strings
1124 my @values = map { length($nas->$_) ? $nas->$_ : undef }
1125 qw( nasname shortname type secret server community description );
1126 my $sth = $dbh->prepare('INSERT INTO nas
1127 (nasname, shortname, type, secret, server, community, description)
1128 VALUES (?, ?, ?, ?, ?, ?, ?)');
1129 $sth->execute(@values) or die $dbh->errstr;
1132 sub sqlradius_nas_delete {
1134 if ( $FS::svc_Common::noexport_hack ) {
1135 carp 'sqlradius_nas_delete() suppressed by noexport_hack' if $DEBUG;
1139 my $dbh = sqlradius_connect(shift, shift, shift);
1141 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
1142 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
1145 sub sqlradius_nas_replace {
1147 if ( $FS::svc_Common::noexport_hack ) {
1148 carp 'sqlradius_nas_replace() suppressed by noexport_hack' if $DEBUG;
1152 my $dbh = sqlradius_connect(shift, shift, shift);
1154 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
1155 or die "nasnum ".$opt{'nasnum'}.' not found';
1156 my @values = map {$nas->$_}
1157 qw( nasname shortname type secret server community description );
1158 my $sth = $dbh->prepare('UPDATE nas SET
1159 nasname = ?, shortname = ?, type = ?, secret = ?,
1160 server = ?, community = ?, description = ?
1161 WHERE nasname = ?');
1162 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
1165 =item export_attr_insert RADIUS_ATTR
1167 =item export_attr_delete RADIUS_ATTR
1169 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
1171 Update the group attribute tables (radgroupcheck and radgroupreply) on
1172 the RADIUS server. In delete and replace actions, the existing records
1173 are identified by the combination of group name and attribute name.
1175 In the special case where attributes are being replaced because a group
1176 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
1177 'groupname' must be set in OLD_RADIUS_ATTR.
1181 # some false laziness with NAS export stuff...
1183 sub export_attr_insert { shift->export_attr_action('insert', @_); }
1185 sub export_attr_delete { shift->export_attr_action('delete', @_); }
1187 sub export_attr_replace { shift->export_attr_action('replace', @_); }
1189 sub export_attr_action {
1191 my ($action, $new, $old) = @_;
1194 if ( $action eq 'delete' ) {
1197 if ( $action eq 'delete' or $action eq 'replace' ) {
1198 # delete based on an exact match
1200 attrname => $old->attrname,
1201 attrtype => $old->attrtype,
1202 groupname => $old->groupname || $old->radius_group->groupname,
1204 value => $old->value,
1206 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1207 return $err_or_queue unless ref $err_or_queue;
1209 # this probably doesn't matter, but just to be safe...
1210 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1211 if ( $action eq 'replace' or $action eq 'insert' ) {
1213 attrname => $new->attrname,
1214 attrtype => $new->attrtype,
1215 groupname => $new->radius_group->groupname,
1217 value => $new->value,
1219 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1220 $err_or_queue->depend_insert($jobnum) if $jobnum;
1221 return $err_or_queue unless ref $err_or_queue;
1226 sub sqlradius_attr_insert {
1228 if ( $FS::svc_Common::noexport_hack ) {
1229 carp 'sqlradius_attr_insert() suppressed by noexport_hack' if $DEBUG;
1233 my $dbh = sqlradius_connect(shift, shift, shift);
1237 # make sure $table is completely safe
1238 if ( $opt{'attrtype'} eq 'C' ) {
1239 $table = 'radgroupcheck';
1241 elsif ( $opt{'attrtype'} eq 'R' ) {
1242 $table = 'radgroupreply';
1245 die "unknown attribute type '$opt{attrtype}'";
1248 my @values = @opt{ qw(groupname attrname op value) };
1249 my $sth = $dbh->prepare(
1250 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1252 $sth->execute(@values) or die $dbh->errstr;
1255 sub sqlradius_attr_delete {
1257 if ( $FS::svc_Common::noexport_hack ) {
1258 carp 'sqlradius_attr_delete() suppressed by noexport_hack' if $DEBUG;
1262 my $dbh = sqlradius_connect(shift, shift, shift);
1266 if ( $opt{'attrtype'} eq 'C' ) {
1267 $table = 'radgroupcheck';
1269 elsif ( $opt{'attrtype'} eq 'R' ) {
1270 $table = 'radgroupreply';
1273 die "unknown attribute type '".$opt{'attrtype'}."'";
1276 my @values = @opt{ qw(groupname attrname op value) };
1277 my $sth = $dbh->prepare(
1278 'DELETE FROM '.$table.
1279 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1282 $sth->execute(@values) or die $dbh->errstr;
1285 #sub sqlradius_attr_replace { no longer needed
1287 =item export_group_replace NEW OLD
1289 Replace the L<FS::radius_group> object OLD with NEW. This will change
1290 the group name and priority in all radusergroup records, and the group
1291 name in radgroupcheck and radgroupreply.
1295 sub export_group_replace {
1297 my ($new, $old) = @_;
1298 return '' if $new->groupname eq $old->groupname
1299 and $new->priority == $old->priority;
1301 my $err_or_queue = $self->sqlradius_queue(
1304 ($self->option('usergroup') || 'usergroup'),
1308 return $err_or_queue unless ref $err_or_queue;
1312 sub sqlradius_group_replace {
1314 if ( $FS::svc_Common::noexport_hack ) {
1315 carp 'sqlradius_group_replace() suppressed by noexport_hack' if $DEBUG;
1319 my $dbh = sqlradius_connect(shift, shift, shift);
1320 my $usergroup = shift;
1321 $usergroup =~ /^(rad)?usergroup$/
1322 or die "bad usergroup table name: $usergroup";
1323 my ($new, $old) = (shift, shift);
1324 # apply renames to check/reply attribute tables
1325 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1326 foreach my $table (qw(radgroupcheck radgroupreply)) {
1327 my $sth = $dbh->prepare(
1328 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1330 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1331 or die $dbh->errstr;
1334 # apply renames and priority changes to usergroup table
1335 my $sth = $dbh->prepare(
1336 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1338 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1339 or die $dbh->errstr;
1342 =item sqlradius_user_disconnect
1344 For a specified user, sends a disconnect request to all nas in the server database.
1346 Accepts L</sqlradius_connect> connection input and the following named parameters:
1348 I<disconnect_ssh> - user@host with access to radclient program (required)
1350 I<svc_acct_username> - the user to be disconnected (required)
1352 I<disconnect_port> - the port (on the nas) to send disconnect requests to (defaults to 1700)
1354 Note this is NOT the opposite of sqlradius_connect.
1358 sub sqlradius_user_disconnect {
1360 if ( $FS::svc_Common::noexport_hack ) {
1361 carp 'sqlradius_user_disconnect() suppressed by noexport_hack' if $DEBUG;
1365 my $dbh = sqlradius_connect(shift, shift, shift);
1368 my $sth = $dbh->prepare('select nasname, secret from nas') or die $dbh->errstr;
1369 $sth->execute() or die $dbh->errstr;
1370 my $nas = $sth->fetchall_arrayref({});
1373 die "No nas found in radius db" unless @$nas;
1374 # set up ssh connection
1375 my $ssh = Net::OpenSSH->new($opt{'disconnect_ssh'});
1376 die "Couldn't establish SSH connection: " . $ssh->error
1378 # send individual disconnect requests
1379 my $user = $opt{'svc_acct_username'}; #svc_acct username
1380 my $port = $opt{'disconnect_port'} || 1700; #or should we pull this from the db?
1382 foreach my $nas (@$nas) {
1383 my $nasname = $nas->{'nasname'};
1384 my $secret = $nas->{'secret'};
1385 my $command = qq(echo "User-Name=$user" | radclient -r 1 $nasname:$port disconnect '$secret');
1386 my ($output, $errput) = $ssh->capture2($command);
1387 $error .= "Error running $command: $errput " . $ssh->error . " "
1388 if $errput || $ssh->error;
1390 $error .= "Some clients may have successfully disconnected"
1391 if $error && (@$nas > 1);
1392 $error = "No clients found"
1394 die $error if $error;
1399 # class method to fetch groups/attributes from the sqlradius install on upgrade
1402 sub _upgrade_exporttype {
1403 # do this only if the radius_attr table is empty
1404 local $FS::radius_attr::noexport_hack = 1;
1406 return if qsearch('radius_attr', {});
1408 foreach my $self ($class->all_sqlradius) {
1409 my $error = $self->import_attrs;
1410 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1417 my $dbh = DBI->connect( map $self->option($_),
1418 qw( datasrc username password ) );
1420 warn "Error connecting to RADIUS server: $DBI::errstr\n";
1424 my $usergroup = $self->option('usergroup') || 'usergroup';
1426 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1429 # map out existing groups and attrs
1432 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1433 $attrs_of{$radius_group->groupname} = +{
1434 map { $_->attrname => $_ } $radius_group->radius_attr
1436 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1439 # get groupnames from radgroupcheck and radgroupreply
1441 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1443 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1444 my @fixes; # things that need to be changed on the radius db
1445 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1446 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1447 warn "$groupname.$attrname\n";
1448 if ( !exists($groupnum_of{$groupname}) ) {
1449 my $radius_group = new FS::radius_group {
1450 'groupname' => $groupname,
1453 $error = $radius_group->insert;
1455 warn "error inserting group $groupname: $error";
1456 next;#don't continue trying to insert the attribute
1458 $attrs_of{$groupname} = {};
1459 $groupnum_of{$groupname} = $radius_group->groupnum;
1462 my $a = $attrs_of{$groupname};
1463 my $old = $a->{$attrname};
1466 if ( $attrtype eq 'R' ) {
1467 # Freeradius tolerates illegal operators in reply attributes. We don't.
1468 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1469 warn "$groupname.$attrname: changing $op to +=\n";
1470 # Make a note to change it in the db
1472 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1473 $groupname, $attrname, $op, $value
1475 # and import it correctly.
1480 if ( defined $old ) {
1482 $new = new FS::radius_attr {
1487 $error = $new->replace($old);
1489 warn "error modifying attr $attrname: $error";
1494 $new = new FS::radius_attr {
1495 'groupnum' => $groupnum_of{$groupname},
1496 'attrname' => $attrname,
1497 'attrtype' => $attrtype,
1501 $error = $new->insert;
1503 warn "error inserting attr $attrname: $error" if $error;
1507 $attrs_of{$groupname}->{$attrname} = $new;
1511 my ($sql, @args) = @$_;
1512 my $sth = $dbh->prepare($sql);
1513 $sth->execute(@args) or warn $sth->errstr;
1526 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1527 # (radiator is supposed to be setup with a radacct table)
1528 #i suppose it would be more slick to look for things that inherit from us..
1530 my @part_export = ();
1531 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1532 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1533 broadband_sqlradius );
1537 sub all_sqlradius_withaccounting {
1539 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;