path: root/FS/FS/part_export/acct_opensrs.pm

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;