FS/FS/part_export/sqlradius.pm

   1 package FS::part_export::sqlradius;
   2
   3 use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
   4 use Exporter;
   5 use Tie::IxHash;
   6 use FS::Record qw( dbh qsearch qsearchs str2time_sql );
   7 use FS::part_export;
   8 use FS::svc_acct;
   9 use FS::export_svc;
  10 use Carp qw( cluck );
  11
  12 @ISA = qw(FS::part_export);
  13 @EXPORT_OK = qw( sqlradius_connect );
  14
  15 $DEBUG = 0;
  16
  17 tie %options, 'Tie::IxHash',
  18   'datasrc'  => { label=>'DBI data source ' },
  19   'username' => { label=>'Database username' },
  20   'password' => { label=>'Database password' },
  21   'ignore_accounting' => {
  22     type  => 'checkbox',
  23     label => 'Ignore accounting records from this database'
  24   },
  25   'hide_ip' => {
  26     type  => 'checkbox',
  27     label => 'Hide IP address information on session reports',
  28   },
  29   'hide_data' => {
  30     type  => 'checkbox',
  31     label => 'Hide download/upload information on session reports',
  32   },
  33   'show_called_station' => {
  34     type  => 'checkbox',
  35     label => 'Show the Called-Station-ID on session reports',
  36   },
  37   'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)', } ,
  38   'groups_susp_reason' => { label =>
  39                              'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
  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="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/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 > 1;
  96   $svc_acct->username;
  97 }
  98
  99 sub _export_insert {
 100   my($self, $svc_x) = (shift, shift);
 101
 102   foreach my $table (qw(reply check)) {
 103     my $method = "radius_$table";
 104     my %attrib = $svc_x->$method();
 105     next unless keys %attrib;
 106     my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
 107       $table, $self->export_username($svc_x), %attrib );
 108     return $err_or_queue unless ref($err_or_queue);
 109   }
 110   my @groups = $svc_x->radius_groups;
 111   if ( @groups ) {
 112     cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
 113           " (". $self->export_username($svc_x). " with ". join(", ", @groups)
 114       if $DEBUG;
 115     my $err_or_queue = $self->sqlradius_queue(
 116       $svc_x->svcnum, 'usergroup_insert',
 117       $self->export_username($svc_x), @groups );
 118     return $err_or_queue unless ref($err_or_queue);
 119   }
 120   '';
 121 }
 122
 123 sub _export_replace {
 124   my( $self, $new, $old ) = (shift, shift, shift);
 125
 126   local $SIG{HUP} = 'IGNORE';
 127   local $SIG{INT} = 'IGNORE';
 128   local $SIG{QUIT} = 'IGNORE';
 129   local $SIG{TERM} = 'IGNORE';
 130   local $SIG{TSTP} = 'IGNORE';
 131   local $SIG{PIPE} = 'IGNORE';
 132
 133   my $oldAutoCommit = $FS::UID::AutoCommit;
 134   local $FS::UID::AutoCommit = 0;
 135   my $dbh = dbh;
 136
 137   my $jobnum = '';
 138   if ( $self->export_username($old) ne $self->export_username($new) ) {
 139     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
 140       $self->export_username($new), $self->export_username($old) );
 141     unless ( ref($err_or_queue) ) {
 142       $dbh->rollback if $oldAutoCommit;
 143       return $err_or_queue;
 144     }
 145     $jobnum = $err_or_queue->jobnum;
 146   }
 147
 148   foreach my $table (qw(reply check)) {
 149     my $method = "radius_$table";
 150     my %new = $new->$method();
 151     my %old = $old->$method();
 152     if ( grep { !exists $old{$_} #new attributes
 153                 || $new{$_} ne $old{$_} #changed
 154               } keys %new
 155     ) {
 156       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 157         $table, $self->export_username($new), %new );
 158       unless ( ref($err_or_queue) ) {
 159         $dbh->rollback if $oldAutoCommit;
 160         return $err_or_queue;
 161       }
 162       if ( $jobnum ) {
 163         my $error = $err_or_queue->depend_insert( $jobnum );
 164         if ( $error ) {
 165           $dbh->rollback if $oldAutoCommit;
 166           return $error;
 167         }
 168       }
 169     }
 170
 171     my @del = grep { !exists $new{$_} } keys %old;
 172     if ( @del ) {
 173       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
 174         $table, $self->export_username($new), @del );
 175       unless ( ref($err_or_queue) ) {
 176         $dbh->rollback if $oldAutoCommit;
 177         return $err_or_queue;
 178       }
 179       if ( $jobnum ) {
 180         my $error = $err_or_queue->depend_insert( $jobnum );
 181         if ( $error ) {
 182           $dbh->rollback if $oldAutoCommit;
 183           return $error;
 184         }
 185       }
 186     }
 187   }
 188
 189   my $error;
 190   my (@oldgroups) = $old->radius_groups;
 191   my (@newgroups) = $new->radius_groups;
 192   $error = $self->sqlreplace_usergroups( $new->svcnum,
 193                                          $self->export_username($new),
 194                                          $jobnum ? $jobnum : '',
 195                                          \@oldgroups,
 196                                          \@newgroups,
 197                                        );
 198   if ( $error ) {
 199     $dbh->rollback if $oldAutoCommit;
 200     return $error;
 201   }
 202
 203   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 204
 205   '';
 206 }
 207
 208 sub _export_suspend {
 209   my( $self, $svc_acct ) = (shift, shift);
 210
 211   my $new = $svc_acct->clone_suspended;
 212
 213   local $SIG{HUP} = 'IGNORE';
 214   local $SIG{INT} = 'IGNORE';
 215   local $SIG{QUIT} = 'IGNORE';
 216   local $SIG{TERM} = 'IGNORE';
 217   local $SIG{TSTP} = 'IGNORE';
 218   local $SIG{PIPE} = 'IGNORE';
 219
 220   my $oldAutoCommit = $FS::UID::AutoCommit;
 221   local $FS::UID::AutoCommit = 0;
 222   my $dbh = dbh;
 223
 224   my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 225     'check', $self->export_username($new), $new->radius_check );
 226   unless ( ref($err_or_queue) ) {
 227     $dbh->rollback if $oldAutoCommit;
 228     return $err_or_queue;
 229   }
 230
 231   my $error;
 232   my (@newgroups) = $self->suspended_usergroups($svc_acct);
 233   $error =
 234     $self->sqlreplace_usergroups( $new->svcnum,
 235                                   $self->export_username($new),
 236                                   '',
 237                                   $svc_acct->usergroup,
 238                                   \@newgroups,
 239                                 );
 240   if ( $error ) {
 241     $dbh->rollback if $oldAutoCommit;
 242     return $error;
 243   }
 244   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 245
 246   '';
 247 }
 248
 249 sub _export_unsuspend {
 250   my( $self, $svc_acct ) = (shift, shift);
 251
 252   local $SIG{HUP} = 'IGNORE';
 253   local $SIG{INT} = 'IGNORE';
 254   local $SIG{QUIT} = 'IGNORE';
 255   local $SIG{TERM} = 'IGNORE';
 256   local $SIG{TSTP} = 'IGNORE';
 257   local $SIG{PIPE} = 'IGNORE';
 258
 259   my $oldAutoCommit = $FS::UID::AutoCommit;
 260   local $FS::UID::AutoCommit = 0;
 261   my $dbh = dbh;
 262
 263   my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
 264     'check', $self->export_username($svc_acct), $svc_acct->radius_check );
 265   unless ( ref($err_or_queue) ) {
 266     $dbh->rollback if $oldAutoCommit;
 267     return $err_or_queue;
 268   }
 269
 270   my $error;
 271   my (@oldgroups) = $self->suspended_usergroups($svc_acct);
 272   $error = $self->sqlreplace_usergroups( $svc_acct->svcnum,
 273                                          $self->export_username($svc_acct),
 274                                          '',
 275                                          \@oldgroups,
 276                                          $svc_acct->usergroup,
 277                                        );
 278   if ( $error ) {
 279     $dbh->rollback if $oldAutoCommit;
 280     return $error;
 281   }
 282   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 283
 284   '';
 285 }
 286
 287 sub _export_delete {
 288   my( $self, $svc_x ) = (shift, shift);
 289   my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
 290     $self->export_username($svc_x) );
 291   ref($err_or_queue) ? '' : $err_or_queue;
 292 }
 293
 294 sub sqlradius_queue {
 295   my( $self, $svcnum, $method ) = (shift, shift, shift);
 296   my $queue = new FS::queue {
 297     'svcnum' => $svcnum,
 298     'job'    => "FS::part_export::sqlradius::sqlradius_$method",
 299   };
 300   $queue->insert(
 301     $self->option('datasrc'),
 302     $self->option('username'),
 303     $self->option('password'),
 304     @_,
 305   ) or $queue;
 306 }
 307
 308 sub suspended_usergroups {
 309   my ($self, $svc_acct) = (shift, shift);
 310
 311   return () unless $svc_acct;
 312
 313   #false laziness with FS::part_export::shellcommands
 314   #subclass part_export?
 315
 316   my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp');
 317   my %reasonmap = $self->_groups_susp_reason_map;
 318   my $userspec = '';
 319   if ($r) {
 320     $userspec = $reasonmap{$r->reasonnum}
 321       if exists($reasonmap{$r->reasonnum});
 322     $userspec = $reasonmap{$r->reason}
 323       if (!$userspec && exists($reasonmap{$r->reason}));
 324   }
 325   my $suspend_user;
 326   if ($userspec =~ /^d+$/ ){
 327     $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
 328   }elsif ($userspec =~ /^\S+\@\S+$/){
 329     my ($username,$domain) = split(/\@/, $userspec);
 330     for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
 331       $suspend_user = $user if $userspec eq $user->email;
 332     }
 333   }elsif ($userspec){
 334     $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
 335   }
 336   #esalf
 337   return $suspend_user->radius_groups if $suspend_user;
 338   ();
 339 }
 340
 341 sub sqlradius_insert { #subroutine, not method
 342   my $dbh = sqlradius_connect(shift, shift, shift);
 343   my( $table, $username, %attributes ) = @_;
 344
 345   foreach my $attribute ( keys %attributes ) {
 346
 347     my $s_sth = $dbh->prepare(
 348       "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
 349     ) or die $dbh->errstr;
 350     $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
 351
 352     if ( $s_sth->fetchrow_arrayref->[0] ) {
 353
 354       my $u_sth = $dbh->prepare(
 355         "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
 356       ) or die $dbh->errstr;
 357       $u_sth->execute($attributes{$attribute}, $username, $attribute)
 358         or die $u_sth->errstr;
 359
 360     } else {
 361
 362       my $i_sth = $dbh->prepare(
 363         "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
 364           "VALUES ( ?, ?, ?, ? )"
 365       ) or die $dbh->errstr;
 366       $i_sth->execute(
 367         $username,
 368         $attribute,
 369         ( $attribute eq 'Password' ? '==' : ':=' ),
 370         $attributes{$attribute},
 371       ) or die $i_sth->errstr;
 372
 373     }
 374
 375   }
 376   $dbh->disconnect;
 377 }
 378
 379 sub sqlradius_usergroup_insert { #subroutine, not method
 380   my $dbh = sqlradius_connect(shift, shift, shift);
 381   my( $username, @groups ) = @_;
 382
 383   my $s_sth = $dbh->prepare(
 384     "SELECT COUNT(*) FROM usergroup WHERE UserName = ? AND GroupName = ?"
 385   ) or die $dbh->errstr;
 386
 387   my $sth = $dbh->prepare(
 388     "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
 389   ) or die $dbh->errstr;
 390
 391   foreach my $group ( @groups ) {
 392     $s_sth->execute( $username, $group ) or die $s_sth->errstr;
 393     if ($s_sth->fetchrow_arrayref->[0]) {
 394       warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
 395            "$group for $username\n"
 396         if $DEBUG;
 397       next;
 398     }
 399     $sth->execute( $username, $group )
 400       or die "can't insert into groupname table: ". $sth->errstr;
 401   }
 402   $dbh->disconnect;
 403 }
 404
 405 sub sqlradius_usergroup_delete { #subroutine, not method
 406   my $dbh = sqlradius_connect(shift, shift, shift);
 407   my( $username, @groups ) = @_;
 408
 409   my $sth = $dbh->prepare(
 410     "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?"
 411   ) or die $dbh->errstr;
 412   foreach my $group ( @groups ) {
 413     $sth->execute( $username, $group )
 414       or die "can't delete from groupname table: ". $sth->errstr;
 415   }
 416   $dbh->disconnect;
 417 }
 418
 419 sub sqlradius_rename { #subroutine, not method
 420   my $dbh = sqlradius_connect(shift, shift, shift);
 421   my($new_username, $old_username) = @_;
 422   foreach my $table (qw(radreply radcheck usergroup )) {
 423     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
 424       or die $dbh->errstr;
 425     $sth->execute($new_username, $old_username)
 426       or die "can't update $table: ". $sth->errstr;
 427   }
 428   $dbh->disconnect;
 429 }
 430
 431 sub sqlradius_attrib_delete { #subroutine, not method
 432   my $dbh = sqlradius_connect(shift, shift, shift);
 433   my( $table, $username, @attrib ) = @_;
 434
 435   foreach my $attribute ( @attrib ) {
 436     my $sth = $dbh->prepare(
 437         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
 438       or die $dbh->errstr;
 439     $sth->execute($username,$attribute)
 440       or die "can't delete from rad$table table: ". $sth->errstr;
 441   }
 442   $dbh->disconnect;
 443 }
 444
 445 sub sqlradius_delete { #subroutine, not method
 446   my $dbh = sqlradius_connect(shift, shift, shift);
 447   my $username = shift;
 448
 449   foreach my $table (qw( radcheck radreply usergroup )) {
 450     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 451     $sth->execute($username)
 452       or die "can't delete from $table table: ". $sth->errstr;
 453   }
 454   $dbh->disconnect;
 455 }
 456
 457 sub sqlradius_connect {
 458   #my($datasrc, $username, $password) = @_;
 459   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 460   DBI->connect(@_) or die $DBI::errstr;
 461 }
 462
 463 sub sqlreplace_usergroups {
 464   my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
 465
 466   # (sorta) false laziness with FS::svc_acct::replace
 467   my @oldgroups = @$old;
 468   my @newgroups = @$new;
 469   my @delgroups = ();
 470   foreach my $oldgroup ( @oldgroups ) {
 471     if ( grep { $oldgroup eq $_ } @newgroups ) {
 472       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 473       next;
 474     }
 475     push @delgroups, $oldgroup;
 476   }
 477
 478   if ( @delgroups ) {
 479     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
 480       $username, @delgroups );
 481     return $err_or_queue
 482       unless ref($err_or_queue);
 483     if ( $jobnum ) {
 484       my $error = $err_or_queue->depend_insert( $jobnum );
 485       return $error if $error;
 486     }
 487   }
 488
 489   if ( @newgroups ) {
 490     cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
 491           "with ".  join(", ", @newgroups)
 492       if $DEBUG;
 493     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
 494       $username, @newgroups );
 495     return $err_or_queue
 496       unless ref($err_or_queue);
 497     if ( $jobnum ) {
 498       my $error = $err_or_queue->depend_insert( $jobnum );
 499       return $error if $error;
 500     }
 501   }
 502   '';
 503 }
 504
 505
 506 #--
 507
 508 =item usage_sessions HASHREF
 509
 510 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 511
 512 New-style: pass a hashref with the following keys:
 513
 514 =over 4
 515
 516 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
 517
 518 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
 519
 520 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
 521
 522 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
 523
 524 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
 525
 526 =item svc_acct
 527
 528 =item ip
 529
 530 =item prefix
 531
 532 =back
 533
 534 Old-style:
 535
 536 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 537 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 538 functions.
 539
 540 SVC_ACCT, if specified, limits the results to the specified account.
 541
 542 IP, if specified, limits the results to the specified IP address.
 543
 544 PREFIX, if specified, limits the results to records with a matching
 545 Called-Station-ID.
 546
 547 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to
 548 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
 549
 550 Returns an arrayref of hashrefs with the following fields:
 551
 552 =over 4
 553
 554 =item username
 555
 556 =item framedipaddress
 557
 558 =item acctstarttime
 559
 560 =item acctstoptime
 561
 562 =item acctsessiontime
 563
 564 =item acctinputoctets
 565
 566 =item acctoutputoctets
 567
 568 =item calledstationid
 569
 570 =back
 571
 572 =cut
 573
 574 #some false laziness w/cust_svc::seconds_since_sqlradacct
 575
 576 sub usage_sessions {
 577   my( $self ) = shift;
 578
 579   my $opt = {};
 580   my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
 581   if ( ref($_[0]) ) {
 582     $opt = shift;
 583     $start    = $opt->{stoptime_start};
 584     $end      = $opt->{stoptime_end};
 585     $svc_acct = $opt->{svc_acct};
 586     $ip       = $opt->{ip};
 587     $prefix   = $opt->{prefix};
 588   } else {
 589     ( $start, $end ) = splice(@_, 0, 2);
 590     $svc_acct = @_ ? shift : '';
 591     $ip = @_ ? shift : '';
 592     $prefix = @_ ? shift : '';
 593     #my $select = @_ ? shift : '*';
 594   }
 595
 596   $end ||= 2147483647;
 597
 598   return [] if $self->option('ignore_accounting');
 599
 600   my $dbh = sqlradius_connect( map $self->option($_),
 601                                    qw( datasrc username password ) );
 602
 603   #select a unix time conversion function based on database type
 604   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 605
 606   my @fields = (
 607                  qw( username realm framedipaddress
 608                      acctsessiontime acctinputoctets acctoutputoctets
 609                      calledstationid
 610                    ),
 611                  "$str2time acctstarttime ) as acctstarttime",
 612                  "$str2time acctstoptime ) as acctstoptime",
 613                );
 614
 615   my @param = ();
 616   my @where = ();
 617
 618   if ( $svc_acct ) {
 619     my $username = $self->export_username($svc_acct);
 620     if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) {
 621       push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
 622       push @param, $username, $1, $2;
 623     } else {
 624       push @where, 'UserName = ?';
 625       push @param, $username;
 626     }
 627   }
 628
 629   if ( length($ip) ) {
 630     push @where, ' FramedIPAddress = ?';
 631     push @param, $ip;
 632   }
 633
 634   if ( length($prefix) ) {
 635     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 636     push @where, " CalledStationID LIKE 'sip:$prefix\%'";
 637   }
 638
 639   if ( $start ) {
 640     push @where, "$str2time AcctStopTime ) >= ?";
 641     push @param, $start;
 642   }
 643   if ( $end ) {
 644     push @where, "$str2time AcctStopTime ) <= ?";
 645     push @param, $end;
 646   }
 647   if ( $opt->{open_sessions} ) {
 648     push @where, 'AcctStopTime IS NULL';
 649   }
 650   if ( $opt->{starttime_start} ) {
 651     push @where, "$str2time AcctStartTime ) >= ?";
 652     push @param, $opt->{starttime_start};
 653   }
 654   if ( $opt->{starttime_end} ) {
 655     push @where, "$str2time AcctStartTime ) <= ?";
 656     push @param, $opt->{starttime_end};
 657   }
 658
 659   my $where = join(' AND ', @where);
 660   $where = "WHERE $where" if $where;
 661
 662   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 663                           "  FROM radacct
 664                              $where
 665                              ORDER BY AcctStartTime DESC
 666   ") or die $dbh->errstr;
 667   $sth->execute(@param) or die $sth->errstr;
 668
 669   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 670
 671 }
 672
 673 =item update_svc_acct
 674
 675 =cut
 676
 677 sub update_svc {
 678   my $self = shift;
 679
 680   my $conf = new FS::Conf;
 681
 682   my $fdbh = dbh;
 683   my $dbh = sqlradius_connect( map $self->option($_),
 684                                    qw( datasrc username password ) );
 685
 686   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 687   my @fields = qw( radacctid username realm acctsessiontime );
 688
 689   my @param = ();
 690   my $where = '';
 691
 692   my $sth = $dbh->prepare("
 693     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
 694            $str2time AcctStartTime),  $str2time AcctStopTime),
 695            AcctInputOctets, AcctOutputOctets
 696       FROM radacct
 697       WHERE FreesideStatus IS NULL
 698         AND AcctStopTime != 0
 699   ") or die $dbh->errstr;
 700   $sth->execute() or die $sth->errstr;
 701
 702   while ( my $row = $sth->fetchrow_arrayref ) {
 703     my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
 704        $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
 705     warn "processing record: ".
 706          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
 707       if $DEBUG;
 708
 709     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 710
 711     #my %search = ( 'username' => $UserName );
 712
 713     my $extra_sql = '';
 714     if ( ref($self) =~ /withdomain/ ) { #well...
 715       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
 716                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 717     }
 718
 719     my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
 720     local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
 721
 722     my @svc_acct =
 723       grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
 724                                       'svcpart'   => $_->cust_svc->svcpart, } )
 725            }
 726       qsearch( 'svc_acct',
 727                  { 'username' => $UserName },
 728                  '',
 729                  $extra_sql
 730                );
 731
 732     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
 733                   "(UserName $UserName, Realm $Realm)";
 734     my $status = 'skipped';
 735     if ( !@svc_acct ) {
 736       warn "WARNING: no svc_acct record found $errinfo - skipping\n";
 737     } elsif ( scalar(@svc_acct) > 1 ) {
 738       warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
 739     } else {
 740
 741       my $svc_acct = $svc_acct[0];
 742       warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
 743
 744       $svc_acct->last_login($AcctStartTime);
 745       $svc_acct->last_logout($AcctStopTime);
 746
 747       my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
 748       if ( $cust_pkg && $AcctStopTime < (    $cust_pkg->last_bill
 749                                           || $cust_pkg->setup     )  ) {
 750         $status = 'skipped (too old)';
 751       } else {
 752         my @st;
 753         push @st, _try_decrement($svc_acct, 'seconds',    $AcctSessionTime   );
 754         push @st, _try_decrement($svc_acct, 'upbytes',    $AcctInputOctets   );
 755         push @st, _try_decrement($svc_acct, 'downbytes',  $AcctOutputOctets  );
 756         push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
 757                                                           + $AcctOutputOctets);
 758         $status=join(' ', @st);
 759       }
 760     }
 761
 762     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
 763     my $psth = $dbh->prepare("UPDATE radacct
 764                                 SET FreesideStatus = ?
 765                                 WHERE RadAcctId = ?"
 766     ) or die $dbh->errstr;
 767     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 768
 769     $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
 770
 771   }
 772
 773 }
 774
 775 sub _try_decrement {
 776   my ($svc_acct, $column, $amount) = @_;
 777   if ( $svc_acct->$column !~ /^$/ ) {
 778     warn "  svc_acct.$column found (". $svc_acct->$column.
 779          ") - decrementing\n"
 780       if $DEBUG;
 781     my $method = 'decrement_' . $column;
 782     my $error = $svc_acct->$method($amount);
 783     die $error if $error;
 784     return 'done';
 785   } else {
 786     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
 787   }
 788   return 'skipped';
 789 }
 790
 791 ###
 792 #class methods
 793 ###
 794
 795 sub all_sqlradius {
 796   #my $class = shift;
 797
 798   #don't just look for ->can('usage_sessions'), we're sqlradius-specific
 799   # (radiator is supposed to be setup with a radacct table)
 800   #i suppose it would be more slick to look for things that inherit from us..
 801
 802   my @part_export = ();
 803   push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
 804     foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius );
 805   @part_export;
 806 }
 807
 808 sub all_sqlradius_withaccounting {
 809   my $class = shift;
 810   grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
 811 }
 812
 813 1;
 814