Export to a sip:provider server.
This requires two service definitions to be configured on the same package:
Export options: -
END ); -sub export_insert { +sub _export_insert { my($self, $svc_x) = (shift, shift); - local $@; + local $SIG{__DIE__}; + my $error; my $role = $self->svc_role($svc_x); if ( $role eq 'subscriber' ) { - eval { $self->insert_subscriber($svc_x) }; - return "$me $@" if $@; + try { $self->insert_subscriber($svc_x) } + catch { $error = $_ }; } elsif ( $role eq 'did' ) { - # only export the DID if it's set to forward to somewhere... - return if $svc_x->forwarddst eq ''; - my $subscriber = qsearchs('svc_phone', { phonenum => $svc_x->forwarddst }); - # and there is a service for the forwarding destination... - return if !$subscriber; - # and that service is managed by this export. - return if !$self->svc_role($subscriber); - - eval { $self->replace_subscriber($subscriber) }; - return "$me $@" if $@; + try { $self->export_did($svc_x) } + catch { $error = $_ }; } + return "$me $error" if $error; ''; } -sub export_replace { +sub _export_replace { my ($self, $svc_new, $svc_old) = @_; + local $SIG{__DIE__}; + my $role = $self->svc_role($svc_new); - local $@; + + my $error; if ( $role eq 'subscriber' ) { - eval { $self->replace_subscriber($svc_new, $svc_old) }; + + try { $self->replace_subscriber($svc_new, $svc_old) } + catch { $error = $_ }; + } elsif ( $role eq 'did' ) { - eval { $self->replace_did($svc_new, $svc_old) }; + + try { $self->export_did($svc_new, $svc_old) } + catch { $error = $_ }; + } - return "$me $@" if $@; + return "$me $error" if $error; ''; } -sub export_delete { +sub _export_delete { my ($self, $svc_x) = (shift, shift); + local $SIG{__DIE__}; + my $role = $self->svc_role($svc_x); - local $@; + my $error; + if ( $role eq 'subscriber' ) { # no need to remove DIDs from it, just drop the subscriber record - eval { $self->delete_subscriber($svc_x) }; + try { $self->delete_subscriber($svc_x) } + catch { $error = $_ }; } elsif ( $role eq 'did' ) { - return if !$svc_x->forwarddst; - my $subscriber = qsearchs('svc_phone', { phonenum => $svc_x->forwarddst }); - return if !$subscriber; - return if !$self->svc_role($subscriber); - - eval { $self->delete_did($svc_x, $subscriber) }; + try { $self->export_did($svc_x) } + catch { $error = $_ }; } - return "$me $@" if $@; + return "$me $error" if $error; ''; } -# XXX NOT DONE YET -sub export_suspend { +# logic to set subscribers to locked/active is in replace_subscriber + +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 + my $error; + if ( $role eq 'subscriber' ) { + try { $self->replace_subscriber($svc_x, $svc_x) } + catch { $error = $_ }; + } return "$me $error" if $error; ''; } -sub export_unsuspend { +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 + my $error; + if ( $role eq 'subscriber' ) { + $svc_x->set('unsuspended', 1); + try { $self->replace_subscriber($svc_x, $svc_x) } + catch { $error = $_ }; + } return "$me $error" if $error; ''; } @@ -184,6 +195,7 @@ sub find_or_create_customer { my $cust_main = $cust_pkg->cust_main; my $cust_location = $cust_pkg->cust_location; my ($email) = $cust_main->invoicing_list_emailonly; + die "Customer contact email required\n" if !$email; my $custid = 'cust_pkg#' . $cust_pkg->pkgnum; # find the billing profile @@ -194,7 +206,7 @@ sub find_or_create_customer { ] ); if (!$billing_profile) { - croak "can't find billing profile '". $self->option('billing_profile') . "'"; + die "can't find billing profile '". $self->option('billing_profile') . "'\n"; } my $bpid = $billing_profile->{id}; @@ -255,6 +267,50 @@ sub find_or_create_domain { ); } +######## +# DIDS # +######## + +=item acct_for_did SVC_PHONE + +Returns the subscriber svc_acct linked to SVC_PHONE. + +=cut + +sub acct_for_did { + my $self = shift; + my $svc_phone = shift; + my $svcnum = $svc_phone->forward_svcnum or return; + my $svc_acct = FS::svc_acct->by_key($svcnum) or return; + $self->svc_role($svc_acct) eq 'subscriber' or return; + $svc_acct; +} + +=item export_did NEW, OLD + +Refreshes the subscriber information for the service the DID was linked to +previously, and the one it's linked to now. + +=cut + +sub export_did { + my $self = shift; + my ($new, $old) = @_; + + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_did() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + + if ( $old and $new->forward_svcnum ne $old->forward_svcnum ) { + my $old_svc_acct = $self->acct_for_did($old); + $self->replace_subscriber( $old_svc_acct ) if $old_svc_acct; + } + my $new_svc_acct = $self->acct_for_did($new); + $self->replace_subscriber( $new_svc_acct ) if $new_svc_acct; +} + ############### # SUBSCRIBERS # ############### @@ -270,7 +326,7 @@ sub get_subscriber { my $svc = shift; my $svcnum = $svc->svcnum; - my $svcid = "svc_phone#$svcnum"; + my $svcid = "svc#$svcnum"; my $pkgnum = $svc->cust_svc->pkgnum; my $custid = "cust_pkg#$pkgnum"; @@ -291,12 +347,11 @@ sub did_numbers_for_svc { my $self = shift; my $svc = shift; my @numbers; - my @possible_dids = qsearch({ + my @dids = qsearch({ 'table' => 'svc_phone', - 'hashref' => { 'forwarddst' => $svc->phonenum }, - 'order_by' => ' ORDER BY phonenum' + 'hashref' => { 'forward_svcnum' => $svc->svcnum } }); - foreach my $did (@possible_dids) { + foreach my $did (@dids) { # only include them if they're interesting to this export if ( $self->svc_role($did) eq 'did' ) { my $phonenum; @@ -308,7 +363,7 @@ sub did_numbers_for_svc { $phonenum = Number::Phone->new($country, $did->phonenum); } if (!$phonenum) { - croak "Can't process phonenum ".$did->countrycode . $did->phonenum; + die "Can't process phonenum ".$did->countrycode . $did->phonenum . "\n"; } push @numbers, { 'cc' => $phonenum->country_code, @@ -320,30 +375,44 @@ sub did_numbers_for_svc { @numbers; } +sub get_subscriber_profile_set_id { + my $self = shift; + if ( my $setname = $self->option('subscriber_profile_set') ) { + my ($set) = $self->api_query('subscriberprofilesets', + [ name => $setname ] + ); + die "Subscriber profile set '$setname' not found" unless $set; + return $set->{id}; + } + ''; +} + sub insert_subscriber { my $self = shift; my $svc = shift; my $cust = $self->find_or_create_customer($svc); - my $svcid = "svc_phone#" . $svc->svcnum; + my $svcid = "svc#" . $svc->svcnum; my $status = $svc->cust_svc->cust_pkg->susp ? 'locked' : 'active'; + $status = 'active' if $svc->get('unsuspended'); my $domain = $self->find_or_create_domain($svc->domain); my @numbers = $self->did_numbers_for_svc($svc); my $first_number = shift @numbers; + my $profile_set_id = $self->get_subscriber_profile_set_id; my $subscriber = $self->api_create('subscribers', { 'alias_numbers' => \@numbers, 'customer_id' => $cust->{id}, - 'display_name' => $svc->phone_name, + 'display_name' => $svc->finger, 'domain_id' => $domain->{id}, - 'email' => $svc->email, 'external_id' => $svcid, - 'password' => $svc->sip_password, + 'password' => $svc->_password, 'primary_number' => $first_number, + 'profile_set_id' => $profile_set_id, 'status' => $status, - 'username' => $svc->phonenum, + 'username' => $svc->username, } ); } @@ -351,11 +420,12 @@ sub insert_subscriber { sub replace_subscriber { my $self = shift; my $svc = shift; - my $old = shift; - my $svcid = "svc_phone#" . $svc->svcnum; + my $old = shift || $svc->replace_old; + my $svcid = "svc#" . $svc->svcnum; my $cust = $self->find_or_create_customer($svc); my $status = $svc->cust_svc->cust_pkg->susp ? 'locked' : 'active'; + $status = 'active' if $svc->get('unsuspended'); my $domain = $self->find_or_create_domain($svc->domain); my @numbers = $self->did_numbers_for_svc($svc); @@ -365,23 +435,25 @@ sub replace_subscriber { if ( $subscriber ) { my $id = $subscriber->{id}; - if ( $svc->phonenum ne $old->phonenum ) { + if ( $svc->username ne $old->username ) { # have to delete and recreate $self->api_delete("subscribers/$id"); $self->insert_subscriber($svc); } else { + my $profile_set_id = $self->get_subscriber_profile_set_id; $self->api_update("subscribers/$id", { 'alias_numbers' => \@numbers, 'customer_id' => $cust->{id}, - 'display_name' => $svc->phone_name, + 'display_name' => $svc->finger, 'domain_id' => $domain->{id}, 'email' => $svc->email, 'external_id' => $svcid, - 'password' => $svc->sip_password, + 'password' => $svc->_password, 'primary_number' => $first_number, + 'profile_set_id' => $profile_set_id, 'status' => $status, - 'username' => $svc->phonenum, + 'username' => $svc->username, } ); } @@ -394,7 +466,7 @@ sub replace_subscriber { sub delete_subscriber { my $self = shift; my $svc = shift; - my $svcid = "svc_phone#" . $svc->svcnum; + my $svcid = "svc#" . $svc->svcnum; my $pkgnum = $svc->cust_svc->pkgnum; my $custid = "cust_pkg#$pkgnum"; @@ -431,6 +503,124 @@ sub delete_subscriber { } } +################ +# CALL DETAILS # +################ + +=item import_cdrs START, END + +Retrieves CDRs for calls in the date range from START to END and inserts them +as a 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; + $end ||= time; + + 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'); + $end->subtract(seconds => 1); # filter by >= and <= only, so... + + # a little different from the usual: we have to fetch these subscriber by + # subscriber, not all at once. + my @svcs = qsearch({ + 'table' => 'svc_acct', + 'addl_from' => ' JOIN cust_svc USING (svcnum)' . + ' JOIN export_svc USING (svcpart)', + 'extra_sql' => ' WHERE export_svc.role = \'subscriber\''. + ' AND export_svc.exportnum = '.$self->exportnum + }); + my $cdr_batch; + my @args = ( 'start_ge' => $start->iso8601, + 'start_le' => $end->iso8601, + ); + + my $error; + SVC: foreach my $svc (@svcs) { + my $subscriber = $self->get_subscriber($svc); + if (!$subscriber) { + warn "$me user ".$svc->label." is not configured on the SIP server.\n"; + next; + } + my $id = $subscriber->{id}; + my @calls; + try { + # alias_field tells "calllists" which field from the source and + # destination to use as the "own_cli" and "other_cli" of the call. + # "user" = username@domain. + @calls = $self->api_query('calllists', [ + 'subscriber_id' => $id, + 'alias_field' => 'user', + @args + ]); + } catch { + $error = "$me $_ (retrieving records for ".$svc->label.")"; + }; + + if (@calls and !$cdr_batch) { + # create a cdr_batch if needed + my $cdrbatchname = 'sipwise-' . $self->exportnum . '-' . $end->epoch; + $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname }); + $error = $cdr_batch->insert; + } + + last SVC if $error; + + foreach my $c (@calls) { + # avoid double-importing + my $uniqueid = $c->{call_id}; + if ( FS::cdr->row_exists("uniqueid = ?", $uniqueid) ) { + warn "skipped call with uniqueid = '$uniqueid' (already imported)\n" + if $DEBUG; + next; + } + my $src = $c->{own_cli}; + my $dst = $c->{other_cli}; + if ( $c->{direction} eq 'in' ) { # then reverse them + ($src, $dst) = ($dst, $src); + } + # parse duration from H:MM:SS format + my $duration; + if ( $c->{duration} =~ /^(\d+):(\d+):(\d+)$/ ) { + $duration = $3 + (60 * $2) + (3600 * $1); + } else { + $error = "call $uniqueid: unparseable duration '".$c->{duration}."'"; + } + + # use the username@domain label for src and/or dst if possible + my $cdr = FS::cdr->new({ + uniqueid => $uniqueid, + upstream_price => $c->{customer_cost}, + startdate => parse_datetime($c->{start_time}), + disposition => $c->{status}, + duration => $duration, + billsec => $duration, + src => $src, + dst => $dst, + }); + $error ||= $cdr->insert; + last SVC if $error; + } + } # foreach $svc + + if ( $error ) { + dbh->rollback if $oldAutoCommit; + return $error; + } elsif ( $cdr_batch ) { + dbh->commit if $oldAutoCommit; + return $cdr_batch; + } else { # no CDRs + return; + } +} + ############## # API ACCESS # ############## @@ -453,6 +643,8 @@ sub api_query { if ( ref $content eq 'HASH' ) { $content = [ %$content ]; } + my $page = 1; + push @$content, ('rows' => 100, 'page' => 1); # 'page' is always last my $result = $self->api_request('GET', $resource, $content); my @records; # depaginate @@ -463,8 +655,14 @@ sub api_query { push @records, $things; } if ( my $linknext = $result->{_links}{next} ) { - warn "$me continued at $linknext\n" if $DEBUG; - $result = $self->api_request('GET', $linknext); + # unfortunately their HAL isn't entirely functional + # it returns "next" links that contain "page" and "rows" but no other + # parameters. so just count the pages: + $page++; + $content->[-1] = $page; + + warn "$me continued: $page\n" if $DEBUG; + $result = $self->api_request('GET', $resource, $content); } else { last; } @@ -490,7 +688,7 @@ sub api_create { if ( $result->{location} ) { return $self->api_request('GET', $result->{location}); } else { - croak $result->{message}; + die $result->{message} . "\n"; } } @@ -508,7 +706,7 @@ sub api_update { my ($endpoint, $content) = @_; my $result = $self->api_request('PUT', $endpoint, $content); if ( $result->{message} ) { - croak $result->{message}; + die $result->{message} . "\n"; } return; } @@ -529,7 +727,7 @@ sub api_delete { warn "$me api_delete $endpoint: does not exist\n"; return; } elsif ( $result->{message} ) { - croak $result->{message}; + die $result->{message} . "\n"; } return; } @@ -591,7 +789,7 @@ sub api_request { if ( $@ ) { # then it can't be parsed; probably a low-level error of some kind. warn "$me Parse error.\n".$response->content."\n\n"; - croak $response->content; + die "$me Parse error:".$response->content . "\n"; } } if ( $response->header('Location') ) { @@ -612,7 +810,10 @@ sub ua { $self->{_ua} ||= do { my @opt; if ( $self->option('ssl_no_verify') ) { - push @opt, ssl_opts => { verify_hostname => 0 }; + push @opt, ssl_opts => { + verify_hostname => 0, + SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE, + }; } my $ua = LWP::UserAgent->new(@opt); $ua->credentials(