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 ( $start ) {
 730     push @where, "$str2time AcctStopTime ) >= ?";
 731     push @param, $start;
 732   }
 733   if ( $end ) {
 734     push @where, "$str2time AcctStopTime ) <= ?";
 735     push @param, $end;
 736   }
 737   if ( $opt->{open_sessions} ) {
 738     push @where, 'AcctStopTime IS NULL';
 739   }
 740   if ( $opt->{starttime_start} ) {
 741     push @where, "$str2time AcctStartTime ) >= ?";
 742     push @param, $opt->{starttime_start};
 743   }
 744   if ( $opt->{starttime_end} ) {
 745     push @where, "$str2time AcctStartTime ) <= ?";
 746     push @param, $opt->{starttime_end};
 747   }
 748
 749   my $where = join(' AND ', @where);
 750   $where = "WHERE $where" if $where;
 751
 752   my $groupby = '';
 753   $groupby = 'GROUP BY username' if $summarize;
 754
 755   my $orderby = 'ORDER BY AcctStartTime DESC';
 756   $orderby = '' if $summarize;
 757
 758   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 759                           "  FROM radacct $where $groupby $orderby
 760                         ") or die $dbh->errstr;
 761   $sth->execute(@param) or die $sth->errstr;
 762
 763   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 764
 765 }
 766
 767 =item update_svc
 768
 769 =cut
 770
 771 sub update_svc {
 772   my $self = shift;
 773
 774   my $conf = new FS::Conf;
 775
 776   my $fdbh = dbh;
 777   my $dbh = sqlradius_connect( map $self->option($_),
 778                                    qw( datasrc username password ) );
 779
 780   my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 781   my @fields = qw( radacctid username realm acctsessiontime );
 782
 783   my @param = ();
 784   my $where = '';
 785
 786   my $sth = $dbh->prepare("
 787     SELECT RadAcctId, UserName, Realm, AcctSessionTime,
 788            $str2time AcctStartTime),  $str2time AcctStopTime),
 789            AcctInputOctets, AcctOutputOctets
 790       FROM radacct
 791       WHERE FreesideStatus IS NULL
 792         AND AcctStopTime IS NOT NULL
 793   ") or die $dbh->errstr;
 794   $sth->execute() or die $sth->errstr;
 795
 796   while ( my $row = $sth->fetchrow_arrayref ) {
 797     my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
 798        $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
 799     warn "processing record: ".
 800          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
 801       if $DEBUG;
 802
 803     $UserName = lc($UserName) unless $conf->exists('username-uppercase');
 804
 805     #my %search = ( 'username' => $UserName );
 806
 807     my $extra_sql = '';
 808     if ( ref($self) =~ /withdomain/ ) { #well...
 809       $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
 810                           WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 811     }
 812
 813     my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
 814     local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
 815
 816     my $status = 'skipped';
 817     my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
 818                   "(UserName $UserName, Realm $Realm)";
 819
 820     if (    $self->option('process_single_realm')
 821          && $self->option('realm') ne $Realm )
 822     {
 823       warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
 824     } else {
 825       my @svc_acct =
 826         grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
 827                                         'svcpart'   => $_->cust_svc->svcpart, } )
 828              }
 829         qsearch( 'svc_acct',
 830                    { 'username' => $UserName },
 831                    '',
 832                    $extra_sql
 833                  );
 834
 835       if ( !@svc_acct ) {
 836         warn "WARNING: no svc_acct record found $errinfo - skipping\n";
 837       } elsif ( scalar(@svc_acct) > 1 ) {
 838         warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
 839       } else {
 840
 841         my $svc_acct = $svc_acct[0];
 842         warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
 843
 844         $svc_acct->last_login($AcctStartTime);
 845         $svc_acct->last_logout($AcctStopTime);
 846
 847         my $session_time = $AcctStopTime;
 848         $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
 849
 850         my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
 851         if ( $cust_pkg && $session_time < (    $cust_pkg->last_bill
 852                                             || $cust_pkg->setup     )  ) {
 853           $status = 'skipped (too old)';
 854         } else {
 855           my @st;
 856           push @st, _try_decrement($svc_acct, 'seconds',    $AcctSessionTime);
 857           push @st, _try_decrement($svc_acct, 'upbytes',    $AcctInputOctets);
 858           push @st, _try_decrement($svc_acct, 'downbytes',  $AcctOutputOctets);
 859           push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
 860                                                           + $AcctOutputOctets);
 861           $status=join(' ', @st);
 862         }
 863       }
 864     }
 865
 866     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
 867     my $psth = $dbh->prepare("UPDATE radacct
 868                                 SET FreesideStatus = ?
 869                                 WHERE RadAcctId = ?"
 870     ) or die $dbh->errstr;
 871     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 872
 873     $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
 874
 875   }
 876
 877 }
 878
 879 sub _try_decrement {
 880   my ($svc_acct, $column, $amount) = @_;
 881   if ( $svc_acct->$column !~ /^$/ ) {
 882     warn "  svc_acct.$column found (". $svc_acct->$column.
 883          ") - decrementing\n"
 884       if $DEBUG;
 885     my $method = 'decrement_' . $column;
 886     my $error = $svc_acct->$method($amount);
 887     die $error if $error;
 888     return 'done';
 889   } else {
 890     warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
 891   }
 892   return 'skipped';
 893 }
 894
 895 =item export_nas_insert NAS
 896
 897 =item export_nas_delete NAS
 898
 899 =item export_nas_replace NEW_NAS OLD_NAS
 900
 901 Update the NAS table (allowed RADIUS clients) on the attached RADIUS
 902 server.  Currently requires the table to be named 'nas' and to follow
 903 the stock schema (/etc/freeradius/nas.sql).
 904
 905 =cut
 906
 907 sub export_nas_insert {  shift->export_nas_action('insert', @_); }
 908 sub export_nas_delete {  shift->export_nas_action('delete', @_); }
 909 sub export_nas_replace { shift->export_nas_action('replace', @_); }
 910
 911 sub export_nas_action {
 912   my $self = shift;
 913   my ($action, $new, $old) = @_;
 914   # find the NAS in the target table by its name
 915   my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname;
 916   my $nasnum = $new->nasnum;
 917
 918   my $err_or_queue = $self->sqlradius_queue('', "nas_$action",
 919     nasname => $nasname,
 920     nasnum => $nasnum
 921   );
 922   return $err_or_queue unless ref $err_or_queue;
 923   '';
 924 }
 925
 926 sub sqlradius_nas_insert {
 927   my $dbh = sqlradius_connect(shift, shift, shift);
 928   my %opt = @_;
 929   my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
 930     or die "nasnum ".$opt{'nasnum'}.' not found';
 931   # insert actual NULLs where FS::Record has translated to empty strings
 932   my @values = map { length($nas->$_) ? $nas->$_ : undef }
 933     qw( nasname shortname type secret server community description );
 934   my $sth = $dbh->prepare('INSERT INTO nas
 935 (nasname, shortname, type, secret, server, community, description)
 936 VALUES (?, ?, ?, ?, ?, ?, ?)');
 937   $sth->execute(@values) or die $dbh->errstr;
 938 }
 939
 940 sub sqlradius_nas_delete {
 941   my $dbh = sqlradius_connect(shift, shift, shift);
 942   my %opt = @_;
 943   my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?');
 944   $sth->execute($opt{'nasname'}) or die $dbh->errstr;
 945 }
 946
 947 sub sqlradius_nas_replace {
 948   my $dbh = sqlradius_connect(shift, shift, shift);
 949   my %opt = @_;
 950   my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} })
 951     or die "nasnum ".$opt{'nasnum'}.' not found';
 952   my @values = map {$nas->$_}
 953     qw( nasname shortname type secret server community description );
 954   my $sth = $dbh->prepare('UPDATE nas SET
 955     nasname = ?, shortname = ?, type = ?, secret = ?,
 956     server = ?, community = ?, description = ?
 957     WHERE nasname = ?');
 958   $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
 959 }
 960
 961 =item export_attr_insert RADIUS_ATTR
 962
 963 =item export_attr_delete RADIUS_ATTR
 964
 965 =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
 966
 967 Update the group attribute tables (radgroupcheck and radgroupreply) on
 968 the RADIUS server.  In delete and replace actions, the existing records
 969 are identified by the combination of group name and attribute name.
 970
 971 In the special case where attributes are being replaced because a group
 972 name (L<FS::radius_group>->groupname) is changing, the pseudo-field
 973 'groupname' must be set in OLD_RADIUS_ATTR.
 974
 975 =cut
 976
 977 # some false laziness with NAS export stuff...
 978
 979 sub export_attr_insert  { shift->export_attr_action('insert', @_); }
 980
 981 sub export_attr_delete  { shift->export_attr_action('delete', @_); }
 982
 983 sub export_attr_replace { shift->export_attr_action('replace', @_); }
 984
 985 sub export_attr_action {
 986   my $self = shift;
 987   my ($action, $new, $old) = @_;
 988   my $err_or_queue;
 989
 990   if ( $action eq 'delete' ) {
 991     $old = $new;
 992   }
 993   if ( $action eq 'delete' or $action eq 'replace' ) {
 994     # delete based on an exact match
 995     my %opt = (
 996       attrname  => $old->attrname,
 997       attrtype  => $old->attrtype,
 998       groupname => $old->groupname || $old->radius_group->groupname,
 999       op        => $old->op,
1000       value     => $old->value,
1001     );
1002     $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt);
1003     return $err_or_queue unless ref $err_or_queue;
1004   }
1005   # this probably doesn't matter, but just to be safe...
1006   my $jobnum = $err_or_queue->jobnum if $action eq 'replace';
1007   if ( $action eq 'replace' or $action eq 'insert' ) {
1008     my %opt = (
1009       attrname  => $new->attrname,
1010       attrtype  => $new->attrtype,
1011       groupname => $new->radius_group->groupname,
1012       op        => $new->op,
1013       value     => $new->value,
1014     );
1015     $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt);
1016     $err_or_queue->depend_insert($jobnum) if $jobnum;
1017     return $err_or_queue unless ref $err_or_queue;
1018   }
1019   '';
1020 }
1021
1022 sub sqlradius_attr_insert {
1023   my $dbh = sqlradius_connect(shift, shift, shift);
1024   my %opt = @_;
1025
1026   my $table;
1027   # make sure $table is completely safe
1028   if ( $opt{'attrtype'} eq 'C' ) {
1029     $table = 'radgroupcheck';
1030   }
1031   elsif ( $opt{'attrtype'} eq 'R' ) {
1032     $table = 'radgroupreply';
1033   }
1034   else {
1035     die "unknown attribute type '$opt{attrtype}'";
1036   }
1037
1038   my @values = @opt{ qw(groupname attrname op value) };
1039   my $sth = $dbh->prepare(
1040     'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
1041   );
1042   $sth->execute(@values) or die $dbh->errstr;
1043 }
1044
1045 sub sqlradius_attr_delete {
1046   my $dbh = sqlradius_connect(shift, shift, shift);
1047   my %opt = @_;
1048
1049   my $table;
1050   if ( $opt{'attrtype'} eq 'C' ) {
1051     $table = 'radgroupcheck';
1052   }
1053   elsif ( $opt{'attrtype'} eq 'R' ) {
1054     $table = 'radgroupreply';
1055   }
1056   else {
1057     die "unknown attribute type '".$opt{'attrtype'}."'";
1058   }
1059
1060   my @values = @opt{ qw(groupname attrname op value) };
1061   my $sth = $dbh->prepare(
1062     'DELETE FROM '.$table.
1063     ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'.
1064     ' LIMIT 1'
1065   );
1066   $sth->execute(@values) or die $dbh->errstr;
1067 }
1068
1069 #sub sqlradius_attr_replace { no longer needed
1070
1071 =item export_group_replace NEW OLD
1072
1073 Replace the L<FS::radius_group> object OLD with NEW.  This will change
1074 the group name and priority in all radusergroup records, and the group
1075 name in radgroupcheck and radgroupreply.
1076
1077 =cut
1078
1079 sub export_group_replace {
1080   my $self = shift;
1081   my ($new, $old) = @_;
1082   return '' if $new->groupname eq $old->groupname
1083            and $new->priority  == $old->priority;
1084
1085   my $err_or_queue = $self->sqlradius_queue(
1086     '',
1087     'group_replace',
1088     ($self->option('usergroup') || 'usergroup'),
1089     $new->hashref,
1090     $old->hashref,
1091   );
1092   return $err_or_queue unless ref $err_or_queue;
1093   '';
1094 }
1095
1096 sub sqlradius_group_replace {
1097   my $dbh = sqlradius_connect(shift, shift, shift);
1098   my $usergroup = shift;
1099   $usergroup =~ /^(rad)?usergroup$/
1100     or die "bad usergroup table name: $usergroup";
1101   my ($new, $old) = (shift, shift);
1102   # apply renames to check/reply attribute tables
1103   if ( $new->{'groupname'} ne $old->{'groupname'} ) {
1104     foreach my $table (qw(radgroupcheck radgroupreply)) {
1105       my $sth = $dbh->prepare(
1106         'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
1107       );
1108       $sth->execute($new->{'groupname'}, $old->{'groupname'})
1109         or die $dbh->errstr;
1110     }
1111   }
1112   # apply renames and priority changes to usergroup table
1113   my $sth = $dbh->prepare(
1114     'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
1115   );
1116   $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
1117     or die $dbh->errstr;
1118 }
1119
1120 ###
1121 # class method to fetch groups/attributes from the sqlradius install on upgrade
1122 ###
1123
1124 sub _upgrade_exporttype {
1125   # do this only if the radius_attr table is empty
1126   local $FS::radius_attr::noexport_hack = 1;
1127   my $class = shift;
1128   return if qsearch('radius_attr', {});
1129
1130   foreach my $self ($class->all_sqlradius) {
1131     my $error = $self->import_attrs;
1132     die "exportnum ".$self->exportnum.":\n$error\n" if $error;
1133   }
1134   return;
1135 }
1136
1137 sub import_attrs {
1138   my $self = shift;
1139   my $dbh =  DBI->connect( map $self->option($_),
1140                                    qw( datasrc username password ) );
1141   unless ( $dbh ) {
1142     warn "Error connecting to RADIUS server: $DBI::errstr\n";
1143     return;
1144   }
1145
1146   my $usergroup = $self->option('usergroup') || 'usergroup';
1147   my $error;
1148   warn "Importing RADIUS groups and attributes from ".$self->option('datasrc').
1149     "\n";
1150
1151   # map out existing groups and attrs
1152   my %attrs_of;
1153   my %groupnum_of;
1154   foreach my $radius_group ( qsearch('radius_group', {}) ) {
1155     $attrs_of{$radius_group->groupname} = +{
1156       map { $_->attrname => $_ } $radius_group->radius_attr
1157     };
1158     $groupnum_of{$radius_group->groupname} = $radius_group->groupnum;
1159   }
1160
1161   # get groupnames from radgroupcheck and radgroupreply
1162   my $sql = '
1163 SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck
1164 UNION
1165 SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply';
1166   my @fixes; # things that need to be changed on the radius db
1167   foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) {
1168     my ($groupname, $attrname, $op, $value, $attrtype) = @$row;
1169     warn "$groupname.$attrname\n";
1170     if ( !exists($groupnum_of{$groupname}) ) {
1171       my $radius_group = new FS::radius_group {
1172         'groupname' => $groupname,
1173         'priority'  => 1,
1174       };
1175       $error = $radius_group->insert;
1176       if ( $error ) {
1177         warn "error inserting group $groupname: $error";
1178         next;#don't continue trying to insert the attribute
1179       }
1180       $attrs_of{$groupname} = {};
1181       $groupnum_of{$groupname} = $radius_group->groupnum;
1182     }
1183
1184     my $a = $attrs_of{$groupname};
1185     my $old = $a->{$attrname};
1186     my $new;
1187
1188     if ( $attrtype eq 'R' ) {
1189       # Freeradius tolerates illegal operators in reply attributes.  We don't.
1190       if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) {
1191         warn "$groupname.$attrname: changing $op to +=\n";
1192         # Make a note to change it in the db
1193         push @fixes, [
1194           'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?',
1195           $groupname, $attrname, $op, $value
1196         ];
1197         # and import it correctly.
1198         $op = '+=';
1199       }
1200     }
1201
1202     if ( defined $old ) {
1203       # replace
1204       $new = new FS::radius_attr {
1205         $old->hash,
1206         'op'    => $op,
1207         'value' => $value,
1208       };
1209       $error = $new->replace($old);
1210       if ( $error ) {
1211         warn "error modifying attr $attrname: $error";
1212         next;
1213       }
1214     }
1215     else {
1216       $new = new FS::radius_attr {
1217         'groupnum' => $groupnum_of{$groupname},
1218         'attrname' => $attrname,
1219         'attrtype' => $attrtype,
1220         'op'       => $op,
1221         'value'    => $value,
1222       };
1223       $error = $new->insert;
1224       if ( $error ) {
1225         warn "error inserting attr $attrname: $error" if $error;
1226         next;
1227       }
1228     }
1229     $attrs_of{$groupname}->{$attrname} = $new;
1230   } #foreach $row
1231
1232   foreach (@fixes) {
1233     my ($sql, @args) = @$_;
1234     my $sth = $dbh->prepare($sql);
1235     $sth->execute(@args) or warn $sth->errstr;
1236   }
1237
1238   return;
1239 }
1240
1241 ###
1242 #class methods
1243 ###
1244
1245 sub all_sqlradius {
1246   #my $class = shift;
1247
1248   #don't just look for ->can('usage_sessions'), we're sqlradius-specific
1249   # (radiator is supposed to be setup with a radacct table)
1250   #i suppose it would be more slick to look for things that inherit from us..
1251
1252   my @part_export = ();
1253   push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
1254     foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
1255                 broadband_sqlradius );
1256   @part_export;
1257 }
1258
1259 sub all_sqlradius_withaccounting {
1260   my $class = shift;
1261   grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
1262 }
1263
1264 1;
1265