FS/FS/part_export/sqlradius.pm

   1 package FS::part_export::sqlradius;
   2
   3 use strict;
   4 use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
   5 use Exporter;
   6 use Tie::IxHash;
   7 use FS::Record qw( dbh qsearch qsearchs str2time_sql );
   8 use FS::part_export;
   9 use FS::svc_acct;
  10 use FS::export_svc;
  11 use Carp qw( cluck );
  12
  13 @ISA = qw(FS::part_export);
  14 @EXPORT_OK = qw( sqlradius_connect );
  15
  16 $DEBUG = 0;
  17
  18 my %groups;
  19 tie %options, 'Tie::IxHash',
  20   'datasrc'  => { label=>'DBI data source ' },
  21   'username' => { label=>'Database username' },
  22   'password' => { label=>'Database password' },
  23   'usergroup' => { label   => 'Group table',
  24                    type    => 'select',
  25                    options => [qw( usergroup radusergroup ) ],
  26                  },
  27   'ignore_accounting' => {
  28     type  => 'checkbox',
  29     label => 'Ignore accounting records from this database'
  30   },
  31   'process_single_realm' => {
  32     type  => 'checkbox',
  33     label => 'Only process one realm of accounting records',
  34   },
  35   'realm' => { label => 'The realm of of accounting records to be processed' },
  36   'ignore_long_sessions' => {
  37     type  => 'checkbox',
  38     label => 'Ignore sessions which span billing periods',
  39   },
  40   'hide_ip' => {
  41     type  => 'checkbox',
  42     label => 'Hide IP address information on session reports',
  43   },
  44   'hide_data' => {
  45     type  => 'checkbox',
  46     label => 'Hide download/upload information on session reports',
  47   },
  48   'show_called_station' => {
  49     type  => 'checkbox',
  50     label => 'Show the Called-Station-ID on session reports',
  51   },
  52   'overlimit_groups' => {
  53       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)',
  54       type  => 'select',
  55       multi => 1,
  56       option_label  => sub {
  57         $groups{$_[0]};
  58       },
  59       option_values => sub {
  60         %groups = (
  61               map { $_->groupnum, $_->long_description }
  62                   qsearch('radius_group', {}),
  63             );
  64             sort keys (%groups);
  65       },
  66    } ,
  67   'groups_susp_reason' => { label =>
  68                              'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
  69                             type  => 'textarea',
  70                           },
  71   'export_attrs' => {
  72     type => 'checkbox',
  73     label => 'Export RADIUS group attributes to this database',
  74   },
  75 ;
  76
  77 $notes1 = <<'END';
  78 Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
  79 tables to any SQL database for
  80 <a href="http://www.freeradius.org/">FreeRADIUS</a>
  81 or <a href="http://radius.innercite.com/">ICRADIUS</a>.
  82 END
  83
  84 $notes2 = <<'END';
  85 An existing RADIUS database will be updated in realtime, but you can use
  86 <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
  87 to delete the entire RADIUS database and repopulate the tables from the
  88 Freeside database.  See the
  89 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
  90 and the
  91 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
  92 for the exact syntax of a DBI data source.
  93 <ul>
  94   <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.
  95   <li>Using ICRADIUS, add a dummy "op" column to your database:
  96     <blockquote><code>
  97       ALTER&nbsp;TABLE&nbsp;radcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  98       ALTER&nbsp;TABLE&nbsp;radreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  99       ALTER&nbsp;TABLE&nbsp;radgroupcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
 100       ALTER&nbsp;TABLE&nbsp;radgroupreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='
 101     </code></blockquote>
 102   <li>Using Radiator, see the
 103     <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
 104     for configuration information.
 105 </ul>
 106 END
 107
 108 %info = (
 109   'svc'      => 'svc_acct',
 110   'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
 111   'options'  => \%options,
 112   'nodomain' => 'Y',
 113   'nas'      => 'Y', # show export_nas selection in UI
 114   'default_svc_class' => 'Internet',
 115   'notes'    => $notes1.
 116                 'This export does not export RADIUS realms (see also '.
 117                 'sqlradius_withdomain).  '.
 118                 $notes2
 119 );
 120
 121 sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
 122                               split( "\n", shift->option('groups_susp_reason'));
 123 }
 124
 125 sub rebless { shift; }
 126
 127 sub export_username { # override for other svcdb
 128   my($self, $svc_acct) = (shift, shift);
 129   warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
 130   $svc_acct->username;
 131 }
 132
 133 sub radius_reply { #override for other svcdb
 134   my($self, $svc_acct) = (shift, shift);
 135   $svc_acct->radius_reply;
 136 }
 137
 138 sub radius_check { #override for other svcdb
 139   my($self, $svc_acct) = (shift, shift);
 140   $svc_acct->radius_check;
 141 }
 142
 143 sub _export_insert {
 144   my($self, $svc_x) = (shift, shift);
 145
 146   foreach my $table (qw(reply check)) {
 147     my $method = "radius_$table";
 148     my %attrib = $self->$method($svc_x);
 149     next unless keys %attrib;
 150     my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
 151       $table, $self->export_username($svc_x), %attrib );
 152     return $err_or_queue unless ref($err_or_queue);
 153   }
 154   my @groups = $svc_x->radius_groups('hashref');
 155   if ( @groups ) {
 156     cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
 157           " (". $self->export_username($svc_x). " with ". join(", ", @groups)
 158       if $DEBUG;
 159     my $usergroup = $self->option('usergroup') || 'usergroup';
 160     my $err_or_queue = $self->sqlradius_queue(
 161       $svc_x->svcnum, 'usergroup_insert',
 162       $self->export_username($svc_x), $usergroup, @groups );
 163     return $err_or_queue unless ref($err_or_queue);
 164   }
 165   '';
 166 }
 167
 168 sub _export_replace {
 169   my( $self, $new, $old ) = (shift, shift, shift);
 170
 171   local $SIG{HUP} = 'IGNORE';
 172   local $SIG{INT} = 'IGNORE';
 173   local $SIG{QUIT} = 'IGNORE';
 174   local $SIG{TERM} = 'IGNORE';
 175   local $SIG{TSTP} = 'IGNORE';
 176   local $SIG{PIPE} = 'IGNORE';
 177
 178   my $oldAutoCommit = $FS::UID::AutoCommit;
 179   local $FS::UID::AutoCommit = 0;
 180   my $dbh = dbh;
 181
 182   my $jobnum = '';
 183   if ( $self->export_username($old) ne $self->export_username($new) ) {
 184     my $usergroup = $self->option('usergroup') || 'usergroup';
 185     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
 186       $self->export_username($new), $self->export_username($old), $usergroup );
 187     unless ( ref($err_or_queue) ) {
 188       $dbh->rollback if $oldAutoCommit;
 189       return $err_or_queue;
 190     }
 191     $jobnum = $err_or_queue->jobnum;
 192   }
 193
 194   foreach my $table (qw(reply check)) {
 195     my $method = "radius_$table";
 196     my %new = $new->$method();
 197     my %old = $old->$method();
 198     if ( grep { !exists $old{$_} #new attributes
 199                 || $new{$_} ne $old{$_} #changed
 200               } keys %new
 201     ) {
 202       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 203         $table, $self->export_username($new), %new );
 204       unless ( ref($err_or_queue) ) {
 205         $dbh->rollback if $oldAutoCommit;
 206         return $err_or_queue;
 207       }
 208       if ( $jobnum ) {
 209         my $error = $err_or_queue->depend_insert( $jobnum );
 210         if ( $error ) {
 211           $dbh->rollback if $oldAutoCommit;
 212           return $error;
 213         }
 214       }
 215     }
 216
 217     my @del = grep { !exists $new{$_} } keys %old;
 218     if ( @del ) {
 219       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
 220         $table, $self->export_username($new), @del );
 221       unless ( ref($err_or_queue) ) {
 222         $dbh->rollback if $oldAutoCommit;
 223         return $err_or_queue;
 224       }
 225       if ( $jobnum ) {
 226         my $error = $err_or_queue->depend_insert( $jobnum );
 227         if ( $error ) {
 228           $dbh->rollback if $oldAutoCommit;
 229           return $error;
 230         }
 231       }
 232     }
 233   }
 234
 235   my $error;
 236   my (@oldgroups) = $old->radius_groups('hashref');
 237   my (@newgroups) = $new->radius_groups('hashref');
 238   $error = $self->sqlreplace_usergroups( $new->svcnum,
 239                                          $self->export_username($new),
 240                                          $jobnum ? $jobnum : '',
 241                                          \@oldgroups,
 242                                          \@newgroups,
 243                                        );
 244   if ( $error ) {
 245     $dbh->rollback if $oldAutoCommit;
 246     return $error;
 247   }
 248
 249   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 250
 251   '';
 252 }
 253
 254 #false laziness w/broadband_sqlradius.pm
 255 sub _export_suspend {
 256   my( $self, $svc_acct ) = (shift, shift);
 257
 258   my $new = $svc_acct->clone_suspended;
 259
 260   local $SIG{HUP} = 'IGNORE';
 261   local $SIG{INT} = 'IGNORE';
 262   local $SIG{QUIT} = 'IGNORE';
 263   local $SIG{TERM} = 'IGNORE';
 264   local $SIG{TSTP} = 'IGNORE';
 265   local $SIG{PIPE} = 'IGNORE';
 266
 267   my $oldAutoCommit = $FS::UID::AutoCommit;
 268   local $FS::UID::AutoCommit = 0;
 269   my $dbh = dbh;
 270
 271   my @newgroups = $self->suspended_usergroups($svc_acct);
 272
 273   unless (@newgroups) { #don't change password if assigning to a suspended group
 274
 275     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 276       'check', $self->export_username($new), $new->radius_check );
 277     unless ( ref($err_or_queue) ) {
 278       $dbh->rollback if $oldAutoCommit;
 279       return $err_or_queue;
 280     }
 281
 282   }
 283
 284   my $error =
 285     $self->sqlreplace_usergroups(
 286       $new->svcnum,
 287       $self->export_username($new),
 288       '',
 289       [ $svc_acct->radius_groups('hashref') ],
 290       \@newgroups,
 291     );
 292   if ( $error ) {
 293     $dbh->rollback if $oldAutoCommit;
 294     return $error;
 295   }
 296   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 297
 298   '';
 299 }
 300
 301 sub _export_unsuspend {
 302   my( $self, $svc_x ) = (shift, shift);
 303
 304   local $SIG{HUP} = 'IGNORE';
 305   local $SIG{INT} = 'IGNORE';
 306   local $SIG{QUIT} = 'IGNORE';
 307   local $SIG{TERM} = 'IGNORE';
 308   local $SIG{TSTP} = 'IGNORE';
 309   local $SIG{PIPE} = 'IGNORE';
 310
 311   my $oldAutoCommit = $FS::UID::AutoCommit;
 312   local $FS::UID::AutoCommit = 0;
 313   my $dbh = dbh;
 314
 315   my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
 316     'check', $self->export_username($svc_x), $self->radius_check($svc_x) );
 317   unless ( ref($err_or_queue) ) {
 318     $dbh->rollback if $oldAutoCommit;
 319     return $err_or_queue;
 320   }
 321
 322   my $error;
 323   my (@oldgroups) = $self->suspended_usergroups($svc_x);
 324   $error = $self->sqlreplace_usergroups(
 325     $svc_x->svcnum,
 326     $self->export_username($svc_x),
 327     '',
 328     \@oldgroups,
 329     [ $svc_x->radius_groups('hashref') ],
 330   );
 331   if ( $error ) {
 332     $dbh->rollback if $oldAutoCommit;
 333     return $error;
 334   }
 335   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 336
 337   '';
 338 }
 339
 340 sub _export_delete {
 341   my( $self, $svc_x ) = (shift, shift);
 342   my $usergroup = $self->option('usergroup') || 'usergroup';
 343   my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
 344     $self->export_username($svc_x), $usergroup );
 345   ref($err_or_queue) ? '' : $err_or_queue;
 346 }
 347
 348 sub sqlradius_queue {
 349   my( $self, $svcnum, $method ) = (shift, shift, shift);
 350   my %args = @_;
 351   my $queue = new FS::queue {
 352     'svcnum' => $svcnum,
 353     'job'    => "FS::part_export::sqlradius::sqlradius_$method",
 354   };
 355   $queue->insert(
 356     $self->option('datasrc'),
 357     $self->option('username'),
 358     $self->option('password'),
 359     @_,
 360   ) or $queue;
 361 }
 362
 363 sub suspended_usergroups {
 364   my ($self, $svc_x) = (shift, shift);
 365
 366   return () unless $svc_x;
 367
 368   my $svc_table = $svc_x->table;
 369
 370   #false laziness with FS::part_export::shellcommands
 371   #subclass part_export?
 372
 373   my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp');
 374   my %reasonmap = $self->_groups_susp_reason_map;
 375   my $userspec = '';
 376   if ($r) {
 377     $userspec = $reasonmap{$r->reasonnum}
 378       if exists($reasonmap{$r->reasonnum});
 379     $userspec = $reasonmap{$r->reason}
 380       if (!$userspec && exists($reasonmap{$r->reason}));
 381   }
 382   my $suspend_svc;
 383   if ( $userspec =~ /^\d+$/ ){
 384     $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } );
 385   } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){
 386     my ($username,$domain) = split(/\@/, $userspec);
 387     for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
 388       $suspend_svc = $user if $userspec eq $user->email;
 389     }
 390   }elsif ( $userspec && $svc_table eq 'svc_acct'  ){
 391     $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } );
 392   }
 393   #esalf
 394   return $suspend_svc->radius_groups('hashref') if $suspend_svc;
 395   ();
 396 }
 397
 398 sub sqlradius_insert { #subroutine, not method
 399   my $dbh = sqlradius_connect(shift, shift, shift);
 400   my( $table, $username, %attributes ) = @_;
 401
 402   foreach my $attribute ( keys %attributes ) {
 403
 404     my $s_sth = $dbh->prepare(
 405       "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
 406     ) or die $dbh->errstr;
 407     $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
 408
 409     if ( $s_sth->fetchrow_arrayref->[0] ) {
 410
 411       my $u_sth = $dbh->prepare(
 412         "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
 413       ) or die $dbh->errstr;
 414       $u_sth->execute($attributes{$attribute}, $username, $attribute)
 415         or die $u_sth->errstr;
 416
 417     } else {
 418
 419       my $i_sth = $dbh->prepare(
 420         "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
 421           "VALUES ( ?, ?, ?, ? )"
 422       ) or die $dbh->errstr;
 423       $i_sth->execute(
 424         $username,
 425         $attribute,
 426         ( $attribute eq 'Password' ? '==' : ':=' ),
 427         $attributes{$attribute},
 428       ) or die $i_sth->errstr;
 429
 430     }
 431
 432   }
 433   $dbh->disconnect;
 434 }
 435
 436 sub sqlradius_usergroup_insert { #subroutine, not method
 437   my $dbh = sqlradius_connect(shift, shift, shift);
 438   my $username = shift;
 439   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
 440   my @groups = @_;
 441
 442   my $s_sth = $dbh->prepare(
 443     "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
 444   ) or die $dbh->errstr;
 445
 446   my $sth = $dbh->prepare(
 447     "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
 448   ) or die $dbh->errstr;
 449
 450   foreach ( @groups ) {
 451     my $group = $_->{'groupname'};
 452     my $priority = $_->{'priority'};
 453     $s_sth->execute( $username, $group ) or die $s_sth->errstr;
 454     if ($s_sth->fetchrow_arrayref->[0]) {
 455       warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
 456            "$group for $username\n"
 457         if $DEBUG;
 458       next;
 459     }
 460     $sth->execute( $username, $group, $priority )
 461       or die "can't insert into groupname table: ". $sth->errstr;
 462   }
 463   if ( $s_sth->{Active} ) {
 464     warn "sqlradius s_sth still active; calling ->finish()";
 465     $s_sth->finish;
 466   }
 467   if ( $sth->{Active} ) {
 468     warn "sqlradius sth still active; calling ->finish()";
 469     $sth->finish;
 470   }
 471   $dbh->disconnect;
 472 }
 473
 474 sub sqlradius_usergroup_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   my @groups = @_;
 479
 480   my $sth = $dbh->prepare(
 481     "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
 482   ) or die $dbh->errstr;
 483   foreach ( @groups ) {
 484     my $group = $_->{'groupname'};
 485     $sth->execute( $username, $group )
 486       or die "can't delete from groupname table: ". $sth->errstr;
 487   }
 488   $dbh->disconnect;
 489 }
 490
 491 sub sqlradius_rename { #subroutine, not method
 492   my $dbh = sqlradius_connect(shift, shift, shift);
 493   my($new_username, $old_username) = (shift, shift);
 494   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
 495   foreach my $table (qw(radreply radcheck), $usergroup ) {
 496     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
 497       or die $dbh->errstr;
 498     $sth->execute($new_username, $old_username)
 499       or die "can't update $table: ". $sth->errstr;
 500   }
 501   $dbh->disconnect;
 502 }
 503
 504 sub sqlradius_attrib_delete { #subroutine, not method
 505   my $dbh = sqlradius_connect(shift, shift, shift);
 506   my( $table, $username, @attrib ) = @_;
 507
 508   foreach my $attribute ( @attrib ) {
 509     my $sth = $dbh->prepare(
 510         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
 511       or die $dbh->errstr;
 512     $sth->execute($username,$attribute)
 513       or die "can't delete from rad$table table: ". $sth->errstr;
 514   }
 515   $dbh->disconnect;
 516 }
 517
 518 sub sqlradius_delete { #subroutine, not method
 519   my $dbh = sqlradius_connect(shift, shift, shift);
 520   my $username = shift;
 521   my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
 522
 523   foreach my $table (qw( radcheck radreply), $usergroup ) {
 524     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 525     $sth->execute($username)
 526       or die "can't delete from $table table: ". $sth->errstr;
 527   }
 528   $dbh->disconnect;
 529 }
 530
 531 sub sqlradius_connect {
 532   #my($datasrc, $username, $password) = @_;
 533   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 534   DBI->connect(@_) or die $DBI::errstr;
 535 }
 536
 537 sub sqlreplace_usergroups {
 538   my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
 539
 540   # (sorta) false laziness with FS::svc_acct::replace
 541   my @oldgroups = @$old;
 542   my @newgroups = @$new;
 543   my @delgroups = ();
 544   foreach my $oldgroup ( @oldgroups ) {
 545     if ( grep { $oldgroup eq $_ } @newgroups ) {
 546       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 547       next;
 548     }
 549     push @delgroups, $oldgroup;
 550   }
 551
 552   my $usergroup = $self->option('usergroup') || 'usergroup';
 553
 554   if ( @delgroups ) {
 555     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
 556       $username, $usergroup, @delgroups );
 557     return $err_or_queue
 558       unless ref($err_or_queue);
 559     if ( $jobnum ) {
 560       my $error = $err_or_queue->depend_insert( $jobnum );
 561       return $error if $error;
 562     }
 563   }
 564
 565   if ( @newgroups ) {
 566     cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
 567           "with ".  join(", ", @newgroups)
 568       if $DEBUG;
 569     my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
 570       $username, $usergroup, @newgroups );
 571     return $err_or_queue
 572       unless ref($err_or_queue);
 573     if ( $jobnum ) {
 574       my $error = $err_or_queue->depend_insert( $jobnum );
 575       return $error if $error;
 576     }
 577   }
 578   '';
 579 }
 580
 581
 582 #--
 583
 584 =item usage_sessions HASHREF
 585
 586 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 587
 588 New-style: pass a hashref with the following keys:
 589
 590 =over 4
 591
 592 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
 593
 594 =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
 595
 596 =item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
 597
 598 =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
 599
 600 =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
 601
 602 =item svc_acct
 603
 604 =item ip
 605
 606 =item prefix
 607
 608 =back
 609
 610 Old-style:
 611
 612 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 613 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 614 functions.
 615
 616 SVC_ACCT, if specified, limits the results to the specified account.
 617
 618 IP, if specified, limits the results to the specified IP address.
 619
 620 PREFIX, if specified, limits the results to records with a matching
 621 Called-Station-ID.
 622
 623 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to
 624 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
 625
 626 Returns an arrayref of hashrefs with the following fields:
 627
 628 =over 4
 629
 630 =item username
 631
 632 =item framedipaddress
 633
 634 =item acctstarttime
 635
 636 =item acctstoptime
 637
 638 =item acctsessiontime
 639
 640 =item acctinputoctets
 641
 642 =item acctoutputoctets
 643
 644 =item calledstationid
 645
 646 =back
 647
 648 =cut
 649
 650 #some false laziness w/cust_svc::seconds_since_sqlradacct
 651
 652 sub usage_sessions {
 653   my( $self ) = shift;
 654
 655   my $opt = {};
 656   my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
 657   my $summarize = 0;
 658   if ( ref($_[0]) ) {
 659     $opt = shift;
 660     $start    = $opt->{stoptime_start};
 661     $end      = $opt->{stoptime_end};
 662     $svc_acct = $opt->{svc_acct};
 663     $ip       = $opt->{ip};
 664     $prefix   = $opt->{prefix};
 665     $summarize   = $opt->{summarize};
 666   } else {
 667     ( $start, $end ) = splice(@_, 0, 2);
 668     $svc_acct = @_ ? shift : '';
 669     $ip = @_ ? shift : '';
 670     $prefix = @_ ? shift : '';
 671     #my $select = @_ ? shift : '*';
 672   }
 673
 674   $end ||= 2147483647;
 675
 676   return [] if $self->option('ignore_accounting');
 677
 678   my $dbh = sqlradius_connect( map $self->option($_),
 679                                    qw( datasrc username password ) );
 680
 681   #select a unix time conversion function based on database type
 682   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 683
 684   my @fields = (
 685                  qw( username realm framedipaddress
 686                      acctsessiontime acctinputoctets acctoutputoctets
 687                      calledstationid
 688                    ),
 689                  "$str2time acctstarttime ) as acctstarttime",
 690                  "$str2time acctstoptime ) as acctstoptime",
 691                );
 692
 693   @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
 694               'sum(acctoutputoctets) as acctoutputoctets',
 695             ) if $summarize;
 696
 697   my @param = ();
 698   my @where = ();
 699
 700   if ( $svc_acct ) {
 701     my $username = $self->export_username($svc_acct);
 702     if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
 703       push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
 704       push @param, $username, $1, $2;
 705     } else {
 706       push @where, 'UserName = ?';
 707       push @param, $username;
 708     }
 709   }
 710
 711   if ($self->option('process_single_realm')) {
 712     push @where, 'Realm = ?';
 713     push @param, $self->option('realm');
 714   }
 715
 716   if ( length($ip) ) {
 717     push @where, ' FramedIPAddress = ?';
 718     push @param, $ip;
 719   }
 720
 721   if ( length($prefix) ) {
 722     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 723     push @where, " CalledStationID LIKE 'sip:$prefix\%'";
 724   }
 725
 726   if ( $start ) {
 727     push @where, "$str2time AcctStopTime ) >= ?";
 728     push @param, $start;
 729   }
 730   if ( $end ) {
 731     push @where, "$str2time AcctStopTime ) <= ?";
 732     push @param, $end;
 733   }
 734   if ( $opt->{open_sessions} ) {
 735     push @where, 'AcctStopTime IS NULL';
 736   }
 737   if ( $opt->{starttime_start} ) {
 738     push @where, "$str2time AcctStartTime ) >= ?";
 739     push @param, $opt->{starttime_start};
 740   }
 741   if ( $opt->{starttime_end} ) {
 742     push @where, "$str2time AcctStartTime ) <= ?";
 743     push @param, $opt->{starttime_end};
 744   }
 745
 746   my $where = join(' AND ', @where);
 747   $where = "WHERE $where" if $where;
 748
 749   my $groupby = '';
 750   $groupby = 'GROUP BY username' if $summarize;
 751
 752   my $orderby = 'ORDER BY AcctStartTime DESC';
 753   $orderby = '' if $summarize;
 754
 755   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 756                           "  FROM radacct $where $groupby $orderby
 757                         ") or die $dbh->errstr;
 758   $sth->execute(@param) or die $sth->errstr;
 759
 760   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 761
 762 }
 763
 764 =item update_svc
 765
 766 =cut
 767
 768 sub update_svc {
 769   my $self = shift;
 770
 771   my $conf = new FS::Conf;
 772
 773   my $fdbh = dbh;
 774   my $dbh = sqlradius_connect( map $self->option($_),
 775                                    qw( datasrc username password ) );
 776
 777   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 778   my @fields = qw( radacctid username realm acctsessiontime );
 779
 780   my @param = ();
 781   my $where = '';
 782
 783   my $sth = $dbh->prepare("
 784     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
 785            $str2time AcctStartTime),  $str2time AcctStopTime),
 786            AcctInputOctets, AcctOutputOctets
 787       FROM radacct
 788       WHERE FreesideStatus IS NULL
 789         AND AcctStopTime IS NOT NULL
 790   ") or die $dbh->errstr;
 791   $sth->execute() or die $sth->errstr;
 792
 793   while ( my $row = $sth->fetchrow_arrayref ) {
 794     my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
 795        $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
 796     warn "processing record: ".
 797          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
 798       if $DEBUG;
 799
 800     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 801
 802     #my %search = ( 'username' => $UserName );
 803
 804     my $extra_sql = '';
 805     if ( ref($self) =~ /withdomain/ ) { #well...
 806       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
 807                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 808     }
 809
 810     my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
 811     local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
 812
 813     my $status = 'skipped';
 814     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
 815                   "(UserName $UserName, Realm $Realm)";
 816
 817     if (    $self->option('process_single_realm')
 818          && $self->option('realm') ne $Realm )
 819     {
 820       warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
 821     } else {
 822       my @svc_acct =
 823         grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
 824                                         'svcpart'   => $_->cust_svc->svcpart, } )
 825              }
 826         qsearch( 'svc_acct',
 827                    { 'username' => $UserName },
 828                    '',
 829                    $extra_sql
 830                  );
 831
 832       if ( !@svc_acct ) {
 833         warn "WARNING: no svc_acct record found $errinfo - skipping\n";
 834       } elsif ( scalar(@svc_acct) > 1 ) {
 835         warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
 836       } else {
 837
 838         my $svc_acct = $svc_acct[0];
 839         warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
 840
 841         $svc_acct->last_login($AcctStartTime);
 842         $svc_acct->last_logout($AcctStopTime);
 843
 844         my $session_time = $AcctStopTime;
 845         $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
 846
 847         my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
 848         if ( $cust_pkg && $session_time < (    $cust_pkg->last_bill
 849                                             || $cust_pkg->setup     )  ) {
 850           $status = 'skipped (too old)';
 851         } else {
 852           my @st;
 853           push @st, _try_decrement($svc_acct, 'seconds',    $AcctSessionTime);
 854           push @st, _try_decrement($svc_acct, 'upbytes',    $AcctInputOctets);
 855           push @st, _try_decrement($svc_acct, 'downbytes',  $AcctOutputOctets);
 856           push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
 857                                                           + $AcctOutputOctets);
 858           $status=join(' ', @st);
 859         }
 860       }
 861     }
 862
 863     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
 864     my $psth = $dbh->prepare("UPDATE radacct
 865                                 SET FreesideStatus = ?
 866                                 WHERE RadAcctId = ?"
 867     ) or die $dbh->errstr;
 868     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 869
 870     $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
 871
 872   }
 873
 874 }
 875
 876 sub _try_decrement {
 877   my ($svc_acct, $column, $amount) = @_;
 878   if ( $svc_acct->$column !~ /^$/ ) {
 879     warn "  svc_acct.$column found (". $svc_acct->$column.
 880          ") - decrementing\n"
 881       if $DEBUG;
 882     my $method = 'decrement_' . $column;
 883     my $error = $svc_acct->$method($amount);
 884     die $error if $error;
 885     return 'done';
 886   } else {
 887     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
 888   }
 889   return 'skipped';
 890 }
 891
 892 =item export_nas_insert NAS
 893
 894 =item export_nas_delete NAS
 895
 896 =item export_nas_replace NEW_NAS OLD_NAS
 897
 898 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
 899 server.  Currently requires the table to be named 'nas' and to follow
 900 the stock schema (/etc/freeradius/nas.sql).
 901
 902 =cut
 903
 904 sub export_nas_insert {  shift->export_nas_action('insert', @_); }
 905 sub export_nas_delete {  shift->export_nas_action('delete', @_); }
 906 sub export_nas_replace { shift->export_nas_action('replace', @_); }
 907
 908 sub export_nas_action {
 909   my $self = shift;
 910   my ($action, $new, $old) = @_;
 911   # find the NAS in the target table by its name
 912   my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
 913   my $nasnum = $new->nasnum;
 914
 915   my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
 916     nasname => $nasname,
 917     nasnum => $nasnum
 918   );
 919   return $err_or_queue unless ref $err_or_queue;
 920   '';
 921 }
 922
 923 sub sqlradius_nas_insert {
 924   my $dbh = sqlradius_connect(shift, shift, shift);
 925   my %opt = @_;
 926   my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
 927     or die "nasnum ".$opt{'nasnum'}.' not found';
 928   # insert actual NULLs where FS::Record has translated to empty strings
 929   my @values = map { length($nas->$_) ? $nas->$_ : undef }
 930     qw( nasname shortname type secret server community description );
 931   my $sth = $dbh->prepare('INSERT INTO nas
 932 (nasname, shortname, type, secret, server, community, description)
 933 VALUES (?, ?, ?, ?, ?, ?, ?)');
 934   $sth->execute(@values) or die $dbh->errstr;
 935 }
 936
 937 sub sqlradius_nas_delete {
 938   my $dbh = sqlradius_connect(shift, shift, shift);
 939   my %opt = @_;
 940   my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
 941   $sth->execute($opt{'nasname'}) or die $dbh->errstr;
 942 }
 943
 944 sub sqlradius_nas_replace {
 945   my $dbh = sqlradius_connect(shift, shift, shift);
 946   my %opt = @_;
 947   my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
 948     or die "nasnum ".$opt{'nasnum'}.' not found';
 949   my @values = map {$nas->$_}
 950     qw( nasname shortname type secret server community description );
 951   my $sth = $dbh->prepare('UPDATE nas SET
 952     nasname = ?, shortname = ?, type = ?, secret = ?,
 953     server = ?, community = ?, description = ?
 954     WHERE nasname = ?');
 955   $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
 956 }
 957
 958 =item export_attr_insert RADIUS_ATTR
 959
 960 =item export_attr_delete RADIUS_ATTR
 961
 962 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
 963
 964 Update the group attribute tables (radgroupcheck and radgroupreply) on
 965 the RADIUS server.  In delete and replace actions, the existing records
 966 are identified by the combination of group name and attribute name.
 967
 968 In the special case where attributes are being replaced because a group
 969 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
 970 'groupname' must be set in OLD_RADIUS_ATTR.
 971
 972 =cut
 973
 974 # some false laziness with NAS export stuff...
 975
 976 sub export_attr_insert  { shift->export_attr_action('insert', @_); }
 977
 978 sub export_attr_delete  { shift->export_attr_action('delete', @_); }
 979
 980 sub export_attr_replace { shift->export_attr_action('replace', @_); }
 981
 982 sub export_attr_action {
 983   my $self = shift;
 984   my ($action, $new, $old) = @_;
 985   my $err_or_queue;
 986
 987   if ( $action eq 'delete' ) {
 988     $old = $new;
 989   }
 990   if ( $action eq 'delete' or $action eq 'replace' ) {
 991     # delete based on an exact match
 992     my %opt = (
 993       attrname  => $old->attrname,
 994       attrtype  => $old->attrtype,
 995       groupname => $old->groupname || $old->radius_group->groupname,
 996       op        => $old->op,
 997       value     => $old->value,
 998     );
 999     $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1000     return $err_or_queue unless ref $err_or_queue;
1001   }
1002   # this probably doesn't matter, but just to be safe...
1003   my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1004   if ( $action eq 'replace' or $action eq 'insert' ) {
1005     my %opt = (
1006       attrname  => $new->attrname,
1007       attrtype  => $new->attrtype,
1008       groupname => $new->radius_group->groupname,
1009       op        => $new->op,
1010       value     => $new->value,
1011     );
1012     $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1013     $err_or_queue->depend_insert($jobnum) if $jobnum;
1014     return $err_or_queue unless ref $err_or_queue;
1015   }
1016   '';
1017 }
1018
1019 sub sqlradius_attr_insert {
1020   my $dbh = sqlradius_connect(shift, shift, shift);
1021   my %opt = @_;
1022
1023   my $table;
1024   # make sure $table is completely safe
1025   if ( $opt{'attrtype'} eq 'C' ) {
1026     $table = 'radgroupcheck';
1027   }
1028   elsif ( $opt{'attrtype'} eq 'R' ) {
1029     $table = 'radgroupreply';
1030   }
1031   else {
1032     die "unknown attribute type '$opt{attrtype}'";
1033   }
1034
1035   my @values = @opt{ qw(groupname attrname op value) };
1036   my $sth = $dbh->prepare(
1037     'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1038   );
1039   $sth->execute(@values) or die $dbh->errstr;
1040 }
1041
1042 sub sqlradius_attr_delete {
1043   my $dbh = sqlradius_connect(shift, shift, shift);
1044   my %opt = @_;
1045
1046   my $table;
1047   if ( $opt{'attrtype'} eq 'C' ) {
1048     $table = 'radgroupcheck';
1049   }
1050   elsif ( $opt{'attrtype'} eq 'R' ) {
1051     $table = 'radgroupreply';
1052   }
1053   else {
1054     die "unknown attribute type '".$opt{'attrtype'}."'";
1055   }
1056
1057   my @values = @opt{ qw(groupname attrname op value) };
1058   my $sth = $dbh->prepare(
1059     'DELETE FROM '.$table.
1060     ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1061     ' LIMIT 1'
1062   );
1063   $sth->execute(@values) or die $dbh->errstr;
1064 }
1065
1066 #sub sqlradius_attr_replace { no longer needed
1067
1068 =item export_group_replace NEW OLD
1069
1070 Replace the L<FS::radius_group> object OLD with NEW.  This will change
1071 the group name and priority in all radusergroup records, and the group
1072 name in radgroupcheck and radgroupreply.
1073
1074 =cut
1075
1076 sub export_group_replace {
1077   my $self = shift;
1078   my ($new, $old) = @_;
1079   return '' if $new->groupname eq $old->groupname
1080            and $new->priority  == $old->priority;
1081
1082   my $err_or_queue = $self->sqlradius_queue(
1083     '',
1084     'group_replace',
1085     ($self->option('usergroup') || 'usergroup'),
1086     $new->hashref,
1087     $old->hashref,
1088   );
1089   return $err_or_queue unless ref $err_or_queue;
1090   '';
1091 }
1092
1093 sub sqlradius_group_replace {
1094   my $dbh = sqlradius_connect(shift, shift, shift);
1095   my $usergroup = shift;
1096   $usergroup =~ /^(rad)?usergroup$/
1097     or die "bad usergroup table name: $usergroup";
1098   my ($new, $old) = (shift, shift);
1099   # apply renames to check/reply attribute tables
1100   if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1101     foreach my $table (qw(radgroupcheck radgroupreply)) {
1102       my $sth = $dbh->prepare(
1103         'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1104       );
1105       $sth->execute($new->{'groupname'}, $old->{'groupname'})
1106         or die $dbh->errstr;
1107     }
1108   }
1109   # apply renames and priority changes to usergroup table
1110   my $sth = $dbh->prepare(
1111     'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1112   );
1113   $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1114     or die $dbh->errstr;
1115 }
1116
1117 ###
1118 # class method to fetch groups/attributes from the sqlradius install on upgrade
1119 ###
1120
1121 sub _upgrade_exporttype {
1122   # do this only if the radius_attr table is empty
1123   local $FS::radius_attr::noexport_hack = 1;
1124   my $class = shift;
1125   return if qsearch('radius_attr', {});
1126
1127   foreach my $self ($class->all_sqlradius) {
1128     my $error = $self->import_attrs;
1129     die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1130   }
1131   return;
1132 }
1133
1134 sub import_attrs {
1135   my $self = shift;
1136   my $dbh =  DBI->connect( map $self->option($_),
1137                                    qw( datasrc username password ) );
1138   unless ( $dbh ) {
1139     warn "Error connecting to RADIUS server: $DBI::errstr\n";
1140     return;
1141   }
1142
1143   my $usergroup = $self->option('usergroup') || 'usergroup';
1144   my $error;
1145   warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1146     "\n";
1147
1148   # map out existing groups and attrs
1149   my %attrs_of;
1150   my %groupnum_of;
1151   foreach my $radius_group ( qsearch('radius_group', {}) ) {
1152     $attrs_of{$radius_group->groupname} = +{
1153       map { $_->attrname => $_ } $radius_group->radius_attr
1154     };
1155     $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1156   }
1157
1158   # get groupnames from radgroupcheck and radgroupreply
1159   my $sql = '
1160 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1161 UNION
1162 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1163   my @fixes; # things that need to be changed on the radius db
1164   foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1165     my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1166     warn "$groupname.$attrname\n";
1167     if ( !exists($groupnum_of{$groupname}) ) {
1168       my $radius_group = new FS::radius_group {
1169         'groupname' => $groupname,
1170         'priority'  => 1,
1171       };
1172       $error = $radius_group->insert;
1173       if ( $error ) {
1174         warn "error inserting group $groupname: $error";
1175         next;#don't continue trying to insert the attribute
1176       }
1177       $attrs_of{$groupname} = {};
1178       $groupnum_of{$groupname} = $radius_group->groupnum;
1179     }
1180
1181     my $a = $attrs_of{$groupname};
1182     my $old = $a->{$attrname};
1183     my $new;
1184
1185     if ( $attrtype eq 'R' ) {
1186       # Freeradius tolerates illegal operators in reply attributes.  We don't.
1187       if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1188         warn "$groupname.$attrname: changing $op to +=\n";
1189         # Make a note to change it in the db
1190         push @fixes, [
1191           'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1192           $groupname, $attrname, $op, $value
1193         ];
1194         # and import it correctly.
1195         $op = '+=';
1196       }
1197     }
1198
1199     if ( defined $old ) {
1200       # replace
1201       $new = new FS::radius_attr {
1202         $old->hash,
1203         'op'    => $op,
1204         'value' => $value,
1205       };
1206       $error = $new->replace($old);
1207       if ( $error ) {
1208         warn "error modifying attr $attrname: $error";
1209         next;
1210       }
1211     }
1212     else {
1213       $new = new FS::radius_attr {
1214         'groupnum' => $groupnum_of{$groupname},
1215         'attrname' => $attrname,
1216         'attrtype' => $attrtype,
1217         'op'       => $op,
1218         'value'    => $value,
1219       };
1220       $error = $new->insert;
1221       if ( $error ) {
1222         warn "error inserting attr $attrname: $error" if $error;
1223         next;
1224       }
1225     }
1226     $attrs_of{$groupname}->{$attrname} = $new;
1227   } #foreach $row
1228
1229   foreach (@fixes) {
1230     my ($sql, @args) = @$_;
1231     my $sth = $dbh->prepare($sql);
1232     $sth->execute(@args) or warn $sth->errstr;
1233   }
1234
1235   return;
1236 }
1237
1238 ###
1239 #class methods
1240 ###
1241
1242 sub all_sqlradius {
1243   #my $class = shift;
1244
1245   #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1246   # (radiator is supposed to be setup with a radacct table)
1247   #i suppose it would be more slick to look for things that inherit from us..
1248
1249   my @part_export = ();
1250   push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1251     foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1252                 broadband_sqlradius );
1253   @part_export;
1254 }
1255
1256 sub all_sqlradius_withaccounting {
1257   my $class = shift;
1258   grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
1259 }
1260
1261 1;
1262