communigate: domain aliases, enabled services & administrator domain, RT#7083
[freeside.git] / FS / FS / part_export / communigate_pro.pm
1 package FS::part_export::communigate_pro;
2
3 use strict;
4 use vars qw(@ISA %info %options %quotas $DEBUG);
5 use Data::Dumper;
6 use Tie::IxHash;
7 use FS::part_export;
8 use FS::queue;
9
10 @ISA = qw(FS::part_export);
11
12 $DEBUG = 1;
13
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)',
19                        type    => 'select',
20                        options => [qw(MultiMailbox TextMailbox MailDirMailbox AGrade BGrade CGrade)],
21                        default => 'MultiMailbox',
22                      },
23   'externalFlag'  => { label   => 'Create accounts with an external (visible for legacy mailers) INBOX.',
24                        type    => 'checkbox',
25                      },
26   'AccessModes'   => { label   => 'Access modes (default when not specified in service)',
27                        default => 'Mail POP IMAP PWD WebMail WebSite',
28                      },
29   'create_domain' => { label   => 'Domain creation API call',
30                        type    => 'select',
31                        options => [qw( CreateDomain CreateSharedDomain )],
32                      }
33 ;
34
35 %info = (
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,
39   'notes'   => <<'END'
40 Real time export of accounts and domains to a
41 <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a>
42 mail server.  The
43 <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a>
44 must be installed as CGP::CLI.
45 END
46 );
47
48 %quotas = (
49   'quota'        => 'MaxAccountSize',
50   'file_quota'   => 'MaxWebSize',
51   'file_maxnum'  => 'MaxWebFiles',
52   'file_maxsize' => 'MaxFileSize',
53 );
54
55 sub rebless { shift; }
56
57 sub export_username {
58   my($self, $svc_acct) = (shift, shift);
59   $svc_acct->email;
60 }
61
62 sub _export_insert {
63   my( $self, $svc_x ) = (shift, shift);
64
65   my $table = $svc_x->table;
66   my $method = "_export_insert_$table";
67   $self->$method($svc_x, @_);
68 }
69
70 sub _export_insert_svc_acct {
71   my( $self, $svc_acct ) = (shift, shift);
72
73   my %settings = (
74     'AccessModes'    => [ split(' ', ( $svc_acct->cgp_accessmodes
75                                        || $self->option('AccessModes') )
76                                )
77                         ],
78     'RealName'       => $svc_acct->finger,
79     'Password'       => $svc_acct->_password,
80     map { $quotas{$_} => $svc_acct->$_() }
81         grep $svc_acct->$_(), keys %quotas
82   );
83   #phase 2: pwdallowed, passwordrecovery, allowed mail rules,
84   # RPOP modifications, accepts mail to all, add trailer to sent mail
85   #phase 3: archive messages, mailing lists
86
87   my @options = ( 'CreateAccount',
88     'accountName'    => $self->export_username($svc_acct),
89     'accountType'    => ( $svc_acct->cgp_type
90                           || $self->option('accountType') ), 
91     'settings'       => \%settings
92   );
93
94   push @options, 'externalFlag'   => $self->option('externalFlag')
95     if $self->option('externalFlag');
96
97   #let's do the create realtime too, for much the same reasons, and to avoid
98   #pain of trying to queue w/dep the prefs & aliases
99   eval { $self->communigate_pro_runcommand( @options ) };
100   return $@ if $@;
101
102   #preferences
103   my %prefs = ();
104   $prefs{'DeleteMode'} = $svc_acct->cgp_deletemode if $svc_acct->cgp_deletemode;
105   $prefs{'EmptyTrash'} = $svc_acct->cgp_emptytrash if $svc_acct->cgp_emptytrash;
106   #phase 2: language, time zone, layout, pronto style, send read receipts
107   if ( keys %prefs ) {
108     my $pref_err = $self->communigate_pro_queue( $svc_acct->svcnum,
109       'UpdateAccountPrefs',
110       $self->export_username($svc_acct),
111       %prefs,
112     );
113    warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err"
114     if $pref_err;
115   }
116
117   #aliases
118   if ( $svc_acct->cgp_aliases ) {
119     my $alias_err = $self->communigate_pro_queue( $svc_acct->svcnum,
120       'SetAccountAliases',
121       $self->export_username($svc_acct),
122       [ split(/\s*[,\s]\s*/, $svc_acct->cgp_aliases) ],
123     );
124     warn "WARNING: error queueing SetAccountAliases job: $alias_err"
125       if $alias_err;
126   }
127
128   '';
129
130 }
131
132 sub _export_insert_svc_domain {
133   my( $self, $svc_domain ) = (shift, shift);
134
135   my $create = $self->option('create_domain') || 'CreateDomain';
136
137   my %settings = (
138     'DomainAccessModes'    => [ split(' ', $svc_domain->cgp_accessmodes ) ],
139   );
140   $settings{'AccountsLimit'} = $svc_domain->max_accounts
141     if $svc_domain->max_accounts;
142   $settings{'AdminDomainName'} = $svc_domain->parent_svc_x->domain
143     if $svc_domain->parent_svcnum;
144
145   my @options = ( $create, $svc_domain->domain, \%settings );
146
147   eval { $self->communigate_pro_runcommand( @options ) };
148   return $@ if $@;
149
150   #aliases
151   if ( $svc_domain->cgp_aliases ) {
152     my $alias_err = $self->communigate_pro_queue( $svc_domain->svcnum,
153       'SetDomainAliases',
154       $svc_domain->domain,
155       split(/\s*[,\s]\s*/, $svc_domain->cgp_aliases),
156     );
157     warn "WARNING: error queueing SetDomainAliases job: $alias_err"
158       if $alias_err;
159   }
160
161   #account defaults
162
163   #account defaults prefs
164
165   '';
166
167 }
168
169 sub _export_insert_svc_forward {
170   my( $self, $svc_forward ) = (shift, shift);
171
172   my $src = $svc_forward->src || $svc_forward->srcsvc_acct->email;
173   my $dst = $svc_forward->dst || $svc_forward->dstsvc_acct->email;
174
175   #real-time here, presuming CGP does some dup detection?
176   eval { $self->communigate_pro_runcommand( 'CreateForwarder', $src, $dst); };
177   return $@ if $@;
178
179   '';
180 }
181
182 sub _export_replace {
183   my( $self, $new, $old ) = (shift, shift, shift);
184
185   my $table = $new->table;
186   my $method = "_export_replace_$table";
187   $self->$method($new, $old, @_);
188 }
189
190 sub _export_replace_svc_acct {
191   my( $self, $new, $old ) = (shift, shift, shift);
192
193   #let's just do the rename part realtime rather than trying to queue
194   #w/dependencies.  we don't want FS winding up out-of-sync with the wrong
195   #username and a queued job anyway.  right??
196   if ( $self->export_username($old) ne $self->export_username($new) ) {
197     eval { $self->communigate_pro_runcommand(
198       'RenameAccount',
199       $self->export_username($old),
200       $self->export_username($new),
201     ) };
202     return $@ if $@;
203   }
204
205   if ( $new->_password ne $old->_password
206        && '*SUSPENDED* '.$old->_password ne $new->_password
207   ) {
208     $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword',
209                                   $self->export_username($new), $new->_password
210                                 );
211   }
212
213   my %settings = ();
214
215   $settings{'RealName'} = $new->finger
216     if $old->finger ne $new->finger;
217   $settings{$quotas{$_}} = $new->$_()
218     foreach grep $old->$_() ne $new->$_(), keys %quotas;
219   $settings{'accountType'} = $new->cgp_type
220     if $old->cgp_type ne $new->cgp_type;
221   $settings{'AccessModes'} = $new->cgp_accessmodes
222     if $old->cgp_accessmodes ne $new->cgp_accessmodes
223     || $old->cgp_type ne $new->cgp_type;
224
225   #phase 2: pwdallowed, passwordrecovery, allowed mail rules,
226   # RPOP modifications, accepts mail to all, add trailer to sent mail
227   #phase 3: archive messages, mailing lists
228
229   if ( keys %settings ) {
230     my $error = $self->communigate_pro_queue(
231       $new->svcnum,
232       'UpdateAccountSettings',
233       $self->export_username($new),
234       %settings,
235     );
236     return $error if $error;
237   }
238
239   #preferences
240   my %prefs = ();
241   $prefs{'DeleteMode'} = $new->cgp_deletemode
242     if $old->cgp_deletemode ne $new->cgp_deletemode;
243   $prefs{'EmptyTrash'} = $new->cgp_emptytrash
244     if $old->cgp_emptytrash ne $new->cgp_emptytrash;
245   #phase 2: language, time zone, layout, pronto style, send read receipts
246   if ( keys %prefs ) {
247     my $pref_err = $self->communigate_pro_queue( $new->svcnum,
248       'UpdateAccountPrefs',
249       $self->export_username($new),
250       %prefs,
251     );
252    warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err"
253     if $pref_err;
254   }
255
256   if ( $old->cgp_aliases ne $new->cgp_aliases ) {
257     my $error = $self->communigate_pro_queue(
258       $new->svcnum,
259       'SetAccountAliases',
260       $self->export_username($new),
261       [ split(/\s*[,\s]\s*/, $new->cgp_aliases) ],
262     );
263     return $error if $error;
264   }
265
266   '';
267
268 }
269
270 sub _export_replace_svc_domain {
271   my( $self, $new, $old ) = (shift, shift, shift);
272
273   if ( $old->domain ne $new->domain ) {
274     my $error = $self->communigate_pro_queue( $new->svcnum, 'RenameDomain',
275       $old->domain, $new->domain,
276     );
277     return $error if $error;
278   }
279   my %settings = ();
280   $settings{'AccountsLimit'} = $new->max_accounts
281     if $old->max_accounts ne $new->max_accounts;
282   $settings{'DomainAccessModes'} = $new->cgp_accessmodes
283     if $old->cgp_accessmodes ne $new->cgp_accessmodes;
284   $settings{'AdminDomainName'} =
285     $new->parent_svcnum ? $new->parent_svc_x->domain : ''
286       if $old->parent_svcnum != $new->parent_svcnum;
287
288   if ( keys %settings ) {
289     my $error = $self->communigate_pro_queue( $new->svcnum,
290       'UpdateDomainSettings',
291       $new->domain,
292       %settings,
293     );
294     return $error if $error;
295   }
296
297   if ( $old->cgp_aliases ne $new->cgp_aliases ) {
298     my $error = $self->communigate_pro_queue( $new->svcnum,
299       'SetDomainAliases',
300       $new->domain,
301       split(/\s*[,\s]\s*/, $new->cgp_aliases),
302     );
303     return $error if $error;
304   }
305
306   #other kinds of changes?
307
308   '';
309 }
310
311 sub _export_replace_svc_forward {
312   my( $self, $new, $old ) = (shift, shift, shift);
313
314   my $osrc = $old->src || $old->srcsvc_acct->email;
315   my $nsrc = $new->src || $new->srcsvc_acct->email;
316   my $odst = $old->dst || $old->dstsvc_acct->email;
317   my $ndst = $new->dst || $new->dstsvc_acct->email;
318
319   if ( $odst ne $ndst ) {
320
321     #no change command, so delete and create (real-time)
322     eval { $self->communigate_pro_runcommand('DeleteForwarder', $osrc) };
323     return $@ if $@;
324     eval { $self->communigate_pro_runcommand('CreateForwarder', $nsrc, $ndst)};
325     return $@ if $@;
326
327   } elsif ( $osrc ne $nsrc ) {
328
329     #real-time here, presuming CGP does some dup detection?
330     eval { $self->communigate_pro_runcommand( 'RenameForwarder', $osrc, $nsrc)};
331     return $@ if $@;
332
333   } else {
334     warn "communigate replace called for svc_forward with no changes\n";#confess
335   }
336
337   '';
338 }
339
340 sub _export_delete {
341   my( $self, $svc_x ) = (shift, shift);
342
343   my $table = $svc_x->table;
344   my $method = "_export_delete_$table";
345   $self->$method($svc_x, @_);
346 }
347
348 sub _export_delete_svc_acct {
349   my( $self, $svc_acct ) = (shift, shift);
350
351   $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount',
352     $self->export_username($svc_acct),
353   );
354 }
355
356 sub _export_delete_svc_domain {
357   my( $self, $svc_domain ) = (shift, shift);
358
359   $self->communigate_pro_queue( $svc_domain->svcnum, 'DeleteDomain',
360     $svc_domain->domain,
361     #XXX turn on force option for domain deletion?
362   );
363 }
364
365 sub _export_delete_svc_forward {
366   my( $self, $svc_forward ) = (shift, shift);
367
368   $self->communigate_pro_queue( $svc_forward->svcnum, 'DeleteForwarder',
369     ($svc_forward->src || $svc_forward->srcsvc_acct->email),
370   );
371 }
372
373 sub _export_suspend {
374   my( $self, $svc_x ) = (shift, shift);
375
376   my $table = $svc_x->table;
377   my $method = "_export_suspend_$table";
378   $self->$method($svc_x, @_);
379
380 }
381
382 sub _export_suspend_svc_acct {
383   my( $self, $svc_acct ) = (shift, shift);
384
385   #XXX is this the desired suspnsion action?
386
387    $self->communigate_pro_queue(
388     $svc_acct->svcnum,
389     'UpdateAccountSettings',
390     $self->export_username($svc_acct),
391     'AccessModes' => 'Mail',
392   );
393
394 }
395
396 sub _export_suspend_svc_domain {
397   my( $self, $svc_domain) = (shift, shift);
398
399   #XXX domain operations
400   '';
401
402 }
403
404 sub _export_unsuspend {
405   my( $self, $svc_x ) = (shift, shift);
406
407   my $table = $svc_x->table;
408   my $method = "_export_unsuspend_$table";
409   $self->$method($svc_x, @_);
410
411 }
412
413 sub _export_unsuspend_svc_acct {
414   my( $self, $svc_acct ) = (shift, shift);
415
416   $self->communigate_pro_queue(
417     $svc_acct->svcnum,
418     'UpdateAccountSettings',
419     $self->export_username($svc_acct),
420     'AccessModes' => ( $svc_acct->cgp_accessmodes
421                          || $self->option('AccessModes') ),
422   );
423
424 }
425
426 sub _export_unsuspend_svc_domain {
427   my( $self, $svc_domain) = (shift, shift);
428
429   #XXX domain operations
430   '';
431
432 }
433
434
435 sub export_getsettings {
436   my($self, $svc_x) = (shift, shift);
437
438   my $table = $svc_x->table;
439   my $method = "export_getsettings_$table";
440
441   $self->can($method) ? $self->$method($svc_x, @_) : '';
442
443 }
444
445 sub export_getsettings_svc_domain {
446   my($self, $svc_domain, $settingsref, $defaultref ) = @_;
447
448   my $settings = eval { $self->communigate_pro_runcommand(
449     'GetDomainSettings',
450     $svc_domain->domain
451   ) };
452   return $@ if $@;
453
454   my $effective_settings = eval { $self->communigate_pro_runcommand(
455     'GetDomainEffectiveSettings',
456     $svc_domain->domain
457   ) };
458   return $@ if $@;
459
460   my $acct_defaults = eval { $self->communigate_pro_runcommand(
461     'GetAccountDefaults',
462     $svc_domain->domain
463   ) };
464   return $@ if $@;
465
466   #warn Dumper($acct_defaults);
467
468   %$effective_settings = ( %$effective_settings,
469                            map { ("Acct. Default $_" => $acct_defaults->{$_}); }
470                                keys(%$acct_defaults)
471                          );
472
473   #aliases too
474   my $aliases = eval { $self->communigate_pro_runcommand(
475     'GetDomainAliases',
476     $svc_domain->domain
477   ) };
478   return $@ if $@;
479
480   $effective_settings->{'Aliases'} = join(', ', @$aliases);
481   $settings->{'Aliases'}           = join(', ', @$aliases);
482
483
484   #false laziness w/below
485   
486   my %defaults = map { $_ => 1 }
487                    grep !exists(${$settings}{$_}), keys %$effective_settings;
488
489   foreach my $key ( grep ref($effective_settings->{$_}),
490                     keys %$effective_settings )
491   {
492     my $value = $effective_settings->{$key};
493     if ( ref($value) eq 'ARRAY' ) {
494       $effective_settings->{$key} = join(' ', @$value);
495     } else {
496       #XXX
497       warn "serializing ". ref($value). " for table display not yet handled";
498     }
499   }
500
501   %{$settingsref} = %$effective_settings;
502   %{$defaultref} = %defaults;
503
504   '';
505 }
506
507 sub export_getsettings_svc_acct {
508   my($self, $svc_acct, $settingsref, $defaultref ) = @_;
509
510   my $settings = eval { $self->communigate_pro_runcommand(
511     'GetAccountSettings',
512     $svc_acct->email
513   ) };
514   return $@ if $@;
515
516   delete($settings->{'Password'});
517
518   my $effective_settings = eval { $self->communigate_pro_runcommand(
519     'GetAccountEffectiveSettings',
520     $svc_acct->email
521   ) };
522   return $@ if $@;
523
524   delete($effective_settings->{'Password'});
525
526   #prefs/effectiveprefs too
527
528   my $prefs = eval { $self->communigate_pro_runcommand(
529     'GetAccountPrefs',
530     $svc_acct->email
531   ) };
532   return $@ if $@;
533
534   my $effective_prefs = eval { $self->communigate_pro_runcommand(
535     'GetAccountEffectivePrefs',
536     $svc_acct->email
537   ) };
538   return $@ if $@;
539
540   %$effective_settings = ( %$effective_settings,
541                            map { ("Pref $_" => $effective_prefs->{$_}); }
542                                keys(%$effective_prefs)
543                          );
544   %$settings = ( %$settings,
545                  map { ("Pref $_" => $prefs->{$_}); }
546                      keys(%$prefs)
547                );
548
549   #aliases too
550
551   my $aliases = eval { $self->communigate_pro_runcommand(
552     'GetAccountAliases',
553     $svc_acct->email
554   ) };
555   return $@ if $@;
556
557   $effective_settings->{'Aliases'} = join(', ', @$aliases);
558   $settings->{'Aliases'}           = join(', ', @$aliases);
559
560   #false laziness w/above
561
562   my %defaults = map { $_ => 1 }
563                    grep !exists(${$settings}{$_}), keys %$effective_settings;
564
565   foreach my $key ( grep ref($effective_settings->{$_}),
566                     keys %$effective_settings )
567   {
568     my $value = $effective_settings->{$key};
569     if ( ref($value) eq 'ARRAY' ) {
570       $effective_settings->{$key} = join(' ', @$value);
571     } else {
572       #XXX
573       warn "serializing ". ref($value). " for table display not yet handled";
574     }
575   }
576
577   %{$settingsref} = %$effective_settings;
578   %{$defaultref} = %defaults;
579
580   '';
581
582 }
583
584 sub communigate_pro_queue {
585   my( $self, $svcnum, $method ) = (shift, shift, shift);
586   my $jobnum = ''; #don't actually care
587   $self->communigate_pro_queue_dep( \$jobnum, $svcnum, $method, @_);
588 }
589
590 sub communigate_pro_queue_dep {
591   my( $self, $jobnumref, $svcnum, $method ) = splice(@_,0,4);
592
593   my %kludge_methods = (
594     #'CreateAccount'         => 'CreateAccount',
595     'UpdateAccountSettings' => 'UpdateAccountSettings',
596     'UpdateAccountPrefs'    => 'cp_Scalar_Hash',
597     #'CreateDomain'          => 'cp_Scalar_Hash',
598     #'CreateSharedDomain'    => 'cp_Scalar_Hash',
599     'UpdateDomainSettings'  => 'UpdateDomainSettings',
600     'SetDomainAliases'      => 'cp_Scalar_Array',
601   );
602   my $sub = exists($kludge_methods{$method})
603               ? $kludge_methods{$method}
604               : 'communigate_pro_command';
605
606   my $queue = new FS::queue {
607     'svcnum' => $svcnum,
608     'job'    => "FS::part_export::communigate_pro::$sub",
609   };
610   my $error = $queue->insert(
611     $self->machine,
612     $self->option('port'),
613     $self->option('login'),
614     $self->option('password'),
615     $method,
616     @_,
617   );
618   $$jobnumref = $queue->jobnum unless $error;
619
620   return $error;
621 }
622
623 sub communigate_pro_runcommand {
624   my( $self, $method ) = (shift, shift);
625
626   communigate_pro_command(
627     $self->machine,
628     $self->option('port'),
629     $self->option('login'),
630     $self->option('password'),
631     $method,
632     @_,
633   );
634
635 }
636
637 #XXX one sub per arg prototype is lame.  more magic?  i suppose queue needs
638 # to store data strctures properly instead of just an arg list.  right.
639
640 sub cp_Scalar_Hash {
641   my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_;
642   my @args = ( $scalar, \%hash );
643   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
644 }
645
646 sub cp_Scalar_Array {
647   my( $machine, $port, $login, $password, $method, $scalar, @array ) = @_;
648   my @args = ( $scalar, \@array );
649   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
650 }
651
652 #sub cp_Hash {
653 #  my( $machine, $port, $login, $password, $method, %hash ) = @_;
654 #  my @args = ( \%hash );
655 #  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
656 #}
657
658 sub UpdateDomainSettings {
659   my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_;
660   $settings{'DomainAccessModes'} = [split(' ',$settings{'DomainAccessModes'})];
661   my @args = ( 'domain' => $domain, 'settings' => \%settings );
662   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
663 }
664
665 #sub CreateAccount {
666 #  my( $machine, $port, $login, $password, $method, %args ) = @_;
667 #  my $accountName  = delete $args{'accountName'};
668 #  my $accountType  = delete $args{'accountType'};
669 #  my $externalFlag = delete $args{'externalFlag'};
670 #  $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
671 #  my @args = ( accountName  => $accountName,
672 #               accountType  => $accountType,
673 #               settings     => \%args,
674 #             );
675 #               #externalFlag => $externalFlag,
676 #  push @args, externalFlag => $externalFlag if $externalFlag;
677 #
678 #  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
679 #
680 #}
681
682 sub UpdateAccountSettings {
683   my( $machine, $port, $login, $password, $method, $accountName, %args ) = @_;
684   $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
685   my @args = ( $accountName, \%args );
686   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
687 }
688
689 sub communigate_pro_command { #subroutine, not method
690   my( $machine, $port, $login, $password, $method, @args ) = @_;
691
692   eval "use CGP::CLI";
693
694   my $cli = new CGP::CLI( {
695     'PeerAddr' => $machine,
696     'PeerPort' => $port,
697     'login'    => $login,
698     'password' => $password,
699   } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
700
701   #warn "$method ". Dumper(@args) if $DEBUG;
702
703   my $return = $cli->$method(@args)
704     or die "Communigate Pro error: ". $cli->getErrMessage. "\n";
705
706   $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n";
707
708   $return;
709
710 }
711
712 1;
713