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 @newgroups = $self->suspended_usergroups($svc_acct);
 255
 256   unless (@newgroups) { #don't change password if assigning to a suspended group
 257
 258     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 259       'check', $self->export_username($new), $new->radius_check );
 260     unless ( ref($err_or_queue) ) {
 261       $dbh->rollback if $oldAutoCommit;
 262       return $err_or_queue;
 263     }
 264
 265   }
 266
 267   my $error =
 268     $self->sqlreplace_usergroups( $new->svcnum,
 269                                   $self->export_username($new),
 270                                   '',
 271                                   [ $svc_acct->radius_groups ],
 272                                   \@newgroups,
 273                                 );
 274   if ( $error ) {
 275     $dbh->rollback if $oldAutoCommit;
 276     return $error;
 277   }
 278   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 279
 280   '';
 281 }
 282
 283 sub _export_unsuspend {
 284   my( $self, $svc_acct ) = (shift, shift);
 285
 286   local $SIG{HUP} = 'IGNORE';
 287   local $SIG{INT} = 'IGNORE';
 288   local $SIG{QUIT} = 'IGNORE';
 289   local $SIG{TERM} = 'IGNORE';
 290   local $SIG{TSTP} = 'IGNORE';
 291   local $SIG{PIPE} = 'IGNORE';
 292
 293   my $oldAutoCommit = $FS::UID::AutoCommit;
 294   local $FS::UID::AutoCommit = 0;
 295   my $dbh = dbh;
 296
 297   my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
 298     'check', $self->export_username($svc_acct), $svc_acct->radius_check );
 299   unless ( ref($err_or_queue) ) {
 300     $dbh->rollback if $oldAutoCommit;
 301     return $err_or_queue;
 302   }
 303
 304   my $error;
 305   my (@oldgroups) = $self->suspended_usergroups($svc_acct);
 306   $error = $self->sqlreplace_usergroups( $svc_acct->svcnum,
 307                                          $self->export_username($svc_acct),
 308                                          '',
 309                                          \@oldgroups,
 310                                          [ $svc_acct->radius_groups ],
 311                                        );
 312   if ( $error ) {
 313     $dbh->rollback if $oldAutoCommit;
 314     return $error;
 315   }
 316   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 317
 318   '';
 319 }
 320
 321 sub _export_delete {
 322   my( $self, $svc_x ) = (shift, shift);
 323   my $usergroup = $self->option('usergroup') || 'usergroup';
 324   my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
 325     $self->export_username($svc_x), $usergroup );
 326   ref($err_or_queue) ? '' : $err_or_queue;
 327 }
 328
 329 sub sqlradius_queue {
 330   my( $self, $svcnum, $method ) = (shift, shift, shift);
 331   my $queue = new FS::queue {
 332     'svcnum' => $svcnum,
 333     'job'    => "FS::part_export::sqlradius::sqlradius_$method",
 334   };
 335   $queue->insert(
 336     $self->option('datasrc'),
 337     $self->option('username'),
 338     $self->option('password'),
 339     @_,
 340   ) or $queue;
 341 }
 342
 343 sub suspended_usergroups {
 344   my ($self, $svc_acct) = (shift, shift);
 345
 346   return () unless $svc_acct;
 347
 348   #false laziness with FS::part_export::shellcommands
 349   #subclass part_export?
 350
 351   my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp');
 352   my %reasonmap = $self->_groups_susp_reason_map;
 353   my $userspec = '';
 354   if ($r) {
 355     $userspec = $reasonmap{$r->reasonnum}
 356       if exists($reasonmap{$r->reasonnum});
 357     $userspec = $reasonmap{$r->reason}
 358       if (!$userspec && exists($reasonmap{$r->reason}));
 359   }
 360   my $suspend_user;
 361   if ($userspec =~ /^\d+$/ ){
 362     $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
 363   }elsif ($userspec =~ /^\S+\@\S+$/){
 364     my ($username,$domain) = split(/\@/, $userspec);
 365     for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
 366       $suspend_user = $user if $userspec eq $user->email;
 367     }
 368   }elsif ($userspec){
 369     $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
 370   }
 371   #esalf
 372   return $suspend_user->radius_groups if $suspend_user;
 373   ();
 374 }
 375
 376 sub sqlradius_insert { #subroutine, not method
 377   my $dbh = sqlradius_connect(shift, shift, shift);
 378   my( $table, $username, %attributes ) = @_;
 379
 380   foreach my $attribute ( keys %attributes ) {
 381
 382     my $s_sth = $dbh->prepare(
 383       "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
 384     ) or die $dbh->errstr;
 385     $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
 386
 387     if ( $s_sth->fetchrow_arrayref->[0] ) {
 388
 389       my $u_sth = $dbh->prepare(
 390         "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
 391       ) or die $dbh->errstr;
 392       $u_sth->execute($attributes{$attribute}, $username, $attribute)
 393         or die $u_sth->errstr;
 394
 395     } else {
 396
 397       my $i_sth = $dbh->prepare(
 398         "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
 399           "VALUES ( ?, ?, ?, ? )"
 400       ) or die $dbh->errstr;
 401       $i_sth->execute(
 402         $username,
 403         $attribute,
 404         ( $attribute eq 'Password' ? '==' : ':=' ),
 405         $attributes{$attribute},
 406       ) or die $i_sth->errstr;
 407
 408     }
 409
 410   }
 411   $dbh->disconnect;
 412 }
 413
 414 sub sqlradius_usergroup_insert { #subroutine, not method
 415   my $dbh = sqlradius_connect(shift, shift, shift);
 416   my $username = shift;
 417   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
 418   my @groups = @_;
 419
 420   my $s_sth = $dbh->prepare(
 421     "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
 422   ) or die $dbh->errstr;
 423
 424   my $sth = $dbh->prepare(
 425     "INSERT INTO $usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
 426   ) or die $dbh->errstr;
 427
 428   foreach my $group ( @groups ) {
 429     $s_sth->execute( $username, $group ) or die $s_sth->errstr;
 430     if ($s_sth->fetchrow_arrayref->[0]) {
 431       warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
 432            "$group for $username\n"
 433         if $DEBUG;
 434       next;
 435     }
 436     $sth->execute( $username, $group )
 437       or die "can't insert into groupname table: ". $sth->errstr;
 438   }
 439   if ( $s_sth->{Active} ) {
 440     warn "sqlradius s_sth still active; calling ->finish()";
 441     $s_sth->finish;
 442   }
 443   if ( $sth->{Active} ) {
 444     warn "sqlradius sth still active; calling ->finish()";
 445     $sth->finish;
 446   }
 447   $dbh->disconnect;
 448 }
 449
 450 sub sqlradius_usergroup_delete { #subroutine, not method
 451   my $dbh = sqlradius_connect(shift, shift, shift);
 452   my $username = shift;
 453   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
 454   my @groups = @_;
 455
 456   my $sth = $dbh->prepare(
 457     "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
 458   ) or die $dbh->errstr;
 459   foreach my $group ( @groups ) {
 460     $sth->execute( $username, $group )
 461       or die "can't delete from groupname table: ". $sth->errstr;
 462   }
 463   $dbh->disconnect;
 464 }
 465
 466 sub sqlradius_rename { #subroutine, not method
 467   my $dbh = sqlradius_connect(shift, shift, shift);
 468   my($new_username, $old_username) = (shift, shift);
 469   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
 470   foreach my $table (qw(radreply radcheck), $usergroup ) {
 471     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
 472       or die $dbh->errstr;
 473     $sth->execute($new_username, $old_username)
 474       or die "can't update $table: ". $sth->errstr;
 475   }
 476   $dbh->disconnect;
 477 }
 478
 479 sub sqlradius_attrib_delete { #subroutine, not method
 480   my $dbh = sqlradius_connect(shift, shift, shift);
 481   my( $table, $username, @attrib ) = @_;
 482
 483   foreach my $attribute ( @attrib ) {
 484     my $sth = $dbh->prepare(
 485         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
 486       or die $dbh->errstr;
 487     $sth->execute($username,$attribute)
 488       or die "can't delete from rad$table table: ". $sth->errstr;
 489   }
 490   $dbh->disconnect;
 491 }
 492
 493 sub sqlradius_delete { #subroutine, not method
 494   my $dbh = sqlradius_connect(shift, shift, shift);
 495   my $username = shift;
 496   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
 497
 498   foreach my $table (qw( radcheck radreply), $usergroup ) {
 499     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 500     $sth->execute($username)
 501       or die "can't delete from $table table: ". $sth->errstr;
 502   }
 503   $dbh->disconnect;
 504 }
 505
 506 sub sqlradius_connect {
 507   #my($datasrc, $username, $password) = @_;
 508   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 509   DBI->connect(@_) or die $DBI::errstr;
 510 }
 511
 512 sub sqlreplace_usergroups {
 513   my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
 514
 515   # (sorta) false laziness with FS::svc_acct::replace
 516   my @oldgroups = @$old;
 517   my @newgroups = @$new;
 518   my @delgroups = ();
 519   foreach my $oldgroup ( @oldgroups ) {
 520     if ( grep { $oldgroup eq $_ } @newgroups ) {
 521       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 522       next;
 523     }
 524     push @delgroups, $oldgroup;
 525   }
 526
 527   my $usergroup = $self->option('usergroup') || 'usergroup';
 528
 529   if ( @delgroups ) {
 530     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
 531       $username, $usergroup, @delgroups );
 532     return $err_or_queue
 533       unless ref($err_or_queue);
 534     if ( $jobnum ) {
 535       my $error = $err_or_queue->depend_insert( $jobnum );
 536       return $error if $error;
 537     }
 538   }
 539
 540   if ( @newgroups ) {
 541     cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
 542           "with ".  join(", ", @newgroups)
 543       if $DEBUG;
 544     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
 545       $username, $usergroup, @newgroups );
 546     return $err_or_queue
 547       unless ref($err_or_queue);
 548     if ( $jobnum ) {
 549       my $error = $err_or_queue->depend_insert( $jobnum );
 550       return $error if $error;
 551     }
 552   }
 553   '';
 554 }
 555
 556
 557 #--
 558
 559 =item usage_sessions HASHREF
 560
 561 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 562
 563 New-style: pass a hashref with the following keys:
 564
 565 =over 4
 566
 567 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
 568
 569 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
 570
 571 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
 572
 573 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
 574
 575 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
 576
 577 =item svc_acct
 578
 579 =item ip
 580
 581 =item prefix
 582
 583 =back
 584
 585 Old-style:
 586
 587 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 588 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 589 functions.
 590
 591 SVC_ACCT, if specified, limits the results to the specified account.
 592
 593 IP, if specified, limits the results to the specified IP address.
 594
 595 PREFIX, if specified, limits the results to records with a matching
 596 Called-Station-ID.
 597
 598 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to
 599 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
 600
 601 Returns an arrayref of hashrefs with the following fields:
 602
 603 =over 4
 604
 605 =item username
 606
 607 =item framedipaddress
 608
 609 =item acctstarttime
 610
 611 =item acctstoptime
 612
 613 =item acctsessiontime
 614
 615 =item acctinputoctets
 616
 617 =item acctoutputoctets
 618
 619 =item calledstationid
 620
 621 =back
 622
 623 =cut
 624
 625 #some false laziness w/cust_svc::seconds_since_sqlradacct
 626
 627 sub usage_sessions {
 628   my( $self ) = shift;
 629
 630   my $opt = {};
 631   my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
 632   my $summarize = 0;
 633   if ( ref($_[0]) ) {
 634     $opt = shift;
 635     $start    = $opt->{stoptime_start};
 636     $end      = $opt->{stoptime_end};
 637     $svc_acct = $opt->{svc_acct};
 638     $ip       = $opt->{ip};
 639     $prefix   = $opt->{prefix};
 640     $summarize   = $opt->{summarize};
 641   } else {
 642     ( $start, $end ) = splice(@_, 0, 2);
 643     $svc_acct = @_ ? shift : '';
 644     $ip = @_ ? shift : '';
 645     $prefix = @_ ? shift : '';
 646     #my $select = @_ ? shift : '*';
 647   }
 648
 649   $end ||= 2147483647;
 650
 651   return [] if $self->option('ignore_accounting');
 652
 653   my $dbh = sqlradius_connect( map $self->option($_),
 654                                    qw( datasrc username password ) );
 655
 656   #select a unix time conversion function based on database type
 657   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 658
 659   my @fields = (
 660                  qw( username realm framedipaddress
 661                      acctsessiontime acctinputoctets acctoutputoctets
 662                      calledstationid
 663                    ),
 664                  "$str2time acctstarttime ) as acctstarttime",
 665                  "$str2time acctstoptime ) as acctstoptime",
 666                );
 667
 668   @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
 669               'sum(acctoutputoctets) as acctoutputoctets',
 670             ) if $summarize;
 671
 672   my @param = ();
 673   my @where = ();
 674
 675   if ( $svc_acct ) {
 676     my $username = $self->export_username($svc_acct);
 677     if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
 678       push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
 679       push @param, $username, $1, $2;
 680     } else {
 681       push @where, 'UserName = ?';
 682       push @param, $username;
 683     }
 684   }
 685
 686   if ($self->option('process_single_realm')) {
 687     push @where, 'Realm = ?';
 688     push @param, $self->option('realm');
 689   }
 690
 691   if ( length($ip) ) {
 692     push @where, ' FramedIPAddress = ?';
 693     push @param, $ip;
 694   }
 695
 696   if ( length($prefix) ) {
 697     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 698     push @where, " CalledStationID LIKE 'sip:$prefix\%'";
 699   }
 700
 701   if ( $start ) {
 702     push @where, "$str2time AcctStopTime ) >= ?";
 703     push @param, $start;
 704   }
 705   if ( $end ) {
 706     push @where, "$str2time AcctStopTime ) <= ?";
 707     push @param, $end;
 708   }
 709   if ( $opt->{open_sessions} ) {
 710     push @where, 'AcctStopTime IS NULL';
 711   }
 712   if ( $opt->{starttime_start} ) {
 713     push @where, "$str2time AcctStartTime ) >= ?";
 714     push @param, $opt->{starttime_start};
 715   }
 716   if ( $opt->{starttime_end} ) {
 717     push @where, "$str2time AcctStartTime ) <= ?";
 718     push @param, $opt->{starttime_end};
 719   }
 720
 721   my $where = join(' AND ', @where);
 722   $where = "WHERE $where" if $where;
 723
 724   my $groupby = '';
 725   $groupby = 'GROUP BY username' if $summarize;
 726
 727   my $orderby = 'ORDER BY AcctStartTime DESC';
 728   $orderby = '' if $summarize;
 729
 730   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 731                           "  FROM radacct $where $groupby $orderby
 732                         ") or die $dbh->errstr;
 733   $sth->execute(@param) or die $sth->errstr;
 734
 735   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 736
 737 }
 738
 739 =item update_svc_acct
 740
 741 =cut
 742
 743 sub update_svc {
 744   my $self = shift;
 745
 746   my $conf = new FS::Conf;
 747
 748   my $fdbh = dbh;
 749   my $dbh = sqlradius_connect( map $self->option($_),
 750                                    qw( datasrc username password ) );
 751
 752   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 753   my @fields = qw( radacctid username realm acctsessiontime );
 754
 755   my @param = ();
 756   my $where = '';
 757
 758   my $sth = $dbh->prepare("
 759     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
 760            $str2time AcctStartTime),  $str2time AcctStopTime),
 761            AcctInputOctets, AcctOutputOctets
 762       FROM radacct
 763       WHERE FreesideStatus IS NULL
 764         AND AcctStopTime != 0
 765   ") or die $dbh->errstr;
 766   $sth->execute() or die $sth->errstr;
 767
 768   while ( my $row = $sth->fetchrow_arrayref ) {
 769     my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
 770        $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
 771     warn "processing record: ".
 772          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
 773       if $DEBUG;
 774
 775     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 776
 777     #my %search = ( 'username' => $UserName );
 778
 779     my $extra_sql = '';
 780     if ( ref($self) =~ /withdomain/ ) { #well...
 781       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
 782                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 783     }
 784
 785     my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
 786     local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
 787
 788     my $status = 'skipped';
 789     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
 790                   "(UserName $UserName, Realm $Realm)";
 791
 792     if (    $self->option('process_single_realm')
 793          && $self->option('realm') ne $Realm )
 794     {
 795       warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
 796     } else {
 797       my @svc_acct =
 798         grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
 799                                         'svcpart'   => $_->cust_svc->svcpart, } )
 800              }
 801         qsearch( 'svc_acct',
 802                    { 'username' => $UserName },
 803                    '',
 804                    $extra_sql
 805                  );
 806
 807       if ( !@svc_acct ) {
 808         warn "WARNING: no svc_acct record found $errinfo - skipping\n";
 809       } elsif ( scalar(@svc_acct) > 1 ) {
 810         warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
 811       } else {
 812
 813         my $svc_acct = $svc_acct[0];
 814         warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
 815
 816         $svc_acct->last_login($AcctStartTime);
 817         $svc_acct->last_logout($AcctStopTime);
 818
 819         my $session_time = $AcctStopTime;
 820         $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
 821
 822         my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
 823         if ( $cust_pkg && $session_time < (    $cust_pkg->last_bill
 824                                             || $cust_pkg->setup     )  ) {
 825           $status = 'skipped (too old)';
 826         } else {
 827           my @st;
 828           push @st, _try_decrement($svc_acct, 'seconds',    $AcctSessionTime);
 829           push @st, _try_decrement($svc_acct, 'upbytes',    $AcctInputOctets);
 830           push @st, _try_decrement($svc_acct, 'downbytes',  $AcctOutputOctets);
 831           push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
 832                                                           + $AcctOutputOctets);
 833           $status=join(' ', @st);
 834         }
 835       }
 836     }
 837
 838     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
 839     my $psth = $dbh->prepare("UPDATE radacct
 840                                 SET FreesideStatus = ?
 841                                 WHERE RadAcctId = ?"
 842     ) or die $dbh->errstr;
 843     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 844
 845     $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
 846
 847   }
 848
 849 }
 850
 851 sub _try_decrement {
 852   my ($svc_acct, $column, $amount) = @_;
 853   if ( $svc_acct->$column !~ /^$/ ) {
 854     warn "  svc_acct.$column found (". $svc_acct->$column.
 855          ") - decrementing\n"
 856       if $DEBUG;
 857     my $method = 'decrement_' . $column;
 858     my $error = $svc_acct->$method($amount);
 859     die $error if $error;
 860     return 'done';
 861   } else {
 862     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
 863   }
 864   return 'skipped';
 865 }
 866
 867 ###
 868 #class methods
 869 ###
 870
 871 sub all_sqlradius {
 872   #my $class = shift;
 873
 874   #don't just look for ->can('usage_sessions'), we're sqlradius-specific
 875   # (radiator is supposed to be setup with a radacct table)
 876   #i suppose it would be more slick to look for things that inherit from us..
 877
 878   my @part_export = ();
 879   push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
 880     foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius );
 881   @part_export;
 882 }
 883
 884 sub all_sqlradius_withaccounting {
 885   my $class = shift;
 886   grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
 887 }
 888
 889 1;
 890