X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fcommunigate_pro.pm;h=a3ec5e0bed2c25bd53d313e1c15e24b632fe0d50;hp=c31aea3855a029186be7fdec327dedf3890cf061;hb=246e76618447bb7ac436e9bfb8c0b042f9613326;hpb=f696f5c9b8ec55b83285a6d159711889cc796619 diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm index c31aea385..a3ec5e0be 100644 --- a/FS/FS/part_export/communigate_pro.pm +++ b/FS/FS/part_export/communigate_pro.pm @@ -33,11 +33,11 @@ tie %options, 'Tie::IxHash', ; %info = ( - 'svc' => [qw( svc_acct svc_domain svc_forward )], - 'desc' => 'Real-time export of accounts and domains to a CommuniGate Pro mail server', + 'svc' => [qw( svc_acct svc_domain svc_forward svc_mailinglist )], + 'desc' => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server', 'options' => \%options, 'notes' => <<'END' -Real time export of accounts and domains to a +Real time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server. The CommuniGate Pro Perl Interface @@ -71,20 +71,26 @@ sub _export_insert_svc_acct { my( $self, $svc_acct ) = (shift, shift); my %settings = ( - 'AccessModes' => ( $svc_acct->cgp_accessmodes - || $self->option('AccessModes') ), + 'AccessModes' => [ split(' ', ( $svc_acct->cgp_accessmodes + || $self->option('AccessModes') ) + ) + ], 'RealName' => $svc_acct->finger, 'Password' => $svc_acct->_password, + + 'PasswordRecovery' => ($svc_acct->password_recover ? 'YES':'NO'), + + 'RulesAllowed' => $svc_acct->cgp_rulesallowed, + 'RPOPAllowed' =>($svc_acct->cgp_rpopallowed ?'YES':'NO'), + 'MailToAll' =>($svc_acct->cgp_mailtoall ?'YES':'NO'), + 'AddMailTrailer' =>($svc_acct->cgp_addmailtrailer ?'YES':'NO'), + + 'ArchiveMessagesAfter' => $svc_acct->cgp_archiveafter, + map { $quotas{$_} => $svc_acct->$_() } grep $svc_acct->$_(), keys %quotas ); - - #XXX preferences phase 1: message delete method, on logout remove trash - #phase 2: language, time zone, layout, pronto style, send read receipts - - #phase 2: pwdallowed, passwordrecovery, allowed mail rules, - # RPOP modifications, accepts mail to all, add trailer to sent mail - #phase 3: archive messages, mailing lists + #XXX phase 3: mailing lists my @options = ( 'CreateAccount', 'accountName' => $self->export_username($svc_acct), @@ -97,16 +103,57 @@ sub _export_insert_svc_acct { if $self->option('externalFlag'); #let's do the create realtime too, for much the same reasons, and to avoid - #pain of trying to queue w/dep the aliases - #my $r= + #pain of trying to queue w/dep the prefs & aliases eval { $self->communigate_pro_runcommand( @options ) }; return $@ if $@; - my $err= $self->communigate_pro_queue( $svc_acct->svcnum, 'SetAccountAliases', + #preferences + my %prefs = (); + $prefs{'DeleteMode'} = $svc_acct->cgp_deletemode if $svc_acct->cgp_deletemode; + $prefs{'EmptyTrash'} = $svc_acct->cgp_emptytrash if $svc_acct->cgp_emptytrash; + $prefs{'Language'} = $svc_acct->cgp_language if $svc_acct->cgp_language; + $prefs{'TimeZone'} = $svc_acct->cgp_timezone if $svc_acct->cgp_timezone; + $prefs{'SkinName'} = $svc_acct->cgp_skinname if $svc_acct->cgp_skinname; + $prefs{'ProntoSkinName'} = $svc_acct->cgp_prontoskinname if $svc_acct->cgp_prontoskinname; + $prefs{'SendMDNMode'} = $svc_acct->cgp_sendmdnmode if $svc_acct->cgp_sendmdnmode; + if ( keys %prefs ) { + my $pref_err = $self->communigate_pro_queue( $svc_acct->svcnum, + 'UpdateAccountPrefs', + $self->export_username($svc_acct), + %prefs, + ); + warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err" + if $pref_err; + } + + #aliases + if ( $svc_acct->cgp_aliases ) { + my $alias_err = $self->communigate_pro_queue( $svc_acct->svcnum, + 'SetAccountAliases', + $self->export_username($svc_acct), + [ split(/\s*[,\s]\s*/, $svc_acct->cgp_aliases) ], + ); + warn "WARNING: error queueing SetAccountAliases job: $alias_err" + if $alias_err; + } + + my $rule_error = $self->communigate_pro_queue( + $svc_acct->svcnum, + 'SetAccountMailRules', + $self->export_username($svc_acct), + $svc_acct->cgp_rule_arrayref, + ); + warn "WARNING: error queueing SetAccountMailRules job: $rule_error" + if $rule_error; + + my $rpop_error = $self->communigate_pro_queue( + $svc_acct->svcnum, + 'SetAccountRPOPs', $self->export_username($svc_acct), - [ split(/\s*,\s*/, $svc_acct->cgp_aliases) ], + $svc_acct->cgp_rpop_hashref, ); - warn "WARNING: error queueing SetAccountAliases job: $err" if $err; + warn "WARNING: error queueing SetAccountMailRPOPs job: $rpop_error" + if $rpop_error; ''; @@ -117,17 +164,119 @@ sub _export_insert_svc_domain { my $create = $self->option('create_domain') || 'CreateDomain'; - my @options = ( $svc_domain->svcnum, $create, $svc_domain->domain, - #other domain creation options? + my %settings = ( + 'DomainAccessModes' => [ split(' ', $svc_domain->cgp_accessmodes ) ], ); - push @options, 'AccountsLimit' => $svc_domain->max_accounts + $settings{'AccountsLimit'} = $svc_domain->max_accounts if $svc_domain->max_accounts; + $settings{'AdminDomainName'} = $svc_domain->parent_svc_x->domain + if $svc_domain->parent_svcnum; + $settings{'TrailerText'} = $svc_domain->trailer + if $svc_domain->trailer; + $settings{'CertificateType'} = $svc_domain->cgp_certificatetype + if $svc_domain->cgp_certificatetype; + + my @options = ( $create, $svc_domain->domain, \%settings ); + + eval { $self->communigate_pro_runcommand( @options ) }; + return $@ if $@; + + #aliases + if ( $svc_domain->cgp_aliases ) { + my $alias_err = $self->communigate_pro_queue( $svc_domain->svcnum, + 'SetDomainAliases', + $svc_domain->domain, + split(/\s*[,\s]\s*/, $svc_domain->cgp_aliases), + ); + warn "WARNING: error queueing SetDomainAliases job: $alias_err" + if $alias_err; + } + + #account defaults + my $def_err = $self->communigate_pro_queue( $svc_domain->svcnum, + 'SetAccountDefaults', + $svc_domain->domain, + 'PWDAllowed' =>($svc_domain->acct_def_password_selfchange ? 'YES':'NO'), + 'PasswordRecovery' => ($svc_domain->acct_def_password_recover ? 'YES':'NO'), + 'AccessModes' => $svc_domain->acct_def_cgp_accessmodes, + 'MaxAccountSize' => $svc_domain->acct_def_quota, + 'MaxWebSize' => $svc_domain->acct_def_file_quota, + 'MaxWebFile' => $svc_domain->acct_def_file_maxnum, + 'MaxFileSize' => $svc_domain->acct_def_file_maxsize, + 'RulesAllowed' => $svc_domain->acct_def_cgp_rulesallowed, + 'RPOPAllowed' =>($svc_domain->acct_def_cgp_rpopallowed ?'YES':'NO'), + 'MailToAll' =>($svc_domain->acct_def_cgp_mailtoall ?'YES':'NO'), + 'AddMailTrailer' =>($svc_domain->acct_def_cgp_addmailtrailer ?'YES':'NO'), + 'ArchiveMessagesAfter' => $svc_domain->acct_def_cgp_archiveafter, + ); + warn "WARNING: error queueing SetAccountDefaults job: $def_err" + if $def_err; + + #account defaults prefs + my $pref_err = $self->communigate_pro_queue( $svc_domain->svcnum, + 'SetAccountDefaultPrefs', + $svc_domain->domain, + 'DeleteMode' => $svc_domain->acct_def_cgp_deletemode, + 'EmptyTrash' => $svc_domain->acct_def_cgp_emptytrash, + 'Language' => $svc_domain->acct_def_cgp_language, + 'TimeZone' => $svc_domain->acct_def_cgp_timezone, + 'SkinName' => $svc_domain->acct_def_cgp_skinname, + 'ProntoSkinName' => $svc_domain->acct_def_cgp_prontoskinname, + 'SendMDNMode' => $svc_domain->acct_def_cgp_sendmdnmode, + ); + warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err" + if $pref_err; + + my $rule_error = $self->communigate_pro_queue( + $svc_domain->svcnum, + 'SetDomainMailRules', + $svc_domain->domain, + $svc_domain->cgp_rule_arrayref, + ); + warn "WARNING: error queueing SetDomainMailRules job: $rule_error" + if $rule_error; + + ''; - $self->communigate_pro_queue( @options ); } -#sub _export_insert_svc_forward { -#} +sub _export_insert_svc_forward { + my( $self, $svc_forward ) = (shift, shift); + + my $src = $svc_forward->src || $svc_forward->srcsvc_acct->email; + my $dst = $svc_forward->dst || $svc_forward->dstsvc_acct->email; + + #real-time here, presuming CGP does some dup detection? + eval { $self->communigate_pro_runcommand( 'CreateForwarder', $src, $dst); }; + return $@ if $@; + + ''; +} + +sub _export_insert_svc_mailinglist { + my( $self, $svc_mlist ) = (shift, shift); + + my @members = map $_->email_address, + $svc_mlist->mailinglist->mailinglistmember; + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'CreateGroup', + $svc_mlist->username.'@'.$svc_mlist->domain, + { 'RealName' => $svc_mlist->listname, + 'SetReplyTo' => ( $svc_mlist->reply_to ? 'YES' : 'NO' ), + 'RemoveAuthor' => ( $svc_mlist->remove_from ? 'YES' : 'NO' ), + 'RejectAuto' => ( $svc_mlist->reject_auto ? 'YES' : 'NO' ), + 'RemoveToAndCc' => ( $svc_mlist->remove_to_and_cc ? 'YES' : 'NO' ), + 'Members' => \@members, + } + ); + }; + return $@ if $@; + + ''; + +} sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); @@ -144,7 +293,6 @@ sub _export_replace_svc_acct { #w/dependencies. we don't want FS winding up out-of-sync with the wrong #username and a queued job anyway. right?? if ( $self->export_username($old) ne $self->export_username($new) ) { - #my $r = eval { $self->communigate_pro_runcommand( 'RenameAccount', $self->export_username($old), @@ -173,9 +321,21 @@ sub _export_replace_svc_acct { if $old->cgp_accessmodes ne $new->cgp_accessmodes || $old->cgp_type ne $new->cgp_type; - #phase 2: pwdallowed, passwordrecovery, allowed mail rules, - # RPOP modifications, accepts mail to all, add trailer to sent mail - #phase 3: archive messages, mailing lists + $settings{'PasswordRecovery'} = ( $new->password_recover ? 'YES':'NO' ) + if $old->password_recover ne $new->password_recover; + + $settings{'RulesAllowed'} = $new->cgp_rulesallowed + if $old->cgp_rulesallowed ne $new->cgp_rulesallowed; + $settings{'RPOPAllowed'} = ( $new->cgp_rpopallowed ? 'YES':'NO' ) + if $old->cgp_rpopallowed ne $new->cgp_rpopallowed; + $settings{'MailToAll'} = ( $new->cgp_mailtoall ? 'YES':'NO' ) + if $old->cgp_mailtoall ne $new->cgp_mailtoall; + $settings{'AddMailTrailer'} = ( $new->cgp_addmailtrailer ? 'YES':'NO' ) + if $old->cgp_addmailtrailer ne $new->cgp_addmailtrailer; + $settings{'ArchiveMessagesAfter'} = $new->cgp_archiveafter + if $old->cgp_archiveafter ne $new->cgp_archiveafter; + + #XXX phase 3: mailing lists if ( keys %settings ) { my $error = $self->communigate_pro_queue( @@ -187,18 +347,59 @@ sub _export_replace_svc_acct { return $error if $error; } + #preferences + my %prefs = (); + $prefs{'DeleteMode'} = $new->cgp_deletemode + if $old->cgp_deletemode ne $new->cgp_deletemode; + $prefs{'EmptyTrash'} = $new->cgp_emptytrash + if $old->cgp_emptytrash ne $new->cgp_emptytrash; + $prefs{'Language'} = $new->cgp_language + if $old->cgp_language ne $new->cgp_language; + $prefs{'TimeZone'} = $new->cgp_timezone + if $old->cgp_timezone ne $new->cgp_timezone; + $prefs{'SkinName'} = $new->cgp_skinname + if $old->cgp_skinname ne $new->cgp_skinname; + $prefs{'ProntoSkinName'} = $new->cgp_prontoskinname + if $old->cgp_prontoskinname ne $new->cgp_prontoskinname; + $prefs{'SendMDNMode'} = $new->cgp_sendmdnmode + if $old->cgp_sendmdnmode ne $new->cgp_sendmdnmode; + if ( keys %prefs ) { + my $pref_err = $self->communigate_pro_queue( $new->svcnum, + 'UpdateAccountPrefs', + $self->export_username($new), + %prefs, + ); + warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err" + if $pref_err; + } + if ( $old->cgp_aliases ne $new->cgp_aliases ) { my $error = $self->communigate_pro_queue( $new->svcnum, 'SetAccountAliases', $self->export_username($new), - [ split(/\s*,\s*/, $new->cgp_aliases) ], + [ split(/\s*[,\s]\s*/, $new->cgp_aliases) ], ); return $error if $error; } - #XXX preferences phase 1: message delete method, on logout remove trash - #phase 2: language, time zone, layout, pronto style, send read receipts + my $rule_error = $self->communigate_pro_queue( + $new->svcnum, + 'SetAccountMailRules', + $self->export_username($new), + $new->cgp_rule_arrayref, + ); + warn "WARNING: error queueing SetAccountMailRules job: $rule_error" + if $rule_error; + + my $rpop_error = $self->communigate_pro_queue( + $new->svcnum, + 'SetAccountRPOPs', + $self->export_username($new), + $new->cgp_rpop_hashref, + ); + warn "WARNING: error queueing SetAccountMailRPOPs job: $rpop_error" + if $rpop_error; ''; @@ -207,25 +408,158 @@ sub _export_replace_svc_acct { sub _export_replace_svc_domain { my( $self, $new, $old ) = (shift, shift, shift); + #let's just do the rename part realtime rather than trying to queue + #w/dependencies. we don't want FS winding up out-of-sync with the wrong + #username and a queued job anyway. right?? if ( $old->domain ne $new->domain ) { - my $error = $self->communigate_pro_queue( $new->svcnum, 'RenameDomain', - $old->domain, $new->domain, + eval { $self->communigate_pro_runcommand( + 'RenameDomain', $old->domain, $new->domain, + ) }; + return $@ if $@; + } + + my %settings = (); + $settings{'AccountsLimit'} = $new->max_accounts + if $old->max_accounts ne $new->max_accounts; + $settings{'TrailerText'} = $new->trailer + if $old->trailer ne $new->trailer; + $settings{'DomainAccessModes'} = $new->cgp_accessmodes + if $old->cgp_accessmodes ne $new->cgp_accessmodes; + $settings{'AdminDomainName'} = + $new->parent_svcnum ? $new->parent_svc_x->domain : '' + if $old->parent_svcnum != $new->parent_svcnum; + $settings{'CertificateType'} = $new->cgp_certificatetype + if $old->cgp_certificatetype ne $new->cgp_certificatetype; + + if ( keys %settings ) { + my $error = $self->communigate_pro_queue( $new->svcnum, + 'UpdateDomainSettings', + $new->domain, + %settings, ); return $error if $error; } - if ( $old->max_accounts ne $new->max_accounts ) { + if ( $old->cgp_aliases ne $new->cgp_aliases ) { my $error = $self->communigate_pro_queue( $new->svcnum, - 'UpdateDomainSettings', + 'SetDomainAliases', $new->domain, - 'AccountsLimit' => ($new->max_accounts || 'default'), + split(/\s*[,\s]\s*/, $new->cgp_aliases), ); return $error if $error; } - #other kinds of changes? + #below this identical to insert... any value to doing an Update here? + #not seeing any big one... i guess it would be nice to avoid the update + #when things haven't changed + + #account defaults + my $def_err = $self->communigate_pro_queue( $new->svcnum, + 'SetAccountDefaults', + $new->domain, + 'PWDAllowed' => ( $new->acct_def_password_selfchange ? 'YES' : 'NO' ), + 'PasswordRecovery' => ( $new->acct_def_password_recover ? 'YES' : 'NO' ), + 'AccessModes' => $new->acct_def_cgp_accessmodes, + 'MaxAccountSize' => $new->acct_def_quota, + 'MaxWebSize' => $new->acct_def_file_quota, + 'MaxWebFile' => $new->acct_def_file_maxnum, + 'MaxFileSize' => $new->acct_def_file_maxsize, + 'RulesAllowed' => $new->acct_def_cgp_rulesallowed, + 'RPOPAllowed' => ( $new->acct_def_cgp_rpopallowed ? 'YES' : 'NO' ), + 'MailToAll' => ( $new->acct_def_cgp_mailtoall ? 'YES' : 'NO' ), + 'AddMailTrailer' => ( $new->acct_def_cgp_addmailtrailer ? 'YES' : 'NO' ), + 'ArchiveMessagesAfter' => $new->acct_def_cgp_archiveafter, + ); + warn "WARNING: error queueing SetAccountDefaults job: $def_err" + if $def_err; + + #account defaults prefs + my $pref_err = $self->communigate_pro_queue( $new->svcnum, + 'SetAccountDefaultPrefs', + $new->domain, + 'DeleteMode' => $new->acct_def_cgp_deletemode, + 'EmptyTrash' => $new->acct_def_cgp_emptytrash, + 'Language' => $new->acct_def_cgp_language, + 'TimeZone' => $new->acct_def_cgp_timezone, + 'SkinName' => $new->acct_def_cgp_skinname, + 'ProntoSkinName' => $new->acct_def_cgp_prontoskinname, + 'SendMDNMode' => $new->acct_def_cgp_sendmdnmode, + ); + warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err" + if $pref_err; + + my $rule_error = $self->communigate_pro_queue( + $new->svcnum, + 'SetDomainMailRules', + $new->domain, + $new->cgp_rule_arrayref, + ); + warn "WARNING: error queueing SetDomainMailRules job: $rule_error" + if $rule_error; + + ''; +} + +sub _export_replace_svc_forward { + my( $self, $new, $old ) = (shift, shift, shift); + + my $osrc = $old->src || $old->srcsvc_acct->email; + my $nsrc = $new->src || $new->srcsvc_acct->email; + my $odst = $old->dst || $old->dstsvc_acct->email; + my $ndst = $new->dst || $new->dstsvc_acct->email; + + if ( $odst ne $ndst ) { + + #no change command, so delete and create (real-time) + eval { $self->communigate_pro_runcommand('DeleteForwarder', $osrc) }; + return $@ if $@; + eval { $self->communigate_pro_runcommand('CreateForwarder', $nsrc, $ndst)}; + return $@ if $@; + + } elsif ( $osrc ne $nsrc ) { + + #real-time here, presuming CGP does some dup detection? + eval { $self->communigate_pro_runcommand( 'RenameForwarder', $osrc, $nsrc)}; + return $@ if $@; + + } else { + warn "communigate replace called for svc_forward with no changes\n";#confess + } + + ''; +} + +sub _export_replace_svc_mailinglist { + my( $self, $new, $old ) = (shift, shift, shift); + + my $oldGroupName = $old->username.'@'.$old->domain; + my $newGroupName = $new->username.'@'.$new->domain; + + if ( $oldGroupName ne $newGroupName ) { + eval { $self->communigate_pro_runcommand( + 'RenameGroup', $oldGroupName, $newGroupName ); }; + return $@ if $@; + } + + my @members = map $_->email_address, + $new->mailinglist->mailinglistmember; + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'SetGroup', $newGroupName, + { 'RealName' => $new->listname, + 'SetReplyTo' => ( $new->reply_to ? 'YES' : 'NO' ), + 'RemoveAuthor' => ( $new->remove_from ? 'YES' : 'NO' ), + 'RejectAuto' => ( $new->reject_auto ? 'YES' : 'NO' ), + 'RemoveToAndCc' => ( $new->remove_to_and_cc ? 'YES' : 'NO' ), + 'Members' => \@members, + } + ); + }; + return $@ if $@; ''; + } sub _export_delete { @@ -242,7 +576,6 @@ sub _export_delete_svc_acct { $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount', $self->export_username($svc_acct), ); - } sub _export_delete_svc_domain { @@ -252,6 +585,28 @@ sub _export_delete_svc_domain { $svc_domain->domain, #XXX turn on force option for domain deletion? ); +} + +sub _export_delete_svc_forward { + my( $self, $svc_forward ) = (shift, shift); + + $self->communigate_pro_queue( $svc_forward->svcnum, 'DeleteForwarder', + ($svc_forward->src || $svc_forward->srcsvc_acct->email), + ); +} + +sub _export_delete_svc_mailinglist { + my( $self, $svc_mailinglist ) = (shift, shift); + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'DeleteGroup', + $svc_mailinglist->username.'@'.$svc_mailinglist->domain, + ); + }; + return $@ if $@; + + ''; } @@ -316,6 +671,20 @@ sub _export_unsuspend_svc_domain { } +sub export_mailinglistmember_insert { + my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); + $svc_mailinglist->replace(); +} + +sub export_mailinglistmember_replace { + my( $self, $svc_mailinglist, $new, $old ) = (shift, shift, shift, shift); + die "no way to do this from the UI right now"; +} + +sub export_mailinglistmember_delete { + my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); + $svc_mailinglist->replace(); +} sub export_getsettings { my($self, $svc_x) = (shift, shift); @@ -348,12 +717,38 @@ sub export_getsettings_svc_domain { ) }; return $@ if $@; - #warn Dumper($acct_defaults); + my $acct_defaultprefs = eval { $self->communigate_pro_runcommand( + 'GetAccountDefaultPrefs', + $svc_domain->domain + ) }; + return $@ if $@; - %$effective_settings = ( %$effective_settings, - map { ("Acct. Default $_" => $acct_defaults->{$_}); } - keys(%$acct_defaults) - ); + my $rules = eval { $self->communigate_pro_runcommand( + 'GetDomainMailRules', + $svc_domain->domain + ) }; + return $@ if $@; + + #aliases too + my $aliases = eval { $self->communigate_pro_runcommand( + 'GetDomainAliases', + $svc_domain->domain + ) }; + return $@ if $@; + + my %more = ( + ( map { ("Acct. Default $_" => $acct_defaults->{$_}); } + keys(%$acct_defaults) + ), + ( map { ("Acct. Default $_" => $acct_defaultprefs->{$_}); } #diff label?? + keys(%$acct_defaultprefs) + ), + ( map _rule2string($_), @$rules ), + 'Aliases' => join(', ', @$aliases), + ); + + %$effective_settings = ( %$effective_settings, %more ); + %$settings = ( %$settings, %more ); #false laziness w/below @@ -363,13 +758,7 @@ sub export_getsettings_svc_domain { foreach my $key ( grep ref($effective_settings->{$_}), keys %$effective_settings ) { - my $value = $effective_settings->{$key}; - if ( ref($value) eq 'ARRAY' ) { - $effective_settings->{$key} = join(' ', @$value); - } else { - #XXX - warn "serializing ". ref($value). " for table display not yet handled"; - } + $effective_settings->{$key} = _pretty( $effective_settings->{$key} ); } %{$settingsref} = %$effective_settings; @@ -420,8 +809,35 @@ sub export_getsettings_svc_acct { keys(%$prefs) ); - #aliases too + #mail rules + my $rules = eval { $self->communigate_pro_runcommand( + 'GetAccountMailRules', + $svc_acct->email + ) }; + return $@ if $@; + + %$effective_settings = ( %$effective_settings, + map _rule2string($_), @$rules + ); + %$settings = ( %$settings, + map _rule2string($_), @$rules + ); + +# #rpops too +# my $rpops = eval { $self->communigate_pro_runcommand( +# 'GetAccountRPOPs', +# $svc_acct->email +# ) }; +# return $@ if $@; +# +# %$effective_settings = ( %$effective_settings, +# map _rpop2string($_), %$rpops +# ); +# %$settings = ( %$settings, +# map _rpop2string($_), %rpops +# ); + #aliases too my $aliases = eval { $self->communigate_pro_runcommand( 'GetAccountAliases', $svc_acct->email @@ -439,13 +855,7 @@ sub export_getsettings_svc_acct { foreach my $key ( grep ref($effective_settings->{$_}), keys %$effective_settings ) { - my $value = $effective_settings->{$key}; - if ( ref($value) eq 'ARRAY' ) { - $effective_settings->{$key} = join(' ', @$value); - } else { - #XXX - warn "serializing ". ref($value). " for table display not yet handled"; - } + $effective_settings->{$key} = _pretty( $effective_settings->{$key} ); } %{$settingsref} = %$effective_settings; @@ -455,6 +865,71 @@ sub export_getsettings_svc_acct { } +sub _pretty { + my $value = shift; + if ( ref($value) eq 'ARRAY' ) { + '['. join(' ', map { ref($_) ? _pretty($_) : $_ } @$value ). ']'; + } elsif ( ref($value) eq 'HASH' ) { + '{'. join(', ', + map { my $v = $value->{$_}; + "$_:". ( ref($v) ? _pretty($v) : $v ); + } + keys %$value + ). '}'; + } else { + warn "serializing ". ref($value). " for table display not yet handled"; + } +} + +sub export_getsettings_svc_forward { + my($self, $svc_forward, $settingsref, $defaultref ) = @_; + + my $dest = eval { $self->communigate_pro_runcommand( + 'GetForwarder', + ($svc_forward->src || $svc_forward->srcsvc_acct->email), + ) }; + return $@ if $@; + + my $settings = { 'Destination' => $dest }; + + %{$settingsref} = %$settings; + %{$defaultref} = (); + + ''; +} + +sub _rule2string { + my $rule = shift; + my($priority, $name, $conditions, $actions, $comment) = @$rule; + $conditions = join(', ', map { my $a = $_; join(' ', @$a); } @$conditions); + $actions = join(', ', map { my $a = $_; join(' ', @$a); } @$actions); + ("Mail rule $name" => "$priority IF $conditions THEN $actions ($comment)"); +} + +#sub _rpop2string { +# my $rpop = shift; +# my($priority, $name, $conditions, $actions, $comment) = @$rule; +# $conditions = join(', ', map { my $a = $_; join(' ', @$a); } @$conditions); +# $actions = join(', ', map { my $a = $_; join(' ', @$a); } @$actions); +# ("Mail rule $name" => "$priority IF $conditions THEN $actions ($comment)"); +#} + +sub export_getsettings_svc_mailinglist { + my($self, $svc_mailinglist, $settingsref, $defaultref ) = @_; + + my $settings = eval { $self->communigate_pro_runcommand( + 'GetGroup', + $svc_mailinglist->username.'@'.$svc_mailinglist->domain, + ) }; + return $@ if $@; + + $settings->{'Members'} = join(', ', @{ $settings->{'Members'} } ); + + %{$settingsref} = %$settings; + + ''; +} + sub communigate_pro_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); my $jobnum = ''; #don't actually care @@ -465,11 +940,18 @@ sub communigate_pro_queue_dep { my( $self, $jobnumref, $svcnum, $method ) = splice(@_,0,4); my %kludge_methods = ( - 'CreateAccount' => 'CreateAccount', - 'UpdateAccountSettings' => 'UpdateAccountSettings', - 'CreateDomain' => 'cp_Scalar_Hash', - 'CreateSharedDomain' => 'cp_Scalar_Hash', - 'UpdateDomainSettings' => 'UpdateDomainSettings', + #'CreateAccount' => 'CreateAccount', + 'UpdateAccountSettings' => 'UpdateAccountSettings', + 'UpdateAccountPrefs' => 'cp_Scalar_Hash', + #'CreateDomain' => 'cp_Scalar_Hash', + #'CreateSharedDomain' => 'cp_Scalar_Hash', + 'UpdateDomainSettings' => 'cp_Scalar_settingsHash', + 'SetDomainAliases' => 'cp_Scalar_Array', + 'SetAccountDefaults' => 'cp_Scalar_settingsHash', + 'UpdateAccountDefaults' => 'cp_Scalar_settingsHash', + 'SetAccountDefaultPrefs' => 'cp_Scalar_settingsHash', + 'UpdateAccountDefaultPrefs' => 'cp_Scalar_settingsHash', + 'SetAccountRPOPs' => 'cp_Scalar_Hash', ); my $sub = exists($kludge_methods{$method}) ? $kludge_methods{$method} @@ -515,34 +997,43 @@ sub cp_Scalar_Hash { communigate_pro_command( $machine, $port, $login, $password, $method, @args ); } +sub cp_Scalar_Array { + my( $machine, $port, $login, $password, $method, $scalar, @array ) = @_; + my @args = ( $scalar, \@array ); + communigate_pro_command( $machine, $port, $login, $password, $method, @args ); +} + #sub cp_Hash { # my( $machine, $port, $login, $password, $method, %hash ) = @_; # my @args = ( \%hash ); # communigate_pro_command( $machine, $port, $login, $password, $method, @args ); #} -sub UpdateDomainSettings { +sub cp_Scalar_settingsHash { my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_; + for (qw( AccessModes DomainAccessModes )) { + $settings{$_} = [split(' ',$settings{$_})] if $settings{$_}; + } my @args = ( 'domain' => $domain, 'settings' => \%settings ); communigate_pro_command( $machine, $port, $login, $password, $method, @args ); } -sub CreateAccount { - my( $machine, $port, $login, $password, $method, %args ) = @_; - my $accountName = delete $args{'accountName'}; - my $accountType = delete $args{'accountType'}; - my $externalFlag = delete $args{'externalFlag'}; - $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; - my @args = ( accountName => $accountName, - accountType => $accountType, - settings => \%args, - ); - #externalFlag => $externalFlag, - push @args, externalFlag => $externalFlag if $externalFlag; - - communigate_pro_command( $machine, $port, $login, $password, $method, @args ); - -} +#sub CreateAccount { +# my( $machine, $port, $login, $password, $method, %args ) = @_; +# my $accountName = delete $args{'accountName'}; +# my $accountType = delete $args{'accountType'}; +# my $externalFlag = delete $args{'externalFlag'}; +# $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; +# my @args = ( accountName => $accountName, +# accountType => $accountType, +# settings => \%args, +# ); +# #externalFlag => $externalFlag, +# push @args, externalFlag => $externalFlag if $externalFlag; +# +# communigate_pro_command( $machine, $port, $login, $password, $method, @args ); +# +#} sub UpdateAccountSettings { my( $machine, $port, $login, $password, $method, $accountName, %args ) = @_; @@ -555,6 +1046,7 @@ sub communigate_pro_command { #subroutine, not method my( $machine, $port, $login, $password, $method, @args ) = @_; eval "use CGP::CLI"; + die $@ if $@; my $cli = new CGP::CLI( { 'PeerAddr' => $machine, @@ -566,7 +1058,7 @@ sub communigate_pro_command { #subroutine, not method #warn "$method ". Dumper(@args) if $DEBUG; my $return = $cli->$method(@args) - or die "Communigate Pro error: ". $cli->getErrMessage; + or die "Communigate Pro error: ". $cli->getErrMessage. "\n"; $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n";