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'
Provision email services (POP3/IMAP boxes) through an OpenSRS reseller account.
This requires the Net::OpenSRS::Email_APP library.
The Domain, User, and Password accounts are for an
account with company-level admin privileges (or domain-level, if you will
only manage a single domain with each export). Environment determines
whether to manage test accounts or live email accounts.
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 value. This is somewhat arbitrary and may
change in the future.
END
);
=head2 METHODS
=item app
Returns a L 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 or C
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;