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