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   if ($r) {
 313     $userspec = $reasonmap{$r->reasonnum}
 314       if exists($reasonmap{$r->reasonnum});
 315     $userspec = $reasonmap{$r->reason}
 316       if (!$userspec && exists($reasonmap{$r->reason}));
 317   }
 318   my $suspend_user;
 319   if ($userspec =~ /^d+$/ ){
 320     $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
 321   }elsif ($userspec =~ /^\S+\@\S+$/){
 322     my ($username,$domain) = split(/\@/, $userspec);
 323     for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
 324       $suspend_user = $user if $userspec eq $user->email;
 325     }
 326   }elsif ($userspec){
 327     $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
 328   }
 329   #esalf
 330   return $suspend_user->radius_groups if $suspend_user;
 331   ();
 332 }
 333
 334 sub sqlradius_insert { #subroutine, not method
 335   my $dbh = sqlradius_connect(shift, shift, shift);
 336   my( $table, $username, %attributes ) = @_;
 337
 338   foreach my $attribute ( keys %attributes ) {
 339
 340     my $s_sth = $dbh->prepare(
 341       "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
 342     ) or die $dbh->errstr;
 343     $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
 344
 345     if ( $s_sth->fetchrow_arrayref->[0] ) {
 346
 347       my $u_sth = $dbh->prepare(
 348         "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
 349       ) or die $dbh->errstr;
 350       $u_sth->execute($attributes{$attribute}, $username, $attribute)
 351         or die $u_sth->errstr;
 352
 353     } else {
 354
 355       my $i_sth = $dbh->prepare(
 356         "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
 357           "VALUES ( ?, ?, ?, ? )"
 358       ) or die $dbh->errstr;
 359       $i_sth->execute(
 360         $username,
 361         $attribute,
 362         ( $attribute =~ /Password/i ? '==' : ':=' ),
 363         $attributes{$attribute},
 364       ) or die $i_sth->errstr;
 365
 366     }
 367
 368   }
 369   $dbh->disconnect;
 370 }
 371
 372 sub sqlradius_usergroup_insert { #subroutine, not method
 373   my $dbh = sqlradius_connect(shift, shift, shift);
 374   my( $username, @groups ) = @_;
 375
 376   my $sth = $dbh->prepare(
 377     "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
 378   ) or die $dbh->errstr;
 379   foreach my $group ( @groups ) {
 380     $sth->execute( $username, $group )
 381       or die "can't insert into groupname table: ". $sth->errstr;
 382   }
 383   $dbh->disconnect;
 384 }
 385
 386 sub sqlradius_usergroup_delete { #subroutine, not method
 387   my $dbh = sqlradius_connect(shift, shift, shift);
 388   my( $username, @groups ) = @_;
 389
 390   my $sth = $dbh->prepare(
 391     "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?"
 392   ) or die $dbh->errstr;
 393   foreach my $group ( @groups ) {
 394     $sth->execute( $username, $group )
 395       or die "can't delete from groupname table: ". $sth->errstr;
 396   }
 397   $dbh->disconnect;
 398 }
 399
 400 sub sqlradius_rename { #subroutine, not method
 401   my $dbh = sqlradius_connect(shift, shift, shift);
 402   my($new_username, $old_username) = @_;
 403   foreach my $table (qw(radreply radcheck usergroup )) {
 404     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
 405       or die $dbh->errstr;
 406     $sth->execute($new_username, $old_username)
 407       or die "can't update $table: ". $sth->errstr;
 408   }
 409   $dbh->disconnect;
 410 }
 411
 412 sub sqlradius_attrib_delete { #subroutine, not method
 413   my $dbh = sqlradius_connect(shift, shift, shift);
 414   my( $table, $username, @attrib ) = @_;
 415
 416   foreach my $attribute ( @attrib ) {
 417     my $sth = $dbh->prepare(
 418         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
 419       or die $dbh->errstr;
 420     $sth->execute($username,$attribute)
 421       or die "can't delete from rad$table table: ". $sth->errstr;
 422   }
 423   $dbh->disconnect;
 424 }
 425
 426 sub sqlradius_delete { #subroutine, not method
 427   my $dbh = sqlradius_connect(shift, shift, shift);
 428   my $username = shift;
 429
 430   foreach my $table (qw( radcheck radreply usergroup )) {
 431     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 432     $sth->execute($username)
 433       or die "can't delete from $table table: ". $sth->errstr;
 434   }
 435   $dbh->disconnect;
 436 }
 437
 438 sub sqlradius_connect {
 439   #my($datasrc, $username, $password) = @_;
 440   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 441   DBI->connect(@_) or die $DBI::errstr;
 442 }
 443
 444 sub sqlreplace_usergroups {
 445   my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
 446
 447   # (sorta) false laziness with FS::svc_acct::replace
 448   my @oldgroups = @$old;
 449   my @newgroups = @$new;
 450   my @delgroups = ();
 451   foreach my $oldgroup ( @oldgroups ) {
 452     if ( grep { $oldgroup eq $_ } @newgroups ) {
 453       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 454       next;
 455     }
 456     push @delgroups, $oldgroup;
 457   }
 458
 459   if ( @delgroups ) {
 460     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
 461       $username, @delgroups );
 462     return $err_or_queue
 463       unless ref($err_or_queue);
 464     if ( $jobnum ) {
 465       my $error = $err_or_queue->depend_insert( $jobnum );
 466       return $error if $error;
 467     }
 468   }
 469
 470   if ( @newgroups ) {
 471     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
 472       $username, @newgroups );
 473     return $err_or_queue
 474       unless ref($err_or_queue);
 475     if ( $jobnum ) {
 476       my $error = $err_or_queue->depend_insert( $jobnum );
 477       return $error if $error;
 478     }
 479   }
 480   '';
 481 }
 482
 483
 484 #--
 485
 486 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 487
 488 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 489 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 490 functions.
 491
 492 SVC_ACCT, if specified, limits the results to the specified account.
 493
 494 IP, if specified, limits the results to the specified IP address.
 495
 496 PREFIX, if specified, limits the results to records with a matching
 497 Called-Station-ID.
 498
 499 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to
 500 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
 501
 502 Returns an arrayref of hashrefs with the following fields:
 503
 504 =over 4
 505
 506 =item username
 507
 508 =item framedipaddress
 509
 510 =item acctstarttime
 511
 512 =item acctstoptime
 513
 514 =item acctsessiontime
 515
 516 =item acctinputoctets
 517
 518 =item acctoutputoctets
 519
 520 =item calledstationid
 521
 522 =back
 523
 524 =cut
 525
 526 #some false laziness w/cust_svc::seconds_since_sqlradacct
 527
 528 sub usage_sessions {
 529   my( $self, $start, $end ) = splice(@_, 0, 3);
 530   my $svc_acct = @_ ? shift : '';
 531   my $ip = @_ ? shift : '';
 532   my $prefix = @_ ? shift : '';
 533   #my $select = @_ ? shift : '*';
 534
 535   $end ||= 2147483647;
 536
 537   return [] if $self->option('ignore_accounting');
 538
 539   my $dbh = sqlradius_connect( map $self->option($_),
 540                                    qw( datasrc username password ) );
 541
 542   #select a unix time conversion function based on database type
 543   my $str2time;
 544   if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
 545     $str2time = 'UNIX_TIMESTAMP(';
 546   } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
 547     $str2time = 'EXTRACT( EPOCH FROM ';
 548   } else {
 549     warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
 550          "; guessing how to convert to UNIX timestamps";
 551     $str2time = 'extract(epoch from ';
 552   }
 553
 554   my @fields = (
 555                  qw( username realm framedipaddress
 556                      acctsessiontime acctinputoctets acctoutputoctets
 557                      calledstationid
 558                    ),
 559                  "$str2time acctstarttime ) as acctstarttime",
 560                  "$str2time acctstoptime ) as acctstoptime",
 561                );
 562
 563   my @param = ();
 564   my $where = '';
 565
 566   if ( $svc_acct ) {
 567     my $username = $self->export_username($svc_acct);
 568     if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) {
 569       $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND';
 570       push @param, $username, $1, $2;
 571     } else {
 572       $where = 'UserName = ? AND';
 573       push @param, $username;
 574     }
 575   }
 576
 577   if ( length($ip) ) {
 578     $where .= ' FramedIPAddress = ? AND';
 579     push @param, $ip;
 580   }
 581
 582   if ( length($prefix) ) {
 583     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 584     $where .= " CalledStationID LIKE 'sip:$prefix\%' AND";
 585   }
 586
 587   push @param, $start, $end;
 588
 589   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 590                           "  FROM radacct
 591                              WHERE $where
 592                                    $str2time AcctStopTime ) >= ?
 593                                AND $str2time AcctStopTime ) <=  ?
 594                                ORDER BY AcctStartTime DESC
 595   ") or die $dbh->errstr;
 596   $sth->execute(@param) or die $sth->errstr;
 597
 598   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 599
 600 }
 601
 602 =item update_svc_acct
 603
 604 =cut
 605
 606 sub update_svc_acct {
 607   my $self = shift;
 608
 609   my $dbh = sqlradius_connect( map $self->option($_),
 610                                    qw( datasrc username password ) );
 611
 612   my @fields = qw( radacctid username realm acctsessiontime );
 613
 614   my @param = ();
 615   my $where = '';
 616
 617   my $sth = $dbh->prepare("
 618     SELECT RadAcctId, UserName, Realm, AcctSessionTime
 619       FROM radacct
 620       WHERE FreesideStatus IS NULL
 621         AND AcctStopTime != 0
 622   ") or die $dbh->errstr;
 623   $sth->execute() or die $sth->errstr;
 624
 625   while ( my $row = $sth->fetchrow_arrayref ) {
 626     my($RadAcctId, $UserName, $Realm, $AcctSessionTime) = @$row;
 627     warn "processing record: ".
 628          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
 629       if $DEBUG;
 630
 631     my %search = ( 'username' => $UserName );
 632     my $extra_sql = '';
 633     if ( ref($self) =~ /withdomain/ ) { #well...
 634       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
 635                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 636       my $svc_domain = qsearch
 637     }
 638
 639     my @svc_acct =
 640       grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
 641                                       'svcpart'   => $_->cust_svc->svcpart, } )
 642            }
 643       qsearch( 'svc_acct',
 644                  { 'username' => $UserName },
 645                  '',
 646                  $extra_sql
 647                );
 648
 649     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
 650                   "(UserName $UserName, Realm $Realm)";
 651     my $status = 'skipped';
 652     if ( !@svc_acct ) {
 653       warn "WARNING: no svc_acct record found $errinfo - skipping\n";
 654     } elsif ( scalar(@svc_acct) > 1 ) {
 655       warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
 656     } else {
 657       my $svc_acct = $svc_acct[0];
 658       warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
 659       if ( $svc_acct->seconds !~ /^$/ ) {
 660         warn "  svc_acct.seconds found (". $svc_acct->seconds.
 661              ") - decrementing\n"
 662           if $DEBUG;
 663         my $error = $svc_acct->decrement_seconds($AcctSessionTime);
 664         die $error if $error;
 665         $status = 'done';
 666       } else {
 667         warn "  no existing seconds value for svc_acct - skiping\n" if $DEBUG;
 668       }
 669     }
 670
 671     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
 672     my $psth = $dbh->prepare("UPDATE radacct
 673                                 SET FreesideStatus = ?
 674                                 WHERE RadAcctId = ?"
 675     ) or die $dbh->errstr;
 676     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 677
 678   }
 679
 680 }
 681
 682 1;
 683