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