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