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