From 3784fb15b8d54aeb37e2f39bf87f61b513ba41c3 Mon Sep 17 00:00:00 2001 From: Jonathan Prykop Date: Mon, 20 Apr 2015 22:26:11 -0500 Subject: [PATCH] RT#24870 Magicmail API --- FS/FS/part_export/magicmail.pm | 1300 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1300 insertions(+) create mode 100644 FS/FS/part_export/magicmail.pm diff --git a/FS/FS/part_export/magicmail.pm b/FS/FS/part_export/magicmail.pm new file mode 100644 index 000000000..c2be9bc05 --- /dev/null +++ b/FS/FS/part_export/magicmail.pm @@ -0,0 +1,1300 @@ +package FS::part_export::magicmail; + +use strict; + +use base qw( FS::part_export ); + +use Data::Dumper; +use MIME::Base64; + +use Net::HTTPS::Any qw( https_get https_post ); +use XML::Simple; +use URI::Escape; + +use FS::Record qw (qsearch); + +use vars qw( $DEBUG ); +$DEBUG = 0; + +=pod + +=head1 NAME + +FS::part_export::magicmail + +=head1 SYNOPSIS + +MagicMail integration for Freeside + +=head1 REQUIRES + +L + +L + +L + +=head1 DESCRIPTION + +This export offers basic svc_acct provisioning for MagicMail. Each customer will +map to an account in MagicMail, and each svc_acct exported will map to a user/mailbox. + +This module also provides generic methods for working through the MagicMail API, and can +be used as a base for more complex exports to MagicMail (just be sure to override +the C<%info> hash and the L.) + +L return an error message on failure, and a blank string on success. +All other methods return a positive value (usually a hashref) on success and return +nothing on failure, instead setting the error message in the export object using +L. Use L to retrieve this message. + +=cut + +use vars qw( %info ); + +tie my %options, 'Tie::IxHash', + 'client_id' => { label => 'API Client ID', + default => '' }, + 'client_password' => { label => 'API Client Password', + default => '' }, + 'account_prefix' => { label => 'Account Prefix', + default => 'FREESIDE' }, + 'package' => { label => 'Package', + default => 'EMAIL' }, + 'port' => { label => 'Port', + default => 443 }, + 'autopurge' => { type => 'checkbox', + label => 'Auto purge user/account on unprovision' }, + 'debug' => { type => 'checkbox', + label => 'Enable debug warnings' }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Export service to MagicMail, for svc_acct services', + 'options' => \%options, + 'notes' => <<'END', +Add service user and email address to MagicMail
+See documentation for details. +END +); + +=head1 Hook Methods + +=cut + +=head2 _export_insert + +Hook that is called when service is initially provisioned. +To avoid confusion, don't use for anything else. + +For this export, creates a MagicMail account for this customer +if it doesn't exist, activates account if it is suspended/deleted, +creates a user/mailbox on that account for the provisioning service, +assigns I (specified by export option) to master user on +account if it hasn't been, and adds the email address for the +provisioning service. On error, attempts to purge any newly +created account/user and remove any newly set package via L. + +On success, also runs L (does not cause fatal +error on failure.) + +Override this method when using this module as a base for other exports. + +=cut + +sub _export_insert { + my ($self, $svc_acct) = @_; + $self->error_init; + my $cust_main = $svc_acct->cust_main; + my $username = $svc_acct->username; + my $r = {}; #rollback input + + # create customer account if it doesn't exist + my $newacct = 0; + my $account_id = $self->cust_account_id($cust_main); + my $account = $self->get_account($account_id); + return $self->error if $self->error; + unless ($account) { + $account = $self->add_account($account_id, + 'first_name' => $cust_main->first, + 'last_name' => $cust_main->last, + # could also add phone & memo + ); + return $self->error if $self->error; + $account_id = $account->{'id'}; + $$r{'purge_account'} = $account_id; + } + + # activate account if suspended/deleted + my $oldstatus = $account->{'status'}; + unless ($oldstatus eq 'active') { + $account = $self->activate_account($account_id); + } + return $self->rollback($r) if $self->error; + $$r{'delete_account'} = $account_id + if $oldstatus eq 'deleted'; + $$r{'suspend_account'} = $account_id + if $oldstatus eq 'suspended'; + + # check for a master user, assign package if found + my $package = $self->option('package'); + my $muser = $self->get_master_user($account_id); + return $self->rollback($r) if $self->error; + if ($muser) { + my $musername = $muser->{'id'}; + my $packages = $self->get_packages($musername); + return $self->rollback($r) if $self->error || !$packages; + unless ($packages->{$package}) { + $packages = $self->assign_package($musername,$package); + return $self->rollback($r) if $self->error || !$packages || !$packages->{$package}; + $$r{'remove_package'} = [$musername,$package]; + } + } + + # add user + my ($first,$last) = $svc_acct->finger =~ /(.*)\s(.*)/; + $first ||= $svc_acct->finger || ''; + $last ||= ''; + my $user = $self->add_user($account_id,$username, + 'first_name' => $first, + 'last_name' => $last, + 'password' => $svc_acct->_password_encryption eq 'plain' + ? $svc_acct->get_cleartext_password + : $svc_acct->_password, + 'password_type' => $svc_acct->_password_encryption eq 'plain' + ? 'plain' + : 'encrypted', + # could also add memo + ); + return $self->rollback($r) if $self->error; + $$r{'purge_user'} = $username; + + # assign package if it hasn't been yet + unless ($muser) { + die "Unexpected lack of master user on account, please contact a developer" + unless $user->{'master_user'} eq 'Y'; + $muser = $user; + # slight false laziness with above + my $musername = $muser->{'id'}; + my $packages = $self->get_packages($musername); + return $self->rollback($r) if $self->error || !$packages; + unless ($packages->{$package}) { + $packages = $self->assign_package($musername,$package); + return $self->rollback($r) if $self->error || !$packages || !$packages->{$package}; + $$r{'remove_package'} = [$musername,$package]; + } + } + + # add email address + $self->add_email_address($username,$username.'@'.$svc_acct->domain); + return $self->rollback($r) if $self->error; + + # double-check packages (only throws warnings, no rollback on fail) + $self->sync_magic_packages($cust_main, 'include' => $svc_acct); + + return ''; +} + +=head2 _export_delete + +Hook that is called when service is unprovisioned. +To avoid confusion, don't use for anything else. + +For this export, deletes the email address and user +associated with the provisioning service. Only sets +an error if this part fails; everything else simply +generates warnings. + +Also attempts to delete the associated account, if there +aren't any more users on the account. + +If deleted user was master user for account and other +users exist on the account, attempts to make another user +the master user. + +Runs L. + +If the I export option is set, also purges +newly deleted users/accounts. + +Override this method when using this module as a base for other exports. + +=cut + +sub _export_delete { + my ($self, $svc_acct) = @_; + $self->error_init; + my $cust_main = $svc_acct->cust_main; + my $username = $svc_acct->username; + + # check account id + my $user = $self->get_user($username); + unless ($user) { + $self->error("Could not remove user from magicmail, username $username not retrievable"); + $self->error_warn; + return ''; #non-fatal error, allow svc to be unprovisioned + } + my $account_id = $user->{'account'}; + return $self->error("Could not remove user from magicmail, account id does not match") + unless $account_id eq $self->cust_account_id($cust_main); #fatal, sort out before unprovisioning + + # check for master change + my $newmaster; + if ($user->{'master_user'}) { + my $users = $self->get_users($account_id); + if ($users && (keys %$users > 1)) { + foreach my $somesvc ( + sort { $a->svcnum <=> $b->svcnum } # cheap way of ordering by provision date + $self->cust_magic_services($cust_main,'ignore'=>$svc_acct) + ) { + next unless $users->{uc($somesvc->username)}; + $newmaster = $somesvc->username; + last; + } + $self->error("Cannot find replacement master user for account $account_id") + unless $newmaster; + } + $self->error_warn; #maybe this should be fatal? + } + + # do the actual deleting + $self->delete_user($username); + return $self->error if $self->error; + + ## no fatal errors after this point + + # transfer master user + $self->make_master_user($newmaster) if $newmaster; + $self->error_warn; + $self->sync_magic_packages($cust_main, 'ignore' => $svc_acct); + + # purge user if configured to do so + $self->purge_user($username) if $self->option('autopurge'); + $self->error_warn; + + # delete account if there are no more users + my $users = $self->get_users($account_id); + $self->error_warn; + return '' unless $users; + return '' if keys %$users; + $self->delete_account($account_id); + return $self->error_warn if $self->error; + + #purge account if configured to do so + $self->purge_account($account_id) if $self->option('autopurge'); + return $self->error_warn; +} + +=head2 _export_replace + +Hook that is called when provisioned service is edited. +To avoid confusion, don't use for anything else. + +Updates user info & password. Cannot be used to change user name. + +Override this method when using this module as a base for other exports. + +=cut + +sub _export_replace { + my($self, $new, $old) = @_; + $self->error_init; + my $username = $new->username; + + return "Cannot change username on a magicmail account" + unless $username eq $old->username; + + # check account id + my $user = $self->get_user($username); + return $self->error("Could not update user, username $username not retrievable") + unless $user; + my $account_id = $user->{'account'}; + return $self->error("Could not update user $username, account id does not match") + unless $account_id eq $self->cust_account_id($new); #fatal, sort out before updating + + # update user + my ($first,$last) = $new->finger =~ /(.*)\s(.*)/; + $first ||= $new->finger || ''; + $last ||= ''; + $user = $self->update_user($account_id,$username, + 'first_name' => $first, + 'last_name' => $last, + 'password' => $new->_password_encryption eq 'plain' + ? $new->get_cleartext_password + : $new->_password, + 'password_type' => $new->_password_encryption eq 'plain' + ? 'plain' + : 'encrypted', + # could also add memo + ); + return $self->error; +} + +=head2 _export_suspend + +Hook that is called when service is suspended. +To avoid confusion, don't use for anything else. + +=cut + +sub _export_suspend { + my ($self, $svc_acct) = @_; + $self->error_init; + my $username = $svc_acct->username; + + # check account id + my $user = $self->get_user($username); + return $self->error("Could not update user, username $username not retrievable") + unless $user; + my $account_id = $user->{'account'}; + return $self->error("Could not update user $username, account id does not match") + unless $account_id eq $self->cust_account_id($svc_acct); #fatal, sort out before updating + + #suspend user + $self->suspend_user($username); + return $self->error; +} + +=head2 _export_unsuspend + +Hook that is called when service is unsuspended. +To avoid confusion, don't use for anything else. + +=cut + +sub _export_unsuspend { + my ($self, $svc_acct) = @_; + $self->error_init; + my $username = $svc_acct->username; + + # check account id + my $user = $self->get_user($username); + return $self->error("Could not update user, username $username not retrievable") + unless $user; + my $account_id = $user->{'account'}; + return $self->error("Could not update user $username, account id does not match") + unless $account_id eq $self->cust_account_id($svc_acct); #fatal, sort out before updating + + #suspend user + $self->activate_user($username); + return $self->error; +} + +=head1 Freeside Methods + +These methods are specific to freeside, used to translate +freeside customers/services/exports +into magicmail accounts/users/packages. + +=head2 cust_account_id + +Accepts either I<$cust_main> or I<$svc_acct>. +Returns MagicMail account_id for this customer under this export. + +=cut + +sub cust_account_id { + my ($self, $in) = @_; + my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main; + return $self->option('account_prefix') . $cust_main->custnum; +} + +=head2 cust_magic_services + +Accepts I<$cust_main> or I<$svc_acct> and the following options: + +I - I<$svc_acct> to be ignored + +I - I<$svc_acct> to be included + +Returns a list services owned by the customer +that are provisioned in MagicMail with the same I +(not necessarily the same export.) + +I is not checked for compatability with the current +export. It will probably cause errors if you pass a service +that doesn't use the current export. + +=cut + +sub cust_magic_services { + my ($self, $in, %opt) = @_; + my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main; + my @out = + grep { + $opt{'ignore'} ? ($_->svcnum != $opt{'ignore'}->svcnum) : 1; + } + map { + qsearch('svc_acct', { 'svcnum' => $_->svcnum }) + } + grep { + grep { + ($_->exporttype eq 'magicmail') + && ($_->option('account_prefix') eq $self->option('account_prefix')) + } + map { + qsearch('part_export',{ 'exportnum' => $_->exportnum }) + } + qsearch('export_svc',{ 'svcpart' => $_->svcpart }) + } + qsearch({ + 'table' => 'cust_svc', + 'addl_from' => 'INNER JOIN cust_pkg ON (cust_svc.pkgnum = cust_pkg.pkgnum)', + 'hashref' => { 'cust_pkg.custnum' => $cust_main->custnum } + }); #end of @out = + push(@out,$opt{'include'}) + unless grep { $opt{'include'} ? ($_->svcnum == $opt{'include'}->svcnum) : 1 } @out; + return @out; +} + +=head2 cust_magic_packages + +Accepts I<$cust_main> or I<$svc_acct> and the same options as L. + +Returns list of MagicMail packages for this customer's L +(ie packages that the master user for this customer should have assigned to it.) + +=cut + +sub cust_magic_packages { + my ($self, $in, %opt) = @_; + my $out = {}; + my @svcs = $self->cust_magic_services($in); + foreach my $svc ($self->cust_magic_services($in,%opt)) { + # there really should only be one export per service, but loop just in case + foreach my $export ( $svc->cust_svc->part_svc->part_export('magicmail') ) { + $out->{$export->option('package')} = 1; + } + } + return keys %$out; +} + +=head2 sync_magic_packages + +Accepts I<$cust_main> or I<$svc_acct> and the same options as L. + +Assigns or removes packages from the master user of L so +that they match L. (Will only attempt to remove +non-matching packages if matching packages are all successfully assigned.) + +All errors will be immediately cleared by L. +No meaningful return value. + +=cut + +sub sync_magic_packages { + my ($self, $in, %opt) = @_; + my $cust_main = ref($in) eq 'FS::cust_main' ? $in : $in->cust_main; + my $account_id = $self->cust_account_id($cust_main); + my $muser = $self->get_master_user($account_id); + return $self->error_warn if $self->error; + return $self->error_warn("Could not find master user for account $account_id") + unless $muser && $muser->{'id'}; + my $musername = $muser->{'id'}; + my $have = $self->get_packages($musername); + return $self->error_warn if $self->error; + my %dont = map { $_ => 1 } keys %$have; + foreach my $want ($self->cust_magic_packages($cust_main,%opt)) { + delete $dont{$want}; + $self->assign_package($musername,$want) + unless $have->{$want}; + } + return $self->error_warn if $self->error; + foreach my $dont (keys %dont) { + $self->remove_package($musername,$dont) + } + return $self->error_warn; +} + +=head1 Helper Methods + +These methods combine account, user and package information +through multiple API requests. + +=head2 get_accounts_and_users + +Returns results of L with extra 'users' key for +each account, the value of which is the result of L +for that account. + +=cut + +sub get_accounts_and_users { + my ($self) = @_; + my $accounts = $self->get_accounts() or return; + foreach my $account (keys %$accounts) { + $accounts->{$account}->{'users'} = $self->get_users($account) or return; + } + return $accounts; +} + +=head2 get_master_user + +Accepts I<$account_id>. Returns hashref of details on master user +for that account (as would be returned by L.) +Returns nothing without setting error if master user is not found. + +=cut + +sub get_master_user { + my ($self,$account_id) = @_; + my $users = $self->get_users($account_id); + return if $self->error || !$users; + foreach my $username (keys %$users) { + if ($users->{$username}->{'master_user'} eq 'Y') { + $users->{$username}->{'id'} = $username; + return $users->{$username}; + } + } + return; +} + +=head2 request + + #send a request to https://machine/api/v2/some/function + my $result = $export->request('POST','/some/function',%args); + +Accepts I<$method>, I<$path> and optional I<%args>. Sends request +to server and returns server response as a hashref (converted from +XML by L.) I<%args> can include a ForceArray key that +will be passed to L; all other args will be +passed in the reqest. Do not include 'client_type' in I<%args>, +and do not include '/api/v2' in I<$path>. + +Used by other methods to send requests; unless you're editing +this module, you should probably be using those other methods instead. + +=cut + +sub request { + my ($self,$method,$path,%args) = @_; + local $Data::Dumper::Terse = 1; + unless (grep(/^$method$/,('GET','POST'))) { + return if $self->error("Can't request method $method"); + } + my $get = $method eq 'GET'; + my $forcearray = []; + if (exists $args{'ForceArray'}) { + $forcearray = delete $args{'ForceArray'}; + } + $args{'client_type'} = 'FREESIDE'; + my %request = ( + 'host' => $self->machine, + 'port' => $self->option('port'), + 'path' => '/api/v2' . $path, + 'headers' => { + 'Authorization' => 'Basic ' . MIME::Base64::encode( + $self->option('client_id') + . ':' + . $self->option('client_password'), + ''), + }, + ); + my ( $page, $response, %reply_headers ); + if ($get) { + my $pathargs = ''; + foreach my $field (keys %args) { + $pathargs .= $pathargs ? '&' : '?'; + $pathargs .= $field . '=' . uri_escape_utf8($args{$field}); + } + $request{'path'} .= $pathargs; + warn "Request = " . Dumper(\%request) if $self->debug; + ( $page, $response, %reply_headers ) = https_get(%request); + } else { + foreach my $field (keys %args) { + $request{'content'} .= '&' if $request{'content'}; + $request{'content'} .= $field . '=' . uri_escape_utf8($args{$field}); + } + warn "Request = " . Dumper(\%request) if $self->debug; + ( $page, $response, %reply_headers ) = https_post(%request); + } + unless ($response =~ /^(200|400|500)/) { + return if $self->error("Bad Response: $response"); + } + warn "Response = " . Dumper($page) if $self->debug; + my $result = $page ? XMLin($page, ForceArray => $forcearray) : {}; + warn "Result = " . Dumper($result) if $self->debug; + return $result; +} + +=head1 Account Methods + +Make individual account-related API requests. + +=head2 add_account + +Accepts I<$account_id> and the following options: + +I + +I + +I + +I + +Returns a hashref containing the created account details. + +=cut + +sub add_account { + my ($self,$id,%opt) = @_; + warn "CREATING ACCOUNT $id\n" if $self->debug; + my %args; + foreach my $field ( qw( first_name last_name phone memo ) ) { + $args{$field} = $opt{$field} if $opt{$field}; + } + my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args ); + return if $self->check_for_error($result); + return $result->{'account'}; +} + +=head2 get_account + +Accepts I<$account_id>. +Returns a hashref containing account details. +Returns nothing without setting error if account is not found. + +=cut + +sub get_account { + my ($self,$id) = @_; + warn "GETTING ACCOUNT $id\n" if $self->debug; + my $result = $self->request('GET','/account/'.uri_escape_utf8($id)); + if ($result->{'error'}) { + return if $result->{'error'}->{'code'} eq 'account.error.not_found'; + } + return if $self->check_for_error($result); + return $result->{'account'}; +} + +=head2 get_accounts + +No input. Returns a hashref, keys are account_id, values +are hashrefs of account details. + +=cut + +sub get_accounts { + my ($self) = @_; + warn "GETTING ALL ACCOUNTS\n" if $self->debug; + my $result = $self->request('GET','/account','ForceArray' => ['account']); + return if $self->check_for_error($result); + return $result->{'accounts'}->{'account'} || {}; +} + +=head2 update_account + +Accepts I<$account_id> and the same options as L. +Updates an existing account. +Returns a hashref containing the updated account details. + +=cut + +sub update_account { + my ($self,$id,%opt) = @_; + warn "UPDATING ACCOUNT $id\n" if $self->debug; + my %args; + foreach my $field ( qw( first_name last_name phone memo ) ) { + $args{$field} = $opt{$field} if $opt{$field}; + } + my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args, action => 'update' ); + return if $self->check_for_error($result); + return $result->{'account'}; +} + +=head2 suspend_account + +Accepts I<$account_id>. Sets account status to suspended. +Returns a hashref containing the updated account details. + +=cut + +sub suspend_account { + my ($self,$id) = @_; + warn "SUSPENDING ACCOUNT $id\n" if $self->debug; + my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'suspended', action => 'update' ); + return if $self->check_for_error($result); + return $result->{'account'}; +} + +=head2 activate_account + +Accepts I<$account_id>. Sets account status to active. +Returns a hashref containing the updated account details. + +=cut + +sub activate_account { + my ($self,$id) = @_; + warn "ACTIVATING ACCOUNT $id\n" if $self->debug; + my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'active', action => 'update' ); + return if $self->check_for_error($result); + return $result->{'account'}; +} + +=head2 delete_account + +Accepts I<$account_id>. Sets account status to deleted. +Returns a hashref containing the updated account details. + +=cut + +sub delete_account { + my ($self,$id) = @_; + warn "DELETING ACCOUNT $id\n" if $self->debug; + my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), status => 'deleted', action => 'update' ); + return if $self->check_for_error($result); + return $result->{'account'}; +} + +=head2 purge_account + +Accepts account I<$id> and the following options: + +I - if true, purges account even if it wasn't first deleted + +Purges account from system. +No meaningful return value. + +=cut + +sub purge_account { + my ($self,$id,%opt) = @_; + my %args; + $args{'force'} = 'true' if $opt{'force'}; + warn "PURGING ACCOUNT $id\n" if $self->debug; + my $result = $self->request('POST', '/account/'.uri_escape_utf8($id), %args, action => 'purge' ); + $self->check_for_error($result); + return; +} + +=head1 User Methods + +Make individual user-related API requests. + +=head2 add_user + +Accepts I<$account_id>, I<$username> and the following options: + +I + +I + +I + +I + +I - plain or encrypted + +Returns a hashref containing the created user details. + +=cut + +sub add_user { + my ($self,$account_id,$username,%opt) = @_; + warn "CREATING USER $username FOR ACCOUNT $account_id\n" if $self->debug; + my %args; + foreach my $field ( qw( first_name last_name memo password password_type ) ) { + $args{$field} = $opt{$field} if $opt{$field}; + } + $args{'account'} = $account_id; + unless ($account_id) { + return if $self->error("Account ID required"); + } + if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) { + return if $self->error("Illegal password_type $args{'password_type'}"); + } + my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args ); + return if $self->check_for_error($result); + return $result->{'user'}; +} + +=head2 get_user + +Accepts I<$username>. +Returns a hashref containing user details. +Returns nothing without setting error if user is not found. + +=cut + +sub get_user { + my ($self,$username) = @_; + warn "GETTING USER $username\n" if $self->debug; + my $result = $self->request('GET','/user/'.uri_escape_utf8($username)); + if ($result->{'error'}) { + return if $result->{'error'}->{'code'} eq 'account.error.not_found'; + } + return if $self->check_for_error($result); + return $result->{'user'}; +} + +=head2 get_users + +Accepts I<$account_id>. Returns a hashref, keys are username, values +are hashrefs of user details. + +=cut + +sub get_users { + my ($self,$account_id) = @_; + warn "GETTING ALL USERS FOR ACCOUNT $account_id\n" if $self->debug; + my $result = $self->request('GET','/user','ForceArray' => ['user'],'account' => $account_id); + return if $self->check_for_error($result); + return $result->{'users'}->{'user'} || {}; +} + +=head2 update_user + +Accepts I<$account_id>, I<$username> and the same options as L. +Updates an existing user. +Returns a hashref containing the updated user details. + +=cut + +sub update_user { + my ($self,$account_id,$username,%opt) = @_; + warn "UPDATING USER $username\n" if $self->debug; + my %args; + foreach my $field ( qw( first_name last_name memo password password_type ) ) { + $args{$field} = $opt{$field} if $opt{$field}; + } + if ($args{'password_type'} && !grep(/$args{'password_type'}/,('plain','encrypted'))) { + return if $self->error("Illegal password_type $args{'password_type'}"); + } + $args{'account'} = $account_id; + my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args, action => 'update' ); + return if $self->check_for_error($result); + return $result->{'user'}; +} + +=head2 make_master_user + +Accepts I<$username>. Sets user to be master user for account. +Returns a hashref containing the updated user details. + +Caution: does not unmake existing master user. + +=cut + +sub make_master_user { + my ($self,$username) = @_; + warn "MAKING MASTER USER $username\n" if $self->debug; + my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), + master_user => 'Y', + action => 'update' + ); + return if $self->check_for_error($result); + return $result->{'user'}; +} + +=head2 suspend_user + +Accepts I<$username>. Sets user status to suspended. +Returns a hashref containing the updated user details. + +=cut + +sub suspend_user { + my ($self,$username) = @_; + warn "SUSPENDING USER $username\n" if $self->debug; + my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'suspended', action => 'update' ); + return if $self->check_for_error($result); + return $result->{'user'}; +} + +=head2 activate_user + +Accepts I<$username>. Sets user status to active. +Returns a hashref containing the updated user details. + +=cut + +sub activate_user { + my ($self,$username) = @_; + warn "ACTIVATING USER $username\n" if $self->debug; + my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'active', action => 'update' ); + return if $self->check_for_error($result); + return $result->{'user'}; +} + +=head2 delete_user + +Accepts I<$username>. Sets user status to deleted. +Returns a hashref containing the updated user details. + +=cut + +sub delete_user { + my ($self,$username) = @_; + warn "DELETING USER $username\n" if $self->debug; + my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), status => 'deleted', action => 'update' ); + return if $self->check_for_error($result); + return $result->{'user'}; +} + +=head2 purge_user + +Accepts I<$username> and the following options: + +I - if true, purges user even if it wasn't first deleted + +Purges user from system. +No meaningful return value. + +=cut + +sub purge_user { + my ($self,$username,%opt) = @_; + my %args; + $args{'force'} = 'true' if $opt{'force'}; + warn "PURGING USER $username\n" if $self->debug; + my $result = $self->request('POST', '/user/'.uri_escape_utf8($username), %args, action => 'purge' ); + $self->check_for_error($result); + return; +} + +=head1 Package Methods + +Make individual package-related API requests. + +=head2 assign_package + +Accepts I<$username> and I<$package>. Assigns package to user. +Returns a hashref of packages assigned to this user, keys are package names +and values are hashrefs of details about those packages. +Returns undef if none are found. + +=cut + +sub assign_package { + my ($self,$username,$package) = @_; + warn "ASSIGNING PACKAGE $package TO USER $username\n" if $self->debug; + my $result = $self->request('POST', '/user_package/'.uri_escape_utf8($username), + 'ForceArray' => ['package'], + 'package' => $package, + ); + return if $self->check_for_error($result); + return $result->{'packages'}->{'package'}; +} + +=head2 get_packages + +Accepts I<$username>. +Returns a hashref of packages assigned to this user, keys are package names +and values are hashrefs of details about those packages. + +=cut + +sub get_packages { + my ($self,$username) = @_; + warn "GETTING PACKAGES ASSIGNED TO USER $username\n" if $self->debug; + my $result = $self->request('GET', '/user_package/'.uri_escape_utf8($username), + 'ForceArray' => ['package'], + ); + return if $self->check_for_error($result); + return $result->{'packages'}->{'package'} || {}; +} + +=head2 remove_package + +Accepts I<$username> and I<$package>. Removes package from user. +No meaningful return value. + +=cut + +sub remove_package { + my ($self,$username,$package) = @_; + warn "REMOVING PACKAGE $package FROM USER $username\n" if $self->debug; + my $result = $self->request('POST', '/user_package/'.uri_escape_utf8($username), + 'package' => $package, + 'action' => 'purge' + ); + $self->check_for_error($result); + return; +} + +=head1 Domain Methods + +Make individual account-related API requests. + +=cut + +### DOMAIN METHODS HAVEN'T BEEN THOROUGLY TESTED, AREN'T CURRENTLY USED ### + +=head2 add_domain + +Accepts I<$account_id> and I<$domain>. Creates domain for that account. + +=cut + +sub add_domain { + my ($self,$account_id,$domain) = @_; + warn "CREATING DOMAIN $domain FOR ACCOUNT $account_id\n" if $self->debug; + my $result = $self->request('POST','/domain/'.uri_escape_utf8($domain), 'account' => $account_id); + return if $self->check_for_error($result); + return $result->{'domain'}; +} + +=head2 get_domain + +Accepts I<$domain>. Returns hasref of domain info if it exists, +or empty if it doesn't exist or permission denied. +Returns nothing without setting error if domain is not found. + +=cut + +sub get_domain { + my ($self, $domain) = @_; + warn "GETTING DOMAIN $domain\n" if $self->debug; + my $result = $self->request('GET','/domain/'.uri_escape_utf8($domain)); + if ($result->{'error'}) { + #unfortunately, no difference between 'does not exist' and true 'permission denied' + return if $result->{'error'}->{'code'} eq 'error.permission_denied'; + } + return if $self->check_for_error($result); + return $result->{'domain'}; +} + +=head2 get_domains + +Accepts I<$account_id>. Returns hasref of domains for that account, +keys are domains, values are hashrefs of info about each domain. + +=cut + +sub get_domains { + my ($self, $account_id) = @_; + warn "GETTING DOMAINS FOR ACCOUNT $account_id\n" if $self->debug; + my $result = $self->request('GET','/domain', + 'ForceArray' => ['domain'], + 'account' => $account_id + ); + return if $self->check_for_error($result); + return $result->{'domains'}->{'domain'} || {}; +} + +=head2 remove_domain + +Accepts I<$domain>. Removes domain. +No meaningful return value. + +=cut + +sub remove_domain { + my ($self,$domain) = @_; + warn "REMOVING DOMAIN $domain\n" if $self->debug; + my $result = $self->request('POST', '/domain/'.uri_escape_utf8($domain), action => 'purge'); + $self->check_for_error($result); + return; +} + +=head1 Email Address Methods + +Make individual emailaddress-related API requests. + +=head2 add_email_address + +Accepts I<$username> and I<$address>. Adds address for that user. +Returns hashref of details for new address. + +=cut + +sub add_email_address { + my ($self, $username, $address) = @_; + warn "ADDING ADDRESS $address FOR USER $username\n" if $self->debug; + my $result = $self->request('POST','/emailaddress/'.uri_escape_utf8($address), + 'user' => $username + ); + return if $self->check_for_error($result); + return $result->{'emailaddress'}; +} + +=head2 get_email_address + +Accepts I<$address>. Returns hasref of address info if it exists, +or empty if it doesn't exist or permission denied. +Returns nothing without setting error if address is not found. + +=cut + +sub get_email_address { + my ($self, $address) = @_; + warn "GETTING ADDRESS $address\n" if $self->debug; + my $result = $self->request('GET','/emailaddress/'.uri_escape_utf8($address)); + if ($result->{'error'}) { + #unfortunately, no difference between 'does not exist' and true 'permission denied' + return if $result->{'error'}->{'code'} eq 'error.permission_denied'; + } + return if $self->check_for_error($result); + return $result->{'emailaddress'}; +} + +=head2 get_email_addresses + +Accepts I<$username>. Returns hasref of email addresses for that account, +keys are domains, values are hashrefs of info about each domain. + +=cut + +sub get_email_addresses { + my ($self, $username) = @_; + warn "GETTING ADDRESSES FOR USER $username\n" if $self->debug; + my $result = $self->request('GET','/emailaddress', + 'ForceArray' => ['emailaddress'], + 'user' => $username, + ); + return if $self->check_for_error($result); + return $result->{'emailaddresses'}->{'emailaddress'} || {}; +} + +=head2 remove_email_address + +Accepts I<$address>. Removes address. +No meaningful return value. + +=cut + +sub remove_email_address { + my ($self,$address) = @_; + warn "REMOVING ADDRESS $address\n" if $self->debug; + my $result = $self->request('POST', '/emailaddress/'.uri_escape_utf8($address), action => 'purge'); + $self->check_for_error($result); + return; +} + +=head1 Error Methods + +Used to track errors during a request, for precision control over when +and how those errors are returned. + +=head2 error + +Accepts optional I<$message>, which will be appended to the internal error message on this +object if defined (use L to clear the message.) Returns current contents of +internal error message on this object. + +=cut + +sub error { + my ($self,$message) = @_; + if (defined($message)) { + $self->{'_error'} .= "\n" if $self->{'_error'}; + $self->{'_error'} .= $message; + } + return $self->{'_error'}; +} + +=head2 check_for_error + +Accepts I<$result> returned by L. Sets error if I<$result> +does not exist or contains an error message. Returns L. + +=cut + +sub check_for_error { + my ($self,$result) = @_; + return $self->error("Unknown error, no result found") + unless $result; + return $self->error($result->{'error'}->{'code'} . ': ' . $result->{'error'}->{'message'}) + if $result->{'error'}; + return $self->error; +} + +=head2 error_init + +Resets error message in object to blank string. +Should only be used at the start of L. +No meaningful return value. + +=cut + +sub error_init { + my ($self) = @_; + $self->{'_error'} = ''; + return; +} + +=head2 error_warn + +Accepts optional I<$message>, which will be appended to the internal error message on this +object if defined. + +Outputs L (if there is one) using warn, then runs L. +Returns blank string. + +=cut + +sub error_warn { + my $self = shift; + my $message = shift; + $self->error($message) if defined($message); + warn $self->error if $self->error; + $self->error_init; + return ''; +} + +=head2 debug + +Returns true if debug is set, either as an export option or in the module code. + +=cut + +sub debug { + my $self = shift; + return $DEBUG || $self->option('debug'); +} + +=head2 rollback + +Accepts hashref with the following fields, use for undoing recent changes: + +I - arrayref of username and package to remove + +I - username to be forcefully purged + +I - account_id to be suspended + +I - account_id to be deleted + +I - account_id to be forcefully purged + +Indicated actions will be performed in the order listed above. +Sets generic error message if no message is found, and returns L. + +=cut + +sub rollback { + my ($self,$r) = @_; + $self->error('Unknown error') unless $self->error; + $self->remove_package(@{$$r{'remove_package'}}) if $$r{'remove_package'}; + $self->purge_user($$r{'purge_user'}, 'force' => 1) if $$r{'purge_user'}; + $self->suspend_account($$r{'suspend_account'}) if $$r{'suspend_account'}; + $self->delete_account($$r{'delete_account'}) if $$r{'delete_account'}; + $self->purge_account($$r{'purge_account'}, 'force' => 1) if $$r{'purge_account'}; + return $self->error; +} + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Jonathan Prykop +jonathan@freeside.biz + +=head1 LICENSE AND COPYRIGHT + +Copyright 2015 Freeside Internet Services + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation. + +=cut + +1; + + -- 2.11.0