FS/FS/part_export/dma_radiusmanager.pm

   1 package FS::part_export::dma_radiusmanager;
   2
   3 use strict;
   4 use vars qw($DEBUG %info %options);
   5 use base 'FS::part_export';
   6 use FS::part_svc;
   7 use FS::svc_acct;
   8 use FS::radius_group;
   9 use Tie::IxHash;
  10 use Digest::MD5 'md5_hex';
  11
  12 tie %options, 'Tie::IxHash',
  13   'dbname'    => { label=>'Database name', default=>'radius' },
  14   'username'  => { label=>'Database username' },
  15   'password'  => { label=>'Database password' },
  16   'manager'   => { label=>'Manager name' },
  17   'groupid'   => { label=>'Group ID', default=>'1' },
  18   'service_prefix' => { label=>'Service name prefix' },
  19   'nasnames'  => { label=>'NAS IDs/addresses' },
  20   'debug'     => { label=>'Enable debugging', type=>'checkbox' },
  21 ;
  22
  23 %info = (
  24   'svc'       => 'svc_acct',
  25   'desc'      => 'Export to DMA Radius Manager',
  26   'options'   => \%options,
  27   'nodomain'  => 'Y',
  28   'notes'     => '', #XXX
  29 );
  30
  31 $DEBUG = 0;
  32
  33 sub connect {
  34   my $self = shift;
  35   my $datasrc = 'dbi:mysql:host='.$self->machine.
  36                 ':database='.$self->option('dbname');
  37   DBI->connect(
  38     $datasrc,
  39     $self->option('username'),
  40     $self->option('password'),
  41     { AutoCommit => 0 }
  42   ) or die $DBI::errstr;
  43 }
  44
  45 sub export_insert  { my $self = shift; $self->dma_rm_queue('insert', @_) }
  46 sub export_delete  { my $self = shift; $self->dma_rm_queue('delete', @_) }
  47 sub export_replace { my $self = shift; $self->dma_rm_queue('replace', @_) }
  48 sub export_suspend { my $self = shift; $self->dma_rm_queue('suspend', @_) }
  49 sub export_unsuspend { my $self = shift; $self->dma_rm_queue('unsuspend', @_) }
  50
  51 sub dma_rm_queue {
  52   my ($self, $action, $svc_acct, $old) = @_;
  53
  54   my $svcnum = $svc_acct->svcnum;
  55
  56   my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
  57   my $cust_main = $cust_pkg->cust_main;
  58   my $location = $cust_pkg->cust_location;
  59
  60   my %params = (
  61     # for the remote side
  62     username    => $svc_acct->username,
  63     password    => md5_hex($svc_acct->_password),
  64     groupid     => $self->option('groupid'),
  65     enableuser  => 1,
  66     firstname   => $cust_main->first,
  67     lastname    => $cust_main->last,
  68     company     => $cust_main->company,
  69     phone       => ($cust_main->daytime || $cust_main->night),
  70     mobile      => $cust_main->mobile,
  71     address     => $location->address1, # address2?
  72     city        => $location->city,
  73     state       => $location->state,
  74     zip         => $location->zip,
  75     country     => $location->country,
  76     gpslat      => $location->latitude,
  77     gpslong     => $location->longitude,
  78     comment     => 'svcnum'.$svcnum,
  79     createdby   => $self->option('manager'),
  80     owner       => $self->option('manager'),
  81     email       => $cust_main->invoicing_list_emailonly_scalar,
  82
  83     # used internally by the export
  84     exportnum   => $self->exportnum,
  85     svcnum      => $svcnum,
  86     action      => $action,
  87     svcpart     => $svc_acct->cust_svc->svcpart,
  88     _password   => $svc_acct->_password,
  89   );
  90   if ( $action eq 'replace' ) {
  91     $params{'old_username'} = $old->username;
  92     $params{'old_password'} = $old->_password;
  93   }
  94   my $queue = FS::queue->new({
  95       'svcnum'  => $svcnum,
  96       'job'     => "FS::part_export::dma_radiusmanager::dma_rm_action",
  97   });
  98   $queue->insert(%params);
  99 }
 100
 101 sub dma_rm_action {
 102   my %params = @_;
 103   my $svcnum = delete $params{svcnum};
 104   my $action = delete $params{action};
 105   my $svcpart = delete $params{svcpart};
 106   my $exportnum = delete $params{exportnum};
 107
 108   my $username = $params{username};
 109   my $password = delete $params{_password};
 110
 111   my $self = FS::part_export->by_key($exportnum);
 112   my $dbh = $self->connect;
 113   local $DEBUG = 1 if $self->option('debug');
 114
 115   # export the part_svc if needed, and get its srvid
 116   my $part_svc = FS::part_svc->by_key($svcpart);
 117   my $srvid = $self->export_part_svc($part_svc, $dbh); # dies on error
 118   $params{srvid} = $srvid;
 119
 120   if ( $action eq 'insert' ) {
 121     warn "rm_users: inserting svcnum$svcnum\n" if $DEBUG;
 122     my $sth = $dbh->prepare( 'INSERT INTO rm_users ( '.
 123       join(', ', keys(%params)).
 124       ') VALUES ('.
 125       join(', ', ('?') x keys(%params)).
 126       ')'
 127     );
 128     $sth->execute(values(%params)) or die $dbh->errstr;
 129
 130     # minor false laziness w/ sqlradius_insert
 131     warn "radcheck: inserting $username\n" if $DEBUG;
 132     $sth = $dbh->prepare( 'INSERT INTO radcheck (
 133       username, attribute, op, value
 134     ) VALUES (?, ?, ?, ?)' );
 135     $sth->execute(
 136       $username,
 137       'Cleartext-Password',
 138       ':=', # :=(
 139       $password,
 140     ) or die $dbh->errstr;
 141
 142     $sth->execute(
 143       $username,
 144       'Simultaneous-Use',
 145       ':=',
 146       1, # should this be an option?
 147     ) or die $dbh->errstr;
 148     # also, we don't support exporting any other radius attrs...
 149     # those should go in 'custattr' if we need them
 150   } elsif ( $action eq 'replace' ) {
 151
 152     my $old_username = delete $params{old_username};
 153     my $old_password = delete $params{old_password};
 154     # svcnum is invariant and on the remote side, so we don't need any
 155     # of the old fields to do this
 156     warn "rm_users: updating svcnum$svcnum\n" if $DEBUG;
 157     my $sth = $dbh->prepare( 'UPDATE rm_users SET '.
 158       join(', ', map { "$_ = ?" } keys(%params)).
 159       ' WHERE comment = ?'
 160     );
 161     $sth->execute(values(%params), $params{comment}) or die $dbh->errstr;
 162     # except for username/password changes
 163     if ( $old_password ne $password ) {
 164       warn "radcheck: changing password for $old_username\n" if $DEBUG;
 165       $sth = $dbh->prepare( 'UPDATE radcheck SET value = ? '.
 166         'WHERE username = ? and attribute = \'Cleartext-Password\''
 167       );
 168       $sth->execute($password, $old_username) or die $dbh->errstr;
 169     }
 170     if ( $old_username ne $username ) {
 171       warn "radcheck: changing username $old_username to $username\n"
 172         if $DEBUG;
 173       $sth = $dbh->prepare( 'UPDATE radcheck SET username = ? '.
 174         'WHERE username = ?'
 175       );
 176       $sth->execute($username, $old_username) or die $dbh->errstr;
 177     }
 178
 179   } elsif ( $action eq 'suspend' ) {
 180
 181     # this is sufficient
 182     warn "rm_users: disabling svcnum#$svcnum\n" if $DEBUG;
 183     my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 0 '.
 184       'WHERE comment = ?'
 185     );
 186     $sth->execute($params{comment}) or die $dbh->errstr;
 187
 188   } elsif ( $action eq 'unsuspend' ) {
 189
 190     warn "rm_users: enabling svcnum#$svcnum\n" if $DEBUG;
 191     my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 1 '.
 192       'WHERE comment = ?'
 193     );
 194     $sth->execute($params{comment}) or die $dbh->errstr;
 195
 196   } elsif ( $action eq 'delete' ) {
 197
 198     warn "rm_users: deleting svcnum#$svcnum\n" if $DEBUG;
 199     my $sth = $dbh->prepare( 'DELETE FROM rm_users WHERE comment = ?' );
 200     $sth->execute($params{comment}) or die $dbh->errstr;
 201
 202     warn "radcheck: deleting $username\n" if $DEBUG;
 203     $sth = $dbh->prepare( 'DELETE FROM radcheck WHERE username = ?' );
 204     $sth->execute($username) or die $dbh->errstr;
 205
 206     # if this were smarter it would also delete the rm_services record
 207     # if it was no longer in use, but that's not really necessary
 208   }
 209
 210   $dbh->commit;
 211   '';
 212 }
 213
 214 =item export_part_svc PART_SVC DBH
 215
 216 Query Radius Manager for a service definition matching the name of
 217 PART_SVC (optionally with a prefix defined in the export options).
 218 If there is one, update it to match the attributes of PART_SVC; if
 219 not, create one.  Then return its srvid.
 220
 221 =cut
 222
 223 sub export_part_svc {
 224   my ($self, $part_svc, $dbh) = @_;
 225
 226   my $name = $self->option('service_prefix').$part_svc->svc;
 227
 228   my %params = (
 229     'srvname'         => $name,
 230     'enableservice'   => 1,
 231     'nextsrvid'       => -1,
 232     'dailynextsrvid'  => -1,
 233   );
 234   my @fixed_groups;
 235   # use speed settings from fixed usergroups configured on this part_svc
 236   if ( my $psc = $part_svc->part_svc_column('usergroup') ) {
 237     if ( $psc->columnflag eq 'F' )  {
 238       # each part_svc really should only have one fixed group with non-null
 239       # speed settings, but go by priority order for consistency
 240       @fixed_groups =
 241         sort { $a->priority <=> $b->priority }
 242         grep { $_ }
 243         map { FS::radius_group->by_key($_) }
 244         split(/\s*,\s*/, $psc->columnvalue);
 245     }
 246   } # otherwise there are no fixed groups, so leave speed empty
 247
 248   foreach (qw(down up)) {
 249     my $speed = "speed_$_";
 250     foreach my $group (@fixed_groups) {
 251       if ( ($group->$speed || 0) > 0 ) {
 252         $params{$_.'rate'} = $group->$speed;
 253         last;
 254       }
 255     }
 256   }
 257   # anything else we need here? poolname, maybe?
 258
 259   warn "rm_services: looking for '$name'\n" if $DEBUG;
 260   my $sth = $dbh->prepare(
 261     'SELECT srvid FROM rm_services WHERE srvname = ? AND enableservice = 1'
 262   );
 263   $sth->execute($name) or die $dbh->errstr;
 264   if ( $sth->rows > 1 ) {
 265     die "Multiple services with name '$name' found in Radius Manager.\n";
 266   } elsif ( $sth->rows == 1 ) {
 267     my $row = $sth->fetchrow_arrayref;
 268     my $srvid = $row->[0];
 269     warn "rm_services: updating srvid#$srvid\n" if $DEBUG;
 270     $sth = $dbh->prepare(
 271       'UPDATE rm_services SET '.join(', ', map {"$_ = ?"} keys %params) .
 272       ' WHERE srvid = ?'
 273     );
 274     $sth->execute(values(%params), $srvid) or die $dbh->errstr;
 275     return $srvid;
 276   } else { # $sth->rows == 0
 277     # create a new one
 278     # but first... get the next available srvid
 279     $sth = $dbh->prepare('SELECT MAX(srvid) FROM rm_services');
 280     $sth->execute or die $dbh->errstr;
 281     my $srvid = 1; # just in case you somehow have nothing in your database
 282     if ( $sth->rows ) {
 283       $srvid = $sth->fetchrow_arrayref->[0] + 1;
 284     }
 285     $params{'srvid'} = $srvid;
 286     # NOW create a new one
 287     warn "rm_services: inserting '$name' as srvid#$srvid\n" if $DEBUG;
 288     $sth = $dbh->prepare(
 289       'INSERT INTO rm_services ('.join(', ', keys %params).
 290       ') VALUES ('.join(', ', map {'?'} keys %params).')'
 291     );
 292     $sth->execute(values(%params)) or die $dbh->errstr;
 293     # also link it to our manager name
 294     warn "rm_services: linking to manager\n" if $DEBUG;
 295     $sth = $dbh->prepare(
 296       'INSERT INTO rm_allowedmanagers (srvid, managername) VALUES (?, ?)'
 297     );
 298     $sth->execute($srvid, $self->option('manager')) or die $dbh->errstr;
 299     # and allow it on our NAS
 300     $sth = $dbh->prepare(
 301       'INSERT INTO rm_allowednases (srvid, nasid) VALUES (?, ?)'
 302     );
 303     foreach my $nasid ($self->nas_ids($dbh)) {
 304       warn "rm_services: linking to nasid#$nasid\n" if $DEBUG;
 305       $sth->execute($srvid, $nasid) or die $dbh->errstr;
 306     }
 307     return $srvid;
 308   }
 309 }
 310
 311 =item nas_ids DBH
 312
 313 Convert the 'nasnames  option into a list of real NAS ids.
 314
 315 =cut
 316
 317 sub nas_ids {
 318   my $self = shift;
 319   my $dbh = shift;
 320
 321   my @nasnames = split(/\s*,\s*/, $self->option('nasnames'));
 322   return unless @nasnames;
 323   # pass these through unchanged
 324   my @ids = grep { /^\d+$/ } @nasnames;
 325   @nasnames = grep { not /^\d+$/ } @nasnames;
 326   my $in_nasnames = join(',', map {$dbh->quote($_)} @nasnames);
 327
 328   my $sth = $dbh->prepare("SELECT id FROM nas WHERE nasname IN ($in_nasnames)");
 329   $sth->execute or die $dbh->errstr;
 330   my $rows = $sth->fetchall_arrayref;
 331   push @ids, $_->[0] foreach @$rows;
 332
 333   return @ids;
 334 }
 335
 336 1;