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 use Carp qw( cluck );
  10
  11 @ISA = qw(FS::part_export);
  12
  13 $DEBUG = 0;
  14
  15 tie %options, 'Tie::IxHash',
  16   'datasrc'  => { label=>'DBI data source ' },
  17   'username' => { label=>'Database username' },
  18   'password' => { label=>'Database password' },
  19   'ignore_accounting' => {
  20     type  => 'checkbox',
  21     label => 'Ignore accounting records from this database'
  22   },
  23   'hide_ip' => {
  24     type  => 'checkbox',
  25     label => 'Hide IP address information on session reports',
  26   },
  27   'hide_data' => {
  28     type  => 'checkbox',
  29     label => 'Hide download/upload information on session reports',
  30   },
  31   'show_called_station' => {
  32     type  => 'checkbox',
  33     label => 'Show the Called-Station-ID on session reports',
  34   },
  35   'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit', } ,
  36   'groups_susp_reason' => { label =>
  37                              'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
  38                             type  => 'textarea',
  39                           },
  40
  41 ;
  42
  43 $notes1 = <<'END';
  44 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>
  45 tables to any SQL database for
  46 <a href="http://www.freeradius.org/">FreeRADIUS</a>
  47 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
  48 END
  49
  50 $notes2 = <<'END';
  51 An existing RADIUS database will be updated in realtime, but you can use
  52 <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
  53 to delete the entire RADIUS database and repopulate the tables from the
  54 Freeside database.  See the
  55 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
  56 and the
  57 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
  58 for the exact syntax of a DBI data source.
  59 <ul>
  60   <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.
  61   <li>Using ICRADIUS, add a dummy "op" column to your database:
  62     <blockquote><code>
  63       ALTER&nbsp;TABLE&nbsp;radcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  64       ALTER&nbsp;TABLE&nbsp;radreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  65       ALTER&nbsp;TABLE&nbsp;radgroupcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  66       ALTER&nbsp;TABLE&nbsp;radgroupreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='
  67     </code></blockquote>
  68   <li>Using Radiator, see the
  69     <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
  70     for configuration information.
  71 </ul>
  72 END
  73
  74 %info = (
  75   'svc'      => 'svc_acct',
  76   'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
  77   'options'  => \%options,
  78   'nodomain' => 'Y',
  79   'notes'    => $notes1.
  80                 'This export does not export RADIUS realms (see also '.
  81                 'sqlradius_withdomain).  '.
  82                 $notes2
  83 );
  84
  85 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
  86                               split( "\n", shift->option('groups_susp_reason'));
  87 }
  88
  89 sub rebless { shift; }
  90
  91 sub export_username {
  92   my($self, $svc_acct) = (shift, shift);
  93   warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
  94   $svc_acct->username;
  95 }
  96
  97 sub _export_insert {
  98   my($self, $svc_acct) = (shift, shift);
  99
 100   foreach my $table (qw(reply check)) {
 101     my $method = "radius_$table";
 102     my %attrib = $svc_acct->$method();
 103     next unless keys %attrib;
 104     my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
 105       $table, $self->export_username($svc_acct), %attrib );
 106     return $err_or_queue unless ref($err_or_queue);
 107   }
 108   my @groups = $svc_acct->radius_groups;
 109   if ( @groups ) {
 110     cluck localtime(). ": queuing usergroup_insert for ". $svc_acct->svcnum.
 111           " (". $self->export_username($svc_acct). " with ". join(", ", @groups)
 112       if $DEBUG;
 113     my $err_or_queue = $self->sqlradius_queue(
 114       $svc_acct->svcnum, 'usergroup_insert',
 115       $self->export_username($svc_acct), @groups );
 116     return $err_or_queue unless ref($err_or_queue);
 117   }
 118   '';
 119 }
 120
 121 sub _export_replace {
 122   my( $self, $new, $old ) = (shift, shift, shift);
 123
 124   local $SIG{HUP} = 'IGNORE';
 125   local $SIG{INT} = 'IGNORE';
 126   local $SIG{QUIT} = 'IGNORE';
 127   local $SIG{TERM} = 'IGNORE';
 128   local $SIG{TSTP} = 'IGNORE';
 129   local $SIG{PIPE} = 'IGNORE';
 130
 131   my $oldAutoCommit = $FS::UID::AutoCommit;
 132   local $FS::UID::AutoCommit = 0;
 133   my $dbh = dbh;
 134
 135   my $jobnum = '';
 136   if ( $self->export_username($old) ne $self->export_username($new) ) {
 137     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
 138       $self->export_username($new), $self->export_username($old) );
 139     unless ( ref($err_or_queue) ) {
 140       $dbh->rollback if $oldAutoCommit;
 141       return $err_or_queue;
 142     }
 143     $jobnum = $err_or_queue->jobnum;
 144   }
 145
 146   foreach my $table (qw(reply check)) {
 147     my $method = "radius_$table";
 148     my %new = $new->$method();
 149     my %old = $old->$method();
 150     if ( grep { !exists $old{$_} #new attributes
 151                 || $new{$_} ne $old{$_} #changed
 152               } keys %new
 153     ) {
 154       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 155         $table, $self->export_username($new), %new );
 156       unless ( ref($err_or_queue) ) {
 157         $dbh->rollback if $oldAutoCommit;
 158         return $err_or_queue;
 159       }
 160       if ( $jobnum ) {
 161         my $error = $err_or_queue->depend_insert( $jobnum );
 162         if ( $error ) {
 163           $dbh->rollback if $oldAutoCommit;
 164           return $error;
 165         }
 166       }
 167     }
 168
 169     my @del = grep { !exists $new{$_} } keys %old;
 170     if ( @del ) {
 171       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
 172         $table, $self->export_username($new), @del );
 173       unless ( ref($err_or_queue) ) {
 174         $dbh->rollback if $oldAutoCommit;
 175         return $err_or_queue;
 176       }
 177       if ( $jobnum ) {
 178         my $error = $err_or_queue->depend_insert( $jobnum );
 179         if ( $error ) {
 180           $dbh->rollback if $oldAutoCommit;
 181           return $error;
 182         }
 183       }
 184     }
 185   }
 186
 187   my $error;
 188   my (@oldgroups) = $old->radius_groups;
 189   my (@newgroups) = $new->radius_groups;
 190   $error = $self->sqlreplace_usergroups( $new->svcnum,
 191                                          $self->export_username($new),
 192                                          $jobnum ? $jobnum : '',
 193                                          \@oldgroups,
 194                                          \@newgroups,
 195                                        );
 196   if ( $error ) {
 197     $dbh->rollback if $oldAutoCommit;
 198     return $error;
 199   }
 200
 201   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 202
 203   '';
 204 }
 205
 206 sub _export_suspend {
 207   my( $self, $svc_acct ) = (shift, shift);
 208
 209   my $new = $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 $s_sth = $dbh->prepare(
 382     "SELECT COUNT(*) FROM usergroup WHERE UserName = ? AND GroupName = ?"
 383   ) or die $dbh->errstr;
 384
 385   my $sth = $dbh->prepare(
 386     "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
 387   ) or die $dbh->errstr;
 388
 389   foreach my $group ( @groups ) {
 390     $s_sth->execute( $username, $group ) or die $s_sth->errstr;
 391     if ($s_sth->fetchrow_arrayref->[0]) {
 392       warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
 393            "$group for $username\n"
 394         if $DEBUG;
 395       next;
 396     }
 397     $sth->execute( $username, $group )
 398       or die "can't insert into groupname table: ". $sth->errstr;
 399   }
 400   $dbh->disconnect;
 401 }
 402
 403 sub sqlradius_usergroup_delete { #subroutine, not method
 404   my $dbh = sqlradius_connect(shift, shift, shift);
 405   my( $username, @groups ) = @_;
 406
 407   my $sth = $dbh->prepare(
 408     "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?"
 409   ) or die $dbh->errstr;
 410   foreach my $group ( @groups ) {
 411     $sth->execute( $username, $group )
 412       or die "can't delete from groupname table: ". $sth->errstr;
 413   }
 414   $dbh->disconnect;
 415 }
 416
 417 sub sqlradius_rename { #subroutine, not method
 418   my $dbh = sqlradius_connect(shift, shift, shift);
 419   my($new_username, $old_username) = @_;
 420   foreach my $table (qw(radreply radcheck usergroup )) {
 421     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
 422       or die $dbh->errstr;
 423     $sth->execute($new_username, $old_username)
 424       or die "can't update $table: ". $sth->errstr;
 425   }
 426   $dbh->disconnect;
 427 }
 428
 429 sub sqlradius_attrib_delete { #subroutine, not method
 430   my $dbh = sqlradius_connect(shift, shift, shift);
 431   my( $table, $username, @attrib ) = @_;
 432
 433   foreach my $attribute ( @attrib ) {
 434     my $sth = $dbh->prepare(
 435         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
 436       or die $dbh->errstr;
 437     $sth->execute($username,$attribute)
 438       or die "can't delete from rad$table table: ". $sth->errstr;
 439   }
 440   $dbh->disconnect;
 441 }
 442
 443 sub sqlradius_delete { #subroutine, not method
 444   my $dbh = sqlradius_connect(shift, shift, shift);
 445   my $username = shift;
 446
 447   foreach my $table (qw( radcheck radreply usergroup )) {
 448     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 449     $sth->execute($username)
 450       or die "can't delete from $table table: ". $sth->errstr;
 451   }
 452   $dbh->disconnect;
 453 }
 454
 455 sub sqlradius_connect {
 456   #my($datasrc, $username, $password) = @_;
 457   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 458   DBI->connect(@_) or die $DBI::errstr;
 459 }
 460
 461 sub sqlreplace_usergroups {
 462   my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
 463
 464   # (sorta) false laziness with FS::svc_acct::replace
 465   my @oldgroups = @$old;
 466   my @newgroups = @$new;
 467   my @delgroups = ();
 468   foreach my $oldgroup ( @oldgroups ) {
 469     if ( grep { $oldgroup eq $_ } @newgroups ) {
 470       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 471       next;
 472     }
 473     push @delgroups, $oldgroup;
 474   }
 475
 476   if ( @delgroups ) {
 477     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
 478       $username, @delgroups );
 479     return $err_or_queue
 480       unless ref($err_or_queue);
 481     if ( $jobnum ) {
 482       my $error = $err_or_queue->depend_insert( $jobnum );
 483       return $error if $error;
 484     }
 485   }
 486
 487   if ( @newgroups ) {
 488     cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
 489           "with ".  join(", ", @newgroups)
 490       if $DEBUG;
 491     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
 492       $username, @newgroups );
 493     return $err_or_queue
 494       unless ref($err_or_queue);
 495     if ( $jobnum ) {
 496       my $error = $err_or_queue->depend_insert( $jobnum );
 497       return $error if $error;
 498     }
 499   }
 500   '';
 501 }
 502
 503
 504 #--
 505
 506 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 507
 508 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 509 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 510 functions.
 511
 512 SVC_ACCT, if specified, limits the results to the specified account.
 513
 514 IP, if specified, limits the results to the specified IP address.
 515
 516 PREFIX, if specified, limits the results to records with a matching
 517 Called-Station-ID.
 518
 519 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to
 520 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
 521
 522 Returns an arrayref of hashrefs with the following fields:
 523
 524 =over 4
 525
 526 =item username
 527
 528 =item framedipaddress
 529
 530 =item acctstarttime
 531
 532 =item acctstoptime
 533
 534 =item acctsessiontime
 535
 536 =item acctinputoctets
 537
 538 =item acctoutputoctets
 539
 540 =item calledstationid
 541
 542 =back
 543
 544 =cut
 545
 546 #some false laziness w/cust_svc::seconds_since_sqlradacct
 547
 548 sub usage_sessions {
 549   my( $self, $start, $end ) = splice(@_, 0, 3);
 550   my $svc_acct = @_ ? shift : '';
 551   my $ip = @_ ? shift : '';
 552   my $prefix = @_ ? shift : '';
 553   #my $select = @_ ? shift : '*';
 554
 555   $end ||= 2147483647;
 556
 557   return [] if $self->option('ignore_accounting');
 558
 559   my $dbh = sqlradius_connect( map $self->option($_),
 560                                    qw( datasrc username password ) );
 561
 562   #select a unix time conversion function based on database type
 563   my $str2time;
 564   if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
 565     $str2time = 'UNIX_TIMESTAMP(';
 566   } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
 567     $str2time = 'EXTRACT( EPOCH FROM ';
 568   } else {
 569     warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
 570          "; guessing how to convert to UNIX timestamps";
 571     $str2time = 'extract(epoch from ';
 572   }
 573
 574   my @fields = (
 575                  qw( username realm framedipaddress
 576                      acctsessiontime acctinputoctets acctoutputoctets
 577                      calledstationid
 578                    ),
 579                  "$str2time acctstarttime ) as acctstarttime",
 580                  "$str2time acctstoptime ) as acctstoptime",
 581                );
 582
 583   my @param = ();
 584   my $where = '';
 585
 586   if ( $svc_acct ) {
 587     my $username = $self->export_username($svc_acct);
 588     if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) {
 589       $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND';
 590       push @param, $username, $1, $2;
 591     } else {
 592       $where = 'UserName = ? AND';
 593       push @param, $username;
 594     }
 595   }
 596
 597   if ( length($ip) ) {
 598     $where .= ' FramedIPAddress = ? AND';
 599     push @param, $ip;
 600   }
 601
 602   if ( length($prefix) ) {
 603     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 604     $where .= " CalledStationID LIKE 'sip:$prefix\%' AND";
 605   }
 606
 607   push @param, $start, $end;
 608
 609   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 610                           "  FROM radacct
 611                              WHERE $where
 612                                    $str2time AcctStopTime ) >= ?
 613                                AND $str2time AcctStopTime ) <=  ?
 614                                ORDER BY AcctStartTime DESC
 615   ") or die $dbh->errstr;
 616   $sth->execute(@param) or die $sth->errstr;
 617
 618   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 619
 620 }
 621
 622 =item update_svc_acct
 623
 624 =cut
 625
 626 sub update_svc_acct {
 627   my $self = shift;
 628
 629   my $conf = new FS::Conf;
 630
 631   my $dbh = sqlradius_connect( map $self->option($_),
 632                                    qw( datasrc username password ) );
 633
 634   my @fields = qw( radacctid username realm acctsessiontime );
 635
 636   my @param = ();
 637   my $where = '';
 638
 639   my $sth = $dbh->prepare("
 640     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
 641            AcctInputOctets, AcctOutputOctets
 642       FROM radacct
 643       WHERE FreesideStatus IS NULL
 644         AND AcctStopTime != 0
 645   ") or die $dbh->errstr;
 646   $sth->execute() or die $sth->errstr;
 647
 648   while ( my $row = $sth->fetchrow_arrayref ) {
 649     my($RadAcctId, $UserName, $Realm, $AcctSessionTime,
 650        $AcctInputOctets, $AcctOutputOctets) = @$row;
 651     warn "processing record: ".
 652          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
 653       if $DEBUG;
 654
 655     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 656
 657     my %search = ( 'username' => $UserName );
 658
 659     my $extra_sql = '';
 660     if ( ref($self) =~ /withdomain/ ) { #well...
 661       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
 662                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 663     }
 664
 665     my @svc_acct =
 666       grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
 667                                       'svcpart'   => $_->cust_svc->svcpart, } )
 668            }
 669       qsearch( 'svc_acct',
 670                  { 'username' => $UserName },
 671                  '',
 672                  $extra_sql
 673                );
 674
 675     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
 676                   "(UserName $UserName, Realm $Realm)";
 677     my $status = 'skipped';
 678     if ( !@svc_acct ) {
 679       warn "WARNING: no svc_acct record found $errinfo - skipping\n";
 680     } elsif ( scalar(@svc_acct) > 1 ) {
 681       warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
 682     } else {
 683       warn "found svc_acct ". $svc_acct[0]->svcnum. " $errinfo\n" if $DEBUG;
 684       _try_decrement($svc_acct[0], 'seconds', $AcctSessionTime)
 685         and $status='done';
 686       _try_decrement($svc_acct[0], 'upbytes', $AcctInputOctets)
 687         and $status='done';
 688       _try_decrement($svc_acct[0], 'downbytes', $AcctOutputOctets)
 689         and $status='done';
 690       _try_decrement($svc_acct[0], 'totalbytes', $AcctInputOctets +
 691                      $AcctOutputOctets)
 692         and $status='done';
 693     }
 694
 695     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
 696     my $psth = $dbh->prepare("UPDATE radacct
 697                                 SET FreesideStatus = ?
 698                                 WHERE RadAcctId = ?"
 699     ) or die $dbh->errstr;
 700     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 701
 702   }
 703
 704 }
 705
 706 sub _try_decrement {
 707   my ($svc_acct, $column, $amount) = @_;
 708   if ( $svc_acct->$column !~ /^$/ ) {
 709     warn "  svc_acct.$column found (". $svc_acct->$column.
 710          ") - decrementing\n"
 711       if $DEBUG;
 712     my $method = 'decrement_' . $column;
 713     my $error = $svc_acct->$method($amount);
 714     die $error if $error;
 715     return 'done';
 716   } else {
 717     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
 718   }
 719   return '';
 720 }
 721
 722 1;
 723