1 package FS::part_export::communigate_pro;
4 use vars qw(@ISA %info %options %quotas $DEBUG);
10 @ISA = qw(FS::part_export);
14 tie %options, 'Tie::IxHash',
15 'port' => { label =>'Port number', default=>'106', },
16 'login' => { label =>'The administrator account name. The name can contain a domain part.', },
17 'password' => { label =>'The administrator account password.', },
18 'accountType' => { label => 'Type for newly-created accounts (default when not specified in service)',
20 options => [qw(MultiMailbox TextMailbox MailDirMailbox AGrade BGrade CGrade)],
21 default => 'MultiMailbox',
23 'externalFlag' => { label => 'Create accounts with an external (visible for legacy mailers) INBOX.',
26 'AccessModes' => { label => 'Access modes (default when not specified in service)',
27 default => 'Mail POP IMAP PWD WebMail WebSite',
29 'create_domain' => { label => 'Domain creation API call',
31 options => [qw( CreateDomain CreateSharedDomain )],
36 'svc' => [qw( svc_acct svc_domain svc_forward )],
37 'desc' => 'Real-time export of accounts and domains to a CommuniGate Pro mail server',
38 'options' => \%options,
40 Real time export of accounts and domains to a
41 <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a>
43 <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a>
44 must be installed as CGP::CLI.
49 'quota' => 'MaxAccountSize',
50 'file_quota' => 'MaxWebSize',
51 'file_maxnum' => 'MaxWebFiles',
52 'file_maxsize' => 'MaxFileSize',
55 sub rebless { shift; }
58 my($self, $svc_acct) = (shift, shift);
63 my( $self, $svc_x ) = (shift, shift);
65 my $table = $svc_x->table;
66 my $method = "_export_insert_$table";
67 $self->$method($svc_x, @_);
70 sub _export_insert_svc_acct {
71 my( $self, $svc_acct ) = (shift, shift);
74 'AccessModes' => ( $svc_acct->cgp_accessmodes
75 || $self->option('AccessModes') ),
76 'RealName' => $svc_acct->finger,
77 'Password' => $svc_acct->_password,
78 map { $quotas{$_} => $svc_acct->$_() }
79 grep $svc_acct->$_(), keys %quotas
82 #XXX preferences phase 1: message delete method, on logout remove trash
83 #phase 2: language, time zone, layout, pronto style, send read receipts
85 #phase 2: pwdallowed, passwordrecovery, allowed mail rules,
86 # RPOP modifications, accepts mail to all, add trailer to sent mail
87 #phase 3: archive messages, mailing lists
89 my @options = ( 'CreateAccount',
90 'accountName' => $self->export_username($svc_acct),
91 'accountType' => ( $svc_acct->cgp_type
92 || $self->option('accountType') ),
93 'settings' => \%settings
96 push @options, 'externalFlag' => $self->option('externalFlag')
97 if $self->option('externalFlag');
99 #let's do the create realtime too, for much the same reasons, and to avoid
100 #pain of trying to queue w/dep the aliases
102 eval { $self->communigate_pro_runcommand( @options ) };
105 my $err= $self->communigate_pro_queue( $svc_acct->svcnum, 'SetAccountAliases',
106 $self->export_username($svc_acct),
107 [ split(/\s*,\s*/, $svc_acct->cgp_aliases) ],
109 warn "WARNING: error queueing SetAccountAliases job: $err" if $err;
115 sub _export_insert_svc_domain {
116 my( $self, $svc_domain ) = (shift, shift);
118 my $create = $self->option('create_domain') || 'CreateDomain';
120 my @options = ( $svc_domain->svcnum, $create, $svc_domain->domain,
121 #other domain creation options?
123 push @options, 'AccountsLimit' => $svc_domain->max_accounts
124 if $svc_domain->max_accounts;
126 $self->communigate_pro_queue( @options );
129 #sub _export_insert_svc_forward {
132 sub _export_replace {
133 my( $self, $new, $old ) = (shift, shift, shift);
135 my $table = $new->table;
136 my $method = "_export_replace_$table";
137 $self->$method($new, $old, @_);
140 sub _export_replace_svc_acct {
141 my( $self, $new, $old ) = (shift, shift, shift);
143 #let's just do the rename part realtime rather than trying to queue
144 #w/dependencies. we don't want FS winding up out-of-sync with the wrong
145 #username and a queued job anyway. right??
146 if ( $self->export_username($old) ne $self->export_username($new) ) {
148 eval { $self->communigate_pro_runcommand(
150 $self->export_username($old),
151 $self->export_username($new),
156 if ( $new->_password ne $old->_password
157 && '*SUSPENDED* '.$old->_password ne $new->_password
159 $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword',
160 $self->export_username($new), $new->_password
166 $settings{'RealName'} = $new->finger
167 if $old->finger ne $new->finger;
168 $settings{$quotas{$_}} = $new->$_()
169 foreach grep $old->$_() ne $new->$_(), keys %quotas;
170 $settings{'accountType'} = $new->cgp_type
171 if $old->cgp_type ne $new->cgp_type;
172 $settings{'AccessModes'} = $new->cgp_accessmodes
173 if $old->cgp_accessmodes ne $new->cgp_accessmodes
174 || $old->cgp_type ne $new->cgp_type;
176 #phase 2: pwdallowed, passwordrecovery, allowed mail rules,
177 # RPOP modifications, accepts mail to all, add trailer to sent mail
178 #phase 3: archive messages, mailing lists
180 if ( keys %settings ) {
181 my $error = $self->communigate_pro_queue(
183 'UpdateAccountSettings',
184 $self->export_username($new),
187 return $error if $error;
190 if ( $old->cgp_aliases ne $new->cgp_aliases ) {
191 my $error = $self->communigate_pro_queue(
194 $self->export_username($new),
195 [ split(/\s*,\s*/, $new->cgp_aliases) ],
197 return $error if $error;
200 #XXX preferences phase 1: message delete method, on logout remove trash
201 #phase 2: language, time zone, layout, pronto style, send read receipts
207 sub _export_replace_svc_domain {
208 my( $self, $new, $old ) = (shift, shift, shift);
210 if ( $old->domain ne $new->domain ) {
211 my $error = $self->communigate_pro_queue( $new->svcnum, 'RenameDomain',
212 $old->domain, $new->domain,
214 return $error if $error;
217 if ( $old->max_accounts ne $new->max_accounts ) {
218 my $error = $self->communigate_pro_queue( $new->svcnum,
219 'UpdateDomainSettings',
221 'AccountsLimit' => ($new->max_accounts || 'default'),
223 return $error if $error;
226 #other kinds of changes?
232 my( $self, $svc_x ) = (shift, shift);
234 my $table = $svc_x->table;
235 my $method = "_export_delete_$table";
236 $self->$method($svc_x, @_);
239 sub _export_delete_svc_acct {
240 my( $self, $svc_acct ) = (shift, shift);
242 $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount',
243 $self->export_username($svc_acct),
248 sub _export_delete_svc_domain {
249 my( $self, $svc_domain ) = (shift, shift);
251 $self->communigate_pro_queue( $svc_domain->svcnum, 'DeleteDomain',
253 #XXX turn on force option for domain deletion?
258 sub _export_suspend {
259 my( $self, $svc_x ) = (shift, shift);
261 my $table = $svc_x->table;
262 my $method = "_export_suspend_$table";
263 $self->$method($svc_x, @_);
267 sub _export_suspend_svc_acct {
268 my( $self, $svc_acct ) = (shift, shift);
270 #XXX is this the desired suspnsion action?
272 $self->communigate_pro_queue(
274 'UpdateAccountSettings',
275 $self->export_username($svc_acct),
276 'AccessModes' => 'Mail',
281 sub _export_suspend_svc_domain {
282 my( $self, $svc_domain) = (shift, shift);
284 #XXX domain operations
289 sub _export_unsuspend {
290 my( $self, $svc_x ) = (shift, shift);
292 my $table = $svc_x->table;
293 my $method = "_export_unsuspend_$table";
294 $self->$method($svc_x, @_);
298 sub _export_unsuspend_svc_acct {
299 my( $self, $svc_acct ) = (shift, shift);
301 $self->communigate_pro_queue(
303 'UpdateAccountSettings',
304 $self->export_username($svc_acct),
305 'AccessModes' => ( $svc_acct->cgp_accessmodes
306 || $self->option('AccessModes') ),
311 sub _export_unsuspend_svc_domain {
312 my( $self, $svc_domain) = (shift, shift);
314 #XXX domain operations
320 sub export_getsettings {
321 my($self, $svc_x) = (shift, shift);
323 my $table = $svc_x->table;
324 my $method = "export_getsettings_$table";
326 $self->can($method) ? $self->$method($svc_x, @_) : '';
330 sub export_getsettings_svc_domain {
331 my($self, $svc_domain, $settingsref, $defaultref ) = @_;
333 my $settings = eval { $self->communigate_pro_runcommand(
339 my $effective_settings = eval { $self->communigate_pro_runcommand(
340 'GetDomainEffectiveSettings',
345 my $acct_defaults = eval { $self->communigate_pro_runcommand(
346 'GetAccountDefaults',
351 #warn Dumper($acct_defaults);
353 %$effective_settings = ( %$effective_settings,
354 map { ("Acct. Default $_" => $acct_defaults->{$_}); }
355 keys(%$acct_defaults)
358 #false laziness w/below
360 my %defaults = map { $_ => 1 }
361 grep !exists(${$settings}{$_}), keys %$effective_settings;
363 foreach my $key ( grep ref($effective_settings->{$_}),
364 keys %$effective_settings )
366 my $value = $effective_settings->{$key};
367 if ( ref($value) eq 'ARRAY' ) {
368 $effective_settings->{$key} = join(' ', @$value);
371 warn "serializing ". ref($value). " for table display not yet handled";
375 %{$settingsref} = %$effective_settings;
376 %{$defaultref} = %defaults;
381 sub export_getsettings_svc_acct {
382 my($self, $svc_acct, $settingsref, $defaultref ) = @_;
384 my $settings = eval { $self->communigate_pro_runcommand(
385 'GetAccountSettings',
390 delete($settings->{'Password'});
392 my $effective_settings = eval { $self->communigate_pro_runcommand(
393 'GetAccountEffectiveSettings',
398 delete($effective_settings->{'Password'});
400 #prefs/effectiveprefs too
402 my $prefs = eval { $self->communigate_pro_runcommand(
408 my $effective_prefs = eval { $self->communigate_pro_runcommand(
409 'GetAccountEffectivePrefs',
414 %$effective_settings = ( %$effective_settings,
415 map { ("Pref $_" => $effective_prefs->{$_}); }
416 keys(%$effective_prefs)
418 %$settings = ( %$settings,
419 map { ("Pref $_" => $prefs->{$_}); }
425 my $aliases = eval { $self->communigate_pro_runcommand(
431 $effective_settings->{'Aliases'} = join(', ', @$aliases);
432 $settings->{'Aliases'} = join(', ', @$aliases);
434 #false laziness w/above
436 my %defaults = map { $_ => 1 }
437 grep !exists(${$settings}{$_}), keys %$effective_settings;
439 foreach my $key ( grep ref($effective_settings->{$_}),
440 keys %$effective_settings )
442 my $value = $effective_settings->{$key};
443 if ( ref($value) eq 'ARRAY' ) {
444 $effective_settings->{$key} = join(' ', @$value);
447 warn "serializing ". ref($value). " for table display not yet handled";
451 %{$settingsref} = %$effective_settings;
452 %{$defaultref} = %defaults;
458 sub communigate_pro_queue {
459 my( $self, $svcnum, $method ) = (shift, shift, shift);
460 my $jobnum = ''; #don't actually care
461 $self->communigate_pro_queue_dep( \$jobnum, $svcnum, $method, @_);
464 sub communigate_pro_queue_dep {
465 my( $self, $jobnumref, $svcnum, $method ) = splice(@_,0,4);
467 my %kludge_methods = (
468 'CreateAccount' => 'CreateAccount',
469 'UpdateAccountSettings' => 'UpdateAccountSettings',
470 'CreateDomain' => 'cp_Scalar_Hash',
471 'CreateSharedDomain' => 'cp_Scalar_Hash',
472 'UpdateDomainSettings' => 'UpdateDomainSettings',
474 my $sub = exists($kludge_methods{$method})
475 ? $kludge_methods{$method}
476 : 'communigate_pro_command';
478 my $queue = new FS::queue {
480 'job' => "FS::part_export::communigate_pro::$sub",
482 my $error = $queue->insert(
484 $self->option('port'),
485 $self->option('login'),
486 $self->option('password'),
490 $$jobnumref = $queue->jobnum unless $error;
495 sub communigate_pro_runcommand {
496 my( $self, $method ) = (shift, shift);
498 communigate_pro_command(
500 $self->option('port'),
501 $self->option('login'),
502 $self->option('password'),
509 #XXX one sub per arg prototype is lame. more magic? i suppose queue needs
510 # to store data strctures properly instead of just an arg list. right.
513 my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_;
514 my @args = ( $scalar, \%hash );
515 communigate_pro_command( $machine, $port, $login, $password, $method, @args );
519 # my( $machine, $port, $login, $password, $method, %hash ) = @_;
520 # my @args = ( \%hash );
521 # communigate_pro_command( $machine, $port, $login, $password, $method, @args );
524 sub UpdateDomainSettings {
525 my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_;
526 my @args = ( 'domain' => $domain, 'settings' => \%settings );
527 communigate_pro_command( $machine, $port, $login, $password, $method, @args );
531 my( $machine, $port, $login, $password, $method, %args ) = @_;
532 my $accountName = delete $args{'accountName'};
533 my $accountType = delete $args{'accountType'};
534 my $externalFlag = delete $args{'externalFlag'};
535 $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
536 my @args = ( accountName => $accountName,
537 accountType => $accountType,
540 #externalFlag => $externalFlag,
541 push @args, externalFlag => $externalFlag if $externalFlag;
543 communigate_pro_command( $machine, $port, $login, $password, $method, @args );
547 sub UpdateAccountSettings {
548 my( $machine, $port, $login, $password, $method, $accountName, %args ) = @_;
549 $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
550 my @args = ( $accountName, \%args );
551 communigate_pro_command( $machine, $port, $login, $password, $method, @args );
554 sub communigate_pro_command { #subroutine, not method
555 my( $machine, $port, $login, $password, $method, @args ) = @_;
559 my $cli = new CGP::CLI( {
560 'PeerAddr' => $machine,
563 'password' => $password,
564 } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
566 #warn "$method ". Dumper(@args) if $DEBUG;
568 my $return = $cli->$method(@args)
569 or die "Communigate Pro error: ". $cli->getErrMessage;
571 $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n";