1 package FS::part_export::acct_opensrs;
4 use vars qw( %info $DEBUG );
5 use base qw( FS::part_export );
9 tie my %options, 'Tie::IxHash',
10 'Environment' => { label => 'Environment',
12 options => [ 'test', 'production' ],
15 'Domain' => { label => 'Administrative domain',
18 'User' => { label => 'Administrative user',
21 'Password' => { label => 'Password',
24 'Debug' => { label => 'Debug level',
26 options => [ 0, 1, 2, 3, 4 ],
32 'desc' => 'Configure OpenSRS hosted email services',
33 'options' => \%options,
37 Provision email services (POP3/IMAP boxes) through an OpenSRS reseller account.
38 This requires the <b>Net::OpenSRS::Email_APP</b> library.
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.
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
59 Returns a L<Net::OpenSRS::Email_APP> handle to the OpenSRS API.
65 $DEBUG ||= $self->option('Debug');
67 eval "use Net::OpenSRS::Email_APP";
69 if ($@ =~ /^Can't locate/) {
70 die "Net::OpenSRS::Email_APP must be installed to configure accounts.\n";
75 my %args = map { $_ => $self->option($_) } qw(
76 Environment User Domain Password
78 warn "Creating APP session.\n" if $DEBUG;
79 warn Dumper \%args if $DEBUG > 1;
80 my $app = Net::OpenSRS::Email_APP->new(%args);
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;
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(
102 Mailbox_List => $username,
104 if ($app->last_status_code) {
105 return $app->last_status_text . ' (checking mailbox availability)';
107 if ($result->{AVAILABLE_LIST} eq 'T') {
108 return "mailbox unavailable";
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(
118 Workgroup => $svcname,
120 if ($app->last_status_code) {
121 return $app->last_status_text . ' (creating workgroup)';
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)';
133 return "OpenSRS export doesn't support this service type";
140 my $app = $self->app;
141 return $app if !ref($app);
142 if ( $old->isa('FS::svc_acct') ) {
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 );
149 warn "Mailbox not found\n" if $DEBUG;
150 return; # nothing to delete
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)';
159 return "OpenSRS export doesn't support this service type";
163 sub _export_replace {
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)';
177 # then the old mailbox was never created; just handle this as an insert
178 return $self->export_insert($new);
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";
187 # rename account if necessary
188 if ($new->username ne $username) {
189 warn "Checking mailbox availability: ".$new->username."\@$domain\n"
191 my $result = $app->get_mailbox_availability(
193 Mailbox_List => $new->username,
195 if ($app->last_status_code) {
196 return $app->last_status_text . ' (checking mailbox availability)';
198 if ($result->{AVAILABLE_LIST} eq 'T') {
199 return "mailbox unavailable";
201 warn "Renaming mailbox $username to ".$new->username."\n" if $DEBUG;
202 $app->rename_mailbox(
204 Old_Mailbox => $old->username,
205 New_Mailbox => $new->username,
207 if ($app->last_status_code) {
208 return $app->last_status_text . ' (renaming mailbox)';
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)';
221 return "OpenSRS export doesn't support this service type";
225 sub _export_suspend {
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
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
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)';
246 sub _export_unsuspend {
247 my ($self, $svc) = @_;
248 $self->export_suspend($svc, 1);
251 =item mailbox_args SVC_ACCT
253 Returns a list of arguments to the C<create_mailbox> or C<change_mailbox>
254 methods for the supplied service.
259 my ($self, $svc) = @_;
260 my $cust_pkg = $svc->cust_svc->cust_pkg;
261 my $cust = $cust_pkg->contact_obj || $cust_pkg->cust_main;
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...
275 # convenience methods on $app
277 sub Net::OpenSRS::Email_APP::last_status_code {
279 $self->{status_code};
282 sub Net::OpenSRS::Email_APP::last_status_text {
284 $self->{status_text};
287 # workaround for a serious bug
288 sub Net::OpenSRS::Email_APP::safe_login {
290 local $Net::OpenSRS::Email_APP::Debug = 1;
291 local $Net::OpenSRS::Email_APP::Emit_Debug = sub {
292 if ($_[0] =~ /^read: \[ER (\d+) (.*)\r/) {
298 eval { $self->login; };