FS/FS/part_export/sqlradius.pm

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