Merge branch 'FREESIDE_3_BRANCH' of git.freeside.biz:/home/git/freeside into FREESIDE_3_BRANCH

2 files changed, 495 insertions, 0 deletions

diff --git a/FS/FS/part_export/aradial.pm b/FS/FS/part_export/aradial.pm
new file mode 100644
index 000000000..f3de614b1
--- /dev/null
+++ b/FS/FS/part_export/aradial.pm
@@ -0,0 +1,225 @@
+package FS::part_export::aradial;
+
+use base qw( FS::part_export );
+use LWP::UserAgent;
+use HTTP::Request;
+use Tie::IxHash;
+use XML::LibXML;
+use URI;
+use Date::Format 'time2str';
+use Data::Dumper;
+use vars qw( %options %info $me $DEBUG );
+use strict;
+
+$me = '[FS::part_export::aradial]';
+$DEBUG = 2;
+
+tie %options, 'Tie::IxHash',
+  'port'  => { label => 'HTTP port', default => 8000 },
+  'login' => { label => 'Admin username' },
+  'pass'  => { label => 'Admin password' },
+  'realm' => { label => 'Admin authentication realm' },
+  'group' => { label => 'Group name' },
+;
+
+%info = (
+  'svc'       => 'svc_acct',
+  'desc'      => 'Export accounts to Aradial RADIUS HTTP interface',
+  'options'   => \%options,
+  'nodomain'  => 'Y',
+  'notes'     => '
+<p>This export maintains user accounts on an Aradial Technologies access
+control server, via the HTTP interface.  The export hostname and the 
+<i>HTTP port</i> option determine the location of the server.</p>
+<p><i>Admin username, password, authentication realm</i> are the settings
+for the HTTP interface, set in the "Admin Web Interface Security" options
+for your Aradial server.</p>
+<p><i>Group name</i> is the user group to assign to new users, and must
+already exist on the Aradial server.  Currently this export will assign 
+all users to a single group; if you want multiple groups for different 
+service types, create another export instance.</p>
+'
+);
+
+sub export_insert {
+  my ($self, $svc) = @_;
+  my $result = $self->request_user_edit(
+    'Add'   => 1,
+    $self->svc_acct_params($svc),
+  );
+  if ($svc->cust_svc->cust_pkg->susp > 0 ) {
+    $result ||= $self->export_suspend($svc);
+  }
+  $result;
+}
+
+sub export_replace {
+  my ($self, $new, $old) = @_;
+  if ($new->username ne $old->username) {
+    return $old->export_delete || $new->export_insert;
+  }
+  my $UserLockout = 0;
+  $UserLockout = 1 if $new->cust_svc->cust_pkg->susp > 0;
+  $self->request_user_edit(
+    'Page'    => 'UserEdit',
+    'Modify'  => 1,
+    $self->svc_acct_params($new),
+    UserLockout => $UserLockout,
+  );
+}
+
+sub export_suspend {
+  my ($self, $svc) = @_;
+  $self->request_user_edit(
+    'Modify'  => 1,
+    'UserID'  => $svc->username,
+    'UserLockout' => 1,
+  );
+}
+
+sub export_unsuspend {
+  my ($self, $svc) = @_;
+  $self->request_user_edit(
+    'Modify'  => 1,
+    'UserID'  => $svc->username,
+    'UserLockout' => 0,
+  );
+}
+
+sub export_delete {
+  my ($self, $svc) = @_;
+  $self->request_user_edit(
+    'ConfirmDelete' => 1,
+    ('$Delete$' . $svc->username) => 1,
+  );
+}
+
+# Send a request to the 'UserEdit' interface, and process the response into
+# an error string (empty on success, per Freeside convention).
+
+sub request_user_edit {
+  my ($self, @params) = @_;
+  my $result = eval { $self->request( Page => 'UserEdit', @params ) };
+  return $result unless ref($result);
+  my $status = $result->findvalue('Result/Status/@value'); # XPath
+  if ($status eq 'Success') {
+    return '';
+  } else {
+    my $error = $result->findvalue('Result/Reason/@value')
+                || 'unknown error';
+    return "updating Aradial user database: $error";
+  }
+}
+
+# Send a request to any interface, parse the response (from XML), and
+# return it (as an XML::LibXML::Document).  Returns a string if there's an 
+# HTTP error.
+
+sub request {
+  my $self = shift;
+  my @params = @_;
+  my $path = '/Admin'; # I think this is always right
+  my $url = URI->new('http://' . $self->host . $path);
+  warn "$me request: \n".Dumper(\@params)."\n\n" if $DEBUG >= 2;
+  my $response = $self->ua->post($url, \@params);
+  if ( $response->is_success ) {
+    my $content = $response->decoded_content;
+    warn "$me response: \n$content\n\n" if $DEBUG >= 2;
+    return $self->parser->parse_string($content);
+    # the formats of these are _variable_.
+    # Some of them have a <Result><Status value="Success"><Entity ... >
+    # kind of structure, but not all.  They do all seem to be XML, though.
+  } else {
+    return "API request error: ".$response->status_line;
+  }
+}
+
+sub svc_acct_params {
+  my $self = shift;
+  my $svc = shift;
+  my $pkg = $svc->cust_svc->cust_pkg;
+  my $cust = $pkg->cust_main;
+  my $location = $pkg->cust_location;
+  # should we use the package contact's name/phone here?
+
+  my $setup_date = time2str('D%Y-%m-%d',
+    ($pkg->setup || $pkg->start_date || time)
+  );
+  my $expire_date = $pkg->expire ? time2str('D%Y-%m-%d', $pkg->expire) : '';
+
+  (
+    'db_Users.UserID'               => $svc->username,
+    $self->password_params($svc),
+    'db_$N$Users.Status'            => 0, # we suspend using UserLockout
+    'db_$D$Users.StartDate'         => $setup_date,
+    'db_$D$Users.UserExpiryDate'    => $expire_date,
+    'db_$RS$Users.GroupName'        => $self->option('group'),
+    'db_$I$Users.UserIP'            => $svc->slipip,
+    'db_UserDetails.FirstName'      => $cust->first,
+    'db_UserDetails.LastName'       => $cust->last,
+    'db_UserDetails.Company'        => $cust->company,
+    'db_UserDetails.Email'          => $cust->invoicing_list_emailonly_scalar,
+    'db_UserDetails.Address1'       => $location->address1,
+    'db_UserDetails.Address2'       => $location->address2,
+    'db_UserDetails.City'           => $location->city,
+    'db_%GS%UserDetails.State'      => $location->state,
+    'db_%GS%UserDetails.Country'    => $location->country,
+    'db_UserDetails.Zip'            => $location->zip,
+    'db_UserDetails.PhoneHome'      => ($cust->daytime || $cust->night || $cust->mobile),
+    'db_UserDetails.PhoneFax'       => $cust->fax,
+  );
+}
+
+sub password_params {
+  my ($self, $svc) = @_;
+
+  my $password_encryption = 0;
+  my $password = $svc->_password;
+  if ($svc->_password_encoding eq 'crypt') {
+    if ($svc->_password_encryption eq 'des') {
+      $password_encryption = 2;
+    } elsif ( $svc->_password_encryption eq 'md5') {
+      $password_encryption = 5;
+    }
+  } elsif ( $svc->_password_encoding eq 'ldap' ) {
+    $svc->_password =~ /^\{([\w-]+)\}(.*)$/;
+    $password = $2;
+    if ($1 eq 'MD5') {
+      $password_encryption = 7;
+    } elsif ($1 eq 'SHA' or $1 eq 'SHA-1') {
+      $password_encryption = 1;
+    }
+  }
+  ( Password => $password,
+    PasswordEncryptionType => $password_encryption
+  );
+}
+
+# return the XML parser
+sub parser {
+  my $self = shift;
+  $self->{_parser} ||= XML::LibXML->new;
+}
+
+# return hostname:port
+sub host {
+  my $self = shift;
+  $self->machine . ':' . $self->option('port');
+}
+
+# return the LWP::UserAgent object
+sub ua {
+  my $self = shift;
+  $self->{_ua} ||= do {
+    my $ua = LWP::UserAgent->new;
+    $ua->credentials(
+      $self->host,
+      $self->option('realm'),
+      $self->option('login'),
+      $self->option('pass')
+    );
+    $ua;
+  }
+}
+
+1;
diff --git a/bin/aradial-sftp_and_import b/bin/aradial-sftp_and_import
new file mode 100644
index 000000000..95546e405
--- /dev/null
+++ b/bin/aradial-sftp_and_import
@@ -0,0 +1,270 @@
+#!/usr/bin/perl
+
+#i'm kinda like freeside-cdr-sftp_and_import... some parts should be libraried
+
+use strict;
+use Getopt::Std;
+use Text::CSV_XS;
+use DBI;
+use FS::UID qw( adminsuidsetup datasrc );
+
+our %aradial2db = (
+  #'Date' => '',
+  'NASIP' => 'NASIPAddress',
+  'AcctSessionId' => 'AcctSessionId',
+  'Port' => 'NasPortId',
+  #'Status-Type' => 'Acct-Status-Type',
+  'UserID' => 'UserName',
+  'Authentic' => 'AccdtAuthentic',
+  'Service-Type' => 'ServiceType',
+  'FramedProtocol' => 'FramedProtocol',
+  #'FramedCompression' => '', #not handled, needed?  unlikely
+  'FramedAddress' => 'FramedIPAddress',
+  'Acct-Delay-Time' => 'AcctStartDelay', #?
+  'Session-Time' => 'AcctSessionTime',
+  #'Input-Gigawords' => '',
+  'Input-Octets' => 'AcctInputOctets',
+  #'Output-Gigawords' => '',
+  'Output-Octets' => 'AcctOutputOctets',
+  'NAS-Port-Type' => 'NASPortType',
+  'Acct-Terminate-Cause' => 'AcctTerminateCause',
+);
+
+###
+# parse command line
+###
+
+use vars qw( $opt_m $opt_a $opt_b $opt_r $opt_d $opt_v $opt_P );
+getopts('m:abr:dP:v:');
+
+my %options = ();
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# %%%FREESIDE_CACHE%%%
+my $cachedir = '%%%FREESIDE_CACHE%%%/cache.'. datasrc. '/cdrs';
+mkdir $cachedir unless -d $cachedir;
+
+my $servername = shift or die &usage;
+
+my( $datasrc, $db_user, $db_pass ) = ( shift, shift, shift );
+my $dbh = DBI->connect( $datasrc, $db_user, $db_pass)
+  or die "can't connect: $DBI::errstr\n";
+
+my $csv = Text::CSV_XS->new;
+
+###
+# get the file list
+###
+
+warn "Retrieving directory listing\n" if $opt_v;
+
+$opt_m = 'sftp' if !defined($opt_m);
+$opt_m = lc($opt_m);
+
+my $ls;
+
+if($opt_m eq 'ftp') {
+  $options{'Port'}    = $opt_P if $opt_P;
+  $options{'Debug'}   = $opt_v if $opt_v;
+  $options{'Passive'} = $opt_a if $opt_a;
+
+  my $ls_ftp = ftp();
+
+  $ls = [ grep { /^.*$/i } $ls_ftp->ls ];
+}
+elsif($opt_m eq 'sftp') {
+  $options{'port'}    = $opt_P if $opt_P;
+  $options{'debug'}   = $opt_v if $opt_v;
+
+  my $ls_sftp = sftp();
+
+  $ls_sftp->setcwd($opt_r) or die "can't chdir to $opt_r\n"
+    if $opt_r;
+
+  $ls = $ls_sftp->ls('.', wanted => qr/^$.*\.$/i,
+                          names_only => 1 );
+}
+else {
+  die "Method '$opt_m' not supported; must be ftp or sftp\n";
+}
+
+###
+# import each file
+###
+
+foreach my $filename ( @$ls ) {
+
+  warn "Downloading $filename\n" if $opt_v;
+
+  #get the file
+  if($opt_m eq 'ftp') {
+    my $ftp = ftp();
+    $ftp->get($filename, "$cachedir/$filename")
+      or die "Can't get $filename: ". $ftp->message . "\n";
+  }
+  else {
+    my $sftp = sftp();
+    $sftp->get($filename, "$cachedir/$filename")
+      or die "Can't get $filename: ". $sftp->error . "\n";
+  }
+
+  warn "Processing $filename\n" if $opt_v;
+ 
+  my $file_timestamp = $filename.'-'.time2str('%Y-%m-%d', time);
+
+  open my $fh, "$cachedir/$filename" or die "$cachedir/$filename: $!";
+  my $header = $csv->getline($fh);
+
+  while ( my $row = $csv->getline($fh) ) {
+
+    my $i = 0;
+    my %hash = map { $_ => $row->[$i++] } @$header;
+
+    my %dbhash = map { $aradial2db{$_} => $hash{$_} }
+                   grep $aradial2db{$_},
+                     keys %hash;
+
+    my @keys = keys %dbhash;
+    my @values = map $dbhash{$_}, @keys;
+
+    if ( $hash{'Acct-Status-Type'} eq 'Start' ) {
+
+      $dbhash{'AcctStartTime'} = $hash{'Date'};
+
+      my $sql = 'INSERT INTO radacct ( ', join(',', @keys).
+                ' ) VALUES ( '. map( ' ? ', @values ). ' )';
+      my $sth = $dbh->prepare($sql) or die $dbh->errstr;
+      $sth->execute(@values) or die $sth->errstr;
+
+    } elsif ( $hash{'Acct-Status-Type'} eq 'Stop' ) {
+
+      my $AcctSessionId = delete($dbhash{AcctSessionId});
+      $dbhash{'AcctStopTime'} = $hash{'Date'};
+
+      my $sql = 'UPDATE radacct '. join(' , ', map "SET $_ = ?", @keys ).
+                ' WHERE AcctSessionId = ? ';
+      my $sth = $dbh->prepare($sql) or die $dbh->errstr;
+      $sth->execute(@values, $AcctSessionId) or die $sth->errstr;
+
+    } elsif ( $hash{'Acct-Status-Type'} eq 'Interim' ) {
+      #not handled, but stop should capture the usage.  unless session are
+      # normally super-long, extending across month boundaries, or we need
+      # real-time-ish data usage detail, it isn't a big deal
+    } else {
+      die 'Unknown Acct-Status-Type '. $hash{'Acct-Status-Type'}. "\n";
+    }
+
+  }
+  
+  if ( $opt_d ) {
+    if ( $opt_m eq 'ftp') {
+      my $ftp = ftp();
+      $ftp->rename($filename, "$opt_d/$file_timestamp")
+        or do {
+          unlink "$cachedir/$filename";
+          die "Can't move $filename to $opt_d: ".$ftp->message . "\n";
+        };
+    } else {
+      my $sftp = sftp();
+      $sftp->rename($filename, "$opt_d/$file_timestamp")
+        or do {
+          unlink "$cachedir/$filename";
+          die "can't move $filename to $opt_d: ". $sftp->error . "\n";
+        };
+    }
+  }
+
+  unlink "$cachedir/$filename";
+
+}
+
+###
+# subs
+###
+
+sub usage {
+  "Usage:
+  aradial-sftp_and_import [ -m method ] [ -a ] [ -b ]
+    [ -r remotefolder ] [ -d donefolder ] [ -v level ] [ -P port ]
+    user format [sftpuser@]servername
+  ";
+}
+
+use vars qw( $sftp $ftp );
+
+sub ftp {
+  return $ftp if $ftp && $ftp->pwd;
+  
+  my ($hostname, $userpass) = reverse split('@', $servername);
+  my ($ftp_user, $ftp_pass) = split(':', $userpass);
+
+  my $ftp = Net::FTP->new($hostname, %options) 
+    or die "FTP connection to '$hostname' failed.";
+  $ftp->login($ftp_user, $ftp_pass) or die "FTP login failed: ".$ftp->message;
+  $ftp->cwd($opt_r) or die "can't chdir to $opt_r\n" if $opt_r;
+  $ftp->binary or die "can't set BINARY mode: ". $ftp->message if $opt_b;
+  return $ftp;
+}
+
+sub sftp {
+
+  #reuse connections
+  return $sftp if $sftp && $sftp->cwd;
+
+  my %sftp = ( host => $servername );
+
+  $sftp = Net::SFTP::Foreign->new(%sftp);
+  $sftp->error and die "SFTP connection failed: ". $sftp->error;
+
+  $sftp;
+}
+
+=head1 NAME
+
+freeside-aradial-sftp_and_import - Download Aradial "CDR" (really RADIUS detail) files from a remote server via SFTP
+
+=head1 SYNOPSIS
+
+  aradial-sftp_and_import [ -m method ] [ -a ] [ -b ]
+    [ -r remotefolder ] [ -d donefolder ] [ -v level ] [ -P port ]
+    user format [sftpuser@]servername dbi_datasrc dbi_username dbi_pass
+
+=head1 DESCRIPTION
+
+Command line tool to download CDR files from a remote server via SFTP 
+or FTP and then import them into the database.
+
+-m: transfer method (sftp or ftp), defaults to sftp
+
+-a: use ftp passive mode
+
+-b: use ftp binary mode
+
+-r: if specified, changes into this remote folder before starting
+
+-d: if specified, moves files to the specified folder when done
+
+-P: if specified, sets the port to use
+
+-v: set verbosity level; this script only has one level, but it will 
+    be passed as the 'debug' argument to the transport method
+
+user: freeside username
+
+format: CDR format name
+
+[sftpuser@]servername: remote server
+(or ftpuser:ftppass@servername)
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cdr>
+
+=cut
+
+1;
+