optionally calculate Suretax taxes based only on the service location, #32043
[freeside.git] / FS / FS / part_export / sqlradius.pm
1 package FS::part_export::sqlradius;
2
3 use strict;
4 use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
5 use Exporter;
6 use Tie::IxHash;
7 use FS::Record qw( dbh qsearch qsearchs str2time_sql str2time_sql_closing );
8 use FS::part_export;
9 use FS::svc_acct;
10 use FS::export_svc;
11 use Carp qw( cluck );
12 use NEXT;
13 use Net::OpenSSH;
14
15 @ISA = qw(FS::part_export);
16 @EXPORT_OK = qw( sqlradius_connect );
17
18 $DEBUG = 0;
19
20 my %groups;
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',
26                    type    => 'select',
27                    options => [qw( usergroup radusergroup ) ],
28                  },
29   'ignore_accounting' => {
30     type  => 'checkbox',
31     label => 'Ignore accounting records from this database'
32   },
33   'process_single_realm' => {
34     type  => 'checkbox',
35     label => 'Only process one realm of accounting records',
36   },
37   'realm' => { label => 'The realm of of accounting records to be processed' },
38   'ignore_long_sessions' => {
39     type  => 'checkbox',
40     label => 'Ignore sessions which span billing periods',
41   },
42   'hide_ip' => {
43     type  => 'checkbox',
44     label => 'Hide IP address information on session reports',
45   },
46   'hide_data' => {
47     type  => 'checkbox',
48     label => 'Hide download/upload information on session reports',
49   },
50   'show_called_station' => {
51     type  => 'checkbox',
52     label => 'Show the Called-Station-ID on session reports', #as a phone number
53   },
54   'overlimit_groups' => {
55       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)', 
56       type  => 'select',
57       multi => 1,
58       option_label  => sub {
59         $groups{$_[0]};
60       },
61       option_values => sub {
62         %groups = (
63               map { $_->groupnum, $_->long_description } 
64                   qsearch('radius_group', {}),
65             );
66             sort keys (%groups);
67       },
68    } ,
69   'groups_susp_reason' => { label =>
70                              'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
71                             type  => 'textarea',
72                           },
73   'export_attrs' => {
74     type => 'checkbox',
75     label => 'Export RADIUS group attributes to this database',
76   },
77   'disconnect_ssh' => {
78     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',
79   },
80   'disconnect_port' => {
81     label => 'Port to send disconnection requests to, default 1700',
82   },
83 ;
84
85 $notes1 = <<'END';
86 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
87 tables to any SQL database for
88 <a href="http://www.freeradius.org/">FreeRADIUS</a>
89 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
90 END
91
92 $notes2 = <<'END';
93 An existing RADIUS database will be updated in realtime, but you can use
94 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
95 to delete the entire RADIUS database and repopulate the tables from the
96 Freeside database.  See the
97 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
98 and the
99 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
100 for the exact syntax of a DBI data source.
101 <ul>
102   <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.
103   <li>Using ICRADIUS, add a dummy "op" column to your database:
104     <blockquote><code>
105       ALTER&nbsp;TABLE&nbsp;radcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
106       ALTER&nbsp;TABLE&nbsp;radreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
107       ALTER&nbsp;TABLE&nbsp;radgroupcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
108       ALTER&nbsp;TABLE&nbsp;radgroupreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='
109     </code></blockquote>
110   <li>Using Radiator, see the
111     <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
112     for configuration information.
113 </ul>
114 END
115
116 %info = (
117   'svc'      => 'svc_acct',
118   'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
119   'options'  => \%options,
120   'nodomain' => 'Y',
121   'no_machine' => 1,
122   'nas'      => 'Y', # show export_nas selection in UI
123   'default_svc_class' => 'Internet',
124   'notes'    => $notes1.
125                 'This export does not export RADIUS realms (see also '.
126                 'sqlradius_withdomain).  '.
127                 $notes2
128 );
129
130 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) } 
131                               split( "\n", shift->option('groups_susp_reason'));
132 }
133
134 sub rebless { shift; }
135
136 sub export_username { # override for other svcdb
137   my($self, $svc_acct) = (shift, shift);
138   warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
139   $svc_acct->username;
140 }
141
142 sub radius_reply { #override for other svcdb
143   my($self, $svc_acct) = (shift, shift);
144   my %every = $svc_acct->EVERY::radius_reply;
145   map { @$_ } values %every;
146 }
147
148 sub radius_check { #override for other svcdb
149   my($self, $svc_acct) = (shift, shift);
150   my %every = $svc_acct->EVERY::radius_check;
151   map { @$_ } values %every;
152 }
153
154 sub _export_insert {
155   my($self, $svc_x) = (shift, shift);
156
157   foreach my $table (qw(reply check)) {
158     my $method = "radius_$table";
159     my %attrib = $self->$method($svc_x);
160     next unless keys %attrib;
161     my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
162       $table, $self->export_username($svc_x), %attrib );
163     return $err_or_queue unless ref($err_or_queue);
164   }
165   my @groups = $svc_x->radius_groups('hashref');
166   if ( @groups ) {
167     cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
168           " (". $self->export_username($svc_x). " with ". join(", ", @groups)
169       if $DEBUG;
170     my $usergroup = $self->option('usergroup') || 'usergroup';
171     my $err_or_queue = $self->sqlradius_queue(
172       $svc_x->svcnum, 'usergroup_insert',
173       $self->export_username($svc_x), $usergroup, @groups );
174     return $err_or_queue unless ref($err_or_queue);
175   }
176   '';
177 }
178
179 sub _export_replace {
180   my( $self, $new, $old ) = (shift, shift, shift);
181
182   local $SIG{HUP} = 'IGNORE';
183   local $SIG{INT} = 'IGNORE';
184   local $SIG{QUIT} = 'IGNORE';
185   local $SIG{TERM} = 'IGNORE';
186   local $SIG{TSTP} = 'IGNORE';
187   local $SIG{PIPE} = 'IGNORE';
188
189   my $oldAutoCommit = $FS::UID::AutoCommit;
190   local $FS::UID::AutoCommit = 0;
191   my $dbh = dbh;
192
193   my $jobnum = '';
194   if ( $self->export_username($old) ne $self->export_username($new) ) {
195     my $usergroup = $self->option('usergroup') || 'usergroup';
196     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
197       $self->export_username($new), $self->export_username($old), $usergroup );
198     unless ( ref($err_or_queue) ) {
199       $dbh->rollback if $oldAutoCommit;
200       return $err_or_queue;
201     }
202     $jobnum = $err_or_queue->jobnum;
203   }
204
205   foreach my $table (qw(reply check)) {
206     my $method = "radius_$table";
207     my %new = $self->$method($new);
208     my %old = $self->$method($old);
209     if ( grep { !exists $old{$_} #new attributes
210                 || $new{$_} ne $old{$_} #changed
211               } keys %new
212     ) {
213       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
214         $table, $self->export_username($new), %new );
215       unless ( ref($err_or_queue) ) {
216         $dbh->rollback if $oldAutoCommit;
217         return $err_or_queue;
218       }
219       if ( $jobnum ) {
220         my $error = $err_or_queue->depend_insert( $jobnum );
221         if ( $error ) {
222           $dbh->rollback if $oldAutoCommit;
223           return $error;
224         }
225       }
226       $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
227     }
228
229     my @del = grep { !exists $new{$_} } keys %old;
230     if ( @del ) {
231       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
232         $table, $self->export_username($new), @del );
233       unless ( ref($err_or_queue) ) {
234         $dbh->rollback if $oldAutoCommit;
235         return $err_or_queue;
236       }
237       if ( $jobnum ) {
238         my $error = $err_or_queue->depend_insert( $jobnum );
239         if ( $error ) {
240           $dbh->rollback if $oldAutoCommit;
241           return $error;
242         }
243       }
244       $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
245     }
246   }
247
248   my $error;
249   my (@oldgroups) = $old->radius_groups('hashref');
250   my (@newgroups) = $new->radius_groups('hashref');
251   ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum,
252                                          $self->export_username($new),
253                                          $jobnum ? $jobnum : '',
254                                          \@oldgroups,
255                                          \@newgroups,
256                                        );
257   if ( $error ) {
258     $dbh->rollback if $oldAutoCommit;
259     return $error;
260   }
261
262   # radius database is used for authorization, so to avoid users reauthorizing
263   # before the database changes, disconnect users after changing database
264   if ($self->option('disconnect_ssh')) {
265     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect',
266       'disconnect_ssh'    => $self->option('disconnect_ssh'),
267       'svc_acct_username' => $old->username,
268       'disconnect_port'   => $self->option('disconnect_port'),
269     );
270     unless ( ref($err_or_queue) ) {
271       $dbh->rollback if $oldAutoCommit;
272       return $err_or_queue;
273     }
274     if ( $jobnum ) {
275       my $error = $err_or_queue->depend_insert( $jobnum );
276       if ( $error ) {
277         $dbh->rollback if $oldAutoCommit;
278         return $error;
279       }
280     }
281   }
282
283   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
284
285   '';
286 }
287
288 #false laziness w/broadband_sqlradius.pm
289 sub _export_suspend {
290   my( $self, $svc_acct ) = (shift, shift);
291
292   my $new = $svc_acct->clone_suspended;
293   
294   local $SIG{HUP} = 'IGNORE';
295   local $SIG{INT} = 'IGNORE';
296   local $SIG{QUIT} = 'IGNORE';
297   local $SIG{TERM} = 'IGNORE';
298   local $SIG{TSTP} = 'IGNORE';
299   local $SIG{PIPE} = 'IGNORE';
300
301   my $oldAutoCommit = $FS::UID::AutoCommit;
302   local $FS::UID::AutoCommit = 0;
303   my $dbh = dbh;
304
305   my $jobnum = '';
306
307   my @newgroups = $self->suspended_usergroups($svc_acct);
308
309   unless (@newgroups) { #don't change password if assigning to a suspended group
310
311     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
312       'check', $self->export_username($new), $new->radius_check );
313     unless ( ref($err_or_queue) ) {
314       $dbh->rollback if $oldAutoCommit;
315       return $err_or_queue;
316     }
317     $jobnum = $err_or_queue->jobnum;
318   }
319
320   my $error;
321   ($error,$jobnum) =
322     $self->sqlreplace_usergroups(
323       $new->svcnum,
324       $self->export_username($new),
325       '',
326       [ $svc_acct->radius_groups('hashref') ],
327       \@newgroups,
328     );
329   if ( $error ) {
330     $dbh->rollback if $oldAutoCommit;
331     return $error;
332   }
333
334   # radius database is used for authorization, so to avoid users reauthorizing
335   # before the database changes, disconnect users after changing database
336   if ($self->option('disconnect_ssh')) {
337     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect',
338       'disconnect_ssh'    => $self->option('disconnect_ssh'),
339       'svc_acct_username' => $svc_acct->username,
340       'disconnect_port'   => $self->option('disconnect_port'),
341     );
342     unless ( ref($err_or_queue) ) {
343       $dbh->rollback if $oldAutoCommit;
344       return $err_or_queue;
345     }
346     if ( $jobnum ) {
347       my $error = $err_or_queue->depend_insert( $jobnum );
348       if ( $error ) {
349         $dbh->rollback if $oldAutoCommit;
350         return $error;
351       }
352     }
353   }
354
355   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
356
357   '';
358 }
359
360 sub _export_unsuspend {
361   my( $self, $svc_x ) = (shift, shift);
362
363   local $SIG{HUP} = 'IGNORE';
364   local $SIG{INT} = 'IGNORE';
365   local $SIG{QUIT} = 'IGNORE';
366   local $SIG{TERM} = 'IGNORE';
367   local $SIG{TSTP} = 'IGNORE';
368   local $SIG{PIPE} = 'IGNORE';
369
370   my $oldAutoCommit = $FS::UID::AutoCommit;
371   local $FS::UID::AutoCommit = 0;
372   my $dbh = dbh;
373
374   my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
375     'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
376   unless ( ref($err_or_queue) ) {
377     $dbh->rollback if $oldAutoCommit;
378     return $err_or_queue;
379   }
380
381   my $error;
382   my (@oldgroups) = $self->suspended_usergroups($svc_x);
383   $error = $self->sqlreplace_usergroups(
384     $svc_x->svcnum,
385     $self->export_username($svc_x),
386     '',
387     \@oldgroups,
388     [ $svc_x->radius_groups('hashref') ],
389   );
390   if ( $error ) {
391     $dbh->rollback if $oldAutoCommit;
392     return $error;
393   }
394   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
395
396   '';
397 }
398
399 sub _export_delete {
400   my( $self, $svc_x ) = (shift, shift);
401
402   my $jobnum = '';
403
404   my $usergroup = $self->option('usergroup') || 'usergroup';
405   my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
406     $self->export_username($svc_x), $usergroup );
407   $jobnum = $err_or_queue->jobnum;
408
409   # radius database is used for authorization, so to avoid users reauthorizing
410   # before the database changes, disconnect users after changing database
411   if ($self->option('disconnect_ssh')) {
412     my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'user_disconnect',
413       'disconnect_ssh'    => $self->option('disconnect_ssh'),
414       'svc_acct_username' => $svc_x->username,
415       'disconnect_port'   => $self->option('disconnect_port'),
416     );
417     return $err_or_queue unless ref($err_or_queue);
418     if ( $jobnum ) {
419       my $error = $err_or_queue->depend_insert( $jobnum );
420       return $error if $error;
421     }
422   }
423
424   ref($err_or_queue) ? '' : $err_or_queue;
425 }
426
427 sub sqlradius_queue {
428   my( $self, $svcnum, $method ) = (shift, shift, shift);
429   #my %args = @_;
430   my $queue = new FS::queue {
431     'svcnum' => $svcnum,
432     'job'    => "FS::part_export::sqlradius::sqlradius_$method",
433   };
434   $queue->insert(
435     $self->option('datasrc'),
436     $self->option('username'),
437     $self->option('password'),
438     @_,
439   ) or $queue;
440 }
441
442 sub suspended_usergroups {
443   my ($self, $svc_x) = (shift, shift);
444
445   return () unless $svc_x;
446
447   my $svc_table = $svc_x->table;
448
449   #false laziness with FS::part_export::shellcommands
450   #subclass part_export?
451
452   my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
453   my %reasonmap = $self->_groups_susp_reason_map;
454   my $userspec = '';
455   if ($r) {
456     $userspec = $reasonmap{$r->reasonnum}
457       if exists($reasonmap{$r->reasonnum});
458     $userspec = $reasonmap{$r->reason}
459       if (!$userspec && exists($reasonmap{$r->reason}));
460   }
461   my $suspend_svc;
462   if ( $userspec =~ /^\d+$/ ){
463     $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
464   } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
465     my ($username,$domain) = split(/\@/, $userspec);
466     for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
467       $suspend_svc = $user if $userspec eq $user->email;
468     }
469   }elsif ( $userspec && $svc_table eq 'svc_acct'  ){
470     $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
471   }
472   #esalf
473   return $suspend_svc->radius_groups('hashref') if $suspend_svc;
474   ();
475 }
476
477 sub sqlradius_insert { #subroutine, not method
478   my $dbh = sqlradius_connect(shift, shift, shift);
479   my( $table, $username, %attributes ) = @_;
480
481   foreach my $attribute ( keys %attributes ) {
482   
483     my $s_sth = $dbh->prepare(
484       "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
485     ) or die $dbh->errstr;
486     $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
487
488     if ( $s_sth->fetchrow_arrayref->[0] ) {
489
490       my $u_sth = $dbh->prepare(
491         "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
492       ) or die $dbh->errstr;
493       $u_sth->execute($attributes{$attribute}, $username, $attribute)
494         or die $u_sth->errstr;
495
496     } else {
497
498       my $i_sth = $dbh->prepare(
499         "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
500           "VALUES ( ?, ?, ?, ? )"
501       ) or die $dbh->errstr;
502       $i_sth->execute(
503         $username,
504         $attribute,
505         ( $attribute eq 'Password' ? '==' : ':=' ),
506         $attributes{$attribute},
507       ) or die $i_sth->errstr;
508
509     }
510
511   }
512   $dbh->disconnect;
513 }
514
515 sub sqlradius_usergroup_insert { #subroutine, not method
516   my $dbh = sqlradius_connect(shift, shift, shift);
517   my $username = shift;
518   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
519   my @groups = @_;
520
521   my $s_sth = $dbh->prepare(
522     "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
523   ) or die $dbh->errstr;
524
525   my $sth = $dbh->prepare( 
526     "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
527   ) or die $dbh->errstr;
528
529   foreach ( @groups ) {
530     my $group = $_->{'groupname'};
531     my $priority = $_->{'priority'};
532     $s_sth->execute( $username, $group ) or die $s_sth->errstr;
533     if ($s_sth->fetchrow_arrayref->[0]) {
534       warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
535            "$group for $username\n"
536         if $DEBUG;
537       next;
538     }
539     $sth->execute( $username, $group, $priority )
540       or die "can't insert into groupname table: ". $sth->errstr;
541   }
542   if ( $s_sth->{Active} ) {
543     warn "sqlradius s_sth still active; calling ->finish()";
544     $s_sth->finish;
545   }
546   if ( $sth->{Active} ) {
547     warn "sqlradius sth still active; calling ->finish()";
548     $sth->finish;
549   }
550   $dbh->disconnect;
551 }
552
553 sub sqlradius_usergroup_delete { #subroutine, not method
554   my $dbh = sqlradius_connect(shift, shift, shift);
555   my $username = shift;
556   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
557   my @groups = @_;
558
559   my $sth = $dbh->prepare( 
560     "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
561   ) or die $dbh->errstr;
562   foreach ( @groups ) {
563     my $group = $_->{'groupname'};
564     $sth->execute( $username, $group )
565       or die "can't delete from groupname table: ". $sth->errstr;
566   }
567   $dbh->disconnect;
568 }
569
570 sub sqlradius_rename { #subroutine, not method
571   my $dbh = sqlradius_connect(shift, shift, shift);
572   my($new_username, $old_username) = (shift, shift);
573   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
574   foreach my $table (qw(radreply radcheck), $usergroup ) {
575     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
576       or die $dbh->errstr;
577     $sth->execute($new_username, $old_username)
578       or die "can't update $table: ". $sth->errstr;
579   }
580   $dbh->disconnect;
581 }
582
583 sub sqlradius_attrib_delete { #subroutine, not method
584   my $dbh = sqlradius_connect(shift, shift, shift);
585   my( $table, $username, @attrib ) = @_;
586
587   foreach my $attribute ( @attrib ) {
588     my $sth = $dbh->prepare(
589         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
590       or die $dbh->errstr;
591     $sth->execute($username,$attribute)
592       or die "can't delete from rad$table table: ". $sth->errstr;
593   }
594   $dbh->disconnect;
595 }
596
597 sub sqlradius_delete { #subroutine, not method
598   my $dbh = sqlradius_connect(shift, shift, shift);
599   my $username = shift;
600   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
601
602   foreach my $table (qw( radcheck radreply), $usergroup ) {
603     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
604     $sth->execute($username)
605       or die "can't delete from $table table: ". $sth->errstr;
606   }
607   $dbh->disconnect;
608 }
609
610 sub sqlradius_connect {
611   #my($datasrc, $username, $password) = @_;
612   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
613   DBI->connect(@_) or die $DBI::errstr;
614 }
615
616 # on success, returns '' in scalar context, ('',$jobnum) in list context
617 # on error, always just returns error
618 sub sqlreplace_usergroups {
619   my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
620
621   # (sorta) false laziness with FS::svc_acct::replace
622   my @oldgroups = @$old;
623   my @newgroups = @$new;
624   my @delgroups = ();
625   foreach my $oldgroup ( @oldgroups ) {
626     if ( grep { $oldgroup eq $_ } @newgroups ) {
627       @newgroups = grep { $oldgroup ne $_ } @newgroups;
628       next;
629     }
630     push @delgroups, $oldgroup;
631   }
632
633   my $usergroup = $self->option('usergroup') || 'usergroup';
634
635   if ( @delgroups ) {
636     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
637       $username, $usergroup, @delgroups );
638     return $err_or_queue
639       unless ref($err_or_queue);
640     if ( $jobnum ) {
641       my $error = $err_or_queue->depend_insert( $jobnum );
642       return $error if $error;
643     }
644     $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
645   }
646
647   if ( @newgroups ) {
648     cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
649           "with ".  join(", ", @newgroups)
650       if $DEBUG;
651     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
652       $username, $usergroup, @newgroups );
653     return $err_or_queue
654       unless ref($err_or_queue);
655     if ( $jobnum ) {
656       my $error = $err_or_queue->depend_insert( $jobnum );
657       return $error if $error;
658     }
659     $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
660   }
661   wantarray ? ('',$jobnum) : '';
662 }
663
664
665 #--
666
667 =item usage_sessions HASHREF
668
669 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
670
671 New-style: pass a hashref with the following keys:
672
673 =over 4
674
675 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
676
677 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
678
679 =item session_status - 'closed' to only show records with AcctStopTime,
680 'open' to only show records I<without> AcctStopTime, empty to show both.
681
682 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
683
684 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
685
686 =item svc_acct
687
688 =item ip
689
690 =item prefix
691
692 =back
693
694 Old-style: 
695
696 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
697 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
698 functions.
699
700 SVC_ACCT, if specified, limits the results to the specified account.
701
702 IP, if specified, limits the results to the specified IP address.
703
704 PREFIX, if specified, limits the results to records with a matching
705 Called-Station-ID.
706
707 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to 
708 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
709
710 Returns an arrayref of hashrefs with the following fields:
711
712 =over 4
713
714 =item username
715
716 =item framedipaddress
717
718 =item acctstarttime
719
720 =item acctstoptime
721
722 =item acctsessiontime
723
724 =item acctinputoctets
725
726 =item acctoutputoctets
727
728 =item callingstationid
729
730 =item calledstationid
731
732 =back
733
734 =cut
735
736 #some false laziness w/cust_svc::seconds_since_sqlradacct
737
738 sub usage_sessions {
739   my( $self ) = shift;
740
741   my $opt = {};
742   my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
743   my $summarize = 0;
744   if ( ref($_[0]) ) {
745     $opt = shift;
746     $start    = $opt->{stoptime_start};
747     $end      = $opt->{stoptime_end};
748     $svc_acct = $opt->{svc} || $opt->{svc_acct};
749     $ip       = $opt->{ip};
750     $prefix   = $opt->{prefix};
751     $summarize   = $opt->{summarize};
752   } else {
753     ( $start, $end ) = splice(@_, 0, 2);
754     $svc_acct = @_ ? shift : '';
755     $ip = @_ ? shift : '';
756     $prefix = @_ ? shift : '';
757     #my $select = @_ ? shift : '*';
758   }
759
760   $end ||= 2147483647;
761
762   return [] if $self->option('ignore_accounting');
763
764   my $dbh = sqlradius_connect( map $self->option($_),
765                                    qw( datasrc username password ) );
766
767   #select a unix time conversion function based on database type
768   my $str2time = str2time_sql(         $dbh->{Driver}->{Name} );
769   my $closing  = str2time_sql_closing( $dbh->{Driver}->{Name} );
770
771   my @fields = (
772                  qw( username realm framedipaddress
773                      acctsessiontime acctinputoctets acctoutputoctets
774                      callingstationid calledstationid
775                    ),
776                  "$str2time acctstarttime $closing as acctstarttime",
777                  "$str2time acctstoptime  $closing as acctstoptime",
778                );
779
780   @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
781               'sum(acctoutputoctets) as acctoutputoctets',
782             ) if $summarize;
783
784   my @param = ();
785   my @where = ();
786
787   if ( $svc_acct ) {
788     my $username = $self->export_username($svc_acct);
789     if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
790       push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
791       push @param, $username, $1, $2;
792     } else {
793       push @where, 'UserName = ?';
794       push @param, $username;
795     }
796   }
797
798   if ($self->option('process_single_realm')) {
799     push @where, 'Realm = ?';
800     push @param, $self->option('realm');
801   }
802
803   if ( length($ip) ) {
804     push @where, ' FramedIPAddress = ?';
805     push @param, $ip;
806   }
807
808   if ( length($prefix) ) {
809     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
810     push @where, " CalledStationID LIKE 'sip:$prefix\%'";
811   }
812
813   my $acctstoptime = '';
814   if ( $opt->{session_status} ne 'open' ) {
815     if ( $start ) {
816       $acctstoptime .= "$str2time AcctStopTime $closing >= ?";
817       push @param, $start;
818       $acctstoptime .= ' AND ' if $end;
819     }
820     if ( $end ) {
821       $acctstoptime .= "$str2time AcctStopTime $closing <= ?";
822       push @param, $end;
823     }
824   }
825   if ( $opt->{session_status} ne 'closed' ) {
826     if ( $acctstoptime ) {
827       $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )";
828     } else {
829       $acctstoptime = 'AcctStopTime IS NULL';
830     }
831   }
832   push @where, $acctstoptime;
833
834   if ( $opt->{starttime_start} ) {
835     push @where, "$str2time AcctStartTime $closing >= ?";
836     push @param, $opt->{starttime_start};
837   }
838   if ( $opt->{starttime_end} ) {
839     push @where, "$str2time AcctStartTime $closing <= ?";
840     push @param, $opt->{starttime_end};
841   }
842
843   my $where = join(' AND ', @where);
844   $where = "WHERE $where" if $where;
845
846   my $groupby = '';
847   $groupby = 'GROUP BY username' if $summarize;
848
849   my $orderby = 'ORDER BY AcctStartTime DESC';
850   $orderby = '' if $summarize;
851
852   my $sql = 'SELECT '. join(', ', @fields).
853             "  FROM radacct $where $groupby $orderby";
854   if ( $DEBUG ) {
855     warn $sql;
856     warn join(',', @param);
857   }
858   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
859   $sth->execute(@param)         or die $sth->errstr;
860
861   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
862
863 }
864
865 =item update_svc
866
867 =cut
868
869 sub update_svc {
870   my $self = shift;
871
872   my $conf = new FS::Conf;
873
874   my $fdbh = dbh;
875   my $dbh = sqlradius_connect( map $self->option($_),
876                                    qw( datasrc username password ) );
877
878   my $str2time = str2time_sql(         $dbh->{Driver}->{Name} );
879   my $closing  = str2time_sql_closing( $dbh->{Driver}->{Name} );
880
881   my @fields = qw( radacctid username realm acctsessiontime );
882
883   my @param = ();
884   my $where = '';
885
886   my $sth = $dbh->prepare("
887     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
888            $str2time AcctStartTime $closing,  $str2time AcctStopTime $closing, 
889            AcctInputOctets, AcctOutputOctets
890       FROM radacct
891       WHERE FreesideStatus IS NULL
892         AND AcctStopTime IS NOT NULL
893   ") or die $dbh->errstr;
894   $sth->execute() or die $sth->errstr;
895
896   while ( my $row = $sth->fetchrow_arrayref ) {
897     my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
898        $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
899     warn "processing record: ".
900          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
901       if $DEBUG;
902
903     my $fs_username = $UserName;
904
905     $fs_username = lc($fs_username) unless $conf->exists('username-uppercase');
906
907     #my %search = ( 'username' => $fs_username );
908
909     my $status = '';
910     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
911                   "(UserName $UserName, Realm $Realm)";
912
913     my $extra_sql = '';
914     if ( ref($self) =~ /withdomain/ ) { #well, should be a callback to that 
915                                         #module or something
916       my $domain;
917       if ( $Realm ) {
918         $domain = $Realm;
919       } elsif ( $fs_username =~ /\@/ ) {
920         ($fs_username, $domain) = split('@', $fs_username);
921       } else {
922         warn 'WARNING: nothing Realm column and no @realm in UserName column '.
923              "$errinfo -- skipping\n" if $DEBUG;
924         $status = 'skipped (no realm)';
925       }
926
927       $extra_sql = " AND '$domain' = ( SELECT domain FROM svc_domain
928                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
929     }
930
931     my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
932     local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
933
934     unless ( $status ) {
935
936       $status = 'skipped';
937
938       if (    $self->option('process_single_realm')
939            && $self->option('realm') ne $Realm )
940       {
941         warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
942       } else {
943         my @svc_acct =
944           grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
945                                           'svcpart'   => $_->cust_svc->svcpart,
946                                         }
947                         )
948                }
949           qsearch( 'svc_acct',
950                      { 'username' => $fs_username },
951                      '',
952                      $extra_sql
953                    );
954
955         if ( !@svc_acct ) {
956           warn "WARNING: no svc_acct record found $errinfo - skipping\n";
957         } elsif ( scalar(@svc_acct) > 1 ) {
958           warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
959         } else {
960
961           my $svc_acct = $svc_acct[0];
962           warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
963
964           $svc_acct->last_login($AcctStartTime);
965           $svc_acct->last_logout($AcctStopTime);
966
967           my $session_time = $AcctStopTime;
968           $session_time = $AcctStartTime
969             if $self->option('ignore_long_sessions');
970
971           my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
972           if ( $cust_pkg && $session_time < (    $cust_pkg->last_bill
973                                               || $cust_pkg->setup     )  ) {
974             $status = 'skipped (too old)';
975           } else {
976             my @st;
977             push @st, _try_decrement($svc_acct,'seconds',    $AcctSessionTime);
978             push @st, _try_decrement($svc_acct,'upbytes',    $AcctInputOctets);
979             push @st, _try_decrement($svc_acct,'downbytes',  $AcctOutputOctets);
980             push @st, _try_decrement($svc_acct,'totalbytes', $AcctInputOctets
981                                                            + $AcctOutputOctets);
982             $status=join(' ', @st);
983           }
984         }
985       }
986
987     }
988
989     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; 
990     my $psth = $dbh->prepare("UPDATE radacct
991                                 SET FreesideStatus = ?
992                                 WHERE RadAcctId = ?"
993     ) or die $dbh->errstr;
994     $psth->execute($status, $RadAcctId) or die $psth->errstr;
995
996     $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
997
998   }
999
1000 }
1001
1002 sub _try_decrement {
1003   my ($svc_acct, $column, $amount) = @_;
1004   if ( $svc_acct->$column !~ /^$/ ) {
1005     warn "  svc_acct.$column found (". $svc_acct->$column.
1006          ") - decrementing\n"
1007       if $DEBUG;
1008     my $method = 'decrement_' . $column;
1009     my $error = $svc_acct->$method($amount);
1010     die $error if $error;
1011     return 'done';
1012   } else {
1013     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
1014   }
1015   return 'skipped';
1016 }
1017
1018 =item export_nas_insert NAS
1019
1020 =item export_nas_delete NAS
1021
1022 =item export_nas_replace NEW_NAS OLD_NAS
1023
1024 Update the NAS table (allowed RADIUS clients) on the attached RADIUS 
1025 server.  Currently requires the table to be named 'nas' and to follow 
1026 the stock schema (/etc/freeradius/nas.sql).
1027
1028 =cut
1029
1030 sub export_nas_insert {  shift->export_nas_action('insert', @_); }
1031 sub export_nas_delete {  shift->export_nas_action('delete', @_); }
1032 sub export_nas_replace { shift->export_nas_action('replace', @_); }
1033
1034 sub export_nas_action {
1035   my $self = shift;
1036   my ($action, $new, $old) = @_;
1037   # find the NAS in the target table by its name
1038   my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
1039   my $nasnum = $new->nasnum;
1040
1041   my $err_or_queue = $self->sqlradius_queue('', "nas_$action", 
1042     nasname => $nasname,
1043     nasnum => $nasnum
1044   );
1045   return $err_or_queue unless ref $err_or_queue;
1046   '';
1047 }
1048
1049 sub sqlradius_nas_insert {
1050   my $dbh = sqlradius_connect(shift, shift, shift);
1051   my %opt = @_;
1052   my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
1053     or die "nasnum ".$opt{'nasnum'}.' not found';
1054   # insert actual NULLs where FS::Record has translated to empty strings
1055   my @values = map { length($nas->$_) ? $nas->$_ : undef }
1056     qw( nasname shortname type secret server community description );
1057   my $sth = $dbh->prepare('INSERT INTO nas 
1058 (nasname, shortname, type, secret, server, community, description)
1059 VALUES (?, ?, ?, ?, ?, ?, ?)');
1060   $sth->execute(@values) or die $dbh->errstr;
1061 }
1062
1063 sub sqlradius_nas_delete {
1064   my $dbh = sqlradius_connect(shift, shift, shift);
1065   my %opt = @_;
1066   my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
1067   $sth->execute($opt{'nasname'}) or die $dbh->errstr;
1068 }
1069
1070 sub sqlradius_nas_replace {
1071   my $dbh = sqlradius_connect(shift, shift, shift);
1072   my %opt = @_;
1073   my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
1074     or die "nasnum ".$opt{'nasnum'}.' not found';
1075   my @values = map {$nas->$_} 
1076     qw( nasname shortname type secret server community description );
1077   my $sth = $dbh->prepare('UPDATE nas SET
1078     nasname = ?, shortname = ?, type = ?, secret = ?,
1079     server = ?, community = ?, description = ?
1080     WHERE nasname = ?');
1081   $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
1082 }
1083
1084 =item export_attr_insert RADIUS_ATTR
1085
1086 =item export_attr_delete RADIUS_ATTR
1087
1088 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
1089
1090 Update the group attribute tables (radgroupcheck and radgroupreply) on
1091 the RADIUS server.  In delete and replace actions, the existing records
1092 are identified by the combination of group name and attribute name.
1093
1094 In the special case where attributes are being replaced because a group 
1095 name (L<FS::radius_group>->groupname) is changing, the pseudo-field 
1096 'groupname' must be set in OLD_RADIUS_ATTR.
1097
1098 =cut
1099
1100 # some false laziness with NAS export stuff...
1101
1102 sub export_attr_insert  { shift->export_attr_action('insert', @_); }
1103
1104 sub export_attr_delete  { shift->export_attr_action('delete', @_); }
1105
1106 sub export_attr_replace { shift->export_attr_action('replace', @_); }
1107
1108 sub export_attr_action {
1109   my $self = shift;
1110   my ($action, $new, $old) = @_;
1111   my $err_or_queue;
1112
1113   if ( $action eq 'delete' ) {
1114     $old = $new;
1115   }
1116   if ( $action eq 'delete' or $action eq 'replace' ) {
1117     # delete based on an exact match
1118     my %opt = (
1119       attrname  => $old->attrname,
1120       attrtype  => $old->attrtype,
1121       groupname => $old->groupname || $old->radius_group->groupname,
1122       op        => $old->op,
1123       value     => $old->value,
1124     );
1125     $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1126     return $err_or_queue unless ref $err_or_queue;
1127   }
1128   # this probably doesn't matter, but just to be safe...
1129   my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1130   if ( $action eq 'replace' or $action eq 'insert' ) {
1131     my %opt = (
1132       attrname  => $new->attrname,
1133       attrtype  => $new->attrtype,
1134       groupname => $new->radius_group->groupname,
1135       op        => $new->op,
1136       value     => $new->value,
1137     );
1138     $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1139     $err_or_queue->depend_insert($jobnum) if $jobnum;
1140     return $err_or_queue unless ref $err_or_queue;
1141   }
1142   '';
1143 }
1144
1145 sub sqlradius_attr_insert {
1146   my $dbh = sqlradius_connect(shift, shift, shift);
1147   my %opt = @_;
1148
1149   my $table;
1150   # make sure $table is completely safe
1151   if ( $opt{'attrtype'} eq 'C' ) {
1152     $table = 'radgroupcheck';
1153   }
1154   elsif ( $opt{'attrtype'} eq 'R' ) {
1155     $table = 'radgroupreply';
1156   }
1157   else {
1158     die "unknown attribute type '$opt{attrtype}'";
1159   }
1160
1161   my @values = @opt{ qw(groupname attrname op value) };
1162   my $sth = $dbh->prepare(
1163     'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1164   );
1165   $sth->execute(@values) or die $dbh->errstr;
1166 }
1167
1168 sub sqlradius_attr_delete {
1169   my $dbh = sqlradius_connect(shift, shift, shift);
1170   my %opt = @_;
1171
1172   my $table;
1173   if ( $opt{'attrtype'} eq 'C' ) {
1174     $table = 'radgroupcheck';
1175   }
1176   elsif ( $opt{'attrtype'} eq 'R' ) {
1177     $table = 'radgroupreply';
1178   }
1179   else {
1180     die "unknown attribute type '".$opt{'attrtype'}."'";
1181   }
1182
1183   my @values = @opt{ qw(groupname attrname op value) };
1184   my $sth = $dbh->prepare(
1185     'DELETE FROM '.$table.
1186     ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1187     ' LIMIT 1'
1188   );
1189   $sth->execute(@values) or die $dbh->errstr;
1190 }
1191
1192 #sub sqlradius_attr_replace { no longer needed
1193
1194 =item export_group_replace NEW OLD
1195
1196 Replace the L<FS::radius_group> object OLD with NEW.  This will change
1197 the group name and priority in all radusergroup records, and the group 
1198 name in radgroupcheck and radgroupreply.
1199
1200 =cut
1201
1202 sub export_group_replace {
1203   my $self = shift;
1204   my ($new, $old) = @_;
1205   return '' if $new->groupname eq $old->groupname
1206            and $new->priority  == $old->priority;
1207
1208   my $err_or_queue = $self->sqlradius_queue(
1209     '',
1210     'group_replace',
1211     ($self->option('usergroup') || 'usergroup'),
1212     $new->hashref,
1213     $old->hashref,
1214   );
1215   return $err_or_queue unless ref $err_or_queue;
1216   '';
1217 }
1218
1219 sub sqlradius_group_replace {
1220   my $dbh = sqlradius_connect(shift, shift, shift);
1221   my $usergroup = shift;
1222   $usergroup =~ /^(rad)?usergroup$/
1223     or die "bad usergroup table name: $usergroup";
1224   my ($new, $old) = (shift, shift);
1225   # apply renames to check/reply attribute tables
1226   if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1227     foreach my $table (qw(radgroupcheck radgroupreply)) {
1228       my $sth = $dbh->prepare(
1229         'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1230       );
1231       $sth->execute($new->{'groupname'}, $old->{'groupname'})
1232         or die $dbh->errstr;
1233     }
1234   }
1235   # apply renames and priority changes to usergroup table
1236   my $sth = $dbh->prepare(
1237     'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1238   );
1239   $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1240     or die $dbh->errstr;
1241 }
1242
1243 =item sqlradius_user_disconnect
1244
1245 For a specified user, sends a disconnect request to all nas in the server database.
1246
1247 Accepts L</sqlradius_connect> connection input and the following named parameters:
1248
1249 I<disconnect_ssh> - user@host with access to radclient program (required)
1250
1251 I<svc_acct_username> - the user to be disconnected (required)
1252
1253 I<disconnect_port> - the port (on the nas) to send disconnect requests to (defaults to 1700)
1254
1255 Note this is NOT the opposite of sqlradius_connect.
1256
1257 =cut
1258
1259 sub sqlradius_user_disconnect {
1260   my $dbh = sqlradius_connect(shift, shift, shift);
1261   my %opt = @_;
1262   # get list of nas
1263   my $sth = $dbh->prepare('select nasname, secret from nas') or die $dbh->errstr;
1264   $sth->execute() or die $dbh->errstr;
1265   my $nas = $sth->fetchall_arrayref({});
1266   $sth->finish();
1267   $dbh->disconnect();
1268   die "No nas found in radius db" unless @$nas;
1269   # set up ssh connection
1270   my $ssh = Net::OpenSSH->new($opt{'disconnect_ssh'});
1271   die "Couldn't establish SSH connection: " . $ssh->error
1272     if $ssh->error;
1273   # send individual disconnect requests
1274   my $user = $opt{'svc_acct_username'}; #svc_acct username
1275   my $port = $opt{'disconnect_port'} || 1700; #or should we pull this from the db?
1276   my $error = '';
1277   foreach my $nas (@$nas) {
1278     my $nasname = $nas->{'nasname'};
1279     my $secret  = $nas->{'secret'};
1280     my $command = qq(echo "User-Name=$user" | radclient -r 1 $nasname:$port disconnect '$secret');
1281     my ($output, $errput) = $ssh->capture2($command);
1282     $error .= "Error running $command: $errput " . $ssh->error . " "
1283       if $errput || $ssh->error;
1284   }
1285   $error .= "Some clients may have successfully disconnected"
1286     if $error && (@$nas > 1);
1287   $error = "No clients found"
1288     unless @$nas;
1289   die $error if $error;
1290   return '';
1291 }
1292
1293 ###
1294 # class method to fetch groups/attributes from the sqlradius install on upgrade
1295 ###
1296
1297 sub _upgrade_exporttype {
1298   # do this only if the radius_attr table is empty
1299   local $FS::radius_attr::noexport_hack = 1;
1300   my $class = shift;
1301   return if qsearch('radius_attr', {});
1302
1303   foreach my $self ($class->all_sqlradius) {
1304     my $error = $self->import_attrs;
1305     die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1306   }
1307   return;
1308 }
1309
1310 sub import_attrs {
1311   my $self = shift;
1312   my $dbh =  DBI->connect( map $self->option($_),
1313                                    qw( datasrc username password ) );
1314   unless ( $dbh ) {
1315     warn "Error connecting to RADIUS server: $DBI::errstr\n";
1316     return;
1317   }
1318
1319   my $usergroup = $self->option('usergroup') || 'usergroup';
1320   my $error;
1321   warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1322     "\n";
1323
1324   # map out existing groups and attrs
1325   my %attrs_of;
1326   my %groupnum_of;
1327   foreach my $radius_group ( qsearch('radius_group', {}) ) {
1328     $attrs_of{$radius_group->groupname} = +{
1329       map { $_->attrname => $_ } $radius_group->radius_attr
1330     };
1331     $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1332   }
1333
1334   # get groupnames from radgroupcheck and radgroupreply
1335   my $sql = '
1336 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1337 UNION
1338 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1339   my @fixes; # things that need to be changed on the radius db
1340   foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1341     my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1342     warn "$groupname.$attrname\n";
1343     if ( !exists($groupnum_of{$groupname}) ) {
1344       my $radius_group = new FS::radius_group {
1345         'groupname' => $groupname,
1346         'priority'  => 1,
1347       };
1348       $error = $radius_group->insert;
1349       if ( $error ) {
1350         warn "error inserting group $groupname: $error";
1351         next;#don't continue trying to insert the attribute
1352       }
1353       $attrs_of{$groupname} = {};
1354       $groupnum_of{$groupname} = $radius_group->groupnum;
1355     }
1356
1357     my $a = $attrs_of{$groupname};
1358     my $old = $a->{$attrname};
1359     my $new;
1360
1361     if ( $attrtype eq 'R' ) {
1362       # Freeradius tolerates illegal operators in reply attributes.  We don't.
1363       if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1364         warn "$groupname.$attrname: changing $op to +=\n";
1365         # Make a note to change it in the db
1366         push @fixes, [
1367           'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1368           $groupname, $attrname, $op, $value
1369         ];
1370         # and import it correctly.
1371         $op = '+=';
1372       }
1373     }
1374
1375     if ( defined $old ) {
1376       # replace
1377       $new = new FS::radius_attr {
1378         $old->hash,
1379         'op'    => $op,
1380         'value' => $value,
1381       };
1382       $error = $new->replace($old);
1383       if ( $error ) {
1384         warn "error modifying attr $attrname: $error";
1385         next;
1386       }
1387     }
1388     else {
1389       $new = new FS::radius_attr {
1390         'groupnum' => $groupnum_of{$groupname},
1391         'attrname' => $attrname,
1392         'attrtype' => $attrtype,
1393         'op'       => $op,
1394         'value'    => $value,
1395       };
1396       $error = $new->insert;
1397       if ( $error ) {
1398         warn "error inserting attr $attrname: $error" if $error;
1399         next;
1400       }
1401     }
1402     $attrs_of{$groupname}->{$attrname} = $new;
1403   } #foreach $row
1404
1405   foreach (@fixes) {
1406     my ($sql, @args) = @$_;
1407     my $sth = $dbh->prepare($sql);
1408     $sth->execute(@args) or warn $sth->errstr;
1409   }
1410     
1411   return;
1412 }
1413
1414 ###
1415 #class methods
1416 ###
1417
1418 sub all_sqlradius {
1419   #my $class = shift;
1420
1421   #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1422   # (radiator is supposed to be setup with a radacct table)
1423   #i suppose it would be more slick to look for things that inherit from us..
1424
1425   my @part_export = ();
1426   push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1427     foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1428                 broadband_sqlradius );
1429   @part_export;
1430 }
1431
1432 sub all_sqlradius_withaccounting {
1433   my $class = shift;
1434   grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
1435 }
1436
1437 1;
1438