FS/FS/part_export/acct_opensrs.pm

   1 package FS::part_export::acct_opensrs;
   2
   3 use strict;
   4 use vars qw( %info $DEBUG );
   5 use base qw( FS::part_export );
   6 use Tie::IxHash;
   7 use Data::Dumper;
   8
   9 tie my %options, 'Tie::IxHash',
  10   'Environment' => { label    => 'Environment',
  11                      type     => 'select',
  12                      options  => [ 'test', 'production' ],
  13                      default  => 'test'
  14                    },
  15   'Domain'      => { label    => 'Administrative domain',
  16                      type     => 'text',
  17                    },
  18   'User'        => { label    => 'Administrative user',
  19                      type     => 'text',
  20                    },
  21   'Password'    => { label    => 'Password',
  22                      type     => 'text',
  23                    },
  24   'Debug'       => { label    => 'Debug level',
  25                      type     => 'select',
  26                      options  => [ 0, 1, 2, 3, 4 ],
  27                    },
  28 ;
  29
  30 %info = (
  31   'svc'     => 'svc_acct',
  32   'desc'    => 'Configure OpenSRS hosted email services',
  33   'options' => \%options,
  34   'no_machine' => 1,
  35   'notes'   => <<'END'
  36 <p>
  37 Provision email services (POP3/IMAP boxes) through an OpenSRS reseller account.
  38 This requires the <b>Net::OpenSRS::Email_APP</b> library.
  39 </p>
  40 <p>
  41 The <I>Domain</i>, <i>User</i>, and <i>Password</i> accounts are for an
  42 account with company-level admin privileges (or domain-level, if you will
  43 only manage a single domain with each export). <i>Environment</i> determines
  44 whether to manage test accounts or live email accounts.
  45 </p>
  46 <p>
  47 OpenSRS requires every account to be assigned to a workgroup (within its
  48 domain).  This export will create a workgroup for each service definition,
  49 named "svc" + the I<svcpart> value.  This is somewhat arbitrary and may
  50 change in the future.
  51 </p>
  52 END
  53 );
  54
  55 =head2 METHODS
  56
  57 =item app
  58
  59 Returns a L<Net::OpenSRS::Email_APP> handle to the OpenSRS API.
  60
  61 =cut
  62
  63 sub app {
  64   my $self = shift;
  65   $DEBUG ||= $self->option('Debug');
  66   local $@;
  67   eval "use Net::OpenSRS::Email_APP";
  68   if ($@) {
  69     if ($@ =~ /^Can't locate/) {
  70       die "Net::OpenSRS::Email_APP must be installed to configure accounts.\n";
  71     } else {
  72       die $@;
  73     }
  74   }
  75   my %args = map { $_ => $self->option($_) } qw(
  76     Environment User Domain Password
  77   );
  78   warn "Creating APP session.\n" if $DEBUG;
  79   warn Dumper \%args if $DEBUG > 1;
  80   my $app = Net::OpenSRS::Email_APP->new(%args);
  81   if ($app) {
  82     $app->debug( $DEBUG - 2 ) if $DEBUG > 2;
  83     warn "Logging in.\n" if $DEBUG;
  84     my $error = $app->safe_login;
  85     return $error || $app;
  86   }
  87   return;
  88 }
  89
  90 sub _export_insert {
  91   my $self = shift;
  92   my $new = shift;
  93   my $app = $self->app;
  94   return $app if !ref($app);
  95   if ($new->isa('FS::svc_acct')) {
  96     # this may at some point support svc_forward and svc_domain
  97     my $domain = $new->domain;
  98     my $username = $new->username;
  99     warn "Checking mailbox availability: $username\@$domain\n" if $DEBUG;
 100     my $result = $app->get_mailbox_availability(
 101       Domain => $domain,
 102       Mailbox_List => $username,
 103     );
 104     if ($app->last_status_code) {
 105       return $app->last_status_text . ' (checking mailbox availability)';
 106     }
 107     if ($result->{AVAILABLE_LIST} eq 'T') {
 108       return "mailbox unavailable";
 109     }
 110
 111     # check existence of workgroup named for the part_svc
 112     my $svcname = 'svc'.$new->cust_svc->svcpart;
 113     $result = $app->get_domain_workgroups( Domain => $domain );
 114     if (! grep {$_->{WORKGROUP} eq $svcname} @$result) {
 115       warn "Creating workgroup '$svcname'\n" if $DEBUG;
 116       $result = $app->create_workgroup(
 117         Domain => $domain,
 118         Workgroup => $svcname,
 119       );
 120       if ($app->last_status_code) {
 121         return $app->last_status_text . ' (creating workgroup)';
 122       }
 123     }
 124     my %args = $self->mailbox_args($new);
 125     warn "Creating mailbox\n" if $DEBUG;
 126     warn Dumper \%args if $DEBUG > 1;
 127     $result = $app->create_mailbox(%args);
 128     if ($app->last_status_code) {
 129       return $app->last_status_text . ' (creating mailbox)';
 130     }
 131     return;
 132   } else {
 133     return "OpenSRS export doesn't support this service type";
 134   }
 135 }
 136
 137 sub _export_delete {
 138   my $self = shift;
 139   my $old = shift;
 140   my $app = $self->app;
 141   return $app if !ref($app);
 142   if ( $old->isa('FS::svc_acct') ) {
 143     # does it exist?
 144     my $domain = $old->domain;
 145     my $username = $old->username;
 146     warn "Checking existence of mailbox $username\@$domain\n" if $DEBUG;
 147     my $result = $app->get_mailbox( Domain => $domain, Mailbox => $username );
 148     if (!$result) {
 149       warn "Mailbox not found\n" if $DEBUG;
 150       return; # nothing to delete
 151     }
 152     warn "Deleting mailbox\n" if $DEBUG;
 153     $result = $app->delete_mailbox( Domain => $domain, Mailbox => $username );
 154     if ($app->last_status_code) {
 155       return $app->last_status_text . ' (deleting mailbox)';
 156     }
 157     return;
 158   } else {
 159     return "OpenSRS export doesn't support this service type";
 160   }
 161 }
 162
 163 sub _export_replace {
 164   my $self = shift;
 165   my ($new, $old) = @_;
 166   my $app = $self->app;
 167   return $app if !ref($app);
 168   if ($new->isa('FS::svc_acct')) {
 169     my $domain = $old->domain;
 170     my $username = $old->username;
 171     warn "Checking existence of mailbox $username\@$domain\n" if $DEBUG;
 172     my $result = $app->get_mailbox( Domain => $domain, Mailbox => $username );
 173     if ($app->last_status_code) {
 174       return $app->last_status_text . ' (checking existence of mailbox)';
 175     }
 176     if (!$result) {
 177       # then the old mailbox was never created; just handle this as an insert
 178       return $self->export_insert($new);
 179     }
 180     # check validity of the change
 181     if ($new->domain ne $domain) {
 182       # OpenSRS doesn't allow moving a mailbox across domains.  We could
 183       # delete the old account and create a new one but that risks losing
 184       # mail, so we're going to just refuse the request.
 185       return "can't move mailbox across domains";
 186     }
 187     # rename account if necessary
 188     if ($new->username ne $username) {
 189       warn "Checking mailbox availability: ".$new->username."\@$domain\n"
 190         if $DEBUG;
 191       my $result = $app->get_mailbox_availability(
 192         Domain => $domain,
 193         Mailbox_List => $new->username,
 194       );
 195       if ($app->last_status_code) {
 196         return $app->last_status_text . ' (checking mailbox availability)';
 197       }
 198       if ($result->{AVAILABLE_LIST} eq 'T') {
 199         return "mailbox unavailable";
 200       }
 201       warn "Renaming mailbox $username to ".$new->username."\n" if $DEBUG;
 202       $app->rename_mailbox(
 203         Domain => $domain,
 204         Old_Mailbox => $old->username,
 205         New_Mailbox => $new->username,
 206       );
 207       if ($app->last_status_code) {
 208         return $app->last_status_text . ' (renaming mailbox)';
 209       }
 210     }
 211     # then make other changes
 212     warn "Modifying mailbox\n" if $DEBUG;
 213     my %args = $self->mailbox_args($new);
 214     warn Dumper \%args if $DEBUG > 1;
 215     $app->change_mailbox(%args);
 216     if ($app->last_status_code) {
 217       return $app->last_status_text . ' (changing mailbox properties)';
 218     }
 219     return;
 220   } else {
 221     return "OpenSRS export doesn't support this service type";
 222   }
 223 }
 224
 225 sub _export_suspend {
 226   my $self = shift;
 227   my $svc = shift;
 228   my $unsuspend = shift || 0;
 229   my $app = $self->app;
 230   return $app if !ref($app);
 231   # XXX apply this to all mail services? or should we have an option
 232   # to restrict it?
 233   warn "Changing mailbox suspension state\n" if $DEBUG;
 234   my %args = ( Domain  => $svc->domain, Mailbox => $svc->username );
 235   foreach (qw(SMTPIn SMTPRelay IMAP POP Webmail)) {
 236     $args{$_} = $unsuspend ? 'F' : 'T'; # True = suspended
 237   }
 238   warn Dumper \%args if $DEBUG > 1;
 239   $app->set_mailbox_suspension(%args);
 240   if ($app->last_status_code) {
 241     return $app->last_status_text . ' (setting mailbox suspension)';
 242   }
 243   return;
 244 }
 245
 246 sub _export_unsuspend {
 247   my ($self, $svc) = @_;
 248   $self->export_suspend($svc, 1);
 249 }
 250
 251 =item mailbox_args SVC_ACCT
 252
 253 Returns a list of arguments to the C<create_mailbox> or C<change_mailbox>
 254 methods for the supplied service.
 255
 256 =cut
 257
 258 sub mailbox_args {
 259   my ($self, $svc) = @_;
 260   my $cust_pkg = $svc->cust_svc->cust_pkg;
 261   my $cust = $cust_pkg->contact_obj || $cust_pkg->cust_main;
 262   return (
 263     Domain        => $svc->domain,
 264     Workgroup     => 'svc'.$svc->cust_svc->svcpart,
 265     Mailbox       => $svc->username,
 266     Password      => $svc->_password,
 267     First_Name    => $cust->first,
 268     Last_Name     => $cust->last,
 269     # other optional fields: FilterOnly, Title, Timezone, Lang,
 270     # Phone, Fax, Spam_Tag, Spam_Folder, Spam_Level
 271     # can add these if necessary...
 272   );
 273 }
 274
 275 # convenience methods on $app
 276
 277 sub Net::OpenSRS::Email_APP::last_status_code {
 278   my $self = shift;
 279   $self->{status_code};
 280 }
 281
 282 sub Net::OpenSRS::Email_APP::last_status_text {
 283   my $self = shift;
 284   $self->{status_text};
 285 }
 286
 287 # workaround for a serious bug
 288 sub Net::OpenSRS::Email_APP::safe_login {
 289   my $self = shift;
 290   local $Net::OpenSRS::Email_APP::Debug = 1;
 291   local $Net::OpenSRS::Email_APP::Emit_Debug = sub {
 292     if ($_[0] =~ /^read: \[ER (\d+) (.*)\r/) {
 293       die "$2\n";
 294     }
 295   };
 296   local $@ = '';
 297   local $SIG{__DIE__};
 298   eval { $self->login; };
 299   return $@;
 300 }
 301
 302 1;