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