FS/FS/part_export/sqlradius.pm

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