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