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