X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fcommunigate_pro.pm;h=c4201c0d00a50376283ecd31603fdbaaf1449f32;hp=ecb37809033c654661cabaa21f95d9ed72a83762;hb=cc647ae934abe5c9d9a5fc12f020adfc566349d9;hpb=af5b5947a7bcb13a94a84bb2b20c80a2778e0f35
diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm
index ecb378090..c4201c0d0 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
CommuniGate Pro
mail server. The
CommuniGate Pro Perl Interface
@@ -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;