FS/FS/part_export/sqlradius.pm

   1 package FS::part_export::sqlradius;
   2
   3 use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
   4 use Exporter;
   5 use Tie::IxHash;
   6 use FS::Record qw( dbh qsearch qsearchs str2time_sql );
   7 use FS::part_export;
   8 use FS::svc_acct;
   9 use FS::export_svc;
  10 use Carp qw( cluck );
  11
  12 @ISA = qw(FS::part_export);
  13 @EXPORT_OK = qw( sqlradius_connect );
  14
  15 $DEBUG = 0;
  16
  17 tie %options, 'Tie::IxHash',
  18   'datasrc'  => { label=>'DBI data source ' },
  19   'username' => { label=>'Database username' },
  20   'password' => { label=>'Database password' },
  21   'ignore_accounting' => {
  22     type  => 'checkbox',
  23     label => 'Ignore accounting records from this database'
  24   },
  25   'process_single_realm' => {
  26     type  => 'checkbox',
  27     label => 'Only process one realm of accounting records',
  28   },
  29   'realm' => { label => 'The realm of of accounting records to be processed' },
  30   'ignore_long_sessions' => {
  31     type  => 'checkbox',
  32     label => 'Ignore sessions which span billing periods',
  33   },
  34   'hide_ip' => {
  35     type  => 'checkbox',
  36     label => 'Hide IP address information on session reports',
  37   },
  38   'hide_data' => {
  39     type  => 'checkbox',
  40     label => 'Hide download/upload information on session reports',
  41   },
  42   'show_called_station' => {
  43     type  => 'checkbox',
  44     label => 'Show the Called-Station-ID on session reports',
  45   },
  46   'overlimit_groups' => { 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)', } ,
  47   'groups_susp_reason' => { label =>
  48                              'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
  49                             type  => 'textarea',
  50                           },
  51
  52 ;
  53
  54 $notes1 = <<'END';
  55 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>
  56 tables to any SQL database for
  57 <a href="http://www.freeradius.org/">FreeRADIUS</a>
  58 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
  59 END
  60
  61 $notes2 = <<'END';
  62 An existing RADIUS database will be updated in realtime, but you can use
  63 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
  64 to delete the entire RADIUS database and repopulate the tables from the
  65 Freeside database.  See the
  66 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
  67 and the
  68 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
  69 for the exact syntax of a DBI data source.
  70 <ul>
  71   <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.
  72   <li>Using ICRADIUS, add a dummy "op" column to your database:
  73     <blockquote><code>
  74       ALTER&nbsp;TABLE&nbsp;radcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  75       ALTER&nbsp;TABLE&nbsp;radreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  76       ALTER&nbsp;TABLE&nbsp;radgroupcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  77       ALTER&nbsp;TABLE&nbsp;radgroupreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='
  78     </code></blockquote>
  79   <li>Using Radiator, see the
  80     <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
  81     for configuration information.
  82 </ul>
  83 END
  84
  85 %info = (
  86   'svc'      => 'svc_acct',
  87   'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
  88   'options'  => \%options,
  89   'nodomain' => 'Y',
  90   'notes'    => $notes1.
  91                 'This export does not export RADIUS realms (see also '.
  92                 'sqlradius_withdomain).  '.
  93                 $notes2
  94 );
  95
  96 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
  97                               split( "\n", shift->option('groups_susp_reason'));
  98 }
  99
 100 sub rebless { shift; }
 101
 102 sub export_username {
 103   my($self, $svc_acct) = (shift, shift);
 104   warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
 105   $svc_acct->username;
 106 }
 107
 108 sub _export_insert {
 109   my($self, $svc_x) = (shift, shift);
 110
 111   foreach my $table (qw(reply check)) {
 112     my $method = "radius_$table";
 113     my %attrib = $svc_x->$method();
 114     next unless keys %attrib;
 115     my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
 116       $table, $self->export_username($svc_x), %attrib );
 117     return $err_or_queue unless ref($err_or_queue);
 118   }
 119   my @groups = $svc_x->radius_groups;
 120   if ( @groups ) {
 121     cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
 122           " (". $self->export_username($svc_x). " with ". join(", ", @groups)
 123       if $DEBUG;
 124     my $err_or_queue = $self->sqlradius_queue(
 125       $svc_x->svcnum, 'usergroup_insert',
 126       $self->export_username($svc_x), @groups );
 127     return $err_or_queue unless ref($err_or_queue);
 128   }
 129   '';
 130 }
 131
 132 sub _export_replace {
 133   my( $self, $new, $old ) = (shift, shift, shift);
 134
 135   local $SIG{HUP} = 'IGNORE';
 136   local $SIG{INT} = 'IGNORE';
 137   local $SIG{QUIT} = 'IGNORE';
 138   local $SIG{TERM} = 'IGNORE';
 139   local $SIG{TSTP} = 'IGNORE';
 140   local $SIG{PIPE} = 'IGNORE';
 141
 142   my $oldAutoCommit = $FS::UID::AutoCommit;
 143   local $FS::UID::AutoCommit = 0;
 144   my $dbh = dbh;
 145
 146   my $jobnum = '';
 147   if ( $self->export_username($old) ne $self->export_username($new) ) {
 148     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
 149       $self->export_username($new), $self->export_username($old) );
 150     unless ( ref($err_or_queue) ) {
 151       $dbh->rollback if $oldAutoCommit;
 152       return $err_or_queue;
 153     }
 154     $jobnum = $err_or_queue->jobnum;
 155   }
 156
 157   foreach my $table (qw(reply check)) {
 158     my $method = "radius_$table";
 159     my %new = $new->$method();
 160     my %old = $old->$method();
 161     if ( grep { !exists $old{$_} #new attributes
 162                 || $new{$_} ne $old{$_} #changed
 163               } keys %new
 164     ) {
 165       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 166         $table, $self->export_username($new), %new );
 167       unless ( ref($err_or_queue) ) {
 168         $dbh->rollback if $oldAutoCommit;
 169         return $err_or_queue;
 170       }
 171       if ( $jobnum ) {
 172         my $error = $err_or_queue->depend_insert( $jobnum );
 173         if ( $error ) {
 174           $dbh->rollback if $oldAutoCommit;
 175           return $error;
 176         }
 177       }
 178     }
 179
 180     my @del = grep { !exists $new{$_} } keys %old;
 181     if ( @del ) {
 182       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
 183         $table, $self->export_username($new), @del );
 184       unless ( ref($err_or_queue) ) {
 185         $dbh->rollback if $oldAutoCommit;
 186         return $err_or_queue;
 187       }
 188       if ( $jobnum ) {
 189         my $error = $err_or_queue->depend_insert( $jobnum );
 190         if ( $error ) {
 191           $dbh->rollback if $oldAutoCommit;
 192           return $error;
 193         }
 194       }
 195     }
 196   }
 197
 198   my $error;
 199   my (@oldgroups) = $old->radius_groups;
 200   my (@newgroups) = $new->radius_groups;
 201   $error = $self->sqlreplace_usergroups( $new->svcnum,
 202                                          $self->export_username($new),
 203                                          $jobnum ? $jobnum : '',
 204                                          \@oldgroups,
 205                                          \@newgroups,
 206                                        );
 207   if ( $error ) {
 208     $dbh->rollback if $oldAutoCommit;
 209     return $error;
 210   }
 211
 212   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 213
 214   '';
 215 }
 216
 217 sub _export_suspend {
 218   my( $self, $svc_acct ) = (shift, shift);
 219
 220   my $new = $svc_acct->clone_suspended;
 221
 222   local $SIG{HUP} = 'IGNORE';
 223   local $SIG{INT} = 'IGNORE';
 224   local $SIG{QUIT} = 'IGNORE';
 225   local $SIG{TERM} = 'IGNORE';
 226   local $SIG{TSTP} = 'IGNORE';
 227   local $SIG{PIPE} = 'IGNORE';
 228
 229   my $oldAutoCommit = $FS::UID::AutoCommit;
 230   local $FS::UID::AutoCommit = 0;
 231   my $dbh = dbh;
 232
 233   my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 234     'check', $self->export_username($new), $new->radius_check );
 235   unless ( ref($err_or_queue) ) {
 236     $dbh->rollback if $oldAutoCommit;
 237     return $err_or_queue;
 238   }
 239
 240   my $error;
 241   my (@newgroups) = $self->suspended_usergroups($svc_acct);
 242   $error =
 243     $self->sqlreplace_usergroups( $new->svcnum,
 244                                   $self->export_username($new),
 245                                   '',
 246                                   $svc_acct->usergroup,
 247                                   \@newgroups,
 248                                 );
 249   if ( $error ) {
 250     $dbh->rollback if $oldAutoCommit;
 251     return $error;
 252   }
 253   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 254
 255   '';
 256 }
 257
 258 sub _export_unsuspend {
 259   my( $self, $svc_acct ) = (shift, shift);
 260
 261   local $SIG{HUP} = 'IGNORE';
 262   local $SIG{INT} = 'IGNORE';
 263   local $SIG{QUIT} = 'IGNORE';
 264   local $SIG{TERM} = 'IGNORE';
 265   local $SIG{TSTP} = 'IGNORE';
 266   local $SIG{PIPE} = 'IGNORE';
 267
 268   my $oldAutoCommit = $FS::UID::AutoCommit;
 269   local $FS::UID::AutoCommit = 0;
 270   my $dbh = dbh;
 271
 272   my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
 273     'check', $self->export_username($svc_acct), $svc_acct->radius_check );
 274   unless ( ref($err_or_queue) ) {
 275     $dbh->rollback if $oldAutoCommit;
 276     return $err_or_queue;
 277   }
 278
 279   my $error;
 280   my (@oldgroups) = $self->suspended_usergroups($svc_acct);
 281   $error = $self->sqlreplace_usergroups( $svc_acct->svcnum,
 282                                          $self->export_username($svc_acct),
 283                                          '',
 284                                          \@oldgroups,
 285                                          $svc_acct->usergroup,
 286                                        );
 287   if ( $error ) {
 288     $dbh->rollback if $oldAutoCommit;
 289     return $error;
 290   }
 291   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 292
 293   '';
 294 }
 295
 296 sub _export_delete {
 297   my( $self, $svc_x ) = (shift, shift);
 298   my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
 299     $self->export_username($svc_x) );
 300   ref($err_or_queue) ? '' : $err_or_queue;
 301 }
 302
 303 sub sqlradius_queue {
 304   my( $self, $svcnum, $method ) = (shift, shift, shift);
 305   my $queue = new FS::queue {
 306     'svcnum' => $svcnum,
 307     'job'    => "FS::part_export::sqlradius::sqlradius_$method",
 308   };
 309   $queue->insert(
 310     $self->option('datasrc'),
 311     $self->option('username'),
 312     $self->option('password'),
 313     @_,
 314   ) or $queue;
 315 }
 316
 317 sub suspended_usergroups {
 318   my ($self, $svc_acct) = (shift, shift);
 319
 320   return () unless $svc_acct;
 321
 322   #false laziness with FS::part_export::shellcommands
 323   #subclass part_export?
 324
 325   my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp');
 326   my %reasonmap = $self->_groups_susp_reason_map;
 327   my $userspec = '';
 328   if ($r) {
 329     $userspec = $reasonmap{$r->reasonnum}
 330       if exists($reasonmap{$r->reasonnum});
 331     $userspec = $reasonmap{$r->reason}
 332       if (!$userspec && exists($reasonmap{$r->reason}));
 333   }
 334   my $suspend_user;
 335   if ($userspec =~ /^d+$/ ){
 336     $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
 337   }elsif ($userspec =~ /^\S+\@\S+$/){
 338     my ($username,$domain) = split(/\@/, $userspec);
 339     for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
 340       $suspend_user = $user if $userspec eq $user->email;
 341     }
 342   }elsif ($userspec){
 343     $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
 344   }
 345   #esalf
 346   return $suspend_user->radius_groups if $suspend_user;
 347   ();
 348 }
 349
 350 sub sqlradius_insert { #subroutine, not method
 351   my $dbh = sqlradius_connect(shift, shift, shift);
 352   my( $table, $username, %attributes ) = @_;
 353
 354   foreach my $attribute ( keys %attributes ) {
 355
 356     my $s_sth = $dbh->prepare(
 357       "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
 358     ) or die $dbh->errstr;
 359     $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
 360
 361     if ( $s_sth->fetchrow_arrayref->[0] ) {
 362
 363       my $u_sth = $dbh->prepare(
 364         "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
 365       ) or die $dbh->errstr;
 366       $u_sth->execute($attributes{$attribute}, $username, $attribute)
 367         or die $u_sth->errstr;
 368
 369     } else {
 370
 371       my $i_sth = $dbh->prepare(
 372         "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
 373           "VALUES ( ?, ?, ?, ? )"
 374       ) or die $dbh->errstr;
 375       $i_sth->execute(
 376         $username,
 377         $attribute,
 378         ( $attribute eq 'Password' ? '==' : ':=' ),
 379         $attributes{$attribute},
 380       ) or die $i_sth->errstr;
 381
 382     }
 383
 384   }
 385   $dbh->disconnect;
 386 }
 387
 388 sub sqlradius_usergroup_insert { #subroutine, not method
 389   my $dbh = sqlradius_connect(shift, shift, shift);
 390   my( $username, @groups ) = @_;
 391
 392   my $s_sth = $dbh->prepare(
 393     "SELECT COUNT(*) FROM usergroup WHERE UserName = ? AND GroupName = ?"
 394   ) or die $dbh->errstr;
 395
 396   my $sth = $dbh->prepare(
 397     "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
 398   ) or die $dbh->errstr;
 399
 400   foreach my $group ( @groups ) {
 401     $s_sth->execute( $username, $group ) or die $s_sth->errstr;
 402     if ($s_sth->fetchrow_arrayref->[0]) {
 403       warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
 404            "$group for $username\n"
 405         if $DEBUG;
 406       next;
 407     }
 408     $sth->execute( $username, $group )
 409       or die "can't insert into groupname table: ". $sth->errstr;
 410   }
 411   if ( $s_sth->{Active} ) {
 412     warn "sqlradius s_sth still active; calling ->finish()";
 413     $s_sth->finish;
 414   }
 415   if ( $sth->{Active} ) {
 416     warn "sqlradius sth still active; calling ->finish()";
 417     $sth->finish;
 418   }
 419   $dbh->disconnect;
 420 }
 421
 422 sub sqlradius_usergroup_delete { #subroutine, not method
 423   my $dbh = sqlradius_connect(shift, shift, shift);
 424   my( $username, @groups ) = @_;
 425
 426   my $sth = $dbh->prepare(
 427     "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?"
 428   ) or die $dbh->errstr;
 429   foreach my $group ( @groups ) {
 430     $sth->execute( $username, $group )
 431       or die "can't delete from groupname table: ". $sth->errstr;
 432   }
 433   $dbh->disconnect;
 434 }
 435
 436 sub sqlradius_rename { #subroutine, not method
 437   my $dbh = sqlradius_connect(shift, shift, shift);
 438   my($new_username, $old_username) = @_;
 439   foreach my $table (qw(radreply radcheck usergroup )) {
 440     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
 441       or die $dbh->errstr;
 442     $sth->execute($new_username, $old_username)
 443       or die "can't update $table: ". $sth->errstr;
 444   }
 445   $dbh->disconnect;
 446 }
 447
 448 sub sqlradius_attrib_delete { #subroutine, not method
 449   my $dbh = sqlradius_connect(shift, shift, shift);
 450   my( $table, $username, @attrib ) = @_;
 451
 452   foreach my $attribute ( @attrib ) {
 453     my $sth = $dbh->prepare(
 454         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
 455       or die $dbh->errstr;
 456     $sth->execute($username,$attribute)
 457       or die "can't delete from rad$table table: ". $sth->errstr;
 458   }
 459   $dbh->disconnect;
 460 }
 461
 462 sub sqlradius_delete { #subroutine, not method
 463   my $dbh = sqlradius_connect(shift, shift, shift);
 464   my $username = shift;
 465
 466   foreach my $table (qw( radcheck radreply usergroup )) {
 467     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 468     $sth->execute($username)
 469       or die "can't delete from $table table: ". $sth->errstr;
 470   }
 471   $dbh->disconnect;
 472 }
 473
 474 sub sqlradius_connect {
 475   #my($datasrc, $username, $password) = @_;
 476   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 477   DBI->connect(@_) or die $DBI::errstr;
 478 }
 479
 480 sub sqlreplace_usergroups {
 481   my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
 482
 483   # (sorta) false laziness with FS::svc_acct::replace
 484   my @oldgroups = @$old;
 485   my @newgroups = @$new;
 486   my @delgroups = ();
 487   foreach my $oldgroup ( @oldgroups ) {
 488     if ( grep { $oldgroup eq $_ } @newgroups ) {
 489       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 490       next;
 491     }
 492     push @delgroups, $oldgroup;
 493   }
 494
 495   if ( @delgroups ) {
 496     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
 497       $username, @delgroups );
 498     return $err_or_queue
 499       unless ref($err_or_queue);
 500     if ( $jobnum ) {
 501       my $error = $err_or_queue->depend_insert( $jobnum );
 502       return $error if $error;
 503     }
 504   }
 505
 506   if ( @newgroups ) {
 507     cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
 508           "with ".  join(", ", @newgroups)
 509       if $DEBUG;
 510     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
 511       $username, @newgroups );
 512     return $err_or_queue
 513       unless ref($err_or_queue);
 514     if ( $jobnum ) {
 515       my $error = $err_or_queue->depend_insert( $jobnum );
 516       return $error if $error;
 517     }
 518   }
 519   '';
 520 }
 521
 522
 523 #--
 524
 525 =item usage_sessions HASHREF
 526
 527 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 528
 529 New-style: pass a hashref with the following keys:
 530
 531 =over 4
 532
 533 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
 534
 535 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
 536
 537 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
 538
 539 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
 540
 541 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
 542
 543 =item svc_acct
 544
 545 =item ip
 546
 547 =item prefix
 548
 549 =back
 550
 551 Old-style:
 552
 553 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 554 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 555 functions.
 556
 557 SVC_ACCT, if specified, limits the results to the specified account.
 558
 559 IP, if specified, limits the results to the specified IP address.
 560
 561 PREFIX, if specified, limits the results to records with a matching
 562 Called-Station-ID.
 563
 564 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to
 565 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
 566
 567 Returns an arrayref of hashrefs with the following fields:
 568
 569 =over 4
 570
 571 =item username
 572
 573 =item framedipaddress
 574
 575 =item acctstarttime
 576
 577 =item acctstoptime
 578
 579 =item acctsessiontime
 580
 581 =item acctinputoctets
 582
 583 =item acctoutputoctets
 584
 585 =item calledstationid
 586
 587 =back
 588
 589 =cut
 590
 591 #some false laziness w/cust_svc::seconds_since_sqlradacct
 592
 593 sub usage_sessions {
 594   my( $self ) = shift;
 595
 596   my $opt = {};
 597   my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
 598   if ( ref($_[0]) ) {
 599     $opt = shift;
 600     $start    = $opt->{stoptime_start};
 601     $end      = $opt->{stoptime_end};
 602     $svc_acct = $opt->{svc_acct};
 603     $ip       = $opt->{ip};
 604     $prefix   = $opt->{prefix};
 605   } else {
 606     ( $start, $end ) = splice(@_, 0, 2);
 607     $svc_acct = @_ ? shift : '';
 608     $ip = @_ ? shift : '';
 609     $prefix = @_ ? shift : '';
 610     #my $select = @_ ? shift : '*';
 611   }
 612
 613   $end ||= 2147483647;
 614
 615   return [] if $self->option('ignore_accounting');
 616
 617   my $dbh = sqlradius_connect( map $self->option($_),
 618                                    qw( datasrc username password ) );
 619
 620   #select a unix time conversion function based on database type
 621   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 622
 623   my @fields = (
 624                  qw( username realm framedipaddress
 625                      acctsessiontime acctinputoctets acctoutputoctets
 626                      calledstationid
 627                    ),
 628                  "$str2time acctstarttime ) as acctstarttime",
 629                  "$str2time acctstoptime ) as acctstoptime",
 630                );
 631
 632   my @param = ();
 633   my @where = ();
 634
 635   if ( $svc_acct ) {
 636     my $username = $self->export_username($svc_acct);
 637     if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
 638       push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
 639       push @param, $username, $1, $2;
 640     } else {
 641       push @where, 'UserName = ?';
 642       push @param, $username;
 643     }
 644   }
 645
 646   if ($self->option('process_single_realm')) {
 647     push @where, 'Realm = ?';
 648     push @param, $self->option('realm');
 649   }
 650
 651   if ( length($ip) ) {
 652     push @where, ' FramedIPAddress = ?';
 653     push @param, $ip;
 654   }
 655
 656   if ( length($prefix) ) {
 657     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 658     push @where, " CalledStationID LIKE 'sip:$prefix\%'";
 659   }
 660
 661   if ( $start ) {
 662     push @where, "$str2time AcctStopTime ) >= ?";
 663     push @param, $start;
 664   }
 665   if ( $end ) {
 666     push @where, "$str2time AcctStopTime ) <= ?";
 667     push @param, $end;
 668   }
 669   if ( $opt->{open_sessions} ) {
 670     push @where, 'AcctStopTime IS NULL';
 671   }
 672   if ( $opt->{starttime_start} ) {
 673     push @where, "$str2time AcctStartTime ) >= ?";
 674     push @param, $opt->{starttime_start};
 675   }
 676   if ( $opt->{starttime_end} ) {
 677     push @where, "$str2time AcctStartTime ) <= ?";
 678     push @param, $opt->{starttime_end};
 679   }
 680
 681   my $where = join(' AND ', @where);
 682   $where = "WHERE $where" if $where;
 683
 684   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 685                           "  FROM radacct
 686                              $where
 687                              ORDER BY AcctStartTime DESC
 688   ") or die $dbh->errstr;
 689   $sth->execute(@param) or die $sth->errstr;
 690
 691   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 692
 693 }
 694
 695 =item update_svc_acct
 696
 697 =cut
 698
 699 sub update_svc {
 700   my $self = shift;
 701
 702   my $conf = new FS::Conf;
 703
 704   my $fdbh = dbh;
 705   my $dbh = sqlradius_connect( map $self->option($_),
 706                                    qw( datasrc username password ) );
 707
 708   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 709   my @fields = qw( radacctid username realm acctsessiontime );
 710
 711   my @param = ();
 712   my $where = '';
 713
 714   my $sth = $dbh->prepare("
 715     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
 716            $str2time AcctStartTime),  $str2time AcctStopTime),
 717            AcctInputOctets, AcctOutputOctets
 718       FROM radacct
 719       WHERE FreesideStatus IS NULL
 720         AND AcctStopTime != 0
 721   ") or die $dbh->errstr;
 722   $sth->execute() or die $sth->errstr;
 723
 724   while ( my $row = $sth->fetchrow_arrayref ) {
 725     my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
 726        $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
 727     warn "processing record: ".
 728          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
 729       if $DEBUG;
 730
 731     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 732
 733     #my %search = ( 'username' => $UserName );
 734
 735     my $extra_sql = '';
 736     if ( ref($self) =~ /withdomain/ ) { #well...
 737       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
 738                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 739     }
 740
 741     my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
 742     local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
 743
 744     my $status = 'skipped';
 745     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
 746                   "(UserName $UserName, Realm $Realm)";
 747
 748     if (    $self->option('process_single_realm')
 749          && $self->option('realm') ne $Realm )
 750     {
 751       warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
 752     } else {
 753       my @svc_acct =
 754         grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
 755                                         'svcpart'   => $_->cust_svc->svcpart, } )
 756              }
 757         qsearch( 'svc_acct',
 758                    { 'username' => $UserName },
 759                    '',
 760                    $extra_sql
 761                  );
 762
 763       if ( !@svc_acct ) {
 764         warn "WARNING: no svc_acct record found $errinfo - skipping\n";
 765       } elsif ( scalar(@svc_acct) > 1 ) {
 766         warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
 767       } else {
 768
 769         my $svc_acct = $svc_acct[0];
 770         warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
 771
 772         $svc_acct->last_login($AcctStartTime);
 773         $svc_acct->last_logout($AcctStopTime);
 774
 775         my $session_time = $AcctStopTime;
 776         $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
 777
 778         my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
 779         if ( $cust_pkg && $session_time < (    $cust_pkg->last_bill
 780                                             || $cust_pkg->setup     )  ) {
 781           $status = 'skipped (too old)';
 782         } else {
 783           my @st;
 784           push @st, _try_decrement($svc_acct, 'seconds',    $AcctSessionTime);
 785           push @st, _try_decrement($svc_acct, 'upbytes',    $AcctInputOctets);
 786           push @st, _try_decrement($svc_acct, 'downbytes',  $AcctOutputOctets);
 787           push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
 788                                                           + $AcctOutputOctets);
 789           $status=join(' ', @st);
 790         }
 791       }
 792     }
 793
 794     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
 795     my $psth = $dbh->prepare("UPDATE radacct
 796                                 SET FreesideStatus = ?
 797                                 WHERE RadAcctId = ?"
 798     ) or die $dbh->errstr;
 799     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 800
 801     $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
 802
 803   }
 804
 805 }
 806
 807 sub _try_decrement {
 808   my ($svc_acct, $column, $amount) = @_;
 809   if ( $svc_acct->$column !~ /^$/ ) {
 810     warn "  svc_acct.$column found (". $svc_acct->$column.
 811          ") - decrementing\n"
 812       if $DEBUG;
 813     my $method = 'decrement_' . $column;
 814     my $error = $svc_acct->$method($amount);
 815     die $error if $error;
 816     return 'done';
 817   } else {
 818     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
 819   }
 820   return 'skipped';
 821 }
 822
 823 ###
 824 #class methods
 825 ###
 826
 827 sub all_sqlradius {
 828   #my $class = shift;
 829
 830   #don't just look for ->can('usage_sessions'), we're sqlradius-specific
 831   # (radiator is supposed to be setup with a radacct table)
 832   #i suppose it would be more slick to look for things that inherit from us..
 833
 834   my @part_export = ();
 835   push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
 836     foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius );
 837   @part_export;
 838 }
 839
 840 sub all_sqlradius_withaccounting {
 841   my $class = shift;
 842   grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
 843 }
 844
 845 1;
 846