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