package FS::part_export::communigate_pro;
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',
},
'create_domain' => { label => 'Domain creation API call',
type => 'select',
options => [qw( CreateDomain CreateSharedDomain )],
}
;
%info = (
'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 of accounts and domains to a
CommuniGate Pro
mail server. The
CommuniGate Pro Perl Interface
must be installed as CGP::CLI.
END
);
sub rebless { shift; }
sub export_username {
my($self, $svc_acct) = (shift, shift);
$svc_acct->email;
}
sub _export_insert {
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);
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_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_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_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 = (
'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",
};
$queue->insert(
$self->machine,
$self->option('port'),
$self->option('login'),
$self->option('password'),
$method,
@_,
);
}
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'};
my $accountType = delete $args{'accountType'};
my $externalFlag = delete $args{'externalFlag'};
$args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
my @args = ( accountName => $accountName,
accountType => $accountType,
settings => \%args,
);
#externalFlag => $externalFlag,
push @args, externalFlag => $externalFlag if $externalFlag;
communigate_pro_command( $machine, $port, $login, $password, $method, @args );
}
sub UpdateAccountSettings {
my( $machine, $port, $login, $password, $method, %args ) = @_;
my $accountName = delete $args{'accountName'};
$args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
my @args = ( $accountName, \%args );
communigate_pro_command( $machine, $port, $login, $password, $method, @args );
}
sub communigate_pro_command { #subroutine, not method
my( $machine, $port, $login, $password, $method, @args ) = @_;
eval "use CGP::CLI";
my $cli = new CGP::CLI( {
'PeerAddr' => $machine,
'PeerPort' => $port,
'login' => $login,
'password' => $password,
} ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
#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;