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