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)],
  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 @options = ( $svc_acct->svcnum, 'CreateAccount',
  74     'accountName'    => $self->export_username($svc_acct),
  75     'accountType'    => ( $svc_acct->cgp_type
  76                           || $self->option('accountType') ),
  77     'AccessModes'    => ( $svc_acct->cgp_accessmodes
  78                           || $self->option('AccessModes') ),
  79     'RealName'       => $svc_acct->finger,
  80     'Password'       => $svc_acct->_password,
  81   );
  82
  83   push @options, $quotas{$_} => $svc_acct->$_()
  84     foreach grep $svc_acct->$_(), keys %quotas;
  85
  86   #phase 2: pwdallowed, passwordrecovery, allowed mail rules,
  87   # RPOP modifications, accepts mail to all, add trailer to sent mail
  88   #phase 3: archive messages, mailing lists
  89
  90   push @options, 'externalFlag'   => $self->option('externalFlag')
  91     if $self->option('externalFlag');
  92
  93   #XXX preferences phase 1: message delete method, on logout remove trash
  94   #phase 2: language, time zone, layout, pronto style, send read receipts
  95
  96   $self->communigate_pro_queue( @options );
  97
  98 }
  99
 100 sub _export_insert_svc_domain {
 101   my( $self, $svc_domain ) = (shift, shift);
 102
 103   my $create = $self->option('create_domain') || 'CreateDomain';
 104
 105   my @options = ( $svc_domain->svcnum, $create, $svc_domain->domain,
 106     #other domain creation options?
 107   );
 108   push @options, 'AccountsLimit' => $svc_domain->max_accounts
 109     if $svc_domain->max_accounts;
 110
 111   $self->communigate_pro_queue( @options );
 112 }
 113
 114 #sub _export_insert_svc_forward {
 115 #}
 116
 117 sub _export_replace {
 118   my( $self, $new, $old ) = (shift, shift, shift);
 119
 120   my $table = $new->table;
 121   my $method = "_export_replace_$table";
 122   $self->$method($new, $old, @_);
 123 }
 124
 125 sub _export_replace_svc_acct {
 126   my( $self, $new, $old ) = (shift, shift, shift);
 127
 128   #let's just do the rename part realtime rather than trying to queue
 129   #w/dependencies.  we don't want FS winding up out-of-sync with the wrong
 130   #username and a queued job anyway.  right??
 131   if ( $self->export_username($old) ne $self->export_username($new) ) {
 132     #my $r =
 133     eval { $self->communigate_pro_runcommand(
 134       'RenameAccount',
 135       $self->export_username($old),
 136       $self->export_username($new),
 137     ) };
 138     return $@ if $@;
 139   }
 140
 141   if ( $new->_password ne $old->_password
 142        && '*SUSPENDED* '.$old->_password ne $new->_password
 143   ) {
 144     $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword',
 145                                   $self->export_username($new), $new->_password
 146                                 );
 147   }
 148
 149   my %settings = ();
 150
 151   $settings{'RealName'} = $new->finger
 152     if $old->finger ne $new->finger;
 153   $settings{$quotas{$_}} = $new->$_()
 154     foreach grep $old->$_() ne $new->$_(), keys %quotas;
 155   $settings{'AccessModes'} = $new->cgp_accessmodes
 156     if $old->cgp_accessmodes ne $new->cgp_accessmodes;
 157   $settings{'accountType'} = $new->cgp_type
 158     if $old->cgp_type ne $new->cgp_type;
 159
 160   #phase 2: pwdallowed, passwordrecovery, allowed mail rules,
 161   # RPOP modifications, accepts mail to all, add trailer to sent mail
 162   #phase 3: archive messages, mailing lists
 163
 164   if ( keys %settings ) {
 165     my $error = $self->communigate_pro_queue(
 166       $new->svcnum,
 167       'UpdateAccountSettings',
 168       $self->export_username($new),
 169       %settings,
 170     );
 171     return $error if $error;
 172   }
 173
 174   #XXX preferences phase 1: message delete method, on logout remove trash
 175   #phase 2: language, time zone, layout, pronto style, send read receipts
 176
 177   '';
 178
 179 }
 180
 181 sub _export_replace_svc_domain {
 182   my( $self, $new, $old ) = (shift, shift, shift);
 183
 184   if ( $old->domain ne $new->domain ) {
 185     my $error = $self->communigate_pro_queue( $new->svcnum, 'RenameDomain',
 186       $old->domain, $new->domain,
 187     );
 188     return $error if $error;
 189   }
 190
 191   if ( $old->max_accounts ne $new->max_accounts ) {
 192     my $error = $self->communigate_pro_queue( $new->svcnum,
 193       'UpdateDomainSettings',
 194       $new->domain,
 195       'AccountsLimit' => ($new->max_accounts || 'default'),
 196     );
 197     return $error if $error;
 198   }
 199
 200   #other kinds of changes?
 201
 202   '';
 203 }
 204
 205 sub _export_delete {
 206   my( $self, $svc_x ) = (shift, shift);
 207
 208   my $table = $svc_x->table;
 209   my $method = "_export_delete_$table";
 210   $self->$method($svc_x, @_);
 211 }
 212
 213 sub _export_delete_svc_acct {
 214   my( $self, $svc_acct ) = (shift, shift);
 215
 216   $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount',
 217     $self->export_username($svc_acct),
 218   );
 219
 220 }
 221
 222 sub _export_delete_svc_domain {
 223   my( $self, $svc_domain ) = (shift, shift);
 224
 225   $self->communigate_pro_queue( $svc_domain->svcnum, 'DeleteDomain',
 226     $svc_domain->domain,
 227     #XXX turn on force option for domain deletion?
 228   );
 229
 230 }
 231
 232 sub _export_suspend {
 233   my( $self, $svc_x ) = (shift, shift);
 234
 235   my $table = $svc_x->table;
 236   my $method = "_export_suspend_$table";
 237   $self->$method($svc_x, @_);
 238
 239 }
 240
 241 sub _export_suspend_svc_acct {
 242   my( $self, $svc_acct ) = (shift, shift);
 243
 244   #XXX is this the desired suspnsion action?
 245
 246    $self->communigate_pro_queue(
 247     $svc_acct->svcnum,
 248     'UpdateAccountSettings',
 249     $self->export_username($svc_acct),
 250     'AccessModes' => 'Mail',
 251   );
 252
 253 }
 254
 255 sub _export_suspend_svc_domain {
 256   my( $self, $svc_domain) = (shift, shift);
 257
 258   #XXX domain operations
 259   '';
 260
 261 }
 262
 263 sub _export_unsuspend {
 264   my( $self, $svc_x ) = (shift, shift);
 265
 266   my $table = $svc_x->table;
 267   my $method = "_export_unsuspend_$table";
 268   $self->$method($svc_x, @_);
 269
 270 }
 271
 272 sub _export_unsuspend_svc_acct {
 273   my( $self, $svc_acct ) = (shift, shift);
 274
 275   $self->communigate_pro_queue(
 276     $svc_acct->svcnum,
 277     'UpdateAccountSettings',
 278     $self->export_username($svc_acct),
 279     'AccessModes' => $self->option('AccessModes'),
 280   );
 281
 282 }
 283
 284 sub _export_unsuspend_svc_domain {
 285   my( $self, $svc_domain) = (shift, shift);
 286
 287   #XXX domain operations
 288   '';
 289
 290 }
 291
 292
 293 sub export_getsettings {
 294   my($self, $svc_x) = (shift, shift);
 295
 296   my $table = $svc_x->table;
 297   my $method = "export_getsettings_$table";
 298
 299   $self->can($method) ? $self->$method($svc_x, @_) : '';
 300
 301 }
 302
 303 sub export_getsettings_svc_domain {
 304   my($self, $svc_domain, $settingsref, $defaultref ) = @_;
 305
 306   my $settings = eval { $self->communigate_pro_runcommand(
 307     'GetDomainSettings',
 308     $svc_domain->domain
 309   ) };
 310   return $@ if $@;
 311
 312   my $effective_settings = eval { $self->communigate_pro_runcommand(
 313     'GetDomainEffectiveSettings',
 314     $svc_domain->domain
 315   ) };
 316   return $@ if $@;
 317
 318   my $acct_defaults = eval { $self->communigate_pro_runcommand(
 319     'GetAccountDefaults',
 320     $svc_domain->domain
 321   ) };
 322   return $@ if $@;
 323
 324   #warn Dumper($acct_defaults);
 325
 326   %$effective_settings = ( %$effective_settings,
 327                            map { ("Acct. Default $_" => $acct_defaults->{$_}); }
 328                                keys(%$acct_defaults)
 329                          );
 330
 331   #false laziness w/below
 332
 333   my %defaults = map { $_ => 1 }
 334                    grep !exists(${$settings}{$_}), keys %$effective_settings;
 335
 336   foreach my $key ( grep ref($effective_settings->{$_}),
 337                     keys %$effective_settings )
 338   {
 339     my $value = $effective_settings->{$key};
 340     if ( ref($value) eq 'ARRAY' ) {
 341       $effective_settings->{$key} = join(', ', @$value);
 342     } else {
 343       #XXX
 344       warn "serializing ". ref($value). " for table display not yet handled";
 345     }
 346   }
 347
 348   %{$settingsref} = %$effective_settings;
 349   %{$defaultref} = %defaults;
 350
 351   '';
 352 }
 353
 354 sub export_getsettings_svc_acct {
 355   my($self, $svc_acct, $settingsref, $defaultref ) = @_;
 356
 357   my $settings = eval { $self->communigate_pro_runcommand(
 358     'GetAccountSettings',
 359     $svc_acct->email
 360   ) };
 361   return $@ if $@;
 362
 363   delete($settings->{'Password'});
 364
 365   my $effective_settings = eval { $self->communigate_pro_runcommand(
 366     'GetAccountEffectiveSettings',
 367     $svc_acct->email
 368   ) };
 369   return $@ if $@;
 370
 371   delete($effective_settings->{'Password'});
 372
 373   #XXX prefs/effectiveprefs too
 374
 375   #false laziness w/above
 376
 377   my %defaults = map { $_ => 1 }
 378                    grep !exists(${$settings}{$_}), keys %$effective_settings;
 379
 380   foreach my $key ( grep ref($effective_settings->{$_}),
 381                     keys %$effective_settings )
 382   {
 383     my $value = $effective_settings->{$key};
 384     if ( ref($value) eq 'ARRAY' ) {
 385       $effective_settings->{$key} = join(', ', @$value);
 386     } else {
 387       #XXX
 388       warn "serializing ". ref($value). " for table display not yet handled";
 389     }
 390   }
 391
 392   %{$settingsref} = %$effective_settings;
 393   %{$defaultref} = %defaults;
 394
 395   '';
 396
 397 }
 398
 399 sub communigate_pro_queue {
 400   my( $self, $svcnum, $method ) = (shift, shift, shift);
 401   my $jobnum = ''; #don't actually care
 402   $self->communigate_pro_queue_dep( \$jobnum, $svcnum, $method, @_);
 403 }
 404
 405 sub communigate_pro_queue_dep {
 406   my( $self, $jobnumref, $svcnum, $method ) = splice(@_,0,4);
 407
 408   my %kludge_methods = (
 409     'CreateAccount'         => 'CreateAccount',
 410     'UpdateAccountSettings' => 'UpdateAccountSettings',
 411     'CreateDomain'          => 'cp_Scalar_Hash',
 412     'CreateSharedDomain'    => 'cp_Scalar_Hash',
 413     'UpdateDomainSettings'  => 'UpdateDomainSettings',
 414   );
 415   my $sub = exists($kludge_methods{$method})
 416               ? $kludge_methods{$method}
 417               : 'communigate_pro_command';
 418
 419   my $queue = new FS::queue {
 420     'svcnum' => $svcnum,
 421     'job'    => "FS::part_export::communigate_pro::$sub",
 422   };
 423   my $error = $queue->insert(
 424     $self->machine,
 425     $self->option('port'),
 426     $self->option('login'),
 427     $self->option('password'),
 428     $method,
 429     @_,
 430   );
 431   $$jobnumref = $queue->jobnum unless $error;
 432
 433   return $error;
 434 }
 435
 436 sub communigate_pro_runcommand {
 437   my( $self, $method ) = (shift, shift);
 438
 439   communigate_pro_command(
 440     $self->machine,
 441     $self->option('port'),
 442     $self->option('login'),
 443     $self->option('password'),
 444     $method,
 445     @_,
 446   );
 447
 448 }
 449
 450 #XXX one sub per arg prototype is lame.  more magic?  i suppose queue needs
 451 # to store data strctures properly instead of just an arg list.  right.
 452
 453 sub cp_Scalar_Hash {
 454   my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_;
 455   my @args = ( $scalar, \%hash );
 456   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 457 }
 458
 459 #sub cp_Hash {
 460 #  my( $machine, $port, $login, $password, $method, %hash ) = @_;
 461 #  my @args = ( \%hash );
 462 #  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 463 #}
 464
 465 sub UpdateDomainSettings {
 466   my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_;
 467   my @args = ( 'domain' => $domain, 'settings' => \%settings );
 468   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 469 }
 470
 471 sub CreateAccount {
 472   my( $machine, $port, $login, $password, $method, %args ) = @_;
 473   my $accountName  = delete $args{'accountName'};
 474   my $accountType  = delete $args{'accountType'};
 475   my $externalFlag = delete $args{'externalFlag'};
 476   $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
 477   my @args = ( accountName  => $accountName,
 478                accountType  => $accountType,
 479                settings     => \%args,
 480              );
 481                #externalFlag => $externalFlag,
 482   push @args, externalFlag => $externalFlag if $externalFlag;
 483
 484   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 485
 486 }
 487
 488 sub UpdateAccountSettings {
 489   my( $machine, $port, $login, $password, $method, $accountName, %args ) = @_;
 490   $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
 491   my @args = ( $accountName, \%args );
 492   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 493 }
 494
 495 sub communigate_pro_command { #subroutine, not method
 496   my( $machine, $port, $login, $password, $method, @args ) = @_;
 497
 498   eval "use CGP::CLI";
 499
 500   my $cli = new CGP::CLI( {
 501     'PeerAddr' => $machine,
 502     'PeerPort' => $port,
 503     'login'    => $login,
 504     'password' => $password,
 505   } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
 506
 507   #warn "$method ". Dumper(@args) if $DEBUG;
 508
 509   my $return = $cli->$method(@args)
 510     or die "Communigate Pro error: ". $cli->getErrMessage;
 511
 512   $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n";
 513
 514   $return;
 515
 516 }
 517
 518 1;
 519