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