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 arrayref of hashrefs with the following fields:
 370
 371 =over 4
 372
 373 =item username
 374
 375 =item framedipaddress
 376
 377 =item acctstarttime
 378
 379 =item acctstoptime
 380
 381 =item acctsessiontime
 382
 383 =item acctinputoctets
 384
 385 =item acctoutputoctets
 386
 387 =item calledstationid
 388
 389 =back
 390
 391 =cut
 392
 393 #some false laziness w/cust_svc::seconds_since_sqlradacct
 394
 395 sub usage_sessions {
 396   my( $self, $start, $end ) = splice(@_, 0, 3);
 397   my $svc_acct = @_ ? shift : '';
 398   my $ip = @_ ? shift : '';
 399   my $prefix = @_ ? shift : '';
 400   #my $select = @_ ? shift : '*';
 401
 402   $end ||= 2147483647;
 403
 404   return [] if $self->option('ignore_accounting');
 405
 406   my $dbh = sqlradius_connect( map $self->option($_),
 407                                    qw( datasrc username password ) );
 408
 409   #select a unix time conversion function based on database type
 410   my $str2time;
 411   if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
 412     $str2time = 'UNIX_TIMESTAMP(';
 413   } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
 414     $str2time = 'EXTRACT( EPOCH FROM ';
 415   } else {
 416     warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
 417          "; guessing how to convert to UNIX timestamps";
 418     $str2time = 'extract(epoch from ';
 419   }
 420
 421   my @fields = (
 422                  qw( username realm framedipaddress
 423                      acctsessiontime acctinputoctets acctoutputoctets
 424                      calledstationid
 425                    ),
 426                  "$str2time acctstarttime ) as acctstarttime",
 427                  "$str2time acctstoptime ) as acctstoptime",
 428                );
 429
 430   my @param = ();
 431   my $where = '';
 432
 433   if ( $svc_acct ) {
 434     my $username = $self->export_username($svc_acct);
 435     if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) {
 436       $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND';
 437       push @param, $username, $1, $2;
 438     } else {
 439       $where = 'UserName = ? AND';
 440       push @param, $username;
 441     }
 442   }
 443
 444   if ( length($ip) ) {
 445     $where .= ' FramedIPAddress = ? AND';
 446     push @param, $ip;
 447   }
 448
 449   if ( length($prefix) ) {
 450     #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
 451     $where .= " CalledStationID LIKE 'sip:$prefix\%' AND";
 452   }
 453
 454   push @param, $start, $end;
 455
 456   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
 457                           "  FROM radacct
 458                              WHERE $where
 459                                    $str2time AcctStopTime ) >= ?
 460                                AND $str2time AcctStopTime ) <=  ?
 461                                ORDER BY AcctStartTime DESC
 462   ") or die $dbh->errstr;
 463   $sth->execute(@param) or die $sth->errstr;
 464
 465   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
 466
 467 }
 468
 469 1;
 470