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