DMA Radius Manager export, #18456

3 files changed, 342 insertions, 0 deletions

diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index a6a1cda..6ad4b74 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -2688,6 +2688,8 @@ sub tables_hashref {
         'groupname',    'varchar', '', $char_d, '', '', 
         'description',  'varchar', 'NULL', $char_d, '', '', 
         'priority', 'int', '', '', '1', '',
+        'speed_up', 'int', 'NULL', '', '', '',
+        'speed_down', 'int', 'NULL', '', '', '',
       ],
       'primary_key' => 'groupnum',
       'unique'      => [ ['groupname'] ],
diff --git a/FS/FS/part_export/dma_radiusmanager.pm b/FS/FS/part_export/dma_radiusmanager.pm
new file mode 100644
index 0000000..ab77c46
--- /dev/null
+++ b/FS/FS/part_export/dma_radiusmanager.pm
@@ -0,0 +1,336 @@
+package FS::part_export::dma_radiusmanager;
+
+use strict;
+use vars qw($DEBUG %info %options);
+use base 'FS::part_export';
+use FS::part_svc;
+use FS::svc_acct;
+use FS::radius_group;
+use Tie::IxHash;
+use Digest::MD5 'md5_hex';
+
+tie %options, 'Tie::IxHash',
+  'dbname'    => { label=>'Database name', default=>'radius' },
+  'username'  => { label=>'Database username' },
+  'password'  => { label=>'Database password' },
+  'manager'   => { label=>'Manager name' },
+  'groupid'   => { label=>'Group ID', default=>'1' },
+  'service_prefix' => { label=>'Service name prefix' },
+  'nasnames'  => { label=>'NAS IDs/addresses' },
+  'debug'     => { label=>'Enable debugging', type=>'checkbox' },
+;
+
+%info = (
+  'svc'       => 'svc_acct',
+  'desc'      => 'Export to DMA Radius Manager',
+  'options'   => \%options,
+  'nodomain'  => 'Y',
+  'notes'     => '', #XXX
+);
+
+$DEBUG = 0;
+
+sub connect {
+  my $self = shift;
+  my $datasrc = 'dbi:mysql:host='.$self->machine.
+                ':database='.$self->option('dbname');
+  DBI->connect(
+    $datasrc,
+    $self->option('username'),
+    $self->option('password'),
+    { AutoCommit => 0 }
+  ) or die $DBI::errstr;
+}
+
+sub export_insert  { my $self = shift; $self->dma_rm_queue('insert', @_) }
+sub export_delete  { my $self = shift; $self->dma_rm_queue('delete', @_) }
+sub export_replace { my $self = shift; $self->dma_rm_queue('replace', @_) }
+sub export_suspend { my $self = shift; $self->dma_rm_queue('suspend', @_) }
+sub export_unsuspend { my $self = shift; $self->dma_rm_queue('unsuspend', @_) }
+
+sub dma_rm_queue {
+  my ($self, $action, $svc_acct, $old) = @_;
+
+  my $svcnum = $svc_acct->svcnum;
+
+  my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
+  my $cust_main = $cust_pkg->cust_main;
+  my $location = $cust_pkg->cust_location;
+
+  my %params = (
+    # for the remote side
+    username    => $svc_acct->username,
+    password    => md5_hex($svc_acct->_password),
+    groupid     => $self->option('groupid'),
+    enableuser  => 1,
+    firstname   => $cust_main->first,
+    lastname    => $cust_main->last,
+    company     => $cust_main->company,
+    phone       => ($cust_main->daytime || $cust_main->night),
+    mobile      => $cust_main->mobile,
+    address     => $location->address1, # address2?
+    city        => $location->city,
+    state       => $location->state,
+    zip         => $location->zip,
+    country     => $location->country,
+    gpslat      => $location->latitude,
+    gpslong     => $location->longitude,
+    comment     => 'svcnum'.$svcnum,
+    createdby   => $self->option('manager'),
+    owner       => $self->option('manager'),
+    email       => $cust_main->invoicing_list_emailonly_scalar,
+
+    # used internally by the export
+    exportnum   => $self->exportnum,
+    svcnum      => $svcnum,
+    action      => $action,
+    svcpart     => $svc_acct->cust_svc->svcpart,
+    _password   => $svc_acct->_password,
+  );
+  if ( $action eq 'replace' ) {
+    $params{'old_username'} = $old->username;
+    $params{'old_password'} = $old->_password;
+  }
+  my $queue = FS::queue->new({
+      'svcnum'  => $svcnum,
+      'job'     => "FS::part_export::dma_radiusmanager::dma_rm_action",
+  });
+  $queue->insert(%params);
+}
+
+sub dma_rm_action {
+  my %params = @_;
+  my $svcnum = delete $params{svcnum};
+  my $action = delete $params{action};
+  my $svcpart = delete $params{svcpart};
+  my $exportnum = delete $params{exportnum};
+
+  my $username = $params{username};
+  my $password = delete $params{_password};
+
+  my $self = FS::part_export->by_key($exportnum);
+  my $dbh = $self->connect;
+  local $DEBUG = 1 if $self->option('debug');
+
+  # export the part_svc if needed, and get its srvid
+  my $part_svc = FS::part_svc->by_key($svcpart);
+  my $srvid = $self->export_part_svc($part_svc, $dbh); # dies on error
+  $params{srvid} = $srvid;
+
+  if ( $action eq 'insert' ) {
+    warn "rm_users: inserting svcnum$svcnum\n" if $DEBUG;
+    my $sth = $dbh->prepare( 'INSERT INTO rm_users ( '.
+      join(', ', keys(%params)).
+      ') VALUES ('.
+      join(', ', ('?') x keys(%params)).
+      ')'
+    );
+    $sth->execute(values(%params)) or die $dbh->errstr;
+
+    # minor false laziness w/ sqlradius_insert
+    warn "radcheck: inserting $username\n" if $DEBUG;
+    $sth = $dbh->prepare( 'INSERT INTO radcheck (
+      username, attribute, op, value
+    ) VALUES (?, ?, ?, ?)' );
+    $sth->execute(
+      $username,
+      'Cleartext-Password',
+      ':=', # :=(
+      $password,
+    ) or die $dbh->errstr;
+
+    $sth->execute(
+      $username,
+      'Simultaneous-Use',
+      ':=',
+      1, # should this be an option?
+    ) or die $dbh->errstr;
+    # also, we don't support exporting any other radius attrs...
+    # those should go in 'custattr' if we need them
+  } elsif ( $action eq 'replace' ) {
+
+    my $old_username = delete $params{old_username};
+    my $old_password = delete $params{old_password};
+    # svcnum is invariant and on the remote side, so we don't need any 
+    # of the old fields to do this
+    warn "rm_users: updating svcnum$svcnum\n" if $DEBUG;
+    my $sth = $dbh->prepare( 'UPDATE rm_users SET '.
+      join(', ', map { "$_ = ?" } keys(%params)).
+      ' WHERE comment = ?'
+    );
+    $sth->execute(values(%params), $params{comment}) or die $dbh->errstr;
+    # except for username/password changes
+    if ( $old_password ne $password ) {
+      warn "radcheck: changing password for $old_username\n" if $DEBUG;
+      $sth = $dbh->prepare( 'UPDATE radcheck SET value = ? '.
+        'WHERE username = ? and attribute = \'Cleartext-Password\''
+      );
+      $sth->execute($password, $old_username) or die $dbh->errstr;
+    }
+    if ( $old_username ne $username ) {
+      warn "radcheck: changing username $old_username to $username\n"
+        if $DEBUG;
+      $sth = $dbh->prepare( 'UPDATE radcheck SET username = ? '.
+        'WHERE username = ?'
+      );
+      $sth->execute($username, $old_username) or die $dbh->errstr;
+    }
+
+  } elsif ( $action eq 'suspend' ) {
+
+    # this is sufficient
+    warn "rm_users: disabling svcnum#$svcnum\n" if $DEBUG;
+    my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 0 '.
+      'WHERE comment = ?'
+    );
+    $sth->execute($params{comment}) or die $dbh->errstr;
+
+  } elsif ( $action eq 'unsuspend' ) {
+
+    warn "rm_users: enabling svcnum#$svcnum\n" if $DEBUG;
+    my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 1 '.
+      'WHERE comment = ?'
+    );
+    $sth->execute($params{comment}) or die $dbh->errstr;
+
+  } elsif ( $action eq 'delete' ) {
+
+    warn "rm_users: deleting svcnum#$svcnum\n" if $DEBUG;
+    my $sth = $dbh->prepare( 'DELETE FROM rm_users WHERE comment = ?' );
+    $sth->execute($params{comment}) or die $dbh->errstr;
+
+    warn "radcheck: deleting $username\n" if $DEBUG;
+    $sth = $dbh->prepare( 'DELETE FROM radcheck WHERE username = ?' );
+    $sth->execute($username) or die $dbh->errstr;
+
+    # if this were smarter it would also delete the rm_services record
+    # if it was no longer in use, but that's not really necessary
+  }
+
+  $dbh->commit;
+  '';
+}
+
+=item export_part_svc PART_SVC DBH
+
+Query Radius Manager for a service definition matching the name of 
+PART_SVC (optionally with a prefix defined in the export options).  
+If there is one, update it to match the attributes of PART_SVC; if 
+not, create one.  Then return its srvid.
+
+=cut
+
+sub export_part_svc {
+  my ($self, $part_svc, $dbh) = @_;
+
+  my $name = $self->option('service_prefix').$part_svc->svc;
+
+  my %params = (
+    'srvname'         => $name,
+    'enableservice'   => 1,
+    'nextsrvid'       => -1,
+    'dailynextsrvid'  => -1,
+  );
+  my @fixed_groups;
+  # use speed settings from fixed usergroups configured on this part_svc
+  if ( my $psc = $part_svc->part_svc_column('usergroup') ) {
+    if ( $psc->columnflag eq 'F' )  {
+      # each part_svc really should only have one fixed group with non-null 
+      # speed settings, but go by priority order for consistency
+      @fixed_groups = 
+        sort { $a->priority <=> $b->priority }
+        grep { $_ }
+        map { FS::radius_group->by_key($_) }
+        split(/\s*,\s*/, $psc->columnvalue);
+    }
+  } # otherwise there are no fixed groups, so leave speed empty
+
+  foreach (qw(down up)) {
+    my $speed = "speed_$_";
+    foreach my $group (@fixed_groups) {
+      if ( ($group->$speed || 0) > 0 ) {
+        $params{$_.'rate'} = $group->$speed;
+        last;
+      }
+    }
+  }
+  # anything else we need here? poolname, maybe?
+
+  warn "rm_services: looking for '$name'\n" if $DEBUG;
+  my $sth = $dbh->prepare( 
+    'SELECT srvid FROM rm_services WHERE srvname = ? AND enableservice = 1'
+  );
+  $sth->execute($name) or die $dbh->errstr;
+  if ( $sth->rows > 1 ) {
+    die "Multiple services with name '$name' found in Radius Manager.\n";
+  } elsif ( $sth->rows == 1 ) {
+    my $row = $sth->fetchrow_arrayref;
+    my $srvid = $row->[0];
+    warn "rm_services: updating srvid#$srvid\n" if $DEBUG;
+    $sth = $dbh->prepare(
+      'UPDATE rm_services SET '.join(', ', map {"$_ = ?"} keys %params) .
+      ' WHERE srvid = ?'
+    );
+    $sth->execute(values(%params), $srvid) or die $dbh->errstr;
+    return $srvid;
+  } else { # $sth->rows == 0
+    # create a new one
+    # but first... get the next available srvid
+    $sth = $dbh->prepare('SELECT MAX(srvid) FROM rm_services');
+    $sth->execute or die $dbh->errstr;
+    my $srvid = 1; # just in case you somehow have nothing in your database
+    if ( $sth->rows ) {
+      $srvid = $sth->fetchrow_arrayref->[0] + 1;
+    }
+    $params{'srvid'} = $srvid;
+    # NOW create a new one
+    warn "rm_services: inserting '$name' as srvid#$srvid\n" if $DEBUG;
+    $sth = $dbh->prepare(
+      'INSERT INTO rm_services ('.join(', ', keys %params).
+      ') VALUES ('.join(', ', map {'?'} keys %params).')'
+    );
+    $sth->execute(values(%params)) or die $dbh->errstr;
+    # also link it to our manager name
+    warn "rm_services: linking to manager\n" if $DEBUG;
+    $sth = $dbh->prepare(
+      'INSERT INTO rm_allowedmanagers (srvid, managername) VALUES (?, ?)'
+    );
+    $sth->execute($srvid, $self->option('manager')) or die $dbh->errstr;
+    # and allow it on our NAS
+    $sth = $dbh->prepare(
+      'INSERT INTO rm_allowednases (srvid, nasid) VALUES (?, ?)'
+    );
+    foreach my $nasid ($self->nas_ids($dbh)) {
+      warn "rm_services: linking to nasid#$nasid\n" if $DEBUG;
+      $sth->execute($srvid, $nasid) or die $dbh->errstr;
+    }
+    return $srvid;
+  }
+}
+
+=item nas_ids DBH
+
+Convert the 'nasnames  option into a list of real NAS ids.
+
+=cut
+
+sub nas_ids {
+  my $self = shift;
+  my $dbh = shift;
+
+  my @nasnames = split(/\s*,\s*/, $self->option('nasnames'));
+  return unless @nasnames;
+  # pass these through unchanged
+  my @ids = grep { /^\d+$/ } @nasnames;
+  @nasnames = grep { not /^\d+$/ } @nasnames;
+  my $in_nasnames = join(',', map {$dbh->quote($_)} @nasnames);
+
+  my $sth = $dbh->prepare("SELECT id FROM nas WHERE nasname IN ($in_nasnames)");
+  $sth->execute or die $dbh->errstr;
+  my $rows = $sth->fetchall_arrayref;
+  push @ids, $_->[0] foreach @$rows;
+
+  return @ids;
+}
+
+1;
diff --git a/FS/FS/radius_group.pm b/FS/FS/radius_group.pm
index 37aa0f3..f1a4efe 100644
--- a/FS/FS/radius_group.pm
+++ b/FS/FS/radius_group.pm
@@ -47,6 +47,8 @@ description
 
 priority - for export
 
+=item speed_up, speed_down - connection speeds in bits per second.  Some 
+exports may use this to generate appropriate RADIUS attributes.
 
 =back
 
@@ -176,6 +178,8 @@ sub check {
     || $self->ut_text('groupname')
     || $self->ut_textn('description')
     || $self->ut_numbern('priority')
+    || $self->ut_numbern('speed_up')
+    || $self->ut_numbern('speed_down')
   ;
   return $error if $error;