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