grandstream device configuration support #4220

10 files changed, 486 insertions, 6 deletions

diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index f20ea64..eb26dde 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -174,6 +174,7 @@ if ( -e $addl_handler_use_file ) {
   use FS::part_export;
   use FS::part_export_option;
   use FS::export_svc;
+  use FS::export_device;
   use FS::msgcat;
   use FS::rate;
   use FS::rate_region;
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 19c2e8e..fdb4a94 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -1851,6 +1851,17 @@ sub tables_hashref {
       'index'       => [ [ 'exportnum' ], [ 'svcpart' ] ],
     },
 
+    'export_device' => {
+      'columns' => [
+        'exportdevicenum' => 'serial', '', '', '', '', 
+        'exportnum'    => 'int', '', '', '', '', 
+        'devicepart'      => 'int', '', '', '', '', 
+      ],
+      'primary_key' => 'exportdevicenum',
+      'unique'      => [ [ 'exportnum', 'devicepart' ] ],
+      'index'       => [ [ 'exportnum' ], [ 'devicepart' ] ],
+    },
+
     'part_export' => {
       'columns' => [
         'exportnum', 'serial', '', '', '', '', 
diff --git a/FS/FS/export_device.pm b/FS/FS/export_device.pm
new file mode 100644
index 0000000..69e3826
--- /dev/null
+++ b/FS/FS/export_device.pm
@@ -0,0 +1,136 @@
+package FS::export_device;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs dbh );
+use FS::part_export;
+use FS::part_device;
+
+=head1 NAME
+
+FS::export_device - Object methods for export_device records
+
+=head1 SYNOPSIS
+
+  use FS::export_device;
+
+  $record = new FS::export_device \%hash;
+  $record = new FS::export_device { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::export_device object links a device definition (see L<FS::part_device>)
+to an export (see L<FS::part_export>).  FS::export_device inherits from
+FS::Record.  The following fields are currently supported:
+
+=over 4
+
+=item exportdevicenum - primary key
+
+=item exportnum - export (see L<FS::part_export>)
+
+=item devicepart - device definition (see L<FS::part_device>)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record.  To add the record to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+sub table { 'export_device'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# may want to check for duplicates against either services or devices
+# cf FS::export_svc
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+=item check
+
+Checks all fields to make sure this is a valid record.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+  my $self = shift;
+
+  $self->ut_numbern('exportdevicenum')
+    || $self->ut_number('exportnum')
+    || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
+    || $self->ut_number('devicepart')
+    || $self->ut_foreign_key('devicepart', 'part_device', 'devicepart')
+    || $self->SUPER::check
+  ;
+}
+
+=item part_export
+
+Returns the FS::part_export object (see L<FS::part_export>).
+
+=cut
+
+sub part_export {
+  my $self = shift;
+  qsearchs( 'part_export', { 'exportnum' => $self->exportnum } );
+}
+
+=item part_device
+
+Returns the FS::part_device object (see L<FS::part_device>).
+
+=cut
+
+sub part_device {
+  my $self = shift;
+  qsearchs( 'part_device', { 'svcpart' => $self->devicepart } );
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::part_export>, L<FS::part_device>, L<FS::Record>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/part_device.pm b/FS/FS/part_device.pm
index 79a534a..4963584 100644
--- a/FS/FS/part_device.pm
+++ b/FS/FS/part_device.pm
@@ -1,8 +1,10 @@
 package FS::part_device;
 
 use strict;
-use base qw( FS::Record );
-use FS::Record; # qw( qsearch qsearchs );
+use base qw( FS::Record FS::m2m_Common );
+use FS::Record qw( qsearch qsearchs );
+use FS::part_export;
+use FS::export_device;
 
 =head1 NAME
 
@@ -107,6 +109,18 @@ sub check {
   $self->SUPER::check;
 }
 
+=item part_export
+
+Returns a list of all exports (see L<FS::part_export>) for this device.
+
+=cut
+
+sub part_export {
+  my $self = shift;
+  map { qsearchs( 'part_export', { 'exportnum' => $_->exportnum } ) }
+    qsearch( 'export_device', { 'devicepart' => $self->devicepart } );
+}
+
 sub process_batch_import {
   my $job = shift;
 
diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index 16aad6d..d533db8 100644
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -226,6 +226,17 @@ sub export_svc {
   qsearch('export_svc', { 'exportnum' => $self->exportnum } );
 }
 
+=item export_device
+
+Returns a list of associated FS::export_device records.
+
+=cut
+
+sub export_device {
+  my $self = shift;
+  qsearch('export_device', { 'exportnum' => $self->exportnum } );
+}
+
 =item part_export_option
 
 Returns all options as FS::part_export_option objects (see
diff --git a/FS/FS/part_export/grandstream.pm b/FS/FS/part_export/grandstream.pm
new file mode 100644
index 0000000..162fb8c
--- /dev/null
+++ b/FS/FS/part_export/grandstream.pm
@@ -0,0 +1,242 @@
+package FS::part_export::grandstream;
+
+use vars qw(@ISA $me %info $GAPSLITE_HOME $JAVA_HOME);
+use URI;
+use MIME::Base64;
+use Tie::IxHash;
+use FS::part_export;
+use FS::CGI qw(rooturl);
+
+@ISA = qw(FS::part_export);
+$me = '[' . __PACKAGE__ . ']';
+$GAPSLITE_HOME = '/usr/local/src/GS/GS_CFG_GEN/';
+$JAVA_HOME = '/usr/lib/jvm/java-6-sun/';
+$JAVA_HOME = '/usr/lib/jvm/java-1.4.2-gcj-4.1-1.4.2.0/';
+
+tie my %options, 'Tie::IxHash',
+  'upload'          => { label=>'Enable upload to tftpserver',
+                         type=>'checkbox',
+                       },
+  'user'            => { label=>'User name for ssh to tftp server' },
+  'tftproot'        => { label=>'Directory in which to upload configuration' },
+  'java_home'       => { label=>'Path to java to be used',
+                         default=>$JAVA_HOME,
+                       },
+  'gapslite_home'   => { label=>'Path to grandstream configuration tool',
+                         default=>$GAPSLITE_HOME,
+                       },
+  'template'        => { label=>'Configuration template',
+                         type=>'textarea',
+                         notes=>'Type or paste the configuration template here',
+                       },
+;
+
+%info = (
+  'svc'      => [ qw( part_device ) ], # svc_phone
+  'desc'     => 'Provision phone numbers to Grandstream Networks phones',
+  'options'  => \%options,
+  'notes'    => '',
+);
+
+sub rebless { shift; }
+
+sub gs_create_config {
+  my($self, $mac, %opt) = (@_);
+
+  eval "use Net::SCP;";
+  die $@ if $@;
+
+  warn "gs_create_config called with mac of $mac\n";
+  $mac = sprintf('%012s', lc($mac));
+  my $dir = '%%%FREESIDE_CONF%%%/cache.'. $FS::UID::datasrc;
+
+  my $fh = new File::Temp(
+    TEMPLATE => "grandstream.$mac.XXXXXXXX",
+    DIR      => $dir,
+    UNLINK   => 0,
+  );
+
+  my $filename = $fh->filename;
+
+  #my $template = new Text::Template (
+  #  TYPE       => 'ARRAY',
+  #  SOURCE     => $self->option('template'),
+  #  DELIMITERS => $delimiters,
+  #  OUTPUT     => $fh,
+  #);
+
+  #$template->compile or die "Can't compile template: $Text::Template::ERROR\n";
+
+  #my $config = $template->fill_in( HASH => { mac_addr => $mac } );
+
+  print $fh $self->option('template') or die "print failed: $!";
+  close $fh;
+  
+  system( "export GAPSLITE_HOME=$GAPSLITE_HOME; export JAVA_HOME=$JAVA_HOME; ".
+          "cd $dir; $GAPSLITE_HOME/bin/encode.sh $mac $filename $dir/cfg$mac"
+        ) == 0
+    or die "grandstream encode failed: $!";
+
+  unlink $filename;
+
+  open my $encoded, "$dir/cfg$mac"  or die "open cfg$mac failed: $!";
+  
+  my $content;
+
+  if ($opt{upload}) {
+    if ($self->option('upload')) {
+      my $scp = new Net::SCP ( {
+        'host' => $self->machine,
+        'user' => $self->option('user'),
+        'cwd'  => $self->option('tftproot'),
+      } );
+
+      $scp->put( "$dir/cfg$mac" ) or die "upload failed: ". $scp->errstr;
+    }
+  } else {
+    local $/;
+    $content = <$encoded>;
+  }
+
+  close $encoded;
+  unlink "$dir/cfg$mac";
+
+  $content;
+}
+
+sub gs_create {
+  my($self, $mac) = (shift, shift);
+
+  return unless $mac;  # be more alarmed?  Or check upstream?
+
+  $self->gs_create_config($mac, 'upload' => 1);
+  '';
+}
+
+sub gs_delete {
+  my($self, $mac) = (shift, shift);
+
+  $mac = sprintf('%012s', lc($mac));
+
+  ssh_cmd( user => $self->option('user'),
+           host => $self->machine,
+           command => 'rm',
+           args    => [ '-f', $self->option(tftproot). "/cfg$mac" ],
+         );
+  '';
+
+}
+
+sub ssh_cmd { #subroutine, not method
+  use Net::SSH '0.08';
+  &Net::SSH::ssh_cmd( { @_ } );
+}
+
+sub _export_insert {
+#  my( $self, $svc_phone ) = (shift, shift);
+#  $self->gs_create($svc_phone->mac_addr);
+  '';
+}
+
+sub _export_replace {
+#  my( $self, $new_svc, $old_svc ) = (shift, shift, shift);
+#  $self->gs_delete($old_svc->mac_addr);
+#  $self->gs_create($new_svc->mac_addr);
+  '';
+}
+
+sub _export_delete {
+#  my( $self, $svc_phone ) = (shift, shift);
+#  $self->gs_delete($svc_phone->mac_addr);
+  '';
+}
+
+sub _export_suspend {
+  '';
+}
+
+sub _export_unsuspend {
+  '';
+}
+
+sub export_device_insert {
+  my( $self, $svc_phone, $phone_device ) = (shift, shift, shift);
+  $self->gs_create($phone_device->mac_addr);
+  '';
+}
+
+sub export_device_delete {
+  my( $self, $svc_phone, $phone_device ) = (shift, shift, shift);
+  $self->gs_delete($phone_device->mac_addr);
+  '';
+}
+
+sub export_device_config {
+  my( $self, $svc_phone, $phone_device ) = (shift, shift, shift);
+
+  my $mac;
+#  if ($phone_device) {
+    $mac = $phone_device->mac_addr;
+#  } else {
+#    $mac = $svc_phone->mac_addr;
+#  }
+
+  return '' unless $mac;  # be more alarmed?  Or check upstream?
+
+  $self->gs_create_config($mac);
+}
+
+
+sub export_device_replace {
+  my( $self, $svc_phone, $new_svc_or_device, $old_svc_or_device ) =
+    (shift, shift, shift, shift);
+
+  $self->gs_delete($old_svc_or_device->mac_addr);
+  $self->gs_create($new_svc_or_device->mac_addr);
+  '';
+}
+
+# bad overloading?
+sub export_links {
+  my($self, $svc_phone, $arrayref) = (shift, shift, shift);
+
+  return;  # remove if we actually support being an export for svc_phone;
+
+  my @deviceparts = map { $_->devicepart } $self->export_device;
+  my @devices = grep { my $part = $_->devicepart;
+                       scalar( grep { $_ == $part } @deviceparts );
+                     } $svc_phone->phone_device;
+
+  my $export = $self->exportnum;
+  my $fsurl = rooturl();
+  if (@devices) {
+    foreach my $device ( @devices ) {
+      next unless $device->mac_addr;
+      my $num = $device->devicenum;
+      push @$arrayref,
+        qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;devicenum=$num">!.
+        qq! Phone config </A>!;
+      }
+  } elsif ($svc_phone->mac_addr) {
+    my $num = $svc_phone->svcnum;
+    push @$arrayref,
+      qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;svcnum=$num">!.
+      qq! Phone config </A>!;
+  } #else
+  '';
+}
+
+sub export_device_links {
+  my($self, $svc_phone, $device, $arrayref) = (shift, shift, shift, shift);
+
+  return unless $device && $device->mac_addr;
+  my $export = $self->exportnum;
+  my $fsurl = rooturl();
+  my $num = $device->devicenum;
+  push @$arrayref,
+    qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;devicenum=$num">!.
+    qq! Phone config </A>!;
+  '';
+}
+
+1;
diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm
index 332edcc..b806894 100644
--- a/FS/FS/part_export/netsapiens.pm
+++ b/FS/FS/part_export/netsapiens.pm
@@ -21,7 +21,7 @@ tie my %options, 'Tie::IxHash',
 ;
 
 %info = (
-  'svc'      => 'svc_phone',
+  'svc'      => [ 'svc_phone', ], # 'part_device',
   'desc'     => 'Provision phone numbers to NetSapiens',
   'options'  => \%options,
   'notes'    => <<'END'
diff --git a/FS/FS/phone_device.pm b/FS/FS/phone_device.pm
index 914f735..ba765e0 100644
--- a/FS/FS/phone_device.pm
+++ b/FS/FS/phone_device.pm
@@ -97,7 +97,7 @@ sub insert {
     return $error;
   }
 
-  $self->svc_phone->export('device_insert', $self); #call device export
+  $self->export('device_insert');
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
@@ -124,7 +124,7 @@ sub delete {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  $self->svc_phone->export('device_delete', $self); #call device export
+  $self->export('device_delete');
 
   my $error = $self->SUPER::delete;
   if ( $error ) {
@@ -167,7 +167,7 @@ sub replace {
     return $error;
   }
 
-  $new->svc_phone->export('device_replace', $new, $old); #call device export
+  $new->export('device_replace', $old);
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
@@ -227,6 +227,64 @@ sub svc_phone {
   qsearchs( 'svc_phone', { 'svcnum' => $self->svcnum } );
 }
 
+=item export HOOK [ EXPORT_ARGS ]
+
+Runs the provided export hook (i.e. "device_insert") for this service.
+
+=cut
+
+sub export {
+  my( $self, $method ) = ( shift, shift );
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $svc_phone = $self->svc_phone;
+  my $error = $svc_phone->export($method, $self, @_); #call device export
+  if ( $error ) {                                     #netsapiens at least
+    $dbh->rollback if $oldAutoCommit;
+    return "error exporting $method event to svc_phone ". $svc_phone->svcnum.
+           " (transaction rolled back): $error";
+  }
+
+  $method = "export_$method" unless $method =~ /^export_/;
+
+  foreach my $part_export ( $self->part_device->part_export ) {
+    next unless $part_export->can($method);
+    my $error = $part_export->$method($svc_phone, $self, @_);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "error exporting $method event to ". $part_export->exporttype.
+             " (transaction rolled back): $error";
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
+=item export_links
+
+Returns a list of html elements associated with this device's exports.
+
+=cut
+
+sub export_links {
+  my $self = shift;
+  my $return = [];
+  $self->export('export_device_links', $return);
+  $return;
+}
+
 =back
 
 =head1 BUGS
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 7152345..f3d2a69 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -87,6 +87,7 @@ FS/h_svc_www.pm
 FS/part_bill_event.pm
 FS/payinfo_Mixin.pm
 FS/export_svc.pm
+FS/export_device.pm
 FS/part_export.pm
 FS/part_export_option.pm
 FS/part_export/acct_sql.pm
@@ -231,6 +232,7 @@ t/domain_record.t
 t/nas.t
 t/part_bill_event.t
 t/export_svc.t
+t/export_device.t
 t/part_export.t
 t/part_export_option.t
 t/part_export-acct_sql.t
diff --git a/FS/t/export_device.t b/FS/t/export_device.t
new file mode 100644
index 0000000..4688326
--- /dev/null
+++ b/FS/t/export_device.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::export_device;
+$loaded=1;
+print "ok 1\n";