communigate pro provisioning, RT#7083

1 files changed, 241 insertions, 71 deletions

diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm
index ecb3780..c4201c0 100644
--- a/FS/FS/part_export/communigate_pro.pm
+++ b/FS/FS/part_export/communigate_pro.pm
@@ -1,35 +1,43 @@
 package FS::part_export::communigate_pro;
 
-use vars qw(@ISA %info %options);
+use strict;
+use vars qw(@ISA %info %options $DEBUG);
+use Data::Dumper;
 use Tie::IxHash;
 use FS::part_export;
 use FS::queue;
 
 @ISA = qw(FS::part_export);
 
+$DEBUG = 1;
+
 tie %options, 'Tie::IxHash',
-  'port'     => { label=>'Port number', default=>'106', },
-  'login'    => { label=>'The administrator account name.  The name can contain a domain part.', },
-  'password' => { label=>'The administrator account password.', },
-  'accountType' => { label=>'Type for newly-created accounts',
-                     type=>'select',
-                     options=>[qw( MultiMailbox TextMailbox MailDirMailbox )],
-                     default=>'MultiMailbox',
-                   },
-  'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.',
-                      type=>'checkbox',
-                    },
-  'AccessModes' => { label=>'Access modes',
-                     default=>'Mail POP IMAP PWD WebMail WebSite',
-                   },
+  'port'          => { label   =>'Port number', default=>'106', },
+  'login'         => { label   =>'The administrator account name.  The name can contain a domain part.', },
+  'password'      => { label   =>'The administrator account password.', },
+  'accountType'   => { label   => 'Type for newly-created accounts',
+                       type    => 'select',
+                       options => [qw(MultiMailbox TextMailbox MailDirMailbox)],
+                       default => 'MultiMailbox',
+                     },
+  'externalFlag'  => { label   => 'Create accounts with an external (visible for legacy mailers) INBOX.',
+                       type    => 'checkbox',
+                     },
+  'AccessModes'   => { label   => 'Access modes',
+                       default => 'Mail POP IMAP PWD WebMail WebSite',
+                     },
+  'create_domain' => { label   => 'Domain creation API call',
+                       type    => 'select',
+                       options => [qw( CreateDomain CreateSharedDomain )],
+                     }
 ;
 
 %info = (
-  'svc'     => 'svc_acct',
-  'desc'    => 'Real-time export to a CommuniGate Pro mail server',
+  'svc'     => [qw( svc_acct svc_domain )],
+  'desc'    => 'Real-time export of accounts and domains to a CommuniGate Pro mail server',
   'options' => \%options,
   'notes'   => <<'END'
-Real time export to a
+Real time export of accounts and domains to a
 <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a>
 mail server.  The
 <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a>
@@ -45,77 +53,199 @@ sub export_username {
 }
 
 sub _export_insert {
-  my( $self, $svc_acct ) = (shift, shift);
-  my @options = ( $svc_acct->svcnum, 'CreateAccount',
-    'accountName'    => $self->export_username($svc_acct),
-    'accountType'    => $self->option('accountType'),
-    'AccessModes'    => $self->option('AccessModes'),
-    'RealName'       => $svc_acct->finger,
-    'Password'       => $svc_acct->_password,
-  );
-  push @options, 'MaxAccountSize' => $svc_acct->quota if $svc_acct->quota;
-  push @options, 'externalFlag'   => $self->option('externalFlag')
-    if $self->option('externalFlag');
+  my( $self, $svc_x ) = (shift, shift);
+
+  my @options;
+
+  if ( $svc_x->isa('FS::svc_acct') ) {
+
+    @options = ( $svc_x->svcnum, 'CreateAccount',
+      'accountName'    => $self->export_username($svc_x),
+      'accountType'    => $self->option('accountType'),
+      'AccessModes'    => $self->option('AccessModes'),
+      'RealName'       => $svc_x->finger,
+      'Password'       => $svc_x->_password,
+    );
+    push @options, 'MaxAccountSize' => $svc_x->quota if $svc_x->quota;
+    push @options, 'externalFlag'   => $self->option('externalFlag')
+      if $self->option('externalFlag');
+
+  } elsif ( $svc_x->isa('FS::svc_domain') ) {
+
+    my $create = $self->option('create_domain') || 'CreateDomain';
+
+    @options = ( $svc_x->svcnum, $create, $svc_x->domain,
+      #other domain creation options?
+    );
+    push @options, 'AccountsLimit' => $svc_x->max_accounts
+      if $svc_x->max_accounts;
+
+  } else {
+    die "guru meditation #14: $svc_x is not FS::svc_acct, or FS::svc_domain";
+  }
 
   $self->communigate_pro_queue( @options );
 }
 
 sub _export_replace {
   my( $self, $new, $old ) = (shift, shift, shift);
-  return "can't (yet) change username with CommuniGate Pro"
-    if $old->username ne $new->username;
-  return "can't (yet) change domain with CommuniGate Pro"
-    if $self->export_username($old) ne $self->export_username($new);
-  return "can't (yet) change GECOS with CommuniGate Pro"
-    if $old->finger ne $new->finger;
-  return "can't (yet) change quota with CommuniGate Pro"
-    if $old->quota ne $new->quota;
-  return '' unless $old->username ne $new->username
-                || $old->_password ne $new->_password
-                || $old->finger ne $new->finger
-                || $old->quota ne $new->quota;
-
-  return '' if '*SUSPENDED* '. $old->_password eq $new->_password;
-
-  #my $err_or_queue = $self->communigate_pro_queue( $new->svcnum,'RenameAccount',
-  #  $old->email, $new->email );
-  #return $err_or_queue unless ref($err_or_queue);
-  #my $jobnum = $err_or_queue->jobnum;
-
-  $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword',
-                                $self->export_username($new), $new->_password        )
-    if $new->_password ne $old->_password;
+
+  if ( $new->isa('FS::svc_acct') ) {
+
+    #XXX they probably need the ability to change some of these
+    return "can't (yet) change username with CommuniGate Pro"
+      if $old->username ne $new->username;
+    return "can't (yet) change domain with CommuniGate Pro"
+      if $self->export_username($old) ne $self->export_username($new);
+    return "can't (yet) change GECOS with CommuniGate Pro"
+      if $old->finger ne $new->finger;
+    return "can't (yet) change quota with CommuniGate Pro"
+      if $old->quota ne $new->quota;
+    return '' unless $old->username ne $new->username
+                  || $old->_password ne $new->_password
+                  || $old->finger ne $new->finger
+                  || $old->quota ne $new->quota;
+
+    return '' if '*SUSPENDED* '. $old->_password eq $new->_password;
+
+    #my $err_or_queue = $self->communigate_pro_queue( $new->svcnum,'RenameAccount',
+    #  $old->email, $new->email );
+    #return $err_or_queue unless ref($err_or_queue);
+    #my $jobnum = $err_or_queue->jobnum;
+
+    $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword',
+                                  $self->export_username($new), $new->_password        )
+      if $new->_password ne $old->_password;
+
+  }  elsif ( $new->isa('FS::svc_domain') ) {
+
+    if ( $old->domain ne $new->domain ) {
+      $self->communigate_pro_queue( $new->svcnum, 'RenameDomain',
+        $old->domain, $new->domain,
+      );
+    }
+
+    if ( $old->max_accounts ne $new->max_accounts ) {
+      $self->communigate_pro_queue( $new->svcnum, 'UpdateDomainSettings',
+        $new->domain, 'AccountsLimit' => ($new->max_accounts || 'default'),
+      );
+    }
+
+    #other kinds of changes?
+
+  } else {
+    die "guru meditation #15: $new is not FS::svc_acct, or FS::svc_domain";
+  }
 
 }
 
 sub _export_delete {
-  my( $self, $svc_acct ) = (shift, shift);
-  $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount',
-    $self->export_username($svc_acct),
-  );
+  my( $self, $svc_x ) = (shift, shift);
+
+  if ( $svc_x->isa('FS::svc_acct') ) {
+
+    $self->communigate_pro_queue( $svc_x->svcnum, 'DeleteAccount',
+      $self->export_username($svc_x),
+    );
+
+  } elsif ( $svc_x->isa('FS::svc_domain') ) {
+
+    $self->communigate_pro_queue( $svc_x->svcnum, 'DeleteDomain',
+      $svc_x->domain,
+      #XXX turn on force option for domain deletion?
+    );
+
+  } else {
+    die "guru meditation #16: $svc_x is not FS::svc_acct, or FS::svc_domain";
+  }
+
 }
 
 sub _export_suspend {
-  my( $self, $svc_acct ) = (shift, shift);
-  $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings',
-    'accountName' => $self->export_username($svc_acct),
-    'AccessModes' => 'Mail',
-  );
+  my( $self, $svc_x ) = (shift, shift);
+
+  if ( $svc_x->isa('FS::svc_acct') ) {
+
+     $self->communigate_pro_queue( $svc_x->svcnum, 'UpdateAccountSettings',
+      'accountName' => $self->export_username($svc_x),
+      'AccessModes' => 'Mail',
+    );
+
+  } elsif ( $svc_x->isa('FS::svc_domain') ) {
+
+    #XXX domain operations
+  } else {
+    die "guru meditation #17: $svc_x is not FS::svc_acct, or FS::svc_domain";
+  }
+
 }
 
 sub _export_unsuspend {
-  my( $self, $svc_acct ) = (shift, shift);
-  $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings',
-    'accountName' => $self->export_username($svc_acct),
-    'AccessModes' => $self->option('AccessModes'),
-  );
+  my( $self, $svc_x ) = (shift, shift);
+
+  if ( $svc_x->isa('FS::svc_acct') ) {
+
+    $self->communigate_pro_queue( $svc_x->svcnum, 'UpdateAccountSettings',
+      'accountName' => $self->export_username($svc_x),
+      'AccessModes' => $self->option('AccessModes'),
+    );
+  } elsif ( $svc_x->isa('FS::svc_domain') ) {
+
+    #XXX domain operations
+  } else {
+    die "guru meditation #18: $svc_x is not FS::svc_acct, or FS::svc_domain";
+  }
+
+}
+
+sub export_getsettings {
+  my($self, $svc_x, $settingsref, $defaultref ) = @_;
+
+  my $settings = eval { $self->communigate_pro_runcommand(
+    'GetDomainSettings',
+    $svc_x->domain
+  ) };
+  return $@ if $@;
+
+  my $effective_settings = eval { $self->communigate_pro_runcommand(
+    'GetDomainEffectiveSettings',
+    $svc_x->domain
+  ) };
+  return $@ if $@;
+
+  my %defaults = map { $_ => 1 }
+                   grep !exists(${$settings}{$_}), keys %$effective_settings;
+
+  foreach my $key ( grep ref($effective_settings->{$_}),
+                    keys %$effective_settings )
+  {
+    my $value = $effective_settings->{$key};
+    if ( ref($value) eq 'ARRAY' ) {
+      $effective_settings->{$key} = join(', ', @$value);
+    } else {
+      #XXX
+      warn "serializing ". ref($value). " for table display not yet handled";
+    }
+  }
+
+  %{$settingsref} = %$effective_settings;
+  %{$defaultref} = %defaults;
+
+  '';
 }
 
 sub communigate_pro_queue {
   my( $self, $svcnum, $method ) = (shift, shift, shift);
-  my @kludge_methods = qw(CreateAccount UpdateAccountSettings);
-  my $sub = 'communigate_pro_command';
-  $sub = $method if grep { $method eq $_ } @kludge_methods;
+  my %kludge_methods = (
+    'CreateAccount'         => 'CreateAccount',
+    'UpdateAccountSettings' => 'UpdateAccountSettings',
+    'CreateDomain'          => 'cp_Scalar_Hash',
+    'CreateSharedDomain'    => 'cp_Scalar_Hash',
+    'UpdateDomainSettings'  => 'UpdateDomainSettings',
+  );
+  my $sub = exists($kludge_methods{$method})
+              ? $kludge_methods{$method}
+              : 'communigate_pro_command';
   my $queue = new FS::queue {
     'svcnum' => $svcnum,
     'job'    => "FS::part_export::communigate_pro::$sub",
@@ -131,6 +261,41 @@ sub communigate_pro_queue {
 
 }
 
+sub communigate_pro_runcommand {
+  my( $self, $method ) = (shift, shift);
+
+  communigate_pro_command(
+    $self->machine,
+    $self->option('port'),
+    $self->option('login'),
+    $self->option('password'),
+    $method,
+    @_,
+  );
+
+}
+
+#XXX one sub per arg prototype is lame.  more magic?  i suppose queue needs
+# to store data strctures properly instead of just an arg list.  right.
+
+sub cp_Scalar_Hash {
+  my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_;
+  my @args = ( $scalar, \%hash );
+  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
+}
+
+#sub cp_Hash {
+#  my( $machine, $port, $login, $password, $method, %hash ) = @_;
+#  my @args = ( \%hash );
+#  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
+#}
+
+sub UpdateDomainSettings {
+  my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_;
+  my @args = ( 'domain' => $domain, 'settings' => \%settings );
+  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
+}
+
 sub CreateAccount {
   my( $machine, $port, $login, $password, $method, %args ) = @_;
   my $accountName  = delete $args{'accountName'};
@@ -152,7 +317,7 @@ sub UpdateAccountSettings {
   my( $machine, $port, $login, $password, $method, %args ) = @_;
   my $accountName  = delete $args{'accountName'};
   $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
-  @args = ( $accountName, \%args );
+  my @args = ( $accountName, \%args );
   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 }
 
@@ -168,10 +333,15 @@ sub communigate_pro_command { #subroutine, not method
     'password' => $password,
   } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
 
-  $cli->$method(@args) or die "CGPro error: ". $cli->getErrMessage;
+  #warn "$method ". Dumper(@args) if $DEBUG;
+
+  my $return = $cli->$method(@args)
+    or die "Communigate Pro error: ". $cli->getErrMessage;
 
   $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n";
 
+  $return;
+
 }
 
 1;