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   $dbh->disconnect;
 412 }
 413
 414 sub sqlradius_usergroup_delete { #subroutine, not method
 415   my $dbh = sqlradius_connect(shift, shift, shift);
 416   my( $username, @groups ) = @_;
 417
 418   my $sth = $dbh->prepare(
 419     "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?"
 420   ) or die $dbh->errstr;
 421   foreach my $group ( @groups ) {
 422     $sth->execute( $username, $group )
 423       or die "can't delete from groupname table: ". $sth->errstr;
 424   }
 425   $dbh->disconnect;
 426 }
 427
 428 sub sqlradius_rename { #subroutine, not method
 429   my $dbh = sqlradius_connect(shift, shift, shift);
 430   my($new_username, $old_username) = @_;
 431   foreach my $table (qw(radreply radcheck usergroup )) {
 432     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
 433       or die $dbh->errstr;
 434     $sth->execute($new_username, $old_username)
 435       or die "can't update $table: ". $sth->errstr;
 436   }
 437   $dbh->disconnect;
 438 }
 439
 440 sub sqlradius_attrib_delete { #subroutine, not method
 441   my $dbh = sqlradius_connect(shift, shift, shift);
 442   my( $table, $username, @attrib ) = @_;
 443
 444   foreach my $attribute ( @attrib ) {
 445     my $sth = $dbh->prepare(
 446         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
 447       or die $dbh->errstr;
 448     $sth->execute($username,$attribute)
 449       or die "can't delete from rad$table table: ". $sth->errstr;
 450   }
 451   $dbh->disconnect;
 452 }
 453
 454 sub sqlradius_delete { #subroutine, not method
 455   my $dbh = sqlradius_connect(shift, shift, shift);
 456   my $username = shift;
 457
 458   foreach my $table (qw( radcheck radreply usergroup )) {
 459     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 460     $sth->execute($username)
 461       or die "can't delete from $table table: ". $sth->errstr;
 462   }
 463   $dbh->disconnect;
 464 }
 465
 466 sub sqlradius_connect {
 467   #my($datasrc, $username, $password) = @_;
 468   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 469   DBI->connect(@_) or die $DBI::errstr;
 470 }
 471
 472 sub sqlreplace_usergroups {
 473   my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
 474
 475   # (sorta) false laziness with FS::svc_acct::replace
 476   my @oldgroups = @$old;
 477   my @newgroups = @$new;
 478   my @delgroups = ();
 479   foreach my $oldgroup ( @oldgroups ) {
 480     if ( grep { $oldgroup eq $_ } @newgroups ) {
 481       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 482       next;
 483     }
 484     push @delgroups, $oldgroup;
 485   }
 486
 487   if ( @delgroups ) {
 488     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
 489       $username, @delgroups );
 490     return $err_or_queue
 491       unless ref($err_or_queue);
 492     if ( $jobnum ) {
 493       my $error = $err_or_queue->depend_insert( $jobnum );
 494       return $error if $error;
 495     }
 496   }
 497
 498   if ( @newgroups ) {
 499     cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
 500           "with ".  join(", ", @newgroups)
 501       if $DEBUG;
 502     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
 503       $username, @newgroups );
 504     return $err_or_queue
 505       unless ref($err_or_queue);
 506     if ( $jobnum ) {
 507       my $error = $err_or_queue->depend_insert( $jobnum );
 508       return $error if $error;
 509     }
 510   }
 511   '';
 512 }
 513
 514
 515 #--
 516
 517 =item usage_sessions HASHREF
 518
 519 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 520
 521 New-style: pass a hashref with the following keys:
 522
 523 =over 4
 524
 525 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
 526
 527 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
 528
 529 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
 530
 531 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
 532
 533 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
 534
 535 =item svc_acct
 536
 537 =item ip
 538
 539 =item prefix
 540
 541 =back
 542
 543 Old-style:
 544
 545 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 546 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 547 functions.
 548
 549 SVC_ACCT, if specified, limits the results to the specified account.
 550
 551 IP, if specified, limits the results to the specified IP address.
 552
 553 PREFIX, if specified, limits the results to records with a matching
 554 Called-Station-ID.
 555
 556 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to
 557 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
 558
 559 Returns an arrayref of hashrefs with the following fields:
 560
 561 =over 4
 562
 563 =item username
 564
 565 =item framedipaddress
 566
 567 =item acctstarttime
 568
 569 =item acctstoptime
 570
 571 =item acctsessiontime
 572
 573 =item acctinputoctets
 574
 575 =item acctoutputoctets
 576
 577 =item calledstationid
 578
 579 =back
 580
 581 =cut
 582
 583 #some false laziness w/cust_svc::seconds_since_sqlradacct
 584
 585 sub usage_sessions {
 586   my( $self ) = shift;
 587
 588   my $opt = {};
 589   my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
 590   if ( ref($_[0]) ) {
 591     $opt = shift;
 592     $start    = $opt->{stoptime_start};
 593     $end      = $opt->{stoptime_end};
 594     $svc_acct = $opt->{svc_acct};
 595     $ip       = $opt->{ip};
 596     $prefix   = $opt->{prefix};
 597   } else {
 598     ( $start, $end ) = splice(@_, 0, 2);
 599     $svc_acct = @_ ? shift : '';
 600     $ip = @_ ? shift : '';
 601     $prefix = @_ ? shift : '';
 602     #my $select = @_ ? shift : '*';
 603   }
 604
 605   $end ||= 2147483647;
 606
 607   return [] if $self->option('ignore_accounting');
 608
 609   my $dbh = sqlradius_connect( map $self->option($_),
 610                                    qw( datasrc username password ) );
 611
 612   #select a unix time conversion function based on database type
 613   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 614
 615   my @fields = (
 616                  qw( username realm framedipaddress
 617                      acctsessiontime acctinputoctets acctoutputoctets
 618                      calledstationid
 619                    ),
 620                  "$str2time acctstarttime ) as acctstarttime",
 621                  "$str2time acctstoptime ) as acctstoptime",
 622                );
 623
 624   my @param = ();
 625   my @where = ();
 626
 627   if ( $svc_acct ) {
 628     my $username = $self->export_username($svc_acct);
 629     if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
 630       push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
 631       push @param, $username, $1, $2;
 632     } else {
 633       push @where, 'UserName = ?';
 634       push @param, $username;
 635     }
 636   }
 637
 638   if ($self->option('process_single_realm')) {
 639     push @where, 'Realm = ?';
 640     push @param, $self->option('realm');
 641   }
 642
 643   if ( length($ip) ) {
 644     push @where, ' FramedIPAddress = ?';
 645     push @param, $ip;
 646   }
 647
 648   if ( length($prefix) ) {
 649     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 650     push @where, " CalledStationID LIKE 'sip:$prefix\%'";
 651   }
 652
 653   if ( $start ) {
 654     push @where, "$str2time AcctStopTime ) >= ?";
 655     push @param, $start;
 656   }
 657   if ( $end ) {
 658     push @where, "$str2time AcctStopTime ) <= ?";
 659     push @param, $end;
 660   }
 661   if ( $opt->{open_sessions} ) {
 662     push @where, 'AcctStopTime IS NULL';
 663   }
 664   if ( $opt->{starttime_start} ) {
 665     push @where, "$str2time AcctStartTime ) >= ?";
 666     push @param, $opt->{starttime_start};
 667   }
 668   if ( $opt->{starttime_end} ) {
 669     push @where, "$str2time AcctStartTime ) <= ?";
 670     push @param, $opt->{starttime_end};
 671   }
 672
 673   my $where = join(' AND ', @where);
 674   $where = "WHERE $where" if $where;
 675
 676   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 677                           "  FROM radacct
 678                              $where
 679                              ORDER BY AcctStartTime DESC
 680   ") or die $dbh->errstr;
 681   $sth->execute(@param) or die $sth->errstr;
 682
 683   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 684
 685 }
 686
 687 =item update_svc_acct
 688
 689 =cut
 690
 691 sub update_svc {
 692   my $self = shift;
 693
 694   my $conf = new FS::Conf;
 695
 696   my $fdbh = dbh;
 697   my $dbh = sqlradius_connect( map $self->option($_),
 698                                    qw( datasrc username password ) );
 699
 700   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 701   my @fields = qw( radacctid username realm acctsessiontime );
 702
 703   my @param = ();
 704   my $where = '';
 705
 706   my $sth = $dbh->prepare("
 707     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
 708            $str2time AcctStartTime),  $str2time AcctStopTime),
 709            AcctInputOctets, AcctOutputOctets
 710       FROM radacct
 711       WHERE FreesideStatus IS NULL
 712         AND AcctStopTime != 0
 713   ") or die $dbh->errstr;
 714   $sth->execute() or die $sth->errstr;
 715
 716   while ( my $row = $sth->fetchrow_arrayref ) {
 717     my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
 718        $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
 719     warn "processing record: ".
 720          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
 721       if $DEBUG;
 722
 723     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 724
 725     #my %search = ( 'username' => $UserName );
 726
 727     my $extra_sql = '';
 728     if ( ref($self) =~ /withdomain/ ) { #well...
 729       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
 730                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 731     }
 732
 733     my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
 734     local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
 735
 736     my $status = 'skipped';
 737     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
 738                   "(UserName $UserName, Realm $Realm)";
 739
 740     if (    $self->option('process_single_realm')
 741          && $self->option('realm') ne $Realm )
 742     {
 743       warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
 744     } else {
 745       my @svc_acct =
 746         grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
 747                                         'svcpart'   => $_->cust_svc->svcpart, } )
 748              }
 749         qsearch( 'svc_acct',
 750                    { 'username' => $UserName },
 751                    '',
 752                    $extra_sql
 753                  );
 754
 755       if ( !@svc_acct ) {
 756         warn "WARNING: no svc_acct record found $errinfo - skipping\n";
 757       } elsif ( scalar(@svc_acct) > 1 ) {
 758         warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
 759       } else {
 760
 761         my $svc_acct = $svc_acct[0];
 762         warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
 763
 764         $svc_acct->last_login($AcctStartTime);
 765         $svc_acct->last_logout($AcctStopTime);
 766
 767         my $session_time = $AcctStopTime;
 768         $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
 769
 770         my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
 771         if ( $cust_pkg && $session_time < (    $cust_pkg->last_bill
 772                                             || $cust_pkg->setup     )  ) {
 773           $status = 'skipped (too old)';
 774         } else {
 775           my @st;
 776           push @st, _try_decrement($svc_acct, 'seconds',    $AcctSessionTime);
 777           push @st, _try_decrement($svc_acct, 'upbytes',    $AcctInputOctets);
 778           push @st, _try_decrement($svc_acct, 'downbytes',  $AcctOutputOctets);
 779           push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
 780                                                           + $AcctOutputOctets);
 781           $status=join(' ', @st);
 782         }
 783       }
 784     }
 785
 786     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
 787     my $psth = $dbh->prepare("UPDATE radacct
 788                                 SET FreesideStatus = ?
 789                                 WHERE RadAcctId = ?"
 790     ) or die $dbh->errstr;
 791     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 792
 793     $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
 794
 795   }
 796
 797 }
 798
 799 sub _try_decrement {
 800   my ($svc_acct, $column, $amount) = @_;
 801   if ( $svc_acct->$column !~ /^$/ ) {
 802     warn "  svc_acct.$column found (". $svc_acct->$column.
 803          ") - decrementing\n"
 804       if $DEBUG;
 805     my $method = 'decrement_' . $column;
 806     my $error = $svc_acct->$method($amount);
 807     die $error if $error;
 808     return 'done';
 809   } else {
 810     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
 811   }
 812   return 'skipped';
 813 }
 814
 815 ###
 816 #class methods
 817 ###
 818
 819 sub all_sqlradius {
 820   #my $class = shift;
 821
 822   #don't just look for ->can('usage_sessions'), we're sqlradius-specific
 823   # (radiator is supposed to be setup with a radacct table)
 824   #i suppose it would be more slick to look for things that inherit from us..
 825
 826   my @part_export = ();
 827   push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
 828     foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius );
 829   @part_export;
 830 }
 831
 832 sub all_sqlradius_withaccounting {
 833   my $class = shift;
 834   grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
 835 }
 836
 837 1;
 838