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 svc_mailinglist )],
  37   'desc'    => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server',
  38   'options' => \%options,
  39   'notes'   => <<'END'
  40 Real time export of accounts, domains, mail forwards and mailing lists 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
  81     'PasswordRecovery' => ($svc_acct->password_recover ? 'YES':'NO'),
  82
  83     'RulesAllowed'     => $svc_acct->cgp_rulesallowed,
  84     'RPOPAllowed'      =>($svc_acct->cgp_rpopallowed    ?'YES':'NO'),
  85     'MailToAll'        =>($svc_acct->cgp_mailtoall      ?'YES':'NO'),
  86     'AddMailTrailer'   =>($svc_acct->cgp_addmailtrailer ?'YES':'NO'),
  87
  88     'ArchiveMessagesAfter' => $svc_acct->cgp_archiveafter,
  89
  90     map { $quotas{$_} => $svc_acct->$_() }
  91         grep $svc_acct->$_(), keys %quotas
  92   );
  93   #XXX phase 3: mailing lists
  94
  95   my @options = ( 'CreateAccount',
  96     'accountName'    => $self->export_username($svc_acct),
  97     'accountType'    => ( $svc_acct->cgp_type
  98                           || $self->option('accountType') ),
  99     'settings'       => \%settings
 100   );
 101
 102   push @options, 'externalFlag'   => $self->option('externalFlag')
 103     if $self->option('externalFlag');
 104
 105   #let's do the create realtime too, for much the same reasons, and to avoid
 106   #pain of trying to queue w/dep the prefs & aliases
 107   eval { $self->communigate_pro_runcommand( @options ) };
 108   return $@ if $@;
 109
 110   #preferences
 111   my %prefs = ();
 112   $prefs{'DeleteMode'} = $svc_acct->cgp_deletemode if $svc_acct->cgp_deletemode;
 113   $prefs{'EmptyTrash'} = $svc_acct->cgp_emptytrash if $svc_acct->cgp_emptytrash;
 114   $prefs{'Language'} = $svc_acct->cgp_language if $svc_acct->cgp_language;
 115   $prefs{'TimeZone'} = $svc_acct->cgp_timezone if $svc_acct->cgp_timezone;
 116   $prefs{'SkinName'} = $svc_acct->cgp_skinname if $svc_acct->cgp_skinname;
 117   $prefs{'ProntoSkinName'} = $svc_acct->cgp_prontoskinname if $svc_acct->cgp_prontoskinname;
 118   $prefs{'SendMDNMode'} = $svc_acct->cgp_sendmdnmode if $svc_acct->cgp_sendmdnmode;
 119   if ( keys %prefs ) {
 120     my $pref_err = $self->communigate_pro_queue( $svc_acct->svcnum,
 121       'UpdateAccountPrefs',
 122       $self->export_username($svc_acct),
 123       %prefs,
 124     );
 125    warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err"
 126     if $pref_err;
 127   }
 128
 129   #aliases
 130   if ( $svc_acct->cgp_aliases ) {
 131     my $alias_err = $self->communigate_pro_queue( $svc_acct->svcnum,
 132       'SetAccountAliases',
 133       $self->export_username($svc_acct),
 134       [ split(/\s*[,\s]\s*/, $svc_acct->cgp_aliases) ],
 135     );
 136     warn "WARNING: error queueing SetAccountAliases job: $alias_err"
 137       if $alias_err;
 138   }
 139
 140   my $rule_error = $self->communigate_pro_queue(
 141     $svc_acct->svcnum,
 142     'SetAccountMailRules',
 143     $self->export_username($svc_acct),
 144     $svc_acct->cgp_rule_arrayref,
 145   );
 146   warn "WARNING: error queueing SetAccountMailRules job: $rule_error"
 147     if $rule_error;
 148
 149   my $rpop_error = $self->communigate_pro_queue(
 150     $svc_acct->svcnum,
 151     'SetAccountRPOPs',
 152     $self->export_username($svc_acct),
 153     $svc_acct->cgp_rpop_hashref,
 154   );
 155   warn "WARNING: error queueing SetAccountMailRPOPs job: $rpop_error"
 156     if $rpop_error;
 157
 158   '';
 159
 160 }
 161
 162 sub _export_insert_svc_domain {
 163   my( $self, $svc_domain ) = (shift, shift);
 164
 165   my $create = $self->option('create_domain') || 'CreateDomain';
 166
 167   my %settings = (
 168     'DomainAccessModes'    => [ split(' ', $svc_domain->cgp_accessmodes ) ],
 169   );
 170   $settings{'AccountsLimit'} = $svc_domain->max_accounts
 171     if $svc_domain->max_accounts;
 172   $settings{'AdminDomainName'} = $svc_domain->parent_svc_x->domain
 173     if $svc_domain->parent_svcnum;
 174   $settings{'TrailerText'} = $svc_domain->trailer
 175     if $svc_domain->trailer;
 176   $settings{'CertificateType'} = $svc_domain->cgp_certificatetype
 177     if $svc_domain->cgp_certificatetype;
 178
 179   my @options = ( $create, $svc_domain->domain, \%settings );
 180
 181   eval { $self->communigate_pro_runcommand( @options ) };
 182   return $@ if $@;
 183
 184   #aliases
 185   if ( $svc_domain->cgp_aliases ) {
 186     my $alias_err = $self->communigate_pro_queue( $svc_domain->svcnum,
 187       'SetDomainAliases',
 188       $svc_domain->domain,
 189       split(/\s*[,\s]\s*/, $svc_domain->cgp_aliases),
 190     );
 191     warn "WARNING: error queueing SetDomainAliases job: $alias_err"
 192       if $alias_err;
 193   }
 194
 195   #account defaults
 196   my $def_err = $self->communigate_pro_queue( $svc_domain->svcnum,
 197     'SetAccountDefaults',
 198     $svc_domain->domain,
 199     'PWDAllowed'     =>($svc_domain->acct_def_password_selfchange ? 'YES':'NO'),
 200     'PasswordRecovery' => ($svc_domain->acct_def_password_recover ? 'YES':'NO'),
 201     'AccessModes'      => $svc_domain->acct_def_cgp_accessmodes,
 202     'MaxAccountSize'   => $svc_domain->acct_def_quota,
 203     'MaxWebSize'       => $svc_domain->acct_def_file_quota,
 204     'MaxWebFile'       => $svc_domain->acct_def_file_maxnum,
 205     'MaxFileSize'      => $svc_domain->acct_def_file_maxsize,
 206     'RulesAllowed'     => $svc_domain->acct_def_cgp_rulesallowed,
 207     'RPOPAllowed'      =>($svc_domain->acct_def_cgp_rpopallowed    ?'YES':'NO'),
 208     'MailToAll'        =>($svc_domain->acct_def_cgp_mailtoall      ?'YES':'NO'),
 209     'AddMailTrailer'   =>($svc_domain->acct_def_cgp_addmailtrailer ?'YES':'NO'),
 210     'ArchiveMessagesAfter' => $svc_domain->acct_def_cgp_archiveafter,
 211   );
 212   warn "WARNING: error queueing SetAccountDefaults job: $def_err"
 213     if $def_err;
 214
 215   #account defaults prefs
 216   my $pref_err = $self->communigate_pro_queue( $svc_domain->svcnum,
 217     'SetAccountDefaultPrefs',
 218     $svc_domain->domain,
 219     'DeleteMode'     => $svc_domain->acct_def_cgp_deletemode,
 220     'EmptyTrash'     => $svc_domain->acct_def_cgp_emptytrash,
 221     'Language'       => $svc_domain->acct_def_cgp_language,
 222     'TimeZone'       => $svc_domain->acct_def_cgp_timezone,
 223     'SkinName'       => $svc_domain->acct_def_cgp_skinname,
 224     'ProntoSkinName' => $svc_domain->acct_def_cgp_prontoskinname,
 225     'SendMDNMode'    => $svc_domain->acct_def_cgp_sendmdnmode,
 226   );
 227   warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err"
 228     if $pref_err;
 229
 230   my $rule_error = $self->communigate_pro_queue(
 231     $svc_domain->svcnum,
 232     'SetDomainMailRules',
 233     $svc_domain->domain,
 234     $svc_domain->cgp_rule_arrayref,
 235   );
 236   warn "WARNING: error queueing SetDomainMailRules job: $rule_error"
 237     if $rule_error;
 238
 239   '';
 240
 241 }
 242
 243 sub _export_insert_svc_forward {
 244   my( $self, $svc_forward ) = (shift, shift);
 245
 246   my $src = $svc_forward->src || $svc_forward->srcsvc_acct->email;
 247   my $dst = $svc_forward->dst || $svc_forward->dstsvc_acct->email;
 248
 249   #real-time here, presuming CGP does some dup detection?
 250   eval { $self->communigate_pro_runcommand( 'CreateForwarder', $src, $dst); };
 251   return $@ if $@;
 252
 253   '';
 254 }
 255
 256 sub _export_insert_svc_mailinglist {
 257   my( $self, $svc_mlist ) = (shift, shift);
 258
 259   my @members = map $_->email_address,
 260                     $svc_mlist->mailinglist->mailinglistmember;
 261
 262   #real-time here, presuming CGP does some dup detection
 263   eval { $self->communigate_pro_runcommand(
 264            'CreateGroup',
 265            $svc_mlist->username.'@'.$svc_mlist->domain,
 266            { 'RealName'      => $svc_mlist->listname,
 267              'SetReplyTo'    => ( $svc_mlist->reply_to         ? 'YES' : 'NO' ),
 268              'RemoveAuthor'  => ( $svc_mlist->remove_from      ? 'YES' : 'NO' ),
 269              'RejectAuto'    => ( $svc_mlist->reject_auto      ? 'YES' : 'NO' ),
 270              'RemoveToAndCc' => ( $svc_mlist->remove_to_and_cc ? 'YES' : 'NO' ),
 271              'Members'       => \@members,
 272            }
 273          );
 274        };
 275   return $@ if $@;
 276
 277   '';
 278
 279 }
 280
 281 sub _export_replace {
 282   my( $self, $new, $old ) = (shift, shift, shift);
 283
 284   my $table = $new->table;
 285   my $method = "_export_replace_$table";
 286   $self->$method($new, $old, @_);
 287 }
 288
 289 sub _export_replace_svc_acct {
 290   my( $self, $new, $old ) = (shift, shift, shift);
 291
 292   #let's just do the rename part realtime rather than trying to queue
 293   #w/dependencies.  we don't want FS winding up out-of-sync with the wrong
 294   #username and a queued job anyway.  right??
 295   if ( $self->export_username($old) ne $self->export_username($new) ) {
 296     eval { $self->communigate_pro_runcommand(
 297       'RenameAccount',
 298       $self->export_username($old),
 299       $self->export_username($new),
 300     ) };
 301     return $@ if $@;
 302   }
 303
 304   if ( $new->_password ne $old->_password
 305        && '*SUSPENDED* '.$old->_password ne $new->_password
 306   ) {
 307     $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword',
 308                                   $self->export_username($new), $new->_password
 309                                 );
 310   }
 311
 312   my %settings = ();
 313
 314   $settings{'RealName'} = $new->finger
 315     if $old->finger ne $new->finger;
 316   $settings{$quotas{$_}} = $new->$_()
 317     foreach grep $old->$_() ne $new->$_(), keys %quotas;
 318   $settings{'accountType'} = $new->cgp_type
 319     if $old->cgp_type ne $new->cgp_type;
 320   $settings{'AccessModes'} = $new->cgp_accessmodes
 321     if $old->cgp_accessmodes ne $new->cgp_accessmodes
 322     || $old->cgp_type ne $new->cgp_type;
 323
 324   $settings{'PasswordRecovery'} = ( $new->password_recover ? 'YES':'NO' )
 325     if $old->password_recover ne $new->password_recover;
 326
 327   $settings{'RulesAllowed'} = $new->cgp_rulesallowed
 328     if $old->cgp_rulesallowed ne $new->cgp_rulesallowed;
 329   $settings{'RPOPAllowed'} = ( $new->cgp_rpopallowed ? 'YES':'NO' )
 330     if $old->cgp_rpopallowed ne $new->cgp_rpopallowed;
 331   $settings{'MailToAll'} = ( $new->cgp_mailtoall ? 'YES':'NO' )
 332     if $old->cgp_mailtoall ne $new->cgp_mailtoall;
 333   $settings{'AddMailTrailer'} = ( $new->cgp_addmailtrailer ? 'YES':'NO' )
 334     if $old->cgp_addmailtrailer ne $new->cgp_addmailtrailer;
 335   $settings{'ArchiveMessagesAfter'} = $new->cgp_archiveafter
 336     if $old->cgp_archiveafter ne $new->cgp_archiveafter;
 337
 338   #XXX phase 3: mailing lists
 339
 340   if ( keys %settings ) {
 341     my $error = $self->communigate_pro_queue(
 342       $new->svcnum,
 343       'UpdateAccountSettings',
 344       $self->export_username($new),
 345       %settings,
 346     );
 347     return $error if $error;
 348   }
 349
 350   #preferences
 351   my %prefs = ();
 352   $prefs{'DeleteMode'} = $new->cgp_deletemode
 353     if $old->cgp_deletemode ne $new->cgp_deletemode;
 354   $prefs{'EmptyTrash'} = $new->cgp_emptytrash
 355     if $old->cgp_emptytrash ne $new->cgp_emptytrash;
 356   $prefs{'Language'} = $new->cgp_language
 357     if $old->cgp_language ne $new->cgp_language;
 358   $prefs{'TimeZone'} = $new->cgp_timezone
 359     if $old->cgp_timezone ne $new->cgp_timezone;
 360   $prefs{'SkinName'} = $new->cgp_skinname
 361     if $old->cgp_skinname ne $new->cgp_skinname;
 362   $prefs{'ProntoSkinName'} = $new->cgp_prontoskinname
 363     if $old->cgp_prontoskinname ne $new->cgp_prontoskinname;
 364   $prefs{'SendMDNMode'} = $new->cgp_sendmdnmode
 365     if $old->cgp_sendmdnmode ne $new->cgp_sendmdnmode;
 366   if ( keys %prefs ) {
 367     my $pref_err = $self->communigate_pro_queue( $new->svcnum,
 368       'UpdateAccountPrefs',
 369       $self->export_username($new),
 370       %prefs,
 371     );
 372    warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err"
 373     if $pref_err;
 374   }
 375
 376   if ( $old->cgp_aliases ne $new->cgp_aliases ) {
 377     my $error = $self->communigate_pro_queue(
 378       $new->svcnum,
 379       'SetAccountAliases',
 380       $self->export_username($new),
 381       [ split(/\s*[,\s]\s*/, $new->cgp_aliases) ],
 382     );
 383     return $error if $error;
 384   }
 385
 386   my $rule_error = $self->communigate_pro_queue(
 387     $new->svcnum,
 388     'SetAccountMailRules',
 389     $self->export_username($new),
 390     $new->cgp_rule_arrayref,
 391   );
 392   warn "WARNING: error queueing SetAccountMailRules job: $rule_error"
 393     if $rule_error;
 394
 395   my $rpop_error = $self->communigate_pro_queue(
 396     $new->svcnum,
 397     'SetAccountRPOPs',
 398     $self->export_username($new),
 399     $new->cgp_rpop_hashref,
 400   );
 401   warn "WARNING: error queueing SetAccountMailRPOPs job: $rpop_error"
 402     if $rpop_error;
 403
 404   '';
 405
 406 }
 407
 408 sub _export_replace_svc_domain {
 409   my( $self, $new, $old ) = (shift, shift, shift);
 410
 411   #let's just do the rename part realtime rather than trying to queue
 412   #w/dependencies.  we don't want FS winding up out-of-sync with the wrong
 413   #username and a queued job anyway.  right??
 414   if ( $old->domain ne $new->domain ) {
 415     eval { $self->communigate_pro_runcommand(
 416              'RenameDomain', $old->domain, $new->domain,
 417          ) };
 418     return $@ if $@;
 419   }
 420
 421   my %settings = ();
 422   $settings{'AccountsLimit'} = $new->max_accounts
 423     if $old->max_accounts ne $new->max_accounts;
 424   $settings{'TrailerText'} = $new->trailer
 425     if $old->trailer ne $new->trailer;
 426   $settings{'DomainAccessModes'} = $new->cgp_accessmodes
 427     if $old->cgp_accessmodes ne $new->cgp_accessmodes;
 428   $settings{'AdminDomainName'} =
 429     $new->parent_svcnum ? $new->parent_svc_x->domain : ''
 430       if $old->parent_svcnum != $new->parent_svcnum;
 431   $settings{'CertificateType'} = $new->cgp_certificatetype
 432     if $old->cgp_certificatetype ne $new->cgp_certificatetype;
 433
 434   if ( keys %settings ) {
 435     my $error = $self->communigate_pro_queue( $new->svcnum,
 436       'UpdateDomainSettings',
 437       $new->domain,
 438       %settings,
 439     );
 440     return $error if $error;
 441   }
 442
 443   if ( $old->cgp_aliases ne $new->cgp_aliases ) {
 444     my $error = $self->communigate_pro_queue( $new->svcnum,
 445       'SetDomainAliases',
 446       $new->domain,
 447       split(/\s*[,\s]\s*/, $new->cgp_aliases),
 448     );
 449     return $error if $error;
 450   }
 451
 452   #below this identical to insert... any value to doing an Update here?
 453   #not seeing any big one... i guess it would be nice to avoid the update
 454   #when things haven't changed
 455
 456   #account defaults
 457   my $def_err = $self->communigate_pro_queue( $new->svcnum,
 458     'SetAccountDefaults',
 459     $new->domain,
 460     'PWDAllowed'       => ( $new->acct_def_password_selfchange ? 'YES' : 'NO' ),
 461     'PasswordRecovery' => ( $new->acct_def_password_recover    ? 'YES' : 'NO' ),
 462     'AccessModes'      => $new->acct_def_cgp_accessmodes,
 463     'MaxAccountSize'   => $new->acct_def_quota,
 464     'MaxWebSize'       => $new->acct_def_file_quota,
 465     'MaxWebFile'       => $new->acct_def_file_maxnum,
 466     'MaxFileSize'      => $new->acct_def_file_maxsize,
 467     'RulesAllowed'     => $new->acct_def_cgp_rulesallowed,
 468     'RPOPAllowed'      => ( $new->acct_def_cgp_rpopallowed    ? 'YES' : 'NO' ),
 469     'MailToAll'        => ( $new->acct_def_cgp_mailtoall      ? 'YES' : 'NO' ),
 470     'AddMailTrailer'   => ( $new->acct_def_cgp_addmailtrailer ? 'YES' : 'NO' ),
 471     'ArchiveMessagesAfter' => $new->acct_def_cgp_archiveafter,
 472   );
 473   warn "WARNING: error queueing SetAccountDefaults job: $def_err"
 474     if $def_err;
 475
 476   #account defaults prefs
 477   my $pref_err = $self->communigate_pro_queue( $new->svcnum,
 478     'SetAccountDefaultPrefs',
 479     $new->domain,
 480     'DeleteMode'     => $new->acct_def_cgp_deletemode,
 481     'EmptyTrash'     => $new->acct_def_cgp_emptytrash,
 482     'Language'       => $new->acct_def_cgp_language,
 483     'TimeZone'       => $new->acct_def_cgp_timezone,
 484     'SkinName'       => $new->acct_def_cgp_skinname,
 485     'ProntoSkinName' => $new->acct_def_cgp_prontoskinname,
 486     'SendMDNMode'    => $new->acct_def_cgp_sendmdnmode,
 487   );
 488   warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err"
 489     if $pref_err;
 490
 491   my $rule_error = $self->communigate_pro_queue(
 492     $new->svcnum,
 493     'SetDomainMailRules',
 494     $new->domain,
 495     $new->cgp_rule_arrayref,
 496   );
 497   warn "WARNING: error queueing SetDomainMailRules job: $rule_error"
 498     if $rule_error;
 499
 500   '';
 501 }
 502
 503 sub _export_replace_svc_forward {
 504   my( $self, $new, $old ) = (shift, shift, shift);
 505
 506   my $osrc = $old->src || $old->srcsvc_acct->email;
 507   my $nsrc = $new->src || $new->srcsvc_acct->email;
 508   my $odst = $old->dst || $old->dstsvc_acct->email;
 509   my $ndst = $new->dst || $new->dstsvc_acct->email;
 510
 511   if ( $odst ne $ndst ) {
 512
 513     #no change command, so delete and create (real-time)
 514     eval { $self->communigate_pro_runcommand('DeleteForwarder', $osrc) };
 515     return $@ if $@;
 516     eval { $self->communigate_pro_runcommand('CreateForwarder', $nsrc, $ndst)};
 517     return $@ if $@;
 518
 519   } elsif ( $osrc ne $nsrc ) {
 520
 521     #real-time here, presuming CGP does some dup detection?
 522     eval { $self->communigate_pro_runcommand( 'RenameForwarder', $osrc, $nsrc)};
 523     return $@ if $@;
 524
 525   } else {
 526     warn "communigate replace called for svc_forward with no changes\n";#confess
 527   }
 528
 529   '';
 530 }
 531
 532 sub _export_replace_svc_mailinglist {
 533   my( $self, $new, $old ) = (shift, shift, shift);
 534
 535   my $oldGroupName = $old->username.'@'.$old->domain;
 536   my $newGroupName = $new->username.'@'.$new->domain;
 537
 538   if ( $oldGroupName ne $newGroupName ) {
 539     eval { $self->communigate_pro_runcommand(
 540              'RenameGroup', $oldGroupName, $newGroupName ); };
 541     return $@ if $@;
 542   }
 543
 544   my @members = map $_->email_address,
 545                 $new->mailinglist->mailinglistmember;
 546
 547   #real-time here, presuming CGP does some dup detection
 548   eval { $self->communigate_pro_runcommand(
 549            'SetGroup', $newGroupName,
 550            { 'RealName'      => $new->listname,
 551              'SetReplyTo'    => ( $new->reply_to         ? 'YES' : 'NO' ),
 552              'RemoveAuthor'  => ( $new->remove_from      ? 'YES' : 'NO' ),
 553              'RejectAuto'    => ( $new->reject_auto      ? 'YES' : 'NO' ),
 554              'RemoveToAndCc' => ( $new->remove_to_and_cc ? 'YES' : 'NO' ),
 555              'Members'       => \@members,
 556            }
 557          );
 558        };
 559   return $@ if $@;
 560
 561   '';
 562
 563 }
 564
 565 sub _export_delete {
 566   my( $self, $svc_x ) = (shift, shift);
 567
 568   my $table = $svc_x->table;
 569   my $method = "_export_delete_$table";
 570   $self->$method($svc_x, @_);
 571 }
 572
 573 sub _export_delete_svc_acct {
 574   my( $self, $svc_acct ) = (shift, shift);
 575
 576   $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount',
 577     $self->export_username($svc_acct),
 578   );
 579 }
 580
 581 sub _export_delete_svc_domain {
 582   my( $self, $svc_domain ) = (shift, shift);
 583
 584   $self->communigate_pro_queue( $svc_domain->svcnum, 'DeleteDomain',
 585     $svc_domain->domain,
 586     #XXX turn on force option for domain deletion?
 587   );
 588 }
 589
 590 sub _export_delete_svc_forward {
 591   my( $self, $svc_forward ) = (shift, shift);
 592
 593   $self->communigate_pro_queue( $svc_forward->svcnum, 'DeleteForwarder',
 594     ($svc_forward->src || $svc_forward->srcsvc_acct->email),
 595   );
 596 }
 597
 598 sub _export_delete_svc_mailinglist {
 599   my( $self, $svc_mailinglist ) = (shift, shift);
 600
 601   #real-time here, presuming CGP does some dup detection
 602   eval { $self->communigate_pro_runcommand(
 603            'DeleteGroup',
 604            $svc_mailinglist->username.'@'.$svc_mailinglist->domain,
 605          );
 606        };
 607   return $@ if $@;
 608
 609   '';
 610
 611 }
 612
 613 sub _export_suspend {
 614   my( $self, $svc_x ) = (shift, shift);
 615
 616   my $table = $svc_x->table;
 617   my $method = "_export_suspend_$table";
 618   $self->$method($svc_x, @_);
 619
 620 }
 621
 622 sub _export_suspend_svc_acct {
 623   my( $self, $svc_acct ) = (shift, shift);
 624
 625   #XXX is this the desired suspnsion action?
 626
 627    $self->communigate_pro_queue(
 628     $svc_acct->svcnum,
 629     'UpdateAccountSettings',
 630     $self->export_username($svc_acct),
 631     'AccessModes' => 'Mail',
 632   );
 633
 634 }
 635
 636 sub _export_suspend_svc_domain {
 637   my( $self, $svc_domain) = (shift, shift);
 638
 639   #XXX domain operations
 640   '';
 641
 642 }
 643
 644 sub _export_unsuspend {
 645   my( $self, $svc_x ) = (shift, shift);
 646
 647   my $table = $svc_x->table;
 648   my $method = "_export_unsuspend_$table";
 649   $self->$method($svc_x, @_);
 650
 651 }
 652
 653 sub _export_unsuspend_svc_acct {
 654   my( $self, $svc_acct ) = (shift, shift);
 655
 656   $self->communigate_pro_queue(
 657     $svc_acct->svcnum,
 658     'UpdateAccountSettings',
 659     $self->export_username($svc_acct),
 660     'AccessModes' => ( $svc_acct->cgp_accessmodes
 661                          || $self->option('AccessModes') ),
 662   );
 663
 664 }
 665
 666 sub _export_unsuspend_svc_domain {
 667   my( $self, $svc_domain) = (shift, shift);
 668
 669   #XXX domain operations
 670   '';
 671
 672 }
 673
 674 sub export_mailinglistmember_insert {
 675   my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift);
 676   $svc_mailinglist->replace();
 677 }
 678
 679 sub export_mailinglistmember_replace {
 680   my( $self, $svc_mailinglist, $new, $old ) = (shift, shift, shift, shift);
 681   die "no way to do this from the UI right now";
 682 }
 683
 684 sub export_mailinglistmember_delete {
 685   my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift);
 686   $svc_mailinglist->replace();
 687 }
 688
 689 sub export_getsettings {
 690   my($self, $svc_x) = (shift, shift);
 691
 692   my $table = $svc_x->table;
 693   my $method = "export_getsettings_$table";
 694
 695   $self->can($method) ? $self->$method($svc_x, @_) : '';
 696
 697 }
 698
 699 sub export_getsettings_svc_domain {
 700   my($self, $svc_domain, $settingsref, $defaultref ) = @_;
 701
 702   my $settings = eval { $self->communigate_pro_runcommand(
 703     'GetDomainSettings',
 704     $svc_domain->domain
 705   ) };
 706   return $@ if $@;
 707
 708   my $effective_settings = eval { $self->communigate_pro_runcommand(
 709     'GetDomainEffectiveSettings',
 710     $svc_domain->domain
 711   ) };
 712   return $@ if $@;
 713
 714   my $acct_defaults = eval { $self->communigate_pro_runcommand(
 715     'GetAccountDefaults',
 716     $svc_domain->domain
 717   ) };
 718   return $@ if $@;
 719
 720   my $acct_defaultprefs = eval { $self->communigate_pro_runcommand(
 721     'GetAccountDefaultPrefs',
 722     $svc_domain->domain
 723   ) };
 724   return $@ if $@;
 725
 726   my $rules = eval { $self->communigate_pro_runcommand(
 727     'GetDomainMailRules',
 728     $svc_domain->domain
 729   ) };
 730   return $@ if $@;
 731
 732   #aliases too
 733   my $aliases = eval { $self->communigate_pro_runcommand(
 734     'GetDomainAliases',
 735     $svc_domain->domain
 736   ) };
 737   return $@ if $@;
 738
 739   my %more = (
 740     ( map { ("Acct. Default $_" => $acct_defaults->{$_}); }
 741           keys(%$acct_defaults)
 742     ),
 743     ( map { ("Acct. Default $_" => $acct_defaultprefs->{$_}); } #diff label??
 744           keys(%$acct_defaultprefs)
 745     ),
 746     ( map _rule2string($_), @$rules ),
 747     'Aliases' => join(', ', @$aliases),
 748   );
 749
 750   %$effective_settings = ( %$effective_settings, %more );
 751   %$settings = ( %$settings, %more );
 752
 753   #false laziness w/below
 754
 755   my %defaults = map { $_ => 1 }
 756                    grep !exists(${$settings}{$_}), keys %$effective_settings;
 757
 758   foreach my $key ( grep ref($effective_settings->{$_}),
 759                     keys %$effective_settings )
 760   {
 761     $effective_settings->{$key} = _pretty( $effective_settings->{$key} );
 762   }
 763
 764   %{$settingsref} = %$effective_settings;
 765   %{$defaultref} = %defaults;
 766
 767   '';
 768 }
 769
 770 sub export_getsettings_svc_acct {
 771   my($self, $svc_acct, $settingsref, $defaultref ) = @_;
 772
 773   my $settings = eval { $self->communigate_pro_runcommand(
 774     'GetAccountSettings',
 775     $svc_acct->email
 776   ) };
 777   return $@ if $@;
 778
 779   delete($settings->{'Password'});
 780
 781   my $effective_settings = eval { $self->communigate_pro_runcommand(
 782     'GetAccountEffectiveSettings',
 783     $svc_acct->email
 784   ) };
 785   return $@ if $@;
 786
 787   delete($effective_settings->{'Password'});
 788
 789   #prefs/effectiveprefs too
 790
 791   my $prefs = eval { $self->communigate_pro_runcommand(
 792     'GetAccountPrefs',
 793     $svc_acct->email
 794   ) };
 795   return $@ if $@;
 796
 797   my $effective_prefs = eval { $self->communigate_pro_runcommand(
 798     'GetAccountEffectivePrefs',
 799     $svc_acct->email
 800   ) };
 801   return $@ if $@;
 802
 803   %$effective_settings = ( %$effective_settings,
 804                            map { ("Pref $_" => $effective_prefs->{$_}); }
 805                                keys(%$effective_prefs)
 806                          );
 807   %$settings = ( %$settings,
 808                  map { ("Pref $_" => $prefs->{$_}); }
 809                      keys(%$prefs)
 810                );
 811
 812   #mail rules
 813   my $rules = eval { $self->communigate_pro_runcommand(
 814     'GetAccountMailRules',
 815     $svc_acct->email
 816   ) };
 817   return $@ if $@;
 818
 819   %$effective_settings = ( %$effective_settings,
 820                            map _rule2string($_), @$rules
 821                          );
 822   %$settings = ( %$settings,
 823                  map _rule2string($_), @$rules
 824                );
 825
 826 #  #rpops too
 827 #  my $rpops = eval { $self->communigate_pro_runcommand(
 828 #    'GetAccountRPOPs',
 829 #    $svc_acct->email
 830 #  ) };
 831 #  return $@ if $@;
 832 #
 833 #  %$effective_settings = ( %$effective_settings,
 834 #                           map _rpop2string($_), %$rpops
 835 #                         );
 836 #  %$settings = ( %$settings,
 837 #                 map _rpop2string($_), %rpops
 838 #               );
 839
 840   #aliases too
 841   my $aliases = eval { $self->communigate_pro_runcommand(
 842     'GetAccountAliases',
 843     $svc_acct->email
 844   ) };
 845   return $@ if $@;
 846
 847   $effective_settings->{'Aliases'} = join(', ', @$aliases);
 848   $settings->{'Aliases'}           = join(', ', @$aliases);
 849
 850   #false laziness w/above
 851
 852   my %defaults = map { $_ => 1 }
 853                    grep !exists(${$settings}{$_}), keys %$effective_settings;
 854
 855   foreach my $key ( grep ref($effective_settings->{$_}),
 856                     keys %$effective_settings )
 857   {
 858     $effective_settings->{$key} = _pretty( $effective_settings->{$key} );
 859   }
 860
 861   %{$settingsref} = %$effective_settings;
 862   %{$defaultref} = %defaults;
 863
 864   '';
 865
 866 }
 867
 868 sub _pretty {
 869   my $value = shift;
 870   if ( ref($value) eq 'ARRAY' ) {
 871     '['. join(' ', map { ref($_) ? _pretty($_) : $_ } @$value ). ']';
 872   } elsif ( ref($value) eq 'HASH' ) {
 873     '{'. join(', ',
 874         map { my $v = $value->{$_};
 875               "$_:". ( ref($v) ? _pretty($v) : $v );
 876             }
 877             keys %$value
 878     ). '}';
 879   } else {
 880     warn "serializing ". ref($value). " for table display not yet handled";
 881   }
 882 }
 883
 884 sub export_getsettings_svc_forward {
 885   my($self, $svc_forward, $settingsref, $defaultref ) = @_;
 886
 887   my $dest = eval { $self->communigate_pro_runcommand(
 888     'GetForwarder',
 889     ($svc_forward->src || $svc_forward->srcsvc_acct->email),
 890   ) };
 891   return $@ if $@;
 892
 893   my $settings = { 'Destination' => $dest };
 894
 895   %{$settingsref} = %$settings;
 896   %{$defaultref} = ();
 897
 898   '';
 899 }
 900
 901 sub _rule2string {
 902   my $rule = shift;
 903   my($priority, $name, $conditions, $actions, $comment) = @$rule;
 904   $conditions = join(', ', map { my $a = $_; join(' ', @$a); } @$conditions);
 905   $actions    = join(', ', map { my $a = $_; join(' ', @$a); } @$actions);
 906   ("Mail rule $name" => "$priority IF $conditions THEN $actions ($comment)");
 907 }
 908
 909 #sub _rpop2string {
 910 #  my $rpop = shift;
 911 #  my($priority, $name, $conditions, $actions, $comment) = @$rule;
 912 #  $conditions = join(', ', map { my $a = $_; join(' ', @$a); } @$conditions);
 913 #  $actions    = join(', ', map { my $a = $_; join(' ', @$a); } @$actions);
 914 #  ("Mail rule $name" => "$priority IF $conditions THEN $actions ($comment)");
 915 #}
 916
 917 sub export_getsettings_svc_mailinglist {
 918   my($self, $svc_mailinglist, $settingsref, $defaultref ) = @_;
 919
 920   my $settings = eval { $self->communigate_pro_runcommand(
 921     'GetGroup',
 922     $svc_mailinglist->username.'@'.$svc_mailinglist->domain,
 923   ) };
 924   return $@ if $@;
 925
 926   $settings->{'Members'} = join(', ', @{ $settings->{'Members'} } );
 927
 928   %{$settingsref} = %$settings;
 929
 930   '';
 931 }
 932
 933 sub communigate_pro_queue {
 934   my( $self, $svcnum, $method ) = (shift, shift, shift);
 935   my $jobnum = ''; #don't actually care
 936   $self->communigate_pro_queue_dep( \$jobnum, $svcnum, $method, @_);
 937 }
 938
 939 sub communigate_pro_queue_dep {
 940   my( $self, $jobnumref, $svcnum, $method ) = splice(@_,0,4);
 941
 942   my %kludge_methods = (
 943     #'CreateAccount'             => 'CreateAccount',
 944     'UpdateAccountSettings'     => 'UpdateAccountSettings',
 945     'UpdateAccountPrefs'        => 'cp_Scalar_Hash',
 946     #'CreateDomain'              => 'cp_Scalar_Hash',
 947     #'CreateSharedDomain'        => 'cp_Scalar_Hash',
 948     'UpdateDomainSettings'      => 'cp_Scalar_settingsHash',
 949     'SetDomainAliases'          => 'cp_Scalar_Array',
 950     'SetAccountDefaults'        => 'cp_Scalar_settingsHash',
 951     'UpdateAccountDefaults'     => 'cp_Scalar_settingsHash',
 952     'SetAccountDefaultPrefs'    => 'cp_Scalar_settingsHash',
 953     'UpdateAccountDefaultPrefs' => 'cp_Scalar_settingsHash',
 954     'SetAccountRPOPs'           => 'cp_Scalar_Hash',
 955   );
 956   my $sub = exists($kludge_methods{$method})
 957               ? $kludge_methods{$method}
 958               : 'communigate_pro_command';
 959
 960   my $queue = new FS::queue {
 961     'svcnum' => $svcnum,
 962     'job'    => "FS::part_export::communigate_pro::$sub",
 963   };
 964   my $error = $queue->insert(
 965     $self->machine,
 966     $self->option('port'),
 967     $self->option('login'),
 968     $self->option('password'),
 969     $method,
 970     @_,
 971   );
 972   $$jobnumref = $queue->jobnum unless $error;
 973
 974   return $error;
 975 }
 976
 977 sub communigate_pro_runcommand {
 978   my( $self, $method ) = (shift, shift);
 979
 980   communigate_pro_command(
 981     $self->machine,
 982     $self->option('port'),
 983     $self->option('login'),
 984     $self->option('password'),
 985     $method,
 986     @_,
 987   );
 988
 989 }
 990
 991 #XXX one sub per arg prototype is lame.  more magic?  i suppose queue needs
 992 # to store data strctures properly instead of just an arg list.  right.
 993
 994 sub cp_Scalar_Hash {
 995   my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_;
 996   my @args = ( $scalar, \%hash );
 997   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 998 }
 999
1000 sub cp_Scalar_Array {
1001   my( $machine, $port, $login, $password, $method, $scalar, @array ) = @_;
1002   my @args = ( $scalar, \@array );
1003   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
1004 }
1005
1006 #sub cp_Hash {
1007 #  my( $machine, $port, $login, $password, $method, %hash ) = @_;
1008 #  my @args = ( \%hash );
1009 #  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
1010 #}
1011
1012 sub cp_Scalar_settingsHash {
1013   my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_;
1014   for (qw( AccessModes DomainAccessModes )) {
1015     $settings{$_} = [split(' ',$settings{$_})] if $settings{$_};
1016   }
1017   my @args = ( 'domain' => $domain, 'settings' => \%settings );
1018   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
1019 }
1020
1021 #sub CreateAccount {
1022 #  my( $machine, $port, $login, $password, $method, %args ) = @_;
1023 #  my $accountName  = delete $args{'accountName'};
1024 #  my $accountType  = delete $args{'accountType'};
1025 #  my $externalFlag = delete $args{'externalFlag'};
1026 #  $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
1027 #  my @args = ( accountName  => $accountName,
1028 #               accountType  => $accountType,
1029 #               settings     => \%args,
1030 #             );
1031 #               #externalFlag => $externalFlag,
1032 #  push @args, externalFlag => $externalFlag if $externalFlag;
1033 #
1034 #  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
1035 #
1036 #}
1037
1038 sub UpdateAccountSettings {
1039   my( $machine, $port, $login, $password, $method, $accountName, %args ) = @_;
1040   $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
1041   my @args = ( $accountName, \%args );
1042   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
1043 }
1044
1045 sub communigate_pro_command { #subroutine, not method
1046   my( $machine, $port, $login, $password, $method, @args ) = @_;
1047
1048   eval "use CGP::CLI";
1049   die $@ if $@;
1050
1051   my $cli = new CGP::CLI( {
1052     'PeerAddr' => $machine,
1053     'PeerPort' => $port,
1054     'login'    => $login,
1055     'password' => $password,
1056   } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
1057
1058   #warn "$method ". Dumper(@args) if $DEBUG;
1059
1060   my $return = $cli->$method(@args)
1061     or die "Communigate Pro error: ". $cli->getErrMessage. "\n";
1062
1063   $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n";
1064
1065   $return;
1066
1067 }
1068
1069 1;
1070