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