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