[freeside-commits] branch master updated. fc7bc7a54a4e5447971b3565fb9e2d1b5d0a70e0
Mark Wells
mark at 420.am
Mon Jun 16 22:33:43 PDT 2014
The branch, master has been updated
via fc7bc7a54a4e5447971b3565fb9e2d1b5d0a70e0 (commit)
from 40bf4749215869a2208db8cb6b25fdfb2f7239e8 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit fc7bc7a54a4e5447971b3565fb9e2d1b5d0a70e0
Author: Mark Wells <mark at freeside.biz>
Date: Mon Jun 16 22:33:26 2014 -0700
OpenSRS email provisioning export, #21246
diff --git a/FS/FS/part_export/acct_opensrs.pm b/FS/FS/part_export/acct_opensrs.pm
new file mode 100644
index 0000000..51cee97
--- /dev/null
+++ b/FS/FS/part_export/acct_opensrs.pm
@@ -0,0 +1,302 @@
+package FS::part_export::acct_opensrs;
+
+use strict;
+use vars qw( %info $DEBUG );
+use base qw( FS::part_export );
+use Tie::IxHash;
+use Data::Dumper;
+
+tie my %options, 'Tie::IxHash',
+ 'Environment' => { label => 'Environment',
+ type => 'select',
+ options => [ 'test', 'production' ],
+ default => 'test'
+ },
+ 'Domain' => { label => 'Administrative domain',
+ type => 'text',
+ },
+ 'User' => { label => 'Administrative user',
+ type => 'text',
+ },
+ 'Password' => { label => 'Password',
+ type => 'text',
+ },
+ 'Debug' => { label => 'Debug level',
+ type => 'select',
+ options => [ 0, 1, 2, 3, 4 ],
+ },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Configure OpenSRS hosted email services',
+ 'options' => \%options,
+ 'no_machine' => 1,
+ 'notes' => <<'END'
+<p>
+Provision email services (POP3/IMAP boxes) through an OpenSRS reseller account.
+This requires the <b>Net::OpenSRS::Email_APP</b> library.
+</p>
+<p>
+The <I>Domain</i>, <i>User</i>, and <i>Password</i> accounts are for an
+account with company-level admin privileges (or domain-level, if you will
+only manage a single domain with each export). <i>Environment</i> determines
+whether to manage test accounts or live email accounts.
+</p>
+<p>
+OpenSRS requires every account to be assigned to a workgroup (within its
+domain). This export will create a workgroup for each service definition,
+named "svc" + the I<svcpart> value. This is somewhat arbitrary and may
+change in the future.
+</p>
+END
+);
+
+=head2 METHODS
+
+=item app
+
+Returns a L<Net::OpenSRS::Email_APP> handle to the OpenSRS API.
+
+=cut
+
+sub app {
+ my $self = shift;
+ $DEBUG ||= $self->option('Debug');
+ local $@;
+ eval "use Net::OpenSRS::Email_APP";
+ if ($@) {
+ if ($@ =~ /^Can't locate/) {
+ die "Net::OpenSRS::Email_APP must be installed to configure accounts.\n";
+ } else {
+ die $@;
+ }
+ }
+ my %args = map { $_ => $self->option($_) } qw(
+ Environment User Domain Password
+ );
+ warn "Creating APP session.\n" if $DEBUG;
+ warn Dumper \%args if $DEBUG > 1;
+ my $app = Net::OpenSRS::Email_APP->new(%args);
+ if ($app) {
+ $app->debug( $DEBUG - 2 ) if $DEBUG > 2;
+ warn "Logging in.\n" if $DEBUG;
+ my $error = $app->safe_login;
+ return $error || $app;
+ }
+ return;
+}
+
+sub export_insert {
+ my $self = shift;
+ my $new = shift;
+ my $app = $self->app;
+ return $app if !ref($app);
+ if ($new->isa('FS::svc_acct')) {
+ # this may at some point support svc_forward and svc_domain
+ my $domain = $new->domain;
+ my $username = $new->username;
+ warn "Checking mailbox availability: $username\@$domain\n" if $DEBUG;
+ my $result = $app->get_mailbox_availability(
+ Domain => $domain,
+ Mailbox_List => $username,
+ );
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (checking mailbox availability)';
+ }
+ if ($result->{AVAILABLE_LIST} eq 'T') {
+ return "mailbox unavailable";
+ }
+
+ # check existence of workgroup named for the part_svc
+ my $svcname = 'svc'.$new->cust_svc->svcpart;
+ $result = $app->get_domain_workgroups( Domain => $domain );
+ if (! grep {$_->{WORKGROUP} eq $svcname} @$result) {
+ warn "Creating workgroup '$svcname'\n" if $DEBUG;
+ $result = $app->create_workgroup(
+ Domain => $domain,
+ Workgroup => $svcname,
+ );
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (creating workgroup)';
+ }
+ }
+ my %args = $self->mailbox_args($new);
+ warn "Creating mailbox\n" if $DEBUG;
+ warn Dumper \%args if $DEBUG > 1;
+ $result = $app->create_mailbox(%args);
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (creating mailbox)';
+ }
+ return;
+ } else {
+ return "OpenSRS export doesn't support this service type";
+ }
+}
+
+sub export_delete {
+ my $self = shift;
+ my $old = shift;
+ my $app = $self->app;
+ return $app if !ref($app);
+ if ( $old->isa('FS::svc_acct') ) {
+ # does it exist?
+ my $domain = $old->domain;
+ my $username = $old->username;
+ warn "Checking existence of mailbox $username\@$domain\n" if $DEBUG;
+ my $result = $app->get_mailbox( Domain => $domain, Mailbox => $username );
+ if (!$result) {
+ warn "Mailbox not found\n" if $DEBUG;
+ return; # nothing to delete
+ }
+ warn "Deleting mailbox\n" if $DEBUG;
+ $result = $app->delete_mailbox( Domain => $domain, Mailbox => $username );
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (deleting mailbox)';
+ }
+ return;
+ } else {
+ return "OpenSRS export doesn't support this service type";
+ }
+}
+
+sub export_replace {
+ my $self = shift;
+ my ($new, $old) = @_;
+ my $app = $self->app;
+ return $app if !ref($app);
+ if ($new->isa('FS::svc_acct')) {
+ my $domain = $old->domain;
+ my $username = $old->username;
+ warn "Checking existence of mailbox $username\@$domain\n" if $DEBUG;
+ my $result = $app->get_mailbox( Domain => $domain, Mailbox => $username );
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (checking existence of mailbox)';
+ }
+ if (!$result) {
+ # then the old mailbox was never created; just handle this as an insert
+ return $self->export_insert($new);
+ }
+ # check validity of the change
+ if ($new->domain ne $domain) {
+ # OpenSRS doesn't allow moving a mailbox across domains. We could
+ # delete the old account and create a new one but that risks losing
+ # mail, so we're going to just refuse the request.
+ return "can't move mailbox across domains";
+ }
+ # rename account if necessary
+ if ($new->username ne $username) {
+ warn "Checking mailbox availability: ".$new->username."\@$domain\n"
+ if $DEBUG;
+ my $result = $app->get_mailbox_availability(
+ Domain => $domain,
+ Mailbox_List => $new->username,
+ );
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (checking mailbox availability)';
+ }
+ if ($result->{AVAILABLE_LIST} eq 'T') {
+ return "mailbox unavailable";
+ }
+ warn "Renaming mailbox $username to ".$new->username."\n" if $DEBUG;
+ $app->rename_mailbox(
+ Domain => $domain,
+ Old_Mailbox => $old->username,
+ New_Mailbox => $new->username,
+ );
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (renaming mailbox)';
+ }
+ }
+ # then make other changes
+ warn "Modifying mailbox\n" if $DEBUG;
+ my %args = $self->mailbox_args($new);
+ warn Dumper \%args if $DEBUG > 1;
+ $app->change_mailbox(%args);
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (changing mailbox properties)';
+ }
+ return;
+ } else {
+ return "OpenSRS export doesn't support this service type";
+ }
+}
+
+sub export_suspend {
+ my $self = shift;
+ my $svc = shift;
+ my $unsuspend = shift || 0;
+ my $app = $self->app;
+ return $app if !ref($app);
+ # XXX apply this to all mail services? or should we have an option
+ # to restrict it?
+ warn "Changing mailbox suspension state\n" if $DEBUG;
+ my %args = ( Domain => $svc->domain, Mailbox => $svc->username );
+ foreach (qw(SMTPIn SMTPRelay IMAP POP Webmail)) {
+ $args{$_} = $unsuspend ? 'F' : 'T'; # True = suspended
+ }
+ warn Dumper \%args if $DEBUG > 1;
+ $app->set_mailbox_suspension(%args);
+ if ($app->last_status_code) {
+ return $app->last_status_text . ' (setting mailbox suspension)';
+ }
+ return;
+}
+
+sub export_unsuspend {
+ my ($self, $svc) = @_;
+ $self->export_suspend($svc, 1);
+}
+
+=item mailbox_args SVC_ACCT
+
+Returns a list of arguments to the C<create_mailbox> or C<change_mailbox>
+methods for the supplied service.
+
+=cut
+
+sub mailbox_args {
+ my ($self, $svc) = @_;
+ my $cust_pkg = $svc->cust_svc->cust_pkg;
+ my $cust = $cust_pkg->contact_obj || $cust_pkg->cust_main;
+ return (
+ Domain => $svc->domain,
+ Workgroup => 'svc'.$svc->cust_svc->svcpart,
+ Mailbox => $svc->username,
+ Password => $svc->_password,
+ First_Name => $cust->first,
+ Last_Name => $cust->last,
+ # other optional fields: FilterOnly, Title, Timezone, Lang,
+ # Phone, Fax, Spam_Tag, Spam_Folder, Spam_Level
+ # can add these if necessary...
+ );
+}
+
+# convenience methods on $app
+
+sub Net::OpenSRS::Email_APP::last_status_code {
+ my $self = shift;
+ $self->{status_code};
+}
+
+sub Net::OpenSRS::Email_APP::last_status_text {
+ my $self = shift;
+ $self->{status_text};
+}
+
+# workaround for a serious bug
+sub Net::OpenSRS::Email_APP::safe_login {
+ my $self = shift;
+ local $Net::OpenSRS::Email_APP::Debug = 1;
+ local $Net::OpenSRS::Email_APP::Emit_Debug = sub {
+ if ($_[0] =~ /^read: \[ER (\d+) (.*)\r/) {
+ die "$2\n";
+ }
+ };
+ local $@ = '';
+ local $SIG{__DIE__};
+ eval { $self->login; };
+ return $@;
+}
+
+1;
-----------------------------------------------------------------------
Summary of changes:
FS/FS/part_export/acct_opensrs.pm | 302 +++++++++++++++++++++++++++++++++++++
1 file changed, 302 insertions(+)
create mode 100644 FS/FS/part_export/acct_opensrs.pm
More information about the freeside-commits
mailing list