FS/FS/part_export/sqlradius.pm

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