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