1 package FS::part_export::voip_ms;
3 use base qw( FS::part_export );
11 use HTTP::Request::Common;
13 use FS::Record qw(dbh);
14 use FS::Misc::DateTime qw(parse_datetime);
17 our $me = '[voip.ms]';
19 # our $DEBUG = 1; # log requests
20 # our $DEBUG = 2; # log requests and content of replies
21 our $base_url = 'https://voip.ms/api/v1/rest.php';
23 # cache cities and provinces
24 our $CACHE; # a FileCache; their API is not as quick as I'd like
25 our $cache_timeout = 86400; # seconds
27 tie my %options, 'Tie::IxHash',
28 'account' => { label => 'Main account ID' },
29 'username' => { label => 'API username', },
30 'password' => { label => 'API password', },
31 'debug' => { label => 'Enable debugging', type => 'checkbox', value => 1 },
32 # could dynamically pull this from the API...
37 option_labels => { 1 => 'SIP', 3 => 'IAX' },
40 label => 'Authorization type',
43 option_labels => { 1 => 'User/Password', 2 => 'Static IP' },
46 label => 'DID billing mode',
49 option_labels => { 1 => 'Per minute', 2 => 'Flat rate' },
52 label => 'Device type',
55 option_labels => { 1 => 'IP PBX, e.g. Asterisk',
56 2 => 'IP phone or softphone',
60 label => 'Canada routing policy',
63 option_labels => { 1 => 'Value (lowest price)',
64 2 => 'Premium (highest quality)'
67 'international_route' => { # yes, 'route'
68 label => 'International routing policy',
70 options => [ 0, 1, 2 ],
71 option_labels => { 0 => 'Disable international calls',
72 1 => 'Value (lowest price)',
73 2 => 'Premium (highest quality)'
77 label => 'Enable CNAM lookup on incoming calls',
83 tie my %roles, 'Tie::IxHash',
84 'subacct' => { label => 'SIP client',
87 'did' => { label => 'DID',
94 'svc' => [qw( svc_acct svc_phone )],
96 'Provision subaccounts and DIDs to voip.ms wholesale',
97 'options' => \%options,
101 <P>Export to <b>voip.ms</b> hosted PBX service.</P>
102 <P>This requires two service definitions to be configured on the same package:
104 <LI>An account service for the subaccount (the "login" used by the
105 customer's PBX or IP phone, and the call routing service). This should
106 be attached to the export in the "subacct" role. If you are using
107 password authentication, the <i>username</i> and <i>_password</i> will
108 be used to authenticate to voip.ms. If you are using static IP
109 authentication, the <i>slipip</I> (IP address) field should be set to
111 <LI>A phone service for a DID, attached to the export in the DID role.
112 You must select a server for the "SIP Host" field. Calls from this DID
113 will be routed to the customer via that server.</LI>
118 <LI>Main account ID: the numeric ID for the master account.
119 Subaccount usernames will be prefixed with this number and an underscore,
120 so if you create a subaccount in Freeside with a username of "myuser",
121 the SIP device will have to authenticate as something like
122 "123456_myuser".</LI>
123 <LI>API username/password: your API login; see
124 <a href="https://www.voip.ms/m/api.php">this page</a> to configure it
125 if you haven't done so yet.</LI>
126 <LI>Enable debugging: writes all traffic with the API server to the log.
127 This includes passwords.</LI>
129 The other options correspond to options in either the subaccount or DID
130 configuration menu in the voip.ms portal; see documentation there for
137 my($self, $svc_x) = (shift, shift);
139 my $role = $self->svc_role($svc_x);
140 if ( $role eq 'subacct' ) {
142 my $error = $self->insert_subacct($svc_x);
143 return "$me $error" if $error;
145 my @existing_dids = ( $self->svc_with_role($svc_x, 'did') );
147 foreach my $svc_phone (@existing_dids) {
148 $error = $self->insert_did($svc_phone, $svc_x);
149 return "$me $error ordering DID ".$svc_phone->phonenum
153 } elsif ( $role eq 'did' ) {
155 my $svc_acct = $self->svc_with_role($svc_x, 'subacct');
156 return if !$svc_acct;
158 my $error = $self->insert_did($svc_x, $svc_acct);
159 return "$me $error" if $error;
166 my ($self, $svc_new, $svc_old) = @_;
167 my $role = $self->svc_role($svc_new);
169 if ( $role eq 'subacct' ) {
170 $error = $self->replace_subacct($svc_new, $svc_old);
171 } elsif ( $role eq 'did' ) {
172 $error = $self->replace_did($svc_new, $svc_old);
174 return "$me $error" if $error;
179 my ($self, $svc_x) = (shift, shift);
180 my $role = $self->svc_role($svc_x);
181 if ( $role eq 'subacct' ) {
183 my @existing_dids = ( $self->svc_with_role($svc_x, 'did') );
186 foreach my $svc_phone (@existing_dids) {
187 $error = $self->delete_did($svc_phone);
188 return "$me $error canceling DID ".$svc_phone->phonenum
192 $error = $self->delete_subacct($svc_x);
193 return "$me $error" if $error;
195 } elsif ( $role eq 'did' ) {
197 my $svc_acct = $self->svc_with_role($svc_x, 'subacct');
198 return if !$svc_acct;
200 my $error = $self->delete_did($svc_x);
201 return "$me $error" if $error;
210 my $role = $self->svc_role($svc_x);
211 return if $role ne 'subacct'; # can't suspend DIDs directly
213 my $error = $self->replace_subacct($svc_x, $svc_x); # will disable it
214 return "$me $error" if $error;
218 sub export_unsuspend {
221 my $role = $self->svc_role($svc_x);
222 return if $role ne 'subacct'; # can't suspend DIDs directly
224 $svc_x->set('unsuspended', 1); # hack to tell replace_subacct to do it
225 my $error = $self->replace_subacct($svc_x, $svc_x); #same
226 return "$me $error" if $error;
235 my ($self, $svc_acct) = @_;
236 my $method = 'createSubAccount';
237 my $content = $self->subacct_content($svc_acct);
239 my $result = $self->api_request($method, $content);
240 if ( $result->{status} ne 'success' ) {
241 return $result->{status}; # or look up the error message string?
244 # result includes the account ID and the full username, but we don't
245 # really need to keep those; we can look them up later
250 my ($self, $svc_phone, $svc_acct) = @_;
251 my $method = 'orderDID';
252 my $content = $self->did_content($svc_phone, $svc_acct);
253 my $result = $self->api_request($method, $content);
254 if ( $result->{status} ne 'success' ) {
255 return $result->{status}; # or look up the error message string?
261 my ($self, $svc_acct) = @_;
262 my $account = $self->option('account') . '_' . $svc_acct->username;
264 my $id = $self->subacct_id($svc_acct);
267 return $id; # it's an error
269 } elsif ( $id eq '' ) {
271 return ''; # account doesn't exist, don't need to delete
273 } # else it's numeric
275 warn "$me deleting account $account with ID $id\n" if $DEBUG;
276 my $result = $self->api_request('delSubAccount', { id => $id });
277 if ( $result->{status} ne 'success' ) {
278 return $result->{status};
284 my ($self, $svc_phone) = @_;
285 my $phonenum = $svc_phone->phonenum;
287 my $result = $self->api_request('cancelDID', { did => $phonenum });
288 if ( $result->{status} ne 'success' and $result->{status} ne 'invalid_did' )
290 return $result->{status};
295 sub replace_subacct {
296 my ($self, $svc_new, $svc_old) = @_;
297 if ( $svc_new->username ne $svc_old->username ) {
298 return "can't change account username; delete and recreate the account instead";
301 my $id = $self->subacct_id($svc_new);
306 } elsif ( $id eq '' ) {
308 # account doesn't exist; provision it anew
309 return $self->insert_subacct($svc_new);
313 my $content = $self->subacct_content($svc_new);
314 delete $content->{username};
315 $content->{id} = $id;
317 my $result = $self->api_request('setSubAccount', $content);
318 if ( $result->{status} ne 'success' ) {
319 return $result->{status};
326 my ($self, $svc_new, $svc_old) = @_;
327 if ( $svc_new->phonenum ne $svc_old->phonenum ) {
328 return "can't change DID phone number";
330 # check that there's a subacct set up
331 my $svc_acct = $self->svc_with_role($svc_new, 'subacct')
334 # check for the existing DID
335 my $result = $self->api_request('getDIDsInfo',
336 { did => $svc_new->phonenum }
338 if ( $result->{status} eq 'invalid_did' ) {
341 return $self->insert_did($svc_new, $svc_acct);
343 } elsif ( $result->{status} ne 'success' ) {
345 return $result->{status};
349 my $existing = $result->{dids}[0];
351 my $content = $self->did_content($svc_new, $svc_acct);
352 if ( $content->{billing_type} == $existing->{billing_type} ) {
353 delete $content->{billing_type}; # confuses the server otherwise
355 $result = $self->api_request('setDIDInfo', $content);
356 if ( $result->{status} ne 'success' ) {
357 return $result->{status};
363 #######################
364 # CONVENIENCE METHODS #
365 #######################
368 my ($self, $svc_acct) = @_;
369 my $account = $self->option('account') . '_' . $svc_acct->username;
371 # look up the subaccount's numeric ID
372 my $result = $self->api_request('getSubAccounts', { account => $account });
373 if ( $result->{status} eq 'invalid_account' ) {
375 } elsif ( $result->{status} ne 'success' ) {
376 return "$result->{status} looking up account ID";
378 return $result->{accounts}[0]{id};
382 sub subacct_content {
383 my ($self, $svc_acct) = @_;
385 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
387 my $desc = $svc_acct->finger || $svc_acct->username;
388 my $intl = $self->option('international_route');
391 $intl = 1; # can't send zero
396 if ( $cust_pkg and $cust_pkg->susp > 0 and !$svc_acct->get('unsuspended') ) {
397 # we can't explicitly suspend their account, so just set its password to
398 # a partially random string that satisfies the password rules
399 # (we still have their real password in the svc_acct record)
400 %auth = ( auth_type => 1,
401 password => sprintf('Suspend-%08d', int(rand(100000000)) ),
404 %auth = ( auth_type => $self->option('auth_type'),
405 password => $svc_acct->_password,
406 ip => $svc_acct->slipip,
410 username => $svc_acct->username,
411 description => $desc,
413 device_type => $self->option('device_type'),
414 canada_routing => $self->option('canada_routing'),
415 lock_international => $lockintl,
416 international_route => $intl,
417 # sensible defaults for these
418 music_on_hold => 'default', # silence
419 allowed_codecs => 'ulaw;g729;gsm',
426 my ($self, $svc_phone, $svc_acct) = @_;
428 my $account = $self->option('account') . '_' . $svc_acct->username;
429 my $phonenum = $svc_phone->phonenum;
430 # look up POP number (for some reason this is assigned per DID...)
431 my $sip_server = $svc_phone->sip_server
432 or return "SIP server required";
433 my $popnum = $self->cache('server_popnum')->{ $svc_phone->sip_server }
434 or return "SIP server '$sip_server' is unknown";
437 routing => "account:$account",
438 # secondary routing options (failovers, voicemail) are outside our
440 # though we could support them using the "forwarddst" field?
442 dialtime => 60, # sensible default, add an option if needed
443 cnam => ($self->option('cnam_lookup') ? 1 : 0),
444 note => $svc_phone->phone_name,
445 billing_type => $self->option('billing_type'),
453 sub get_dids_npa_select { 0 } # all Canadian VoIP providers seem to have this
459 my ($exportnum) = $self->exportnum =~ /^(\d+)$/;
461 if ( $opt{'region'} ) {
463 # return numbers (probably shouldn't cache this)
464 my ($ratecenter, $province) = $opt{'region'} =~ /^(.*), (..)$/;
465 my $country = $self->cache('province_country')->{ $province };
467 if ( $country eq 'CAN' ) {
468 $result = $self->api_insist('getDIDsCAN',
469 { province => $province,
470 ratecenter => $ratecenter
473 } elsif ( $country eq 'USA' ) {
474 $result = $self->api_insist('getDIDsUSA',
475 { state => $province,
476 ratecenter => $ratecenter
480 my @return = map { $_->{did} } @{ $result->{dids} };
484 if ( $opt{'state'} ) {
485 my $province = $opt{'state'};
487 # cache() will refresh the cache if necessary, and die on failure.
488 # default here is only in case someone gives us a state that
490 return $self->cache('province_city', $province) || [];
494 # return a list of provinces
496 @{ $self->cache('country_province')->{CAN} },
497 @{ $self->cache('country_province')->{USA} },
503 sub get_sip_servers {
505 return [ sort keys %{ $self->cache('server_popnum') } ];
510 my $element = shift or return;
511 my $province = shift;
513 $CACHE ||= Cache::FileCache->new({
514 'cache_root' => $FS::UID::cache_dir.'/cache.'.$FS::UID::datasrc,
515 'namespace' => __PACKAGE__,
516 'default_expires_in' => $cache_timeout,
519 if ( $element eq 'province_city' ) {
520 $element .= ".$province";
522 return $CACHE->get($element) || $self->reload_cache($element);
528 if ( $element eq 'province_country' or $element eq 'country_province' ) {
529 # populate provinces/states
531 my %province_country;
532 my %country_province = ( CAN => [], USA => [] );
534 my $result = $self->api_insist('getProvinces');
535 foreach my $province (map { $_->{province} } @{ $result->{provinces} }) {
536 $province_country{$province} = 'CAN';
537 push @{ $country_province{CAN} }, $province;
540 $result = $self->api_insist('getStates');
541 foreach my $state (map { $_->{state} } @{ $result->{states} }) {
542 $province_country{$state} = 'USA';
543 push @{ $country_province{USA} }, $state;
546 $CACHE->set('province_country', \%province_country);
547 $CACHE->set('country_province', \%country_province);
548 return $CACHE->get($element);
550 } elsif ( $element eq 'server_popnum' ) {
552 my $result = $self->api_insist('getServersInfo');
554 foreach (@{ $result->{servers} }) {
555 $server_popnum{ $_->{server_hostname} } = $_->{server_pop};
558 $CACHE->set('server_popnum', \%server_popnum);
559 return \%server_popnum;
561 } elsif ( $element =~ /^province_city\.(\w+)$/ ) {
565 # then get the ratecenters for that province
566 my $country = $self->cache('province_country')->{$province};
569 if ( $country eq 'CAN' ) {
571 my $result = $self->api_insist('getRateCentersCAN',
572 { province => $province });
574 foreach (@{ $result->{ratecenters} }) {
575 my $ratecenter = $_->{ratecenter} . ", $province"; # disambiguate
576 push @ratecenters, $ratecenter;
579 } elsif ( $country eq 'USA' ) {
581 my $result = $self->api_insist('getRateCentersUSA',
582 { state => $province });
583 foreach (@{ $result->{ratecenters} }) {
584 my $ratecenter = $_->{ratecenter} . ", $province";
585 push @ratecenters, $ratecenter;
590 $CACHE->set($element, \@ratecenters);
591 return \@ratecenters;
602 =item import_cdrs START, END
604 Retrieves CDRs for calls in the date range from START to END and inserts them
605 as a new CDR batch. On success, returns a new cdr_batch object. On failure,
606 returns an error message. If there are no new CDRs, returns nothing.
611 my ($self, $start, $end) = @_;
612 $start ||= 0; # all CDRs ever
614 $DEBUG ||= $self->option('debug');
616 my $oldAutoCommit = $FS::UID::AutoCommit;
617 local $FS::UID::AutoCommit = 0;
619 ($start, $end) = ($end, $start) if $end < $start;
620 $start = DateTime->from_epoch(epoch => $start, time_zone => 'local');
621 $end = DateTime->from_epoch(epoch => $end, time_zone => 'local');
622 my $accountnum = $self->option('account');
624 # can't retrieve more than 92 days at a time
625 # actually, it's even less than that; on large batches their server
626 # sometimes cuts off in mid-sentence. so set the chunk size smaller.
627 while ( $start < $end ) {
629 my $this_end = $start->clone;
630 $this_end->add(days => 14);
631 if ($this_end > $end) {
635 my $date_from = $start->strftime('%F');
636 my $date_to = $this_end->strftime('%F');
637 warn "retrieving CDRs from $date_from to $date_to\n" if $DEBUG;
638 my $timezone = $start->strftime('%z') / 100; # integer number of hours
639 my $result = $self->api_request('getCDR', {
640 date_from => $date_from,
646 timezone => $timezone,
648 if ( $result->{status} eq 'success' ) {
651 my $cdrbatchname = 'voip_ms-' . $self->exportnum . '-' . $end->epoch;
652 $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname });
653 my $error = $cdr_batch->insert;
655 dbh->rollback if $oldAutoCommit;
660 foreach ( @{ $result->{cdr} } ) {
661 my $uniqueid = $_->{uniqueid};
662 # download ranges may overlap; avoid double-importing CDRs
663 if ( FS::cdr->row_exists("uniqueid = ?", $uniqueid) ) {
664 warn "skipped call with uniqueid = '$uniqueid' (already imported)\n"
668 # in this case, and probably in other cases in the near future,
669 # easier to do this than to create a FS::cdr::* format module
671 disposition => $_->{disposition},
672 calldate => $_->{date},
673 dst => $_->{destination},
674 uniqueid => $_->{uniqueid},
675 upstream_price => $_->{total},
676 upstream_dst_regionname => $_->{description},
677 clid => $_->{callerid},
678 duration => $_->{seconds},
679 billsec => $_->{seconds},
680 cdrbatchnum => $cdr_batch->cdrbatchnum,
683 $hash->{startdate} = parse_datetime($_->{date});
685 if ( $_->{account} eq $accountnum ) {
686 # calls made from the master account, not a subaccount
687 # charged_party will be set to the source number
688 $hash->{charged_party} = '';
689 } elsif ( $_->{account} =~ /^${accountnum}_(\w+)$/ ) {
690 $hash->{charged_party} = $1;
692 warn "skipped call with account = '$_->{account}'\n";
695 if ( $_->{callerid} =~ /<(\w+)>$/ ) {
697 } elsif ( $_->{callerid} =~ /^(\w+)$/ ) {
700 # else what? they don't have a source number anywhere else
701 warn "skipped call with unparseable callerid '$_->{callerid}'\n";
705 my $cdr = FS::cdr->new($hash);
706 my $error = $cdr->insert;
708 dbh->rollback if $oldAutoCommit;
709 return "$error (uniqueid $_->{uniqueid})";
711 } # foreach @{ $result->{cdr} }
713 } elsif ( $result->{status} eq 'no_cdr' ) {
714 # normal result if there are no CDRs, duh
715 next; # there may still be more CDRs later
717 dbh->rollback if $oldAutoCommit;
718 return "$me error retrieving CDRs: $result->{status}";
721 # we've retrieved and inserted this sub-batch of CDRs
722 $start->add(days => 15);
723 } # while ( $start < $end )
726 dbh->commit if $oldAutoCommit;
729 # no CDRs were ever found
738 =item api_request METHOD, CONTENT
740 Makes a REST request with method name METHOD, and POST content CONTENT (as
747 my ($method, $content) = @_;
748 $DEBUG ||= 1 if $self->option('debug');
749 my $url = URI->new($base_url);
752 'api_username' => $self->option('username'),
753 'api_password' => $self->option('password'),
757 my $request = GET($url,
758 'Accept' => 'text/json',
761 warn "$me $method\n" if $DEBUG;
762 warn $request->as_string ."\n" if $DEBUG > 1;
763 my $ua = LWP::UserAgent->new;
764 my $response = $ua->request($request);
765 warn "$me received\n" . $response->as_string ."\n" if $DEBUG > 1;
766 if ( !$response->is_success ) {
767 return { status => $response->content };
771 my $decoded_response = eval { decode_json($response->content) };
773 die "Error parsing response:\n" . $response->content . "\n\n";
775 return $decoded_response;
778 =item api_insist METHOD, CONTENT
780 Exactly like L</api_request>, but if the returned "status" is not "success",
788 my $result = $self->api_request(@_);
789 if ( $result->{status} eq 'success' ) {
791 } elsif ( $result->{status} ) {
792 die "$me $method: $result->{status}\n";
794 die "$me $method: no status returned\n";