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 );
16 @ISA = qw(FS::part_export);
17 @EXPORT_OK = qw( sqlradius_connect );
22 tie %options, 'Tie::IxHash',
23 'datasrc' => { label=>'DBI data source ' },
24 'username' => { label=>'Database username' },
25 'password' => { label=>'Database password' },
26 'usergroup' => { label => 'Group table',
28 options => [qw( usergroup radusergroup ) ],
30 'skip_provisioning' => {
32 label => 'Skip provisioning records to this database'
34 'ignore_accounting' => {
36 label => 'Ignore accounting records from this database'
38 'process_single_realm' => {
40 label => 'Only process one realm of accounting records',
42 'realm' => { label => 'The realm of of accounting records to be processed' },
43 'ignore_long_sessions' => {
45 label => 'Ignore sessions which span billing periods',
49 label => 'Hide IP address information on session reports',
53 label => 'Hide download/upload information on session reports',
55 'show_called_station' => {
57 label => 'Show the Called-Station-ID on session reports', #as a phone number
59 'overlimit_groups' => {
60 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)',
66 option_values => sub {
68 map { $_->groupnum, $_->long_description }
69 qsearch('radius_group', {}),
74 'groups_susp_reason' => { label =>
75 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
80 label => 'Export RADIUS group attributes to this database',
83 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',
85 'disconnect_port' => {
86 label => 'Port to send disconnection requests to, default 1700',
91 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
92 tables to any SQL database for
93 <a href="http://www.freeradius.org/">FreeRADIUS</a>
94 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
98 An existing RADIUS database will be updated in realtime, but you can use
99 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
100 to delete the entire RADIUS database and repopulate the tables from the
101 Freeside database. See the
102 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
104 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
105 for the exact syntax of a DBI data source.
107 <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.
108 <li>Using ICRADIUS, add a dummy "op" column to your database:
110 ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
111 ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
112 ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
113 ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
115 <li>Using Radiator, see the
116 <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
117 for configuration information.
123 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
124 'options' => \%options,
127 'nas' => 'Y', # show export_nas selection in UI
128 'default_svc_class' => 'Internet',
130 'This export does not export RADIUS realms (see also '.
131 'sqlradius_withdomain). '.
135 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
136 split( "\n", shift->option('groups_susp_reason'));
139 sub rebless { shift; }
141 sub export_username { # override for other svcdb
142 my($self, $svc_acct) = (shift, shift);
143 warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
147 sub radius_reply { #override for other svcdb
148 my($self, $svc_acct) = (shift, shift);
149 my %every = $svc_acct->EVERY::radius_reply;
150 map { @$_ } values %every;
153 sub radius_check { #override for other svcdb
154 my($self, $svc_acct) = (shift, shift);
155 my %every = $svc_acct->EVERY::radius_check;
156 map { @$_ } values %every;
160 my($self, $svc_x) = (shift, shift);
162 return '' if $self->option('skip_provisioning');
164 foreach my $table (qw(reply check)) {
165 my $method = "radius_$table";
166 my %attrib = $self->$method($svc_x);
167 next unless keys %attrib;
168 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
169 $table, $self->export_username($svc_x), %attrib );
170 return $err_or_queue unless ref($err_or_queue);
172 my @groups = $svc_x->radius_groups('hashref');
174 cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
175 " (". $self->export_username($svc_x). " with ". join(", ", @groups)
177 my $usergroup = $self->option('usergroup') || 'usergroup';
178 my $err_or_queue = $self->sqlradius_queue(
179 $svc_x->svcnum, 'usergroup_insert',
180 $self->export_username($svc_x), $usergroup, @groups );
181 return $err_or_queue unless ref($err_or_queue);
186 sub _export_replace {
187 my( $self, $new, $old ) = (shift, shift, shift);
189 return '' if $self->option('skip_provisioning');
191 local $SIG{HUP} = 'IGNORE';
192 local $SIG{INT} = 'IGNORE';
193 local $SIG{QUIT} = 'IGNORE';
194 local $SIG{TERM} = 'IGNORE';
195 local $SIG{TSTP} = 'IGNORE';
196 local $SIG{PIPE} = 'IGNORE';
198 my $oldAutoCommit = $FS::UID::AutoCommit;
199 local $FS::UID::AutoCommit = 0;
203 if ( $self->export_username($old) ne $self->export_username($new) ) {
204 my $usergroup = $self->option('usergroup') || 'usergroup';
205 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
206 $self->export_username($new), $self->export_username($old), $usergroup );
207 unless ( ref($err_or_queue) ) {
208 $dbh->rollback if $oldAutoCommit;
209 return $err_or_queue;
211 $jobnum = $err_or_queue->jobnum;
214 foreach my $table (qw(reply check)) {
215 my $method = "radius_$table";
216 my %new = $self->$method($new);
217 my %old = $self->$method($old);
218 if ( grep { !exists $old{$_} #new attributes
219 || $new{$_} ne $old{$_} #changed
222 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
223 $table, $self->export_username($new), %new );
224 unless ( ref($err_or_queue) ) {
225 $dbh->rollback if $oldAutoCommit;
226 return $err_or_queue;
229 my $error = $err_or_queue->depend_insert( $jobnum );
231 $dbh->rollback if $oldAutoCommit;
235 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
238 my @del = grep { !exists $new{$_} } keys %old;
240 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
241 $table, $self->export_username($new), @del );
242 unless ( ref($err_or_queue) ) {
243 $dbh->rollback if $oldAutoCommit;
244 return $err_or_queue;
247 my $error = $err_or_queue->depend_insert( $jobnum );
249 $dbh->rollback if $oldAutoCommit;
253 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
258 my (@oldgroups) = $old->radius_groups('hashref');
259 my (@newgroups) = $new->radius_groups('hashref');
260 ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum,
261 $self->export_username($new),
262 $jobnum ? $jobnum : '',
267 $dbh->rollback if $oldAutoCommit;
271 # radius database is used for authorization, so to avoid users reauthorizing
272 # before the database changes, disconnect users after changing database
273 if ($self->option('disconnect_ssh')) {
274 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect',
275 'disconnect_ssh' => $self->option('disconnect_ssh'),
276 'svc_acct_username' => $old->username,
277 'disconnect_port' => $self->option('disconnect_port'),
279 unless ( ref($err_or_queue) ) {
280 $dbh->rollback if $oldAutoCommit;
281 return $err_or_queue;
284 my $error = $err_or_queue->depend_insert( $jobnum );
286 $dbh->rollback if $oldAutoCommit;
292 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
297 #false laziness w/broadband_sqlradius.pm
298 sub _export_suspend {
299 my( $self, $svc_acct ) = (shift, shift);
301 return '' if $self->option('skip_provisioning');
303 my $new = $svc_acct->clone_suspended;
305 local $SIG{HUP} = 'IGNORE';
306 local $SIG{INT} = 'IGNORE';
307 local $SIG{QUIT} = 'IGNORE';
308 local $SIG{TERM} = 'IGNORE';
309 local $SIG{TSTP} = 'IGNORE';
310 local $SIG{PIPE} = 'IGNORE';
312 my $oldAutoCommit = $FS::UID::AutoCommit;
313 local $FS::UID::AutoCommit = 0;
318 my @newgroups = $self->suspended_usergroups($svc_acct);
320 unless (@newgroups) { #don't change password if assigning to a suspended group
322 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
323 'check', $self->export_username($new), $new->radius_check );
324 unless ( ref($err_or_queue) ) {
325 $dbh->rollback if $oldAutoCommit;
326 return $err_or_queue;
328 $jobnum = $err_or_queue->jobnum;
333 $self->sqlreplace_usergroups(
335 $self->export_username($new),
337 [ $svc_acct->radius_groups('hashref') ],
341 $dbh->rollback if $oldAutoCommit;
345 # radius database is used for authorization, so to avoid users reauthorizing
346 # before the database changes, disconnect users after changing database
347 if ($self->option('disconnect_ssh')) {
348 my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect',
349 'disconnect_ssh' => $self->option('disconnect_ssh'),
350 'svc_acct_username' => $svc_acct->username,
351 'disconnect_port' => $self->option('disconnect_port'),
353 unless ( ref($err_or_queue) ) {
354 $dbh->rollback if $oldAutoCommit;
355 return $err_or_queue;
358 my $error = $err_or_queue->depend_insert( $jobnum );
360 $dbh->rollback if $oldAutoCommit;
366 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
371 sub _export_unsuspend {
372 my( $self, $svc_x ) = (shift, shift);
374 return '' if $self->option('skip_provisioning');
376 local $SIG{HUP} = 'IGNORE';
377 local $SIG{INT} = 'IGNORE';
378 local $SIG{QUIT} = 'IGNORE';
379 local $SIG{TERM} = 'IGNORE';
380 local $SIG{TSTP} = 'IGNORE';
381 local $SIG{PIPE} = 'IGNORE';
383 my $oldAutoCommit = $FS::UID::AutoCommit;
384 local $FS::UID::AutoCommit = 0;
387 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
388 'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
389 unless ( ref($err_or_queue) ) {
390 $dbh->rollback if $oldAutoCommit;
391 return $err_or_queue;
395 my (@oldgroups) = $self->suspended_usergroups($svc_x);
396 $error = $self->sqlreplace_usergroups(
398 $self->export_username($svc_x),
401 [ $svc_x->radius_groups('hashref') ],
404 $dbh->rollback if $oldAutoCommit;
407 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
413 my( $self, $svc_x ) = (shift, shift);
415 return '' if $self->option('skip_provisioning');
419 my $usergroup = $self->option('usergroup') || 'usergroup';
420 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
421 $self->export_username($svc_x), $usergroup );
422 $jobnum = $err_or_queue->jobnum;
424 # radius database is used for authorization, so to avoid users reauthorizing
425 # before the database changes, disconnect users after changing database
426 if ($self->option('disconnect_ssh')) {
427 my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'user_disconnect',
428 'disconnect_ssh' => $self->option('disconnect_ssh'),
429 'svc_acct_username' => $svc_x->username,
430 'disconnect_port' => $self->option('disconnect_port'),
432 return $err_or_queue unless ref($err_or_queue);
434 my $error = $err_or_queue->depend_insert( $jobnum );
435 return $error if $error;
439 ref($err_or_queue) ? '' : $err_or_queue;
442 sub sqlradius_queue {
443 my( $self, $svcnum, $method ) = (shift, shift, shift);
445 my $queue = new FS::queue {
447 'job' => "FS::part_export::sqlradius::sqlradius_$method",
450 $self->option('datasrc'),
451 $self->option('username'),
452 $self->option('password'),
457 sub suspended_usergroups {
458 my ($self, $svc_x) = (shift, shift);
460 return () unless $svc_x;
462 my $svc_table = $svc_x->table;
464 #false laziness with FS::part_export::shellcommands
465 #subclass part_export?
467 my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
468 my %reasonmap = $self->_groups_susp_reason_map;
471 $userspec = $reasonmap{$r->reasonnum}
472 if exists($reasonmap{$r->reasonnum});
473 $userspec = $reasonmap{$r->reason}
474 if (!$userspec && exists($reasonmap{$r->reason}));
477 if ( $userspec =~ /^\d+$/ ){
478 $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
479 } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
480 my ($username,$domain) = split(/\@/, $userspec);
481 for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
482 $suspend_svc = $user if $userspec eq $user->email;
484 }elsif ( $userspec && $svc_table eq 'svc_acct' ){
485 $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
488 return $suspend_svc->radius_groups('hashref') if $suspend_svc;
492 sub sqlradius_insert { #subroutine, not method
494 if ( $FS::svc_Common::noexport_hack ) {
495 carp 'sqlradius_insert() suppressed by noexport_hack' if $DEBUG;
499 my $dbh = sqlradius_connect(shift, shift, shift);
500 my( $table, $username, %attributes ) = @_;
502 foreach my $attribute ( keys %attributes ) {
504 my $s_sth = $dbh->prepare(
505 "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
506 ) or die $dbh->errstr;
507 $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
509 if ( $s_sth->fetchrow_arrayref->[0] ) {
511 my $u_sth = $dbh->prepare(
512 "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
513 ) or die $dbh->errstr;
514 $u_sth->execute($attributes{$attribute}, $username, $attribute)
515 or die $u_sth->errstr;
519 my $i_sth = $dbh->prepare(
520 "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
521 "VALUES ( ?, ?, ?, ? )"
522 ) or die $dbh->errstr;
526 ( $attribute eq 'Password' ? '==' : ':=' ),
527 $attributes{$attribute},
528 ) or die $i_sth->errstr;
536 sub sqlradius_usergroup_insert { #subroutine, not method
538 if ( $FS::svc_Common::noexport_hack ) {
539 carp 'sqlradius_usergroup_insert() suppressed by noexport_hack' if $DEBUG;
543 my $dbh = sqlradius_connect(shift, shift, shift);
544 my $username = shift;
545 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
548 my $s_sth = $dbh->prepare(
549 "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
550 ) or die $dbh->errstr;
552 my $sth = $dbh->prepare(
553 "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
554 ) or die $dbh->errstr;
556 foreach ( @groups ) {
557 my $group = $_->{'groupname'};
558 my $priority = $_->{'priority'};
559 $s_sth->execute( $username, $group ) or die $s_sth->errstr;
560 if ($s_sth->fetchrow_arrayref->[0]) {
561 warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
562 "$group for $username\n"
566 $sth->execute( $username, $group, $priority )
567 or die "can't insert into groupname table: ". $sth->errstr;
569 if ( $s_sth->{Active} ) {
570 warn "sqlradius s_sth still active; calling ->finish()";
573 if ( $sth->{Active} ) {
574 warn "sqlradius sth still active; calling ->finish()";
580 sub sqlradius_usergroup_delete { #subroutine, not method
582 if ( $FS::svc_Common::noexport_hack ) {
583 carp 'sqlradius_usergroup_delete() suppressed by noexport_hack' if $DEBUG;
587 my $dbh = sqlradius_connect(shift, shift, shift);
588 my $username = shift;
589 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
592 my $sth = $dbh->prepare(
593 "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
594 ) or die $dbh->errstr;
595 foreach ( @groups ) {
596 my $group = $_->{'groupname'};
597 $sth->execute( $username, $group )
598 or die "can't delete from groupname table: ". $sth->errstr;
603 sub sqlradius_rename { #subroutine, not method
605 if ( $FS::svc_Common::noexport_hack ) {
606 carp 'sqlradius_rename() suppressed by noexport_hack' if $DEBUG;
610 my $dbh = sqlradius_connect(shift, shift, shift);
611 my($new_username, $old_username) = (shift, shift);
612 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
613 foreach my $table (qw(radreply radcheck), $usergroup ) {
614 my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
616 $sth->execute($new_username, $old_username)
617 or die "can't update $table: ". $sth->errstr;
622 sub sqlradius_attrib_delete { #subroutine, not method
624 if ( $FS::svc_Common::noexport_hack ) {
625 carp 'sqlradius_attrib_delete() suppressed by noexport_hack' if $DEBUG;
629 my $dbh = sqlradius_connect(shift, shift, shift);
630 my( $table, $username, @attrib ) = @_;
632 foreach my $attribute ( @attrib ) {
633 my $sth = $dbh->prepare(
634 "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
636 $sth->execute($username,$attribute)
637 or die "can't delete from rad$table table: ". $sth->errstr;
642 sub sqlradius_delete { #subroutine, not method
644 if ( $FS::svc_Common::noexport_hack ) {
645 carp 'sqlradius_delete() suppressed by noexport_hack' if $DEBUG;
649 my $dbh = sqlradius_connect(shift, shift, shift);
650 my $username = shift;
651 my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
653 foreach my $table (qw( radcheck radreply), $usergroup ) {
654 my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
655 $sth->execute($username)
656 or die "can't delete from $table table: ". $sth->errstr;
661 sub sqlradius_connect {
662 #my($datasrc, $username, $password) = @_;
663 #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
664 FS::DBI->connect(@_) or die $FS::DBI::errstr;
667 # on success, returns '' in scalar context, ('',$jobnum) in list context
668 # on error, always just returns error
669 sub sqlreplace_usergroups {
670 my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
672 # (sorta) false laziness with FS::svc_acct::replace
673 my @oldgroups = @$old;
674 my @newgroups = @$new;
676 foreach my $oldgroup ( @oldgroups ) {
677 if ( grep { $oldgroup eq $_ } @newgroups ) {
678 @newgroups = grep { $oldgroup ne $_ } @newgroups;
681 push @delgroups, $oldgroup;
684 my $usergroup = $self->option('usergroup') || 'usergroup';
687 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
688 $username, $usergroup, @delgroups );
690 unless ref($err_or_queue);
692 my $error = $err_or_queue->depend_insert( $jobnum );
693 return $error if $error;
695 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
699 cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
700 "with ". join(", ", @newgroups)
702 my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
703 $username, $usergroup, @newgroups );
705 unless ref($err_or_queue);
707 my $error = $err_or_queue->depend_insert( $jobnum );
708 return $error if $error;
710 $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
712 wantarray ? ('',$jobnum) : '';
718 =item usage_sessions HASHREF
720 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
722 New-style: pass a hashref with the following keys:
726 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
728 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
730 =item session_status - 'closed' to only show records with AcctStopTime,
731 'open' to only show records I<without> AcctStopTime, empty to show both.
733 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
735 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
747 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
748 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
751 SVC_ACCT, if specified, limits the results to the specified account.
753 IP, if specified, limits the results to the specified IP address.
755 PREFIX, if specified, limits the results to records with a matching
758 #SQL_SELECT defaults to * if unspecified. It can be useful to set it to
759 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
761 Returns an arrayref of hashrefs with the following fields:
767 =item framedipaddress
773 =item acctsessiontime
775 =item acctinputoctets
777 =item acctoutputoctets
779 =item callingstationid
781 =item calledstationid
787 #some false laziness w/cust_svc::seconds_since_sqlradacct
793 my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
797 $start = $opt->{stoptime_start};
798 $end = $opt->{stoptime_end};
799 $svc_acct = $opt->{svc} || $opt->{svc_acct};
801 $prefix = $opt->{prefix};
802 $summarize = $opt->{summarize};
804 ( $start, $end ) = splice(@_, 0, 2);
805 $svc_acct = @_ ? shift : '';
806 $ip = @_ ? shift : '';
807 $prefix = @_ ? shift : '';
808 #my $select = @_ ? shift : '*';
813 return [] if $self->option('ignore_accounting');
815 my $dbh = sqlradius_connect( map $self->option($_),
816 qw( datasrc username password ) );
818 #select a unix time conversion function based on database type
819 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
820 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
823 qw( username realm framedipaddress
824 acctsessiontime acctinputoctets acctoutputoctets
825 callingstationid calledstationid
827 "$str2time acctstarttime $closing as acctstarttime",
828 "$str2time acctstoptime $closing as acctstoptime",
831 @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
832 'sum(acctoutputoctets) as acctoutputoctets',
839 my $username = $self->export_username($svc_acct);
840 if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
841 push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
842 push @param, $username, $1, $2;
844 push @where, 'UserName = ?';
845 push @param, $username;
849 if ($self->option('process_single_realm')) {
850 push @where, 'Realm = ?';
851 push @param, $self->option('realm');
855 push @where, ' FramedIPAddress = ?';
859 if ( length($prefix) ) {
860 #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
861 push @where, " CalledStationID LIKE 'sip:$prefix\%'";
864 my $acctstoptime = '';
865 if ( $opt->{session_status} ne 'open' ) {
867 $acctstoptime .= "$str2time AcctStopTime $closing >= ?";
869 $acctstoptime .= ' AND ' if $end;
872 $acctstoptime .= "$str2time AcctStopTime $closing <= ?";
876 if ( $opt->{session_status} ne 'closed' ) {
877 if ( $acctstoptime ) {
878 $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )";
880 $acctstoptime = 'AcctStopTime IS NULL';
883 push @where, $acctstoptime;
885 if ( $opt->{starttime_start} ) {
886 push @where, "$str2time AcctStartTime $closing >= ?";
887 push @param, $opt->{starttime_start};
889 if ( $opt->{starttime_end} ) {
890 push @where, "$str2time AcctStartTime $closing <= ?";
891 push @param, $opt->{starttime_end};
894 my $where = join(' AND ', @where);
895 $where = "WHERE $where" if $where;
898 $groupby = 'GROUP BY username' if $summarize;
900 my $orderby = 'ORDER BY AcctStartTime DESC';
901 $orderby = '' if $summarize;
903 my $sql = 'SELECT '. join(', ', @fields).
904 " FROM radacct $where $groupby $orderby";
907 warn join(',', @param);
909 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
910 $sth->execute(@param) or die $sth->errstr;
912 [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
923 if ( $FS::svc_Common::noexport_hack ) {
924 carp 'update_svc() suppressed by noexport_hack'
925 if $self->option('debug') || $DEBUG;
929 my $conf = new FS::Conf;
932 my $dbh = sqlradius_connect( map $self->option($_),
933 qw( datasrc username password ) );
935 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
936 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
938 my @fields = qw( radacctid username realm acctsessiontime );
943 my $sth = $dbh->prepare("
944 SELECT RadAcctId, UserName, Realm, AcctSessionTime,
945 $str2time AcctStartTime $closing, $str2time AcctStopTime $closing,
946 AcctInputOctets, AcctOutputOctets
948 WHERE FreesideStatus IS NULL
949 AND AcctStopTime IS NOT NULL
950 ") or die $dbh->errstr;
951 $sth->execute() or die $sth->errstr;
953 while ( my $row = $sth->fetchrow_arrayref ) {
954 my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
955 $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
956 warn "processing record: ".
957 "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
960 my $fs_username = $UserName;
962 $fs_username = lc($fs_username) unless $conf->exists('username-uppercase');
964 #my %search = ( 'username' => $fs_username );
967 my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
968 "(UserName $UserName, Realm $Realm)";
971 if ( ref($self) =~ /withdomain/ ) { #well, should be a callback to that
976 } elsif ( $fs_username =~ /\@/ ) {
977 ($fs_username, $domain) = split('@', $fs_username);
979 warn 'WARNING: nothing Realm column and no @realm in UserName column '.
980 "$errinfo -- skipping\n" if $DEBUG;
981 $status = 'skipped (no realm)';
984 $extra_sql = " AND '$domain' = ( SELECT domain FROM svc_domain
985 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
988 my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
989 local $FS::UID::AutoCommit = 0; # least we can avoid over counting
995 if ( $self->option('process_single_realm')
996 && $self->option('realm') ne $Realm )
998 warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
1001 grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
1002 'svcpart' => $_->cust_svc->svcpart,
1006 qsearch( 'svc_acct',
1007 { 'username' => $fs_username },
1013 warn "WARNING: no svc_acct record found $errinfo - skipping\n";
1014 } elsif ( scalar(@svc_acct) > 1 ) {
1015 warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
1018 my $svc_acct = $svc_acct[0];
1019 warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
1021 $svc_acct->last_login($AcctStartTime);
1022 $svc_acct->last_logout($AcctStopTime);
1024 my $session_time = $AcctStopTime;
1025 $session_time = $AcctStartTime
1026 if $self->option('ignore_long_sessions');
1028 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
1029 if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
1030 || $cust_pkg->setup ) ) {
1031 $status = 'skipped (too old)';
1034 push @st, _try_decrement($svc_acct,'seconds', $AcctSessionTime);
1035 push @st, _try_decrement($svc_acct,'upbytes', $AcctInputOctets);
1036 push @st, _try_decrement($svc_acct,'downbytes', $AcctOutputOctets);
1037 push @st, _try_decrement($svc_acct,'totalbytes', $AcctInputOctets
1038 + $AcctOutputOctets);
1039 $status=join(' ', @st);
1046 warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
1047 my $psth = $dbh->prepare("UPDATE radacct
1048 SET FreesideStatus = ?
1049 WHERE RadAcctId = ?"
1050 ) or die $dbh->errstr;
1051 $psth->execute($status, $RadAcctId) or die $psth->errstr;
1053 $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
1059 sub _try_decrement {
1060 my ($svc_acct, $column, $amount) = @_;
1061 if ( $svc_acct->$column !~ /^$/ ) {
1062 warn " svc_acct.$column found (". $svc_acct->$column.
1063 ") - decrementing\n"
1065 my $method = 'decrement_' . $column;
1066 my $error = $svc_acct->$method($amount);
1067 die $error if $error;
1070 warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
1075 =item export_nas_insert NAS
1077 =item export_nas_delete NAS
1079 =item export_nas_replace NEW_NAS OLD_NAS
1081 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
1082 server. Currently requires the table to be named 'nas' and to follow
1083 the stock schema (/etc/freeradius/nas.sql).
1087 sub export_nas_insert { shift->export_nas_action('insert', @_); }
1088 sub export_nas_delete { shift->export_nas_action('delete', @_); }
1089 sub export_nas_replace { shift->export_nas_action('replace', @_); }
1091 sub export_nas_action {
1093 my ($action, $new, $old) = @_;
1095 if ( $FS::svc_Common::noexport_hack ) {
1096 carp "export_nas_action($action) suppressed by noexport_hack"
1097 if $self->option('debug') || $DEBUG;
1101 # find the NAS in the target table by its name
1102 my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
1103 my $nasnum = $new->nasnum;
1105 my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
1106 nasname => $nasname,
1109 return $err_or_queue unless ref $err_or_queue;
1113 sub sqlradius_nas_insert {
1115 if ( $FS::svc_Common::noexport_hack ) {
1116 carp 'sqlradius_nas_insert() suppressed by noexport_hack' if $DEBUG;
1120 my $dbh = sqlradius_connect(shift, shift, shift);
1122 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
1123 or die "nasnum ".$opt{'nasnum'}.' not found';
1124 # insert actual NULLs where FS::Record has translated to empty strings
1125 my @values = map { length($nas->$_) ? $nas->$_ : undef }
1126 qw( nasname shortname type secret server community description );
1127 my $sth = $dbh->prepare('INSERT INTO nas
1128 (nasname, shortname, type, secret, server, community, description)
1129 VALUES (?, ?, ?, ?, ?, ?, ?)');
1130 $sth->execute(@values) or die $dbh->errstr;
1133 sub sqlradius_nas_delete {
1135 if ( $FS::svc_Common::noexport_hack ) {
1136 carp 'sqlradius_nas_delete() suppressed by noexport_hack' if $DEBUG;
1140 my $dbh = sqlradius_connect(shift, shift, shift);
1142 my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
1143 $sth->execute($opt{'nasname'}) or die $dbh->errstr;
1146 sub sqlradius_nas_replace {
1148 if ( $FS::svc_Common::noexport_hack ) {
1149 carp 'sqlradius_nas_replace() suppressed by noexport_hack' if $DEBUG;
1153 my $dbh = sqlradius_connect(shift, shift, shift);
1155 my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
1156 or die "nasnum ".$opt{'nasnum'}.' not found';
1157 my @values = map {$nas->$_}
1158 qw( nasname shortname type secret server community description );
1159 my $sth = $dbh->prepare('UPDATE nas SET
1160 nasname = ?, shortname = ?, type = ?, secret = ?,
1161 server = ?, community = ?, description = ?
1162 WHERE nasname = ?');
1163 $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
1166 =item export_attr_insert RADIUS_ATTR
1168 =item export_attr_delete RADIUS_ATTR
1170 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
1172 Update the group attribute tables (radgroupcheck and radgroupreply) on
1173 the RADIUS server. In delete and replace actions, the existing records
1174 are identified by the combination of group name and attribute name.
1176 In the special case where attributes are being replaced because a group
1177 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
1178 'groupname' must be set in OLD_RADIUS_ATTR.
1182 # some false laziness with NAS export stuff...
1184 sub export_attr_insert { shift->export_attr_action('insert', @_); }
1186 sub export_attr_delete { shift->export_attr_action('delete', @_); }
1188 sub export_attr_replace { shift->export_attr_action('replace', @_); }
1190 sub export_attr_action {
1192 my ($action, $new, $old) = @_;
1195 if ( $action eq 'delete' ) {
1198 if ( $action eq 'delete' or $action eq 'replace' ) {
1199 # delete based on an exact match
1201 attrname => $old->attrname,
1202 attrtype => $old->attrtype,
1203 groupname => $old->groupname || $old->radius_group->groupname,
1205 value => $old->value,
1207 $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1208 return $err_or_queue unless ref $err_or_queue;
1210 # this probably doesn't matter, but just to be safe...
1211 my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1212 if ( $action eq 'replace' or $action eq 'insert' ) {
1214 attrname => $new->attrname,
1215 attrtype => $new->attrtype,
1216 groupname => $new->radius_group->groupname,
1218 value => $new->value,
1220 $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1221 $err_or_queue->depend_insert($jobnum) if $jobnum;
1222 return $err_or_queue unless ref $err_or_queue;
1227 sub sqlradius_attr_insert {
1229 if ( $FS::svc_Common::noexport_hack ) {
1230 carp 'sqlradius_attr_insert() suppressed by noexport_hack' if $DEBUG;
1234 my $dbh = sqlradius_connect(shift, shift, shift);
1238 # make sure $table is completely safe
1239 if ( $opt{'attrtype'} eq 'C' ) {
1240 $table = 'radgroupcheck';
1242 elsif ( $opt{'attrtype'} eq 'R' ) {
1243 $table = 'radgroupreply';
1246 die "unknown attribute type '$opt{attrtype}'";
1249 my @values = @opt{ qw(groupname attrname op value) };
1250 my $sth = $dbh->prepare(
1251 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1253 $sth->execute(@values) or die $dbh->errstr;
1256 sub sqlradius_attr_delete {
1258 if ( $FS::svc_Common::noexport_hack ) {
1259 carp 'sqlradius_attr_delete() suppressed by noexport_hack' if $DEBUG;
1263 my $dbh = sqlradius_connect(shift, shift, shift);
1267 if ( $opt{'attrtype'} eq 'C' ) {
1268 $table = 'radgroupcheck';
1270 elsif ( $opt{'attrtype'} eq 'R' ) {
1271 $table = 'radgroupreply';
1274 die "unknown attribute type '".$opt{'attrtype'}."'";
1277 my @values = @opt{ qw(groupname attrname op value) };
1278 my $sth = $dbh->prepare(
1279 'DELETE FROM '.$table.
1280 ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1283 $sth->execute(@values) or die $dbh->errstr;
1286 #sub sqlradius_attr_replace { no longer needed
1288 =item export_group_replace NEW OLD
1290 Replace the L<FS::radius_group> object OLD with NEW. This will change
1291 the group name and priority in all radusergroup records, and the group
1292 name in radgroupcheck and radgroupreply.
1296 sub export_group_replace {
1298 my ($new, $old) = @_;
1299 return '' if $new->groupname eq $old->groupname
1300 and $new->priority == $old->priority;
1302 my $err_or_queue = $self->sqlradius_queue(
1305 ($self->option('usergroup') || 'usergroup'),
1309 return $err_or_queue unless ref $err_or_queue;
1313 sub sqlradius_group_replace {
1315 if ( $FS::svc_Common::noexport_hack ) {
1316 carp 'sqlradius_group_replace() suppressed by noexport_hack' if $DEBUG;
1320 my $dbh = sqlradius_connect(shift, shift, shift);
1321 my $usergroup = shift;
1322 $usergroup =~ /^(rad)?usergroup$/
1323 or die "bad usergroup table name: $usergroup";
1324 my ($new, $old) = (shift, shift);
1325 # apply renames to check/reply attribute tables
1326 if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1327 foreach my $table (qw(radgroupcheck radgroupreply)) {
1328 my $sth = $dbh->prepare(
1329 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1331 $sth->execute($new->{'groupname'}, $old->{'groupname'})
1332 or die $dbh->errstr;
1335 # apply renames and priority changes to usergroup table
1336 my $sth = $dbh->prepare(
1337 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1339 $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1340 or die $dbh->errstr;
1343 =item sqlradius_user_disconnect
1345 For a specified user, sends a disconnect request to all nas in the server database.
1347 Accepts L</sqlradius_connect> connection input and the following named parameters:
1349 I<disconnect_ssh> - user@host with access to radclient program (required)
1351 I<svc_acct_username> - the user to be disconnected (required)
1353 I<disconnect_port> - the port (on the nas) to send disconnect requests to (defaults to 1700)
1355 Note this is NOT the opposite of sqlradius_connect.
1359 sub sqlradius_user_disconnect {
1361 if ( $FS::svc_Common::noexport_hack ) {
1362 carp 'sqlradius_user_disconnect() suppressed by noexport_hack' if $DEBUG;
1366 my $dbh = sqlradius_connect(shift, shift, shift);
1369 my $sth = $dbh->prepare('select nasname, secret from nas') or die $dbh->errstr;
1370 $sth->execute() or die $dbh->errstr;
1371 my $nas = $sth->fetchall_arrayref({});
1374 die "No nas found in radius db" unless @$nas;
1375 # set up ssh connection
1376 my $ssh = Net::OpenSSH->new($opt{'disconnect_ssh'});
1377 die "Couldn't establish SSH connection: " . $ssh->error
1379 # send individual disconnect requests
1380 my $user = $opt{'svc_acct_username'}; #svc_acct username
1381 my $port = $opt{'disconnect_port'} || 1700; #or should we pull this from the db?
1383 foreach my $nas (@$nas) {
1384 my $nasname = $nas->{'nasname'};
1385 my $secret = $nas->{'secret'};
1386 my $command = qq(echo "User-Name=$user" | radclient -r 1 $nasname:$port disconnect '$secret');
1387 my ($output, $errput) = $ssh->capture2($command);
1388 $error .= "Error running $command: $errput " . $ssh->error . " "
1389 if $errput || $ssh->error;
1391 $error .= "Some clients may have successfully disconnected"
1392 if $error && (@$nas > 1);
1393 $error = "No clients found"
1395 die $error if $error;
1400 # class method to fetch groups/attributes from the sqlradius install on upgrade
1403 sub _upgrade_exporttype {
1404 # do this only if the radius_attr table is empty
1405 local $FS::radius_attr::noexport_hack = 1;
1407 return if qsearch('radius_attr', {});
1409 foreach my $self ($class->all_sqlradius) {
1410 my $error = $self->import_attrs;
1411 die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1418 my $dbh = FS::DBI->connect( map $self->option($_),
1419 qw( datasrc username password ) );
1421 warn "Error connecting to RADIUS server: $FS::DBI::errstr\n";
1425 my $usergroup = $self->option('usergroup') || 'usergroup';
1427 warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1430 # map out existing groups and attrs
1433 foreach my $radius_group ( qsearch('radius_group', {}) ) {
1434 $attrs_of{$radius_group->groupname} = +{
1435 map { $_->attrname => $_ } $radius_group->radius_attr
1437 $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1440 # get groupnames from radgroupcheck and radgroupreply
1442 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1444 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1445 my @fixes; # things that need to be changed on the radius db
1446 foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1447 my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1448 warn "$groupname.$attrname\n";
1449 if ( !exists($groupnum_of{$groupname}) ) {
1450 my $radius_group = new FS::radius_group {
1451 'groupname' => $groupname,
1454 $error = $radius_group->insert;
1456 warn "error inserting group $groupname: $error";
1457 next;#don't continue trying to insert the attribute
1459 $attrs_of{$groupname} = {};
1460 $groupnum_of{$groupname} = $radius_group->groupnum;
1463 my $a = $attrs_of{$groupname};
1464 my $old = $a->{$attrname};
1467 if ( $attrtype eq 'R' ) {
1468 # Freeradius tolerates illegal operators in reply attributes. We don't.
1469 if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1470 warn "$groupname.$attrname: changing $op to +=\n";
1471 # Make a note to change it in the db
1473 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1474 $groupname, $attrname, $op, $value
1476 # and import it correctly.
1481 if ( defined $old ) {
1483 $new = new FS::radius_attr {
1488 $error = $new->replace($old);
1490 warn "error modifying attr $attrname: $error";
1495 $new = new FS::radius_attr {
1496 'groupnum' => $groupnum_of{$groupname},
1497 'attrname' => $attrname,
1498 'attrtype' => $attrtype,
1502 $error = $new->insert;
1504 warn "error inserting attr $attrname: $error" if $error;
1508 $attrs_of{$groupname}->{$attrname} = $new;
1512 my ($sql, @args) = @$_;
1513 my $sth = $dbh->prepare($sql);
1514 $sth->execute(@args) or warn $sth->errstr;
1527 #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1528 # (radiator is supposed to be setup with a radacct table)
1529 #i suppose it would be more slick to look for things that inherit from us..
1531 my @part_export = ();
1532 push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1533 foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1534 broadband_sqlradius );
1538 sub all_sqlradius_withaccounting {
1540 grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;