FS/FS/part_export/aradial.pm

   1 package FS::part_export::aradial;
   2
   3 use base qw( FS::part_export );
   4 use LWP::UserAgent;
   5 use HTTP::Request;
   6 use Tie::IxHash;
   7 use XML::LibXML;
   8 use URI;
   9 use Date::Format 'time2str';
  10 use Data::Dumper;
  11 use vars qw( %options %info $me $DEBUG );
  12 use strict;
  13
  14 $me = '[FS::part_export::aradial]';
  15 $DEBUG = 2;
  16
  17 tie %options, 'Tie::IxHash',
  18   'port'  => { label => 'HTTP port', default => 8000 },
  19   'login' => { label => 'Admin username' },
  20   'pass'  => { label => 'Admin password' },
  21   'realm' => { label => 'Admin authentication realm' },
  22   'group' => { label => 'Group name' },
  23 ;
  24
  25 %info = (
  26   'svc'       => 'svc_acct',
  27   'desc'      => 'Export accounts to Aradial RADIUS HTTP interface',
  28   'options'   => \%options,
  29   'nodomain'  => 'Y',
  30   'notes'     => '
  31 <p>This export maintains user accounts on an Aradial Technologies access
  32 control server, via the HTTP interface.  The export hostname and the
  33 <i>HTTP port</i> option determine the location of the server.</p>
  34 <p><i>Admin username, password, authentication realm</i> are the settings
  35 for the HTTP interface, set in the "Admin Web Interface Security" options
  36 for your Aradial server.</p>
  37 <p><i>Group name</i> is the user group to assign to new users, and must
  38 already exist on the Aradial server.  Currently this export will assign
  39 all users to a single group; if you want multiple groups for different
  40 service types, create another export instance.</p>
  41 '
  42 );
  43
  44 sub _export_insert {
  45   my ($self, $svc) = @_;
  46   my $result = $self->request_user_edit(
  47     'Add'   => 1,
  48     $self->svc_acct_params($svc),
  49     'db_$N$Users.Status' => 0,
  50   );
  51   if ($svc->cust_svc->cust_pkg->susp > 0 ) {
  52     $result ||= $self->export_suspend($svc);
  53   }
  54   $result;
  55 }
  56
  57 sub _export_replace {
  58   my ($self, $new, $old) = @_;
  59   if ($new->email ne $old->email) {
  60     return $old->export_delete || $new->export_insert;
  61   }
  62   my $Status = 0;
  63   $Status = 3 if $new->cust_svc->cust_pkg->susp > 0;
  64   $self->request_user_edit(
  65     'Page'    => 'UserEdit',
  66     'Modify'  => 1,
  67     'UserID'  => $old->email,
  68     $self->svc_acct_params($new),
  69     'db_$N$Users.Status' => $Status,
  70   );
  71 }
  72
  73 sub _export_suspend {
  74   my ($self, $svc) = @_;
  75   $self->request_user_edit(
  76     'Modify'  => 1,
  77     'UserID'  => $svc->email,
  78     'db_$N$Users.Status' => '3',
  79   );
  80 }
  81
  82 sub _export_unsuspend {
  83   my ($self, $svc) = @_;
  84   $self->request_user_edit(
  85     'Modify'  => 1,
  86     'UserID'  => $svc->email,
  87     'db_$N$Users.Status' => 0,
  88   );
  89 }
  90
  91 sub _export_delete {
  92   my ($self, $svc) = @_;
  93   $self->request_user_edit(
  94     'ConfirmDelete' => 1,
  95     ('$Checked$' . $svc->email) => 1,
  96   );
  97 }
  98
  99 # Send a request to the 'UserEdit' interface, and process the response into
 100 # an error string (empty on success, per Freeside convention).
 101
 102 sub request_user_edit {
 103   my ($self, @params) = @_;
 104   my $result = eval { $self->request( Page => 'UserEdit', @params ) };
 105   return $result unless ref($result);
 106   my $status = $result->findvalue('Result/Status/@value'); # XPath
 107   if ($status eq 'Success') {
 108     return '';
 109   } else {
 110     my $error = $result->findvalue('Result/Reason/@value')
 111                 || 'unknown error';
 112     return "updating Aradial user database: $error";
 113   }
 114 }
 115
 116 # Send a request to any interface, parse the response (from XML), and
 117 # return it (as an XML::LibXML::Document).  Returns a string if there's an
 118 # HTTP error.
 119
 120 sub request {
 121   my $self = shift;
 122   my @params = @_;
 123   my $path = '/ArdWeb/ARDAdminIs.dll'; # I think this is always right
 124   my $url = URI->new('http://' . $self->host . $path);
 125   warn "$me request: \n".Dumper(\@params)."\n\n" if $DEBUG >= 2;
 126   my $response = $self->ua->post($url, \@params);
 127   if ( $response->is_success ) {
 128     my $content = $response->decoded_content;
 129     warn "$me response: \n$content\n\n" if $DEBUG >= 2;
 130     return $self->parser->parse_string($content);
 131     # the formats of these are _variable_.
 132     # Some of them have a <Result><Status value="Success"><Entity ... >
 133     # kind of structure, but not all.  They do all seem to be XML, though.
 134   } else {
 135     return "API request error: ".$response->status_line;
 136   }
 137 }
 138
 139 sub svc_acct_params {
 140   my $self = shift;
 141   my $svc = shift;
 142   my $pkg = $svc->cust_svc->cust_pkg;
 143   my $cust = $pkg->cust_main;
 144   my $location = $pkg->cust_location;
 145   # should we use the package contact's name/phone here?
 146
 147   my $setup_date = time2str('D%Y-%m-%d',
 148     ($pkg->setup || $pkg->start_date || time)
 149   );
 150   my $expire_date = $pkg->expire ? time2str('D%Y-%m-%d', $pkg->expire) : '';
 151
 152   (
 153     'db_Users.UserID'               => $svc->email,
 154     $self->password_params($svc),
 155     'db_$D$Users.StartDate'         => $setup_date,
 156     'db_$D$Users.UserExpiryDate'    => $expire_date,
 157     'db_$RS$Users.GroupName'        => $self->option('group'),
 158     'db_$I$Users.UserIP'            => $svc->slipip,
 159     'db_UserDetails.FirstName'      => $cust->first,
 160     'db_UserDetails.LastName'       => $cust->last,
 161     'db_UserDetails.Company'        => $cust->company,
 162     'db_UserDetails.Email'          => $cust->invoicing_list_emailonly_scalar,
 163     'db_UserDetails.Address1'       => $location->address1,
 164     'db_UserDetails.Address2'       => $location->address2,
 165     'db_UserDetails.City'           => $location->city,
 166     'db_%GS%UserDetails.State'      => $location->state,
 167     'db_%GS%UserDetails.Country'    => $location->country,
 168     'db_UserDetails.Zip'            => $location->zip,
 169     'db_UserDetails.PhoneHome'      => ($cust->daytime || $cust->night || $cust->mobile),
 170     'db_UserDetails.PhoneFax'       => $cust->fax,
 171   );
 172 }
 173
 174 sub password_params {
 175   my ($self, $svc) = @_;
 176
 177   my $password_encryption = 0;
 178   my $password = $svc->_password;
 179   if ($svc->_password_encoding eq 'crypt') {
 180     if ($svc->_password_encryption eq 'des') {
 181       $password_encryption = 2;
 182     } elsif ( $svc->_password_encryption eq 'md5') {
 183       $password_encryption = 5;
 184     }
 185   } elsif ( $svc->_password_encoding eq 'ldap' ) {
 186     $svc->_password =~ /^\{([\w-]+)\}(.*)$/;
 187     $password = $2;
 188     if ($1 eq 'MD5') {
 189       $password_encryption = 7;
 190     } elsif ($1 eq 'SHA' or $1 eq 'SHA-1') {
 191       $password_encryption = 1;
 192     }
 193   }
 194   ( Password => $password,
 195     PasswordEncryptionType => $password_encryption
 196   );
 197 }
 198
 199 # return the XML parser
 200 sub parser {
 201   my $self = shift;
 202   $self->{_parser} ||= XML::LibXML->new;
 203 }
 204
 205 # return hostname:port
 206 sub host {
 207   my $self = shift;
 208   $self->machine . ':' . $self->option('port');
 209 }
 210
 211 # return the LWP::UserAgent object
 212 sub ua {
 213   my $self = shift;
 214   $self->{_ua} ||= do {
 215     my $ua = LWP::UserAgent->new;
 216     $ua->credentials(
 217       $self->host,
 218       $self->option('realm'),
 219       $self->option('login'),
 220       $self->option('pass')
 221     );
 222     $ua;
 223   }
 224 }
 225
 226 1;