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