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