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
81 #phase 2: pwdallowed, passwordrecovery, allowed mail rules,
82 # RPOP modifications, accepts mail to all, add trailer to sent mail
83 #phase 3: archive messages, mailing lists
85 my @options = ( 'CreateAccount',
86 'accountName' => $self->export_username($svc_acct),
87 'accountType' => ( $svc_acct->cgp_type
88 || $self->option('accountType') ),
89 'settings' => \%settings
92 push @options, 'externalFlag' => $self->option('externalFlag')
93 if $self->option('externalFlag');
95 #let's do the create realtime too, for much the same reasons, and to avoid
96 #pain of trying to queue w/dep the prefs & aliases
98 eval { $self->communigate_pro_runcommand( @options ) };
103 $prefs{'DeleteMode'} = $svc_acct->cgp_deletemode if $svc_acct->cgp_deletemode;
104 $prefs{'EmptyTrash'} = $svc_acct->cgp_emptytrash if $svc_acct->cgp_emptytrash;
105 #phase 2: language, time zone, layout, pronto style, send read receipts
107 my $pref_err = $self->communigate_pro_queue( $svc_acct->svcnum,
108 'UpdateAccountPrefs',
109 $self->export_username($svc_acct),
112 warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err"
117 if ( $svc_acct->cgp_aliases ) {
118 my $alias_err = $self->communigate_pro_queue( $svc_acct->svcnum,
120 $self->export_username($svc_acct),
121 [ split(/\s*,\s*/, $svc_acct->cgp_aliases) ],
123 warn "WARNING: error queueing SetAccountAliases job: $alias_err"
131 sub _export_insert_svc_domain {
132 my( $self, $svc_domain ) = (shift, shift);
134 my $create = $self->option('create_domain') || 'CreateDomain';
136 my @options = ( $svc_domain->svcnum, $create, $svc_domain->domain,
137 #other domain creation options?
139 push @options, 'AccountsLimit' => $svc_domain->max_accounts
140 if $svc_domain->max_accounts;
142 $self->communigate_pro_queue( @options );
145 #sub _export_insert_svc_forward {
148 sub _export_replace {
149 my( $self, $new, $old ) = (shift, shift, shift);
151 my $table = $new->table;
152 my $method = "_export_replace_$table";
153 $self->$method($new, $old, @_);
156 sub _export_replace_svc_acct {
157 my( $self, $new, $old ) = (shift, shift, shift);
159 #let's just do the rename part realtime rather than trying to queue
160 #w/dependencies. we don't want FS winding up out-of-sync with the wrong
161 #username and a queued job anyway. right??
162 if ( $self->export_username($old) ne $self->export_username($new) ) {
164 eval { $self->communigate_pro_runcommand(
166 $self->export_username($old),
167 $self->export_username($new),
172 if ( $new->_password ne $old->_password
173 && '*SUSPENDED* '.$old->_password ne $new->_password
175 $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword',
176 $self->export_username($new), $new->_password
182 $settings{'RealName'} = $new->finger
183 if $old->finger ne $new->finger;
184 $settings{$quotas{$_}} = $new->$_()
185 foreach grep $old->$_() ne $new->$_(), keys %quotas;
186 $settings{'accountType'} = $new->cgp_type
187 if $old->cgp_type ne $new->cgp_type;
188 $settings{'AccessModes'} = $new->cgp_accessmodes
189 if $old->cgp_accessmodes ne $new->cgp_accessmodes
190 || $old->cgp_type ne $new->cgp_type;
192 #phase 2: pwdallowed, passwordrecovery, allowed mail rules,
193 # RPOP modifications, accepts mail to all, add trailer to sent mail
194 #phase 3: archive messages, mailing lists
196 if ( keys %settings ) {
197 my $error = $self->communigate_pro_queue(
199 'UpdateAccountSettings',
200 $self->export_username($new),
203 return $error if $error;
208 $prefs{'DeleteMode'} = $new->cgp_deletemode
209 if $old->cgp_deletemode ne $new->cgp_deletemode;
210 $prefs{'EmptyTrash'} = $new->cgp_emptytrash
211 if $old->cgp_emptytrash ne $new->cgp_emptytrash;
212 #phase 2: language, time zone, layout, pronto style, send read receipts
214 my $pref_err = $self->communigate_pro_queue( $new->svcnum,
215 'UpdateAccountPrefs',
216 $self->export_username($new),
219 warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err"
223 if ( $old->cgp_aliases ne $new->cgp_aliases ) {
224 my $error = $self->communigate_pro_queue(
227 $self->export_username($new),
228 [ split(/\s*,\s*/, $new->cgp_aliases) ],
230 return $error if $error;
237 sub _export_replace_svc_domain {
238 my( $self, $new, $old ) = (shift, shift, shift);
240 if ( $old->domain ne $new->domain ) {
241 my $error = $self->communigate_pro_queue( $new->svcnum, 'RenameDomain',
242 $old->domain, $new->domain,
244 return $error if $error;
247 if ( $old->max_accounts ne $new->max_accounts ) {
248 my $error = $self->communigate_pro_queue( $new->svcnum,
249 'UpdateDomainSettings',
251 'AccountsLimit' => ($new->max_accounts || 'default'),
253 return $error if $error;
256 #other kinds of changes?
262 my( $self, $svc_x ) = (shift, shift);
264 my $table = $svc_x->table;
265 my $method = "_export_delete_$table";
266 $self->$method($svc_x, @_);
269 sub _export_delete_svc_acct {
270 my( $self, $svc_acct ) = (shift, shift);
272 $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount',
273 $self->export_username($svc_acct),
278 sub _export_delete_svc_domain {
279 my( $self, $svc_domain ) = (shift, shift);
281 $self->communigate_pro_queue( $svc_domain->svcnum, 'DeleteDomain',
283 #XXX turn on force option for domain deletion?
288 sub _export_suspend {
289 my( $self, $svc_x ) = (shift, shift);
291 my $table = $svc_x->table;
292 my $method = "_export_suspend_$table";
293 $self->$method($svc_x, @_);
297 sub _export_suspend_svc_acct {
298 my( $self, $svc_acct ) = (shift, shift);
300 #XXX is this the desired suspnsion action?
302 $self->communigate_pro_queue(
304 'UpdateAccountSettings',
305 $self->export_username($svc_acct),
306 'AccessModes' => 'Mail',
311 sub _export_suspend_svc_domain {
312 my( $self, $svc_domain) = (shift, shift);
314 #XXX domain operations
319 sub _export_unsuspend {
320 my( $self, $svc_x ) = (shift, shift);
322 my $table = $svc_x->table;
323 my $method = "_export_unsuspend_$table";
324 $self->$method($svc_x, @_);
328 sub _export_unsuspend_svc_acct {
329 my( $self, $svc_acct ) = (shift, shift);
331 $self->communigate_pro_queue(
333 'UpdateAccountSettings',
334 $self->export_username($svc_acct),
335 'AccessModes' => ( $svc_acct->cgp_accessmodes
336 || $self->option('AccessModes') ),
341 sub _export_unsuspend_svc_domain {
342 my( $self, $svc_domain) = (shift, shift);
344 #XXX domain operations
350 sub export_getsettings {
351 my($self, $svc_x) = (shift, shift);
353 my $table = $svc_x->table;
354 my $method = "export_getsettings_$table";
356 $self->can($method) ? $self->$method($svc_x, @_) : '';
360 sub export_getsettings_svc_domain {
361 my($self, $svc_domain, $settingsref, $defaultref ) = @_;
363 my $settings = eval { $self->communigate_pro_runcommand(
369 my $effective_settings = eval { $self->communigate_pro_runcommand(
370 'GetDomainEffectiveSettings',
375 my $acct_defaults = eval { $self->communigate_pro_runcommand(
376 'GetAccountDefaults',
381 #warn Dumper($acct_defaults);
383 %$effective_settings = ( %$effective_settings,
384 map { ("Acct. Default $_" => $acct_defaults->{$_}); }
385 keys(%$acct_defaults)
388 #false laziness w/below
390 my %defaults = map { $_ => 1 }
391 grep !exists(${$settings}{$_}), keys %$effective_settings;
393 foreach my $key ( grep ref($effective_settings->{$_}),
394 keys %$effective_settings )
396 my $value = $effective_settings->{$key};
397 if ( ref($value) eq 'ARRAY' ) {
398 $effective_settings->{$key} = join(' ', @$value);
401 warn "serializing ". ref($value). " for table display not yet handled";
405 %{$settingsref} = %$effective_settings;
406 %{$defaultref} = %defaults;
411 sub export_getsettings_svc_acct {
412 my($self, $svc_acct, $settingsref, $defaultref ) = @_;
414 my $settings = eval { $self->communigate_pro_runcommand(
415 'GetAccountSettings',
420 delete($settings->{'Password'});
422 my $effective_settings = eval { $self->communigate_pro_runcommand(
423 'GetAccountEffectiveSettings',
428 delete($effective_settings->{'Password'});
430 #prefs/effectiveprefs too
432 my $prefs = eval { $self->communigate_pro_runcommand(
438 my $effective_prefs = eval { $self->communigate_pro_runcommand(
439 'GetAccountEffectivePrefs',
444 %$effective_settings = ( %$effective_settings,
445 map { ("Pref $_" => $effective_prefs->{$_}); }
446 keys(%$effective_prefs)
448 %$settings = ( %$settings,
449 map { ("Pref $_" => $prefs->{$_}); }
455 my $aliases = eval { $self->communigate_pro_runcommand(
461 $effective_settings->{'Aliases'} = join(', ', @$aliases);
462 $settings->{'Aliases'} = join(', ', @$aliases);
464 #false laziness w/above
466 my %defaults = map { $_ => 1 }
467 grep !exists(${$settings}{$_}), keys %$effective_settings;
469 foreach my $key ( grep ref($effective_settings->{$_}),
470 keys %$effective_settings )
472 my $value = $effective_settings->{$key};
473 if ( ref($value) eq 'ARRAY' ) {
474 $effective_settings->{$key} = join(' ', @$value);
477 warn "serializing ". ref($value). " for table display not yet handled";
481 %{$settingsref} = %$effective_settings;
482 %{$defaultref} = %defaults;
488 sub communigate_pro_queue {
489 my( $self, $svcnum, $method ) = (shift, shift, shift);
490 my $jobnum = ''; #don't actually care
491 $self->communigate_pro_queue_dep( \$jobnum, $svcnum, $method, @_);
494 sub communigate_pro_queue_dep {
495 my( $self, $jobnumref, $svcnum, $method ) = splice(@_,0,4);
497 my %kludge_methods = (
498 'CreateAccount' => 'CreateAccount',
499 'UpdateAccountSettings' => 'UpdateAccountSettings',
500 'UpdateAccountPrefs' => 'cp_Scalar_Hash',
501 'CreateDomain' => 'cp_Scalar_Hash',
502 'CreateSharedDomain' => 'cp_Scalar_Hash',
503 'UpdateDomainSettings' => 'UpdateDomainSettings',
505 my $sub = exists($kludge_methods{$method})
506 ? $kludge_methods{$method}
507 : 'communigate_pro_command';
509 my $queue = new FS::queue {
511 'job' => "FS::part_export::communigate_pro::$sub",
513 my $error = $queue->insert(
515 $self->option('port'),
516 $self->option('login'),
517 $self->option('password'),
521 $$jobnumref = $queue->jobnum unless $error;
526 sub communigate_pro_runcommand {
527 my( $self, $method ) = (shift, shift);
529 communigate_pro_command(
531 $self->option('port'),
532 $self->option('login'),
533 $self->option('password'),
540 #XXX one sub per arg prototype is lame. more magic? i suppose queue needs
541 # to store data strctures properly instead of just an arg list. right.
544 my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_;
545 my @args = ( $scalar, \%hash );
546 communigate_pro_command( $machine, $port, $login, $password, $method, @args );
550 # my( $machine, $port, $login, $password, $method, %hash ) = @_;
551 # my @args = ( \%hash );
552 # communigate_pro_command( $machine, $port, $login, $password, $method, @args );
555 sub UpdateDomainSettings {
556 my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_;
557 my @args = ( 'domain' => $domain, 'settings' => \%settings );
558 communigate_pro_command( $machine, $port, $login, $password, $method, @args );
562 my( $machine, $port, $login, $password, $method, %args ) = @_;
563 my $accountName = delete $args{'accountName'};
564 my $accountType = delete $args{'accountType'};
565 my $externalFlag = delete $args{'externalFlag'};
566 $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
567 my @args = ( accountName => $accountName,
568 accountType => $accountType,
571 #externalFlag => $externalFlag,
572 push @args, externalFlag => $externalFlag if $externalFlag;
574 communigate_pro_command( $machine, $port, $login, $password, $method, @args );
578 sub UpdateAccountSettings {
579 my( $machine, $port, $login, $password, $method, $accountName, %args ) = @_;
580 $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
581 my @args = ( $accountName, \%args );
582 communigate_pro_command( $machine, $port, $login, $password, $method, @args );
585 sub communigate_pro_command { #subroutine, not method
586 my( $machine, $port, $login, $password, $method, @args ) = @_;
590 my $cli = new CGP::CLI( {
591 'PeerAddr' => $machine,
594 'password' => $password,
595 } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
597 #warn "$method ". Dumper(@args) if $DEBUG;
599 my $return = $cli->$method(@args)
600 or die "Communigate Pro error: ". $cli->getErrMessage;
602 $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n";