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 $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',
  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',
  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 )],
  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 sub rebless { shift; }
  49
  50 sub export_username {
  51   my($self, $svc_acct) = (shift, shift);
  52   $svc_acct->email;
  53 }
  54
  55 sub _export_insert {
  56   my( $self, $svc_x ) = (shift, shift);
  57
  58   my @options;
  59
  60   if ( $svc_x->isa('FS::svc_acct') ) {
  61
  62     @options = ( $svc_x->svcnum, 'CreateAccount',
  63       'accountName'    => $self->export_username($svc_x),
  64       'accountType'    => $self->option('accountType'),
  65       'AccessModes'    => $self->option('AccessModes'),
  66       'RealName'       => $svc_x->finger,
  67       'Password'       => $svc_x->_password,
  68     );
  69     push @options, 'MaxAccountSize' => $svc_x->quota if $svc_x->quota;
  70     push @options, 'externalFlag'   => $self->option('externalFlag')
  71       if $self->option('externalFlag');
  72
  73   } elsif ( $svc_x->isa('FS::svc_domain') ) {
  74
  75     my $create = $self->option('create_domain') || 'CreateDomain';
  76
  77     @options = ( $svc_x->svcnum, $create, $svc_x->domain,
  78       #other domain creation options?
  79     );
  80     push @options, 'AccountsLimit' => $svc_x->max_accounts
  81       if $svc_x->max_accounts;
  82
  83   } else {
  84     die "guru meditation #14: $svc_x is not FS::svc_acct, or FS::svc_domain";
  85   }
  86
  87   $self->communigate_pro_queue( @options );
  88 }
  89
  90 sub _export_replace {
  91   my( $self, $new, $old ) = (shift, shift, shift);
  92
  93   if ( $new->isa('FS::svc_acct') ) {
  94
  95     #XXX they probably need the ability to change some of these
  96     return "can't (yet) change username with CommuniGate Pro"
  97       if $old->username ne $new->username;
  98     return "can't (yet) change domain with CommuniGate Pro"
  99       if $self->export_username($old) ne $self->export_username($new);
 100     return "can't (yet) change GECOS with CommuniGate Pro"
 101       if $old->finger ne $new->finger;
 102     return "can't (yet) change quota with CommuniGate Pro"
 103       if $old->quota ne $new->quota;
 104     return '' unless $old->username ne $new->username
 105                   || $old->_password ne $new->_password
 106                   || $old->finger ne $new->finger
 107                   || $old->quota ne $new->quota;
 108
 109     return '' if '*SUSPENDED* '. $old->_password eq $new->_password;
 110
 111     #my $err_or_queue = $self->communigate_pro_queue( $new->svcnum,'RenameAccount',
 112     #  $old->email, $new->email );
 113     #return $err_or_queue unless ref($err_or_queue);
 114     #my $jobnum = $err_or_queue->jobnum;
 115
 116     $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword',
 117                                   $self->export_username($new), $new->_password        )
 118       if $new->_password ne $old->_password;
 119
 120   }  elsif ( $new->isa('FS::svc_domain') ) {
 121
 122     if ( $old->domain ne $new->domain ) {
 123       $self->communigate_pro_queue( $new->svcnum, 'RenameDomain',
 124         $old->domain, $new->domain,
 125       );
 126     }
 127
 128     if ( $old->max_accounts ne $new->max_accounts ) {
 129       $self->communigate_pro_queue( $new->svcnum, 'UpdateDomainSettings',
 130         $new->domain, 'AccountsLimit' => ($new->max_accounts || 'default'),
 131       );
 132     }
 133
 134     #other kinds of changes?
 135
 136   } else {
 137     die "guru meditation #15: $new is not FS::svc_acct, or FS::svc_domain";
 138   }
 139
 140 }
 141
 142 sub _export_delete {
 143   my( $self, $svc_x ) = (shift, shift);
 144
 145   if ( $svc_x->isa('FS::svc_acct') ) {
 146
 147     $self->communigate_pro_queue( $svc_x->svcnum, 'DeleteAccount',
 148       $self->export_username($svc_x),
 149     );
 150
 151   } elsif ( $svc_x->isa('FS::svc_domain') ) {
 152
 153     $self->communigate_pro_queue( $svc_x->svcnum, 'DeleteDomain',
 154       $svc_x->domain,
 155       #XXX turn on force option for domain deletion?
 156     );
 157
 158   } else {
 159     die "guru meditation #16: $svc_x is not FS::svc_acct, or FS::svc_domain";
 160   }
 161
 162 }
 163
 164 sub _export_suspend {
 165   my( $self, $svc_x ) = (shift, shift);
 166
 167   if ( $svc_x->isa('FS::svc_acct') ) {
 168
 169      $self->communigate_pro_queue( $svc_x->svcnum, 'UpdateAccountSettings',
 170       'accountName' => $self->export_username($svc_x),
 171       'AccessModes' => 'Mail',
 172     );
 173
 174   } elsif ( $svc_x->isa('FS::svc_domain') ) {
 175
 176     #XXX domain operations
 177   } else {
 178     die "guru meditation #17: $svc_x is not FS::svc_acct, or FS::svc_domain";
 179   }
 180
 181 }
 182
 183 sub _export_unsuspend {
 184   my( $self, $svc_x ) = (shift, shift);
 185
 186   if ( $svc_x->isa('FS::svc_acct') ) {
 187
 188     $self->communigate_pro_queue( $svc_x->svcnum, 'UpdateAccountSettings',
 189       'accountName' => $self->export_username($svc_x),
 190       'AccessModes' => $self->option('AccessModes'),
 191     );
 192   } elsif ( $svc_x->isa('FS::svc_domain') ) {
 193
 194     #XXX domain operations
 195   } else {
 196     die "guru meditation #18: $svc_x is not FS::svc_acct, or FS::svc_domain";
 197   }
 198
 199 }
 200
 201 sub export_getsettings {
 202   my($self, $svc_x, $settingsref, $defaultref ) = @_;
 203
 204   my $settings = eval { $self->communigate_pro_runcommand(
 205     'GetDomainSettings',
 206     $svc_x->domain
 207   ) };
 208   return $@ if $@;
 209
 210   my $effective_settings = eval { $self->communigate_pro_runcommand(
 211     'GetDomainEffectiveSettings',
 212     $svc_x->domain
 213   ) };
 214   return $@ if $@;
 215
 216   my %defaults = map { $_ => 1 }
 217                    grep !exists(${$settings}{$_}), keys %$effective_settings;
 218
 219   foreach my $key ( grep ref($effective_settings->{$_}),
 220                     keys %$effective_settings )
 221   {
 222     my $value = $effective_settings->{$key};
 223     if ( ref($value) eq 'ARRAY' ) {
 224       $effective_settings->{$key} = join(', ', @$value);
 225     } else {
 226       #XXX
 227       warn "serializing ". ref($value). " for table display not yet handled";
 228     }
 229   }
 230
 231   %{$settingsref} = %$effective_settings;
 232   %{$defaultref} = %defaults;
 233
 234   '';
 235 }
 236
 237 sub communigate_pro_queue {
 238   my( $self, $svcnum, $method ) = (shift, shift, shift);
 239   my %kludge_methods = (
 240     'CreateAccount'         => 'CreateAccount',
 241     'UpdateAccountSettings' => 'UpdateAccountSettings',
 242     'CreateDomain'          => 'cp_Scalar_Hash',
 243     'CreateSharedDomain'    => 'cp_Scalar_Hash',
 244     'UpdateDomainSettings'  => 'UpdateDomainSettings',
 245   );
 246   my $sub = exists($kludge_methods{$method})
 247               ? $kludge_methods{$method}
 248               : 'communigate_pro_command';
 249   my $queue = new FS::queue {
 250     'svcnum' => $svcnum,
 251     'job'    => "FS::part_export::communigate_pro::$sub",
 252   };
 253   $queue->insert(
 254     $self->machine,
 255     $self->option('port'),
 256     $self->option('login'),
 257     $self->option('password'),
 258     $method,
 259     @_,
 260   );
 261
 262 }
 263
 264 sub communigate_pro_runcommand {
 265   my( $self, $method ) = (shift, shift);
 266
 267   communigate_pro_command(
 268     $self->machine,
 269     $self->option('port'),
 270     $self->option('login'),
 271     $self->option('password'),
 272     $method,
 273     @_,
 274   );
 275
 276 }
 277
 278 #XXX one sub per arg prototype is lame.  more magic?  i suppose queue needs
 279 # to store data strctures properly instead of just an arg list.  right.
 280
 281 sub cp_Scalar_Hash {
 282   my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_;
 283   my @args = ( $scalar, \%hash );
 284   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 285 }
 286
 287 #sub cp_Hash {
 288 #  my( $machine, $port, $login, $password, $method, %hash ) = @_;
 289 #  my @args = ( \%hash );
 290 #  communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 291 #}
 292
 293 sub UpdateDomainSettings {
 294   my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_;
 295   my @args = ( 'domain' => $domain, 'settings' => \%settings );
 296   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 297 }
 298
 299 sub CreateAccount {
 300   my( $machine, $port, $login, $password, $method, %args ) = @_;
 301   my $accountName  = delete $args{'accountName'};
 302   my $accountType  = delete $args{'accountType'};
 303   my $externalFlag = delete $args{'externalFlag'};
 304   $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
 305   my @args = ( accountName => $accountName,
 306                accountType  => $accountType,
 307                settings     => \%args,
 308              );
 309                #externalFlag => $externalFlag,
 310   push @args, externalFlag => $externalFlag if $externalFlag;
 311
 312   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 313
 314 }
 315
 316 sub UpdateAccountSettings {
 317   my( $machine, $port, $login, $password, $method, %args ) = @_;
 318   my $accountName  = delete $args{'accountName'};
 319   $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
 320   my @args = ( $accountName, \%args );
 321   communigate_pro_command( $machine, $port, $login, $password, $method, @args );
 322 }
 323
 324 sub communigate_pro_command { #subroutine, not method
 325   my( $machine, $port, $login, $password, $method, @args ) = @_;
 326
 327   eval "use CGP::CLI";
 328
 329   my $cli = new CGP::CLI( {
 330     'PeerAddr' => $machine,
 331     'PeerPort' => $port,
 332     'login'    => $login,
 333     'password' => $password,
 334   } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
 335
 336   #warn "$method ". Dumper(@args) if $DEBUG;
 337
 338   my $return = $cli->$method(@args)
 339     or die "Communigate Pro error: ". $cli->getErrMessage;
 340
 341   $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n";
 342
 343   $return;
 344
 345 }
 346
 347 1;
 348