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