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