FS/FS/part_export/sqlradius.pm

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