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