FS/FS/part_export/sqlradius.pm

   1 package FS::part_export::sqlradius;
   2
   3 use vars qw(@ISA $DEBUG %info %options $notes1 $notes2);
   4 use Tie::IxHash;
   5 use FS::Record qw( dbh );
   6 use FS::part_export;
   7
   8 @ISA = qw(FS::part_export);
   9
  10 $DEBUG = 0;
  11
  12 tie %options, 'Tie::IxHash',
  13   'datasrc'  => { label=>'DBI data source ' },
  14   'username' => { label=>'Database username' },
  15   'password' => { label=>'Database password' },
  16   'ignore_accounting' => {
  17     type  => 'checkbox',
  18     label => 'Ignore accounting records from this database'
  19   },
  20   'hide_ip' => {
  21     type  => 'checkbox',
  22     label => 'Hide IP address information on session reports',
  23   },
  24   'hide_data' => {
  25     type  => 'checkbox',
  26     label => 'Hide download/upload information on session reports',
  27   },
  28   'show_called_station' => {
  29     type  => 'checkbox',
  30     label => 'Show the Called-Station-ID on session reports',
  31   },
  32 ;
  33
  34 $notes1 = <<'END';
  35 Real-time export of radcheck, radreply and usergroup tables to any SQL database
  36 for <a href="http://www.freeradius.org/">FreeRADIUS</a>,
  37 <a href="http://radius.innercite.com/">ICRADIUS</a>
  38 or <a href="http://www.open.com.au/radiator/">Radiator</a>.
  39 END
  40
  41 $notes2 = <<'END';
  42 An existing RADIUS database will be updated in realtime, but you can use
  43 <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
  44 to delete the entire RADIUS database and repopulate the tables from the
  45 Freeside database.  See the
  46 <a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
  47 and the
  48 <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
  49 for the exact syntax of a DBI data source.
  50 <ul>
  51   <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.
  52   <li>Using ICRADIUS, add a dummy "op" column to your database:
  53     <blockquote><code>
  54       ALTER&nbsp;TABLE&nbsp;radcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  55       ALTER&nbsp;TABLE&nbsp;radreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  56       ALTER&nbsp;TABLE&nbsp;radgroupcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
  57       ALTER&nbsp;TABLE&nbsp;radgroupreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='
  58     </code></blockquote>
  59   <li>Using Radiator, see the
  60     <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
  61     for configuration information.
  62 </ul>
  63 END
  64
  65 %info = (
  66   'svc'      => 'svc_acct',
  67   'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator)',
  68   'options'  => \%options,
  69   'nodomain' => 'Y',
  70   'notes'    => $notes1.
  71                 'This export does not export RADIUS realms (see also '.
  72                 'sqlradius_withdomain).  '.
  73                 $notes2
  74 );
  75
  76 sub rebless { shift; }
  77
  78 sub export_username {
  79   my($self, $svc_acct) = (shift, shift);
  80   warn "export_username called on $self with arg $svc_acct" if $DEBUG;
  81   $svc_acct->username;
  82 }
  83
  84 sub _export_insert {
  85   my($self, $svc_acct) = (shift, shift);
  86
  87   foreach my $table (qw(reply check)) {
  88     my $method = "radius_$table";
  89     my %attrib = $svc_acct->$method();
  90     next unless keys %attrib;
  91     my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
  92       $table, $self->export_username($svc_acct), %attrib );
  93     return $err_or_queue unless ref($err_or_queue);
  94   }
  95   my @groups = $svc_acct->radius_groups;
  96   if ( @groups ) {
  97     my $err_or_queue = $self->sqlradius_queue(
  98       $svc_acct->svcnum, 'usergroup_insert',
  99       $self->export_username($svc_acct), @groups );
 100     return $err_or_queue unless ref($err_or_queue);
 101   }
 102   '';
 103 }
 104
 105 sub _export_replace {
 106   my( $self, $new, $old ) = (shift, shift, shift);
 107
 108   local $SIG{HUP} = 'IGNORE';
 109   local $SIG{INT} = 'IGNORE';
 110   local $SIG{QUIT} = 'IGNORE';
 111   local $SIG{TERM} = 'IGNORE';
 112   local $SIG{TSTP} = 'IGNORE';
 113   local $SIG{PIPE} = 'IGNORE';
 114
 115   my $oldAutoCommit = $FS::UID::AutoCommit;
 116   local $FS::UID::AutoCommit = 0;
 117   my $dbh = dbh;
 118
 119   my $jobnum = '';
 120   if ( $self->export_username($old) ne $self->export_username($new) ) {
 121     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
 122       $self->export_username($new), $self->export_username($old) );
 123     unless ( ref($err_or_queue) ) {
 124       $dbh->rollback if $oldAutoCommit;
 125       return $err_or_queue;
 126     }
 127     $jobnum = $err_or_queue->jobnum;
 128   }
 129
 130   foreach my $table (qw(reply check)) {
 131     my $method = "radius_$table";
 132     my %new = $new->$method();
 133     my %old = $old->$method();
 134     if ( grep { !exists $old{$_} #new attributes
 135                 || $new{$_} ne $old{$_} #changed
 136               } keys %new
 137     ) {
 138       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
 139         $table, $self->export_username($new), %new );
 140       unless ( ref($err_or_queue) ) {
 141         $dbh->rollback if $oldAutoCommit;
 142         return $err_or_queue;
 143       }
 144       if ( $jobnum ) {
 145         my $error = $err_or_queue->depend_insert( $jobnum );
 146         if ( $error ) {
 147           $dbh->rollback if $oldAutoCommit;
 148           return $error;
 149         }
 150       }
 151     }
 152
 153     my @del = grep { !exists $new{$_} } keys %old;
 154     if ( @del ) {
 155       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
 156         $table, $self->export_username($new), @del );
 157       unless ( ref($err_or_queue) ) {
 158         $dbh->rollback if $oldAutoCommit;
 159         return $err_or_queue;
 160       }
 161       if ( $jobnum ) {
 162         my $error = $err_or_queue->depend_insert( $jobnum );
 163         if ( $error ) {
 164           $dbh->rollback if $oldAutoCommit;
 165           return $error;
 166         }
 167       }
 168     }
 169   }
 170
 171   # (sorta) false laziness with FS::svc_acct::replace
 172   my @oldgroups = @{$old->usergroup}; #uuuh
 173   my @newgroups = $new->radius_groups;
 174   my @delgroups = ();
 175   foreach my $oldgroup ( @oldgroups ) {
 176     if ( grep { $oldgroup eq $_ } @newgroups ) {
 177       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 178       next;
 179     }
 180     push @delgroups, $oldgroup;
 181   }
 182
 183   if ( @delgroups ) {
 184     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete',
 185       $self->export_username($new), @delgroups );
 186     unless ( ref($err_or_queue) ) {
 187       $dbh->rollback if $oldAutoCommit;
 188       return $err_or_queue;
 189     }
 190     if ( $jobnum ) {
 191       my $error = $err_or_queue->depend_insert( $jobnum );
 192       if ( $error ) {
 193         $dbh->rollback if $oldAutoCommit;
 194         return $error;
 195       }
 196     }
 197   }
 198
 199   if ( @newgroups ) {
 200     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert',
 201       $self->export_username($new), @newgroups );
 202     unless ( ref($err_or_queue) ) {
 203       $dbh->rollback if $oldAutoCommit;
 204       return $err_or_queue;
 205     }
 206     if ( $jobnum ) {
 207       my $error = $err_or_queue->depend_insert( $jobnum );
 208       if ( $error ) {
 209         $dbh->rollback if $oldAutoCommit;
 210         return $error;
 211       }
 212     }
 213   }
 214
 215   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 216
 217   '';
 218 }
 219
 220 sub _export_delete {
 221   my( $self, $svc_acct ) = (shift, shift);
 222   my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete',
 223     $self->export_username($svc_acct) );
 224   ref($err_or_queue) ? '' : $err_or_queue;
 225 }
 226
 227 sub sqlradius_queue {
 228   my( $self, $svcnum, $method ) = (shift, shift, shift);
 229   my $queue = new FS::queue {
 230     'svcnum' => $svcnum,
 231     'job'    => "FS::part_export::sqlradius::sqlradius_$method",
 232   };
 233   $queue->insert(
 234     $self->option('datasrc'),
 235     $self->option('username'),
 236     $self->option('password'),
 237     @_,
 238   ) or $queue;
 239 }
 240
 241 sub sqlradius_insert { #subroutine, not method
 242   my $dbh = sqlradius_connect(shift, shift, shift);
 243   my( $table, $username, %attributes ) = @_;
 244
 245   foreach my $attribute ( keys %attributes ) {
 246
 247     my $s_sth = $dbh->prepare(
 248       "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
 249     ) or die $dbh->errstr;
 250     $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
 251
 252     if ( $s_sth->fetchrow_arrayref->[0] ) {
 253
 254       my $u_sth = $dbh->prepare(
 255         "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
 256       ) or die $dbh->errstr;
 257       $u_sth->execute($attributes{$attribute}, $username, $attribute)
 258         or die $u_sth->errstr;
 259
 260     } else {
 261
 262       my $i_sth = $dbh->prepare(
 263         "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
 264           "VALUES ( ?, ?, ?, ? )"
 265       ) or die $dbh->errstr;
 266       $i_sth->execute(
 267         $username,
 268         $attribute,
 269         ( $attribute =~ /Password/i ? '==' : ':=' ),
 270         $attributes{$attribute},
 271       ) or die $i_sth->errstr;
 272
 273     }
 274
 275   }
 276   $dbh->disconnect;
 277 }
 278
 279 sub sqlradius_usergroup_insert { #subroutine, not method
 280   my $dbh = sqlradius_connect(shift, shift, shift);
 281   my( $username, @groups ) = @_;
 282
 283   my $sth = $dbh->prepare(
 284     "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
 285   ) or die $dbh->errstr;
 286   foreach my $group ( @groups ) {
 287     $sth->execute( $username, $group )
 288       or die "can't insert into groupname table: ". $sth->errstr;
 289   }
 290   $dbh->disconnect;
 291 }
 292
 293 sub sqlradius_usergroup_delete { #subroutine, not method
 294   my $dbh = sqlradius_connect(shift, shift, shift);
 295   my( $username, @groups ) = @_;
 296
 297   my $sth = $dbh->prepare(
 298     "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?"
 299   ) or die $dbh->errstr;
 300   foreach my $group ( @groups ) {
 301     $sth->execute( $username, $group )
 302       or die "can't delete from groupname table: ". $sth->errstr;
 303   }
 304   $dbh->disconnect;
 305 }
 306
 307 sub sqlradius_rename { #subroutine, not method
 308   my $dbh = sqlradius_connect(shift, shift, shift);
 309   my($new_username, $old_username) = @_;
 310   foreach my $table (qw(radreply radcheck usergroup )) {
 311     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
 312       or die $dbh->errstr;
 313     $sth->execute($new_username, $old_username)
 314       or die "can't update $table: ". $sth->errstr;
 315   }
 316   $dbh->disconnect;
 317 }
 318
 319 sub sqlradius_attrib_delete { #subroutine, not method
 320   my $dbh = sqlradius_connect(shift, shift, shift);
 321   my( $table, $username, @attrib ) = @_;
 322
 323   foreach my $attribute ( @attrib ) {
 324     my $sth = $dbh->prepare(
 325         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
 326       or die $dbh->errstr;
 327     $sth->execute($username,$attribute)
 328       or die "can't delete from rad$table table: ". $sth->errstr;
 329   }
 330   $dbh->disconnect;
 331 }
 332
 333 sub sqlradius_delete { #subroutine, not method
 334   my $dbh = sqlradius_connect(shift, shift, shift);
 335   my $username = shift;
 336
 337   foreach my $table (qw( radcheck radreply usergroup )) {
 338     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 339     $sth->execute($username)
 340       or die "can't delete from $table table: ". $sth->errstr;
 341   }
 342   $dbh->disconnect;
 343 }
 344
 345 sub sqlradius_connect {
 346   #my($datasrc, $username, $password) = @_;
 347   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
 348   DBI->connect(@_) or die $DBI::errstr;
 349 }
 350
 351 #--
 352
 353 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
 354
 355 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 356 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 357 functions.
 358
 359 SVC_ACCT, if specified, limits the results to the specified account.
 360
 361 IP, if specified, limits the results to the specified IP address.
 362
 363 PREFIX, if specified, limits the results to records with a matching
 364 Called-Station-ID.
 365
 366 #SQL_SELECT defaults to * if unspecified.  It can be useful to set it to
 367 #SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
 368
 369 Returns an array of hash references
 370 Returns an arrayref of hashrefs with the following fields:
 371
 372 =over 4
 373
 374 =item username
 375
 376 =item framedipaddress
 377
 378 =item acctstarttime
 379
 380 =item acctstoptime
 381
 382 =item acctsessiontime
 383
 384 =item acctinputoctets
 385
 386 =item acctoutputoctets
 387
 388 =item calledstationid
 389
 390 =back
 391
 392 =cut
 393
 394 #some false laziness w/cust_svc::seconds_since_sqlradacct
 395
 396 sub usage_sessions {
 397   my( $self, $start, $end ) = splice(@_, 0, 3);
 398   my $svc_acct = @_ ? shift : '';
 399   my $ip = @_ ? shift : '';
 400   my $prefix = @_ ? shift : '';
 401   #my $select = @_ ? shift : '*';
 402
 403   $end ||= 2147483647;
 404
 405   return [] if $self->option('ignore_accounting');
 406
 407   my $dbh = sqlradius_connect( map $self->option($_),
 408                                    qw( datasrc username password ) );
 409
 410   #select a unix time conversion function based on database type
 411   my $str2time;
 412   if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
 413     $str2time = 'UNIX_TIMESTAMP(';
 414   } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
 415     $str2time = 'EXTRACT( EPOCH FROM ';
 416   } else {
 417     warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
 418          "; guessing how to convert to UNIX timestamps";
 419     $str2time = 'extract(epoch from ';
 420   }
 421
 422   my @fields = (
 423                  qw( username realm framedipaddress
 424                      acctsessiontime acctinputoctets acctoutputoctets
 425                      calledstationid
 426                    ),
 427                  "$str2time acctstarttime ) as acctstarttime",
 428                  "$str2time acctstoptime ) as acctstoptime",
 429                );
 430
 431   my @param = ();
 432   my $where = '';
 433
 434   if ( $svc_acct ) {
 435     my $username = $self->export_username($svc_acct);
 436     if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) {
 437       $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND';
 438       push @param, $username, $1, $2;
 439     } else {
 440       $where = 'UserName = ? AND';
 441       push @param, $username;
 442     }
 443   }
 444
 445   if ( length($ip) ) {
 446     $where .= ' FramedIPAddress = ? AND';
 447     push @param, $ip;
 448   }
 449
 450   if ( length($prefix) ) {
 451     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 452     $where .= " CalledStationID LIKE 'sip:$prefix\%' AND";
 453   }
 454
 455   push @param, $start, $end;
 456
 457   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 458                           "  FROM radacct
 459                              WHERE $where
 460                                    $str2time AcctStopTime ) >= ?
 461                                AND $str2time AcctStopTime ) <=  ?
 462                                ORDER BY AcctStartTime DESC
 463   ") or die $dbh->errstr;
 464   $sth->execute(@param) or die $sth->errstr;
 465
 466   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 467
 468 }
 469
 470 1;
 471