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