FS/FS/part_export/sqlradius.pm

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