package FS::part_export::voip_ms; use base qw( FS::part_export ); use strict; use Tie::IxHash; use LWP::UserAgent; use URI; use URI::Escape; use Cpanel::JSON::XS; use HTTP::Request::Common; use Cache::FileCache; use FS::Record qw(dbh); use FS::Misc::DateTime qw(parse_datetime); use DateTime; our $me = '[voip.ms]'; our $DEBUG = 0; # our $DEBUG = 1; # log requests # our $DEBUG = 2; # log requests and content of replies our $base_url = 'https://voip.ms/api/v1/rest.php'; # cache cities and provinces our $CACHE; # a FileCache; their API is not as quick as I'd like our $cache_timeout = 86400; # seconds tie my %options, 'Tie::IxHash', 'account' => { label => 'Main account ID' }, 'username' => { label => 'API username', }, 'password' => { label => 'API password', }, 'debug' => { label => 'Enable debugging', type => 'checkbox', value => 1 }, # could dynamically pull this from the API... 'protocol' => { label => 'Protocol', type => 'select', options => [ 1, 3 ], option_labels => { 1 => 'SIP', 3 => 'IAX' }, }, 'auth_type' => { label => 'Authorization type', type => 'select', options => [ 1, 2 ], option_labels => { 1 => 'User/Password', 2 => 'Static IP' }, }, 'billing_type' => { label => 'DID billing mode', type => 'select', options => [ 1, 2 ], option_labels => { 1 => 'Per minute', 2 => 'Flat rate' }, }, 'device_type' => { label => 'Device type', type => 'select', options => [ 1, 2 ], option_labels => { 1 => 'IP PBX, e.g. Asterisk', 2 => 'IP phone or softphone', }, }, 'canada_routing' => { label => 'Canada routing policy', type => 'select', options => [ 1, 2 ], option_labels => { 1 => 'Value (lowest price)', 2 => 'Premium (highest quality)' }, }, 'international_route' => { # yes, 'route' label => 'International routing policy', type => 'select', options => [ 0, 1, 2 ], option_labels => { 0 => 'Disable international calls', 1 => 'Value (lowest price)', 2 => 'Premium (highest quality)' }, }, 'cnam_lookup' => { label => 'Enable CNAM lookup on incoming calls', type => 'checkbox', }, ; tie my %roles, 'Tie::IxHash', 'subacct' => { label => 'SIP client', svcdb => 'svc_acct', }, 'did' => { label => 'DID', svcdb => 'svc_phone', multiple => 1, }, ; our %info = ( 'svc' => [qw( svc_acct svc_phone )], 'desc' => 'Provision subaccounts and DIDs to voip.ms wholesale', 'options' => \%options, 'roles' => \%roles, 'no_machine' => 1, 'notes' => <<'END'

Export to voip.ms hosted PBX service.

This requires two service definitions to be configured on the same package:

  1. An account service for the subaccount (the "login" used by the customer's PBX or IP phone, and the call routing service). This should be attached to the export in the "subacct" role. If you are using password authentication, the username and _password will be used to authenticate to voip.ms. If you are using static IP authentication, the slipip (IP address) field should be set to the address.
  2. A phone service for a DID, attached to the export in the DID role. You must select a server for the "SIP Host" field. Calls from this DID will be routed to the customer via that server.

Export options:

The other options correspond to options in either the subaccount or DID configuration menu in the voip.ms portal; see documentation there for details.

END ); sub _export_insert { my($self, $svc_x) = (shift, shift); my $role = $self->svc_role($svc_x); if ( $role eq 'subacct' ) { my $error = $self->insert_subacct($svc_x); return "$me $error" if $error; my @existing_dids = ( $self->svc_with_role($svc_x, 'did') ); foreach my $svc_phone (@existing_dids) { $error = $self->insert_did($svc_phone, $svc_x); return "$me $error ordering DID ".$svc_phone->phonenum if $error; } } elsif ( $role eq 'did' ) { my $svc_acct = $self->svc_with_role($svc_x, 'subacct'); return if !$svc_acct; my $error = $self->insert_did($svc_x, $svc_acct); return "$me $error" if $error; } ''; } sub _export_replace { my ($self, $svc_new, $svc_old) = @_; my $role = $self->svc_role($svc_new); my $error; if ( $role eq 'subacct' ) { $error = $self->replace_subacct($svc_new, $svc_old); } elsif ( $role eq 'did' ) { $error = $self->replace_did($svc_new, $svc_old); } return "$me $error" if $error; ''; } sub _export_delete { my ($self, $svc_x) = (shift, shift); my $role = $self->svc_role($svc_x); if ( $role eq 'subacct' ) { my @existing_dids = ( $self->svc_with_role($svc_x, 'did') ); my $error; foreach my $svc_phone (@existing_dids) { $error = $self->delete_did($svc_phone); return "$me $error canceling DID ".$svc_phone->phonenum if $error; } $error = $self->delete_subacct($svc_x); return "$me $error" if $error; } elsif ( $role eq 'did' ) { my $svc_acct = $self->svc_with_role($svc_x, 'subacct'); return if !$svc_acct; my $error = $self->delete_did($svc_x); return "$me $error" if $error; } ''; } sub _export_suspend { my $self = shift; my $svc_x = shift; my $role = $self->svc_role($svc_x); return if $role ne 'subacct'; # can't suspend DIDs directly my $error = $self->replace_subacct($svc_x, $svc_x); # will disable it return "$me $error" if $error; ''; } sub _export_unsuspend { my $self = shift; my $svc_x = shift; my $role = $self->svc_role($svc_x); return if $role ne 'subacct'; # can't suspend DIDs directly $svc_x->set('unsuspended', 1); # hack to tell replace_subacct to do it my $error = $self->replace_subacct($svc_x, $svc_x); #same return "$me $error" if $error; ''; } ################ # PROVISIONING # ################ sub insert_subacct { my ($self, $svc_acct) = @_; my $method = 'createSubAccount'; my $content = $self->subacct_content($svc_acct); my $result = $self->api_request($method, $content); if ( $result->{status} ne 'success' ) { return $result->{status}; # or look up the error message string? } # result includes the account ID and the full username, but we don't # really need to keep those; we can look them up later ''; } sub insert_did { my ($self, $svc_phone, $svc_acct) = @_; my $method = 'orderDID'; my $content = $self->did_content($svc_phone, $svc_acct); my $result = $self->api_request($method, $content); if ( $result->{status} ne 'success' ) { return $result->{status}; # or look up the error message string? } ''; } sub delete_subacct { my ($self, $svc_acct) = @_; my $account = $self->option('account') . '_' . $svc_acct->username; my $id = $self->subacct_id($svc_acct); if ( $id =~ /\D/ ) { return $id; # it's an error } elsif ( $id eq '' ) { return ''; # account doesn't exist, don't need to delete } # else it's numeric warn "$me deleting account $account with ID $id\n" if $DEBUG; my $result = $self->api_request('delSubAccount', { id => $id }); if ( $result->{status} ne 'success' ) { return $result->{status}; } ''; } sub delete_did { my ($self, $svc_phone) = @_; my $phonenum = $svc_phone->phonenum; my $result = $self->api_request('cancelDID', { did => $phonenum }); if ( $result->{status} ne 'success' and $result->{status} ne 'invalid_did' ) { return $result->{status}; } ''; } sub replace_subacct { my ($self, $svc_new, $svc_old) = @_; if ( $svc_new->username ne $svc_old->username ) { return "can't change account username; delete and recreate the account instead"; } my $id = $self->subacct_id($svc_new); if ( $id =~ /\D/ ) { return $id; } elsif ( $id eq '' ) { # account doesn't exist; provision it anew return $self->insert_subacct($svc_new); } my $content = $self->subacct_content($svc_new); delete $content->{username}; $content->{id} = $id; my $result = $self->api_request('setSubAccount', $content); if ( $result->{status} ne 'success' ) { return $result->{status}; } ''; } sub replace_did { my ($self, $svc_new, $svc_old) = @_; if ( $svc_new->phonenum ne $svc_old->phonenum ) { return "can't change DID phone number"; } # check that there's a subacct set up my $svc_acct = $self->svc_with_role($svc_new, 'subacct') or return ''; # check for the existing DID my $result = $self->api_request('getDIDsInfo', { did => $svc_new->phonenum } ); if ( $result->{status} eq 'invalid_did' ) { # provision the DID return $self->insert_did($svc_new, $svc_acct); } elsif ( $result->{status} ne 'success' ) { return $result->{status}; } my $existing = $result->{dids}[0]; my $content = $self->did_content($svc_new, $svc_acct); if ( $content->{billing_type} == $existing->{billing_type} ) { delete $content->{billing_type}; # confuses the server otherwise } $result = $self->api_request('setDIDInfo', $content); if ( $result->{status} ne 'success' ) { return $result->{status}; } return ''; } ####################### # CONVENIENCE METHODS # ####################### sub subacct_id { my ($self, $svc_acct) = @_; my $account = $self->option('account') . '_' . $svc_acct->username; # look up the subaccount's numeric ID my $result = $self->api_request('getSubAccounts', { account => $account }); if ( $result->{status} eq 'invalid_account' ) { return ''; } elsif ( $result->{status} ne 'success' ) { return "$result->{status} looking up account ID"; } else { return $result->{accounts}[0]{id}; } } sub subacct_content { my ($self, $svc_acct) = @_; my $cust_pkg = $svc_acct->cust_svc->cust_pkg; my $desc = $svc_acct->finger || $svc_acct->username; my $intl = $self->option('international_route'); my $lockintl = 0; if ($intl == 0) { $intl = 1; # can't send zero $lockintl = 1; } my %auth; if ( $cust_pkg and $cust_pkg->susp > 0 and !$svc_acct->get('unsuspended') ) { # we can't explicitly suspend their account, so just set its password to # a partially random string that satisfies the password rules # (we still have their real password in the svc_acct record) %auth = ( auth_type => 1, password => sprintf('Suspend-%08d', int(rand(100000000)) ), ); } else { %auth = ( auth_type => $self->option('auth_type'), password => $svc_acct->_password, ip => $svc_acct->slipip, ); } return { username => $svc_acct->username, protocol => $self->option('protocol'), description => $desc, %auth, device_type => $self->option('device_type'), canada_routing => $self->option('canada_routing'), lock_international => $lockintl, international_route => $intl, # sensible defaults for these music_on_hold => 'default', # silence allowed_codecs => 'ulaw;g729;gsm', dtmf_mode => 'AUTO', nat => 'yes', }; } sub did_content { my ($self, $svc_phone, $svc_acct) = @_; my $account = $self->option('account') . '_' . $svc_acct->username; my $phonenum = $svc_phone->phonenum; # look up POP number (for some reason this is assigned per DID...) my $sip_server = $svc_phone->sip_server or return "SIP server required"; my $popnum = $self->cache('server_popnum')->{ $svc_phone->sip_server } or return "SIP server '$sip_server' is unknown"; return { did => $phonenum, routing => "account:$account", # secondary routing options (failovers, voicemail) are outside our # scope here # though we could support them using the "forwarddst" field? pop => $popnum, dialtime => 60, # sensible default, add an option if needed cnam => ($self->option('cnam_lookup') ? 1 : 0), note => $svc_phone->phone_name, billing_type => $self->option('billing_type'), }; } ################# # DID SELECTION # ################# sub get_dids_npa_select { 0 } # all Canadian VoIP providers seem to have this sub get_dids { my $self = shift; my %opt = @_; my ($exportnum) = $self->exportnum =~ /^(\d+)$/; if ( $opt{'region'} ) { # return numbers (probably shouldn't cache this) my ($ratecenter, $province) = $opt{'region'} =~ /^(.*), (..)$/; my $country = $self->cache('province_country')->{ $province }; my $result; if ( $country eq 'CAN' ) { $result = $self->api_insist('getDIDsCAN', { province => $province, ratecenter => $ratecenter } ); } elsif ( $country eq 'USA' ) { $result = $self->api_insist('getDIDsUSA', { state => $province, ratecenter => $ratecenter } ); } my @return = map { $_->{did} } @{ $result->{dids} }; return \@return; } else { if ( $opt{'state'} ) { my $province = $opt{'state'}; # cache() will refresh the cache if necessary, and die on failure. # default here is only in case someone gives us a state that # doesn't exist. return $self->cache('province_city', $province) || []; } else { # return a list of provinces return [ @{ $self->cache('country_province')->{CAN} }, @{ $self->cache('country_province')->{USA} }, ]; } } } sub get_sip_servers { my $self = shift; return [ sort keys %{ $self->cache('server_popnum') } ]; } sub cache { my $self = shift; my $element = shift or return; my $province = shift; $CACHE ||= Cache::FileCache->new({ 'cache_root' => $FS::UID::cache_dir.'/cache.'.$FS::UID::datasrc, 'namespace' => __PACKAGE__, 'default_expires_in' => $cache_timeout, }); if ( $element eq 'province_city' ) { $element .= ".$province"; } return $CACHE->get($element) || $self->reload_cache($element); } sub reload_cache { my $self = shift; my $element = shift; if ( $element eq 'province_country' or $element eq 'country_province' ) { # populate provinces/states my %province_country; my %country_province = ( CAN => [], USA => [] ); my $result = $self->api_insist('getProvinces'); foreach my $province (map { $_->{province} } @{ $result->{provinces} }) { $province_country{$province} = 'CAN'; push @{ $country_province{CAN} }, $province; } $result = $self->api_insist('getStates'); foreach my $state (map { $_->{state} } @{ $result->{states} }) { $province_country{$state} = 'USA'; push @{ $country_province{USA} }, $state; } $CACHE->set('province_country', \%province_country); $CACHE->set('country_province', \%country_province); return $CACHE->get($element); } elsif ( $element eq 'server_popnum' ) { my $result = $self->api_insist('getServersInfo'); my %server_popnum; foreach (@{ $result->{servers} }) { $server_popnum{ $_->{server_hostname} } = $_->{server_pop}; } $CACHE->set('server_popnum', \%server_popnum); return \%server_popnum; } elsif ( $element =~ /^province_city\.(\w+)$/ ) { my $province = $1; # then get the ratecenters for that province my $country = $self->cache('province_country')->{$province}; my @ratecenters; if ( $country eq 'CAN' ) { my $result = $self->api_insist('getRateCentersCAN', { province => $province }); foreach (@{ $result->{ratecenters} }) { my $ratecenter = $_->{ratecenter} . ", $province"; # disambiguate push @ratecenters, $ratecenter; } } elsif ( $country eq 'USA' ) { my $result = $self->api_insist('getRateCentersUSA', { state => $province }); foreach (@{ $result->{ratecenters} }) { my $ratecenter = $_->{ratecenter} . ", $province"; push @ratecenters, $ratecenter; } } $CACHE->set($element, \@ratecenters); return \@ratecenters; } else { return; } } ################ # CALL DETAILS # ################ =item import_cdrs START, END Retrieves CDRs for calls in the date range from START to END and inserts them as a new CDR batch. On success, returns a new cdr_batch object. On failure, returns an error message. If there are no new CDRs, returns nothing. =cut sub import_cdrs { my ($self, $start, $end) = @_; $start ||= 0; # all CDRs ever $end ||= time; $DEBUG ||= $self->option('debug'); my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; ($start, $end) = ($end, $start) if $end < $start; $start = DateTime->from_epoch(epoch => $start, time_zone => 'local'); $end = DateTime->from_epoch(epoch => $end, time_zone => 'local'); my $accountnum = $self->option('account'); my $cdr_batch; # can't retrieve more than 92 days at a time # actually, it's even less than that; on large batches their server # sometimes cuts off in mid-sentence. so set the chunk size smaller. while ( $start < $end ) { my $this_end = $start->clone; $this_end->add(days => 14); if ($this_end > $end) { $this_end = $end; } my $date_from = $start->strftime('%F'); my $date_to = $this_end->strftime('%F'); warn "retrieving CDRs from $date_from to $date_to\n" if $DEBUG; my $timezone = $start->strftime('%z') / 100; # integer number of hours my $result = $self->api_request('getCDR', { date_from => $date_from, date_to => $date_to, answered => 1, noanswer => 1, busy => 1, failed => 1, timezone => $timezone, }); if ( $result->{status} eq 'success' ) { if (!$cdr_batch) { # then create one my $cdrbatchname = 'voip_ms-' . $self->exportnum . '-' . $end->epoch; $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname }); my $error = $cdr_batch->insert; if ( $error ) { dbh->rollback if $oldAutoCommit; return $error; } } foreach ( @{ $result->{cdr} } ) { my $uniqueid = $_->{uniqueid}; # download ranges may overlap; avoid double-importing CDRs if ( FS::cdr->row_exists("uniqueid = ?", $uniqueid) ) { warn "skipped call with uniqueid = '$uniqueid' (already imported)\n" if $DEBUG; next; } # in this case, and probably in other cases in the near future, # easier to do this than to create a FS::cdr::* format module my $hash = { disposition => $_->{disposition}, calldate => $_->{date}, dst => $_->{destination}, uniqueid => $_->{uniqueid}, upstream_price => $_->{total}, upstream_dst_regionname => $_->{description}, clid => $_->{callerid}, duration => $_->{seconds}, billsec => $_->{seconds}, cdrbatchnum => $cdr_batch->cdrbatchnum, }; if ( $_->{date} ) { $hash->{startdate} = parse_datetime($_->{date}); } if ( $_->{account} eq $accountnum ) { # calls made from the master account, not a subaccount # charged_party will be set to the source number $hash->{charged_party} = ''; } elsif ( $_->{account} =~ /^${accountnum}_(\w+)$/ ) { $hash->{charged_party} = $1; } else { warn "skipped call with account = '$_->{account}'\n"; next; } if ( $_->{callerid} =~ /<(\w+)>$/ ) { $hash->{src} = $1; } elsif ( $_->{callerid} =~ /^(\w+)$/ ) { $hash->{src} = $1; } else { # else what? they don't have a source number anywhere else warn "skipped call with unparseable callerid '$_->{callerid}'\n"; next; } my $cdr = FS::cdr->new($hash); my $error = $cdr->insert; if ( $error ) { dbh->rollback if $oldAutoCommit; return "$error (uniqueid $_->{uniqueid})"; } } # foreach @{ $result->{cdr} } } elsif ( $result->{status} eq 'no_cdr' ) { # normal result if there are no CDRs, duh next; # there may still be more CDRs later } else { dbh->rollback if $oldAutoCommit; return "$me error retrieving CDRs: $result->{status}"; } # we've retrieved and inserted this sub-batch of CDRs $start->add(days => 15); } # while ( $start < $end ) if ( $cdr_batch ) { dbh->commit if $oldAutoCommit; return $cdr_batch; } else { # no CDRs were ever found return; } } ############## # API ACCESS # ############## =item api_request METHOD, CONTENT Makes a REST request with method name METHOD, and POST content CONTENT (as a hashref). =cut sub api_request { my $self = shift; my ($method, $content) = @_; $DEBUG ||= 1 if $self->option('debug'); my $url = URI->new($base_url); $url->query_form( 'method' => $method, 'api_username' => $self->option('username'), 'api_password' => $self->option('password'), %$content ); my $request = GET($url, 'Accept' => 'text/json', ); warn "$me $method\n" if $DEBUG; warn $request->as_string ."\n" if $DEBUG > 1; my $ua = LWP::UserAgent->new; my $response = $ua->request($request); warn "$me received\n" . $response->as_string ."\n" if $DEBUG > 1; if ( !$response->is_success ) { return { status => $response->content }; } local $@; my $decoded_response = eval { decode_json($response->content) }; if ( $@ ) { die "Error parsing response:\n" . $response->content . "\n\n"; } return $decoded_response; } =item api_insist METHOD, CONTENT Exactly like L, but if the returned "status" is not "success", throws an exception. =cut sub api_insist { my $self = shift; my $method = $_[0]; my $result = $self->api_request(@_); if ( $result->{status} eq 'success' ) { return $result; } elsif ( $result->{status} ) { die "$me $method: $result->{status}\n"; } else { die "$me $method: no status returned\n"; } } 1;