FS/FS/part_export/bandwidth_com.pm

   1 package FS::part_export::bandwidth_com;
   2
   3 use base qw( FS::part_export );
   4 use strict;
   5
   6 use Tie::IxHash;
   7 use LWP::UserAgent;
   8 use URI;
   9 use HTTP::Request::Common;
  10 use Cache::FileCache;
  11 use FS::Record qw(dbh qsearch);
  12 use FS::queue;
  13 use XML::LibXML::Simple qw(XMLin);
  14 use XML::Writer;
  15 use Try::Tiny;
  16
  17 our $me = '[bandwidth.com]';
  18
  19 # cache NPA/NXX records, peer IDs, etc.
  20 our %CACHE; # exportnum => cache
  21 our $cache_timeout = 86400; # seconds
  22
  23 our $API_VERSION = 'v1.0';
  24
  25 tie my %options, 'Tie::IxHash',
  26   'accountId'       => { label => 'Account ID' },
  27   'username'        => { label => 'API username', },
  28   'password'        => { label => 'API password', },
  29   'siteId'          => { label => 'Site ID' },
  30   'num_dids'        => { label => 'Maximum available phone numbers to show',
  31                          default => '20'
  32                        },
  33   'debug'           => { label => 'Debugging',
  34                          type => 'select',
  35                          options => [ 0, 1, 2 ],
  36                          option_labels => {
  37                            0 => 'none',
  38                            1 => 'terse',
  39                            2 => 'verbose',
  40                          }
  41                        },
  42   'test'            => { label => 'Use test server', type => 'checkbox', value => 1 },
  43 ;
  44
  45 our %info = (
  46   'svc'      => [qw( svc_phone )],
  47   'desc'     => 'Provision DIDs to Bandwidth.com',
  48   'options'  => \%options,
  49   'no_machine' => 1,
  50   'notes'    => <<'END'
  51 <P>Export to <b>bandwidth.com</b> interconnected VoIP service.</P>
  52 <P>Bandwidth.com uses a SIP peering architecture. Each phone number is routed
  53 to a specific peer, which comprises one or more IP addresses. The IP address
  54 will be taken from the "sip_server" field of the phone service. If no peer
  55 with this IP address exists, one will be created.</P>
  56 <P>If you are operating a central SIP gateway to receive traffic for all (or
  57 a subset of) customers, you should configure a phone service with a fixed
  58 value, or a list of fixed values, for the sip_server field.</P>
  59 END
  60 );
  61
  62 sub export_insert {
  63   my($self, $svc_phone) = (shift, shift);
  64   local $SIG{__DIE__};
  65   try {
  66     my $account_id = $self->option('accountId');
  67     my $peer = $self->find_peer($svc_phone)
  68       or die "couldn't find SIP peer for ".$svc_phone->sip_server.".\n";
  69     my $phonenum = $svc_phone->phonenum;
  70     # future: reserve numbers before activating?
  71     # and an option to order first available number instead of selecting DID?
  72     my $order = {
  73       Order => {
  74         Name      => "Order svc#".$svc_phone->svcnum." - $phonenum",
  75         SiteId    => $peer->{SiteId},
  76         PeerId    => $peer->{PeerId},
  77         Quantity  => 1,
  78         ExistingTelephoneNumberOrderType => {
  79           TelephoneNumberList => {
  80             TelephoneNumber => $phonenum
  81           }
  82         }
  83       }
  84     };
  85     my $result = $self->api_post("orders", $order);
  86     # future: add a queue job here to poll the order completion status.
  87     '';
  88   } catch {
  89     "$me $_";
  90   };
  91 }
  92
  93 sub export_replace {
  94   my ($self, $new, $old) = @_;
  95   # we only export the IP address and the phone number,
  96   # neither of which we can change in place.
  97   if (   $new->phonenum ne $old->phonenum
  98       or $new->sip_server ne $old->sip_server ) {
  99     return $self->export_delete($old) || $self->export_insert($new);
 100   }
 101   '';
 102 }
 103
 104 sub export_delete {
 105   my ($self, $svc_phone) = (shift, shift);
 106   local $SIG{__DIE__};
 107   try {
 108     my $phonenum = $svc_phone->phonenum;
 109     my $disconnect = {
 110       DisconnectTelephoneNumberOrder => {
 111         Name => "Disconnect svc#".$svc_phone->svcnum." - $phonenum",
 112         DisconnectTelephoneNumberOrderType => {
 113           TelephoneNumberList => [
 114             { TelephoneNumber => $phonenum },
 115           ],
 116         },
 117       }
 118     };
 119     my $result = $self->api_post("disconnects", $disconnect);
 120     # this is also an order, and we could poll its status also
 121     '';
 122   } catch {
 123     "$me $_";
 124   };
 125 }
 126
 127 sub find_peer {
 128   my $self = shift;
 129   my $svc_phone = shift;
 130   my $ip = $svc_phone->sip_server; # future: support svc_pbx for this
 131   die "SIP server address required.\n" if !$ip;
 132
 133   my $peers = $self->peer_cache;
 134   if ( $peers->{hostname}{$ip} ) {
 135     return $peers->{hostname}{$ip};
 136   }
 137   # refresh the cache and try again
 138   $self->cache->remove('peers');
 139   $peers = $self->peer_cache;
 140   return $peers->{hostname}{$ip} || undef;
 141 }
 142
 143 #################
 144 # DID SELECTION #
 145 #################
 146
 147 sub can_get_dids { 1 }
 148
 149 # we don't yet have tollfree support
 150
 151 sub get_dids_npa_select { 1 }
 152
 153 sub get_dids {
 154   local $SIG{__DIE__};
 155
 156   my $self = shift;
 157   my %opt = @_;
 158
 159   my ($exportnum) = $self->exportnum =~ /^(\d+)$/;
 160
 161   return [] if $opt{'tollfree'}; # we'll come back to this
 162
 163   my ($state, $npa, $nxx) = @opt{'state', 'areacode', 'exchange'};
 164
 165   if ( $nxx ) {
 166
 167     die "areacode required\n" unless $npa;
 168     my $limit = $self->option('num_dids') || 20;
 169     my $result = $self->api_get('availableNumbers', [
 170         'npaNxx'    => $npa.$nxx,
 171         'quantity'  => $limit,
 172         'LCA'       => 'false',
 173         # find only those that match the NPA-NXX, not those thought to be in
 174         # the same local calling area. though that might be useful.
 175     ]);
 176     return [ $result->findnodes('//TelephoneNumber')->to_literal_list ];
 177
 178   } elsif ( $npa ) {
 179
 180     return $self->npanxx_cache($npa);
 181
 182   } elsif ( $state ) {
 183
 184     return $self->npa_cache($state);
 185
 186   } else { # something's wrong
 187
 188     warn "get_dids called with no arguments";
 189     return [];
 190
 191   }
 192
 193 }
 194
 195 #########
 196 # CACHE #
 197 #########
 198
 199 =item peer_cache
 200
 201 Returns a hashref of information on peer addresses. Currently has one key,
 202 'hostname', pointing to a hash of (IP address => peer ID).
 203
 204 =cut
 205
 206 sub peer_cache {
 207   my $self = shift;
 208   my $peer_table = $self->cache->get('peers');
 209   if (!$peer_table) {
 210     $peer_table = { hostname => {} };
 211     my $result = $self->api_get('sites');
 212     my @site_ids = $result->findnodes('//Site/Id')->to_literal_list;
 213     foreach my $site_id (@site_ids) {
 214       $result = $self->api_get("sites/$site_id/sippeers");
 215       my @peers = $result->findnodes('//SipPeer');
 216       foreach my $peer (@peers) {
 217         my $peer_id = $peer->findvalue('PeerId');
 218         my @hosts = $peer->findnodes('VoiceHosts/Host/HostName')->to_literal_list;
 219         foreach my $host (@hosts) {
 220           $peer_table->{hostname}->{ $host } = {
 221             PeerId => $peer_id,
 222             SiteId => $site_id,
 223           };
 224         }
 225         # any other peer info we need? I don't think so.
 226       } # foreach $peer
 227     } # foreach $site_id
 228     $self->cache->set('peers', $peer_table, $cache_timeout);
 229   }
 230   $peer_table;
 231 }
 232
 233 =item npanxx_cache NPA
 234
 235 Returns an arrayref of exchange prefixes in the areacode NPA. This will
 236 only work if the available prefixes in that areacode's state have already
 237 been loaded.
 238
 239 =cut
 240
 241 sub npanxx_cache {
 242   my $self = shift;
 243   my $npa = shift;
 244   my $exchanges = $self->cache->get("npanxx_$npa");
 245   if (!$exchanges) {
 246     warn "NPA $npa not yet loaded; returning nothing";
 247     return [];
 248   }
 249   $exchanges;
 250 }
 251
 252 =item npa_cache STATE
 253
 254 Returns an arrayref of area codes in the state. This will refresh the cache
 255 if necessary.
 256
 257 =cut
 258
 259 sub npa_cache {
 260   my $self = shift;
 261   my $state = shift;
 262
 263   my $npas = $self->cache->get("npa_$state");
 264   if (!$npas) {
 265     my $data = {}; # NPA => [ NPANXX, ... ]
 266     my $result = $self->api_get('availableNpaNxx', [ 'state' => $state ]);
 267     foreach my $entry ($result->findnodes('//AvailableNpaNxx')) {
 268       my $npa = $entry->findvalue('Npa');
 269       my $nxx = $entry->findvalue('Nxx');
 270       my $city = $entry->findvalue('City');
 271       push @{ $data->{$npa} ||= [] }, "$city ($npa-$nxx-XXXX)";
 272     }
 273     $npas = [ sort keys %$data ];
 274     $self->cache->set("npa_$state", $npas);
 275     foreach (@$npas) {
 276       # sort by city, then NXX
 277       $data->{$_} = [ sort @{ $data->{$_} } ];
 278       $self->cache->set("npanxx_$_", $data->{$_});
 279     }
 280   }
 281   return $npas;
 282 }
 283
 284 =item cache
 285
 286 Returns the Cache::FileCache object for this export. Each instance of the
 287 export gets a separate cache.
 288
 289 =cut
 290
 291 sub cache {
 292   my $self = shift;
 293
 294   my $exportnum = $self->get('exportnum');
 295   $CACHE{$exportnum} ||= Cache::FileCache->new({
 296     'cache_root' => $FS::UID::cache_dir.'/cache.'.$FS::UID::datasrc,
 297     'namespace'  => __PACKAGE__ . '_' . $exportnum,
 298     'default_expires_in' => $cache_timeout,
 299   });
 300
 301 }
 302
 303 ##############
 304 # API ACCESS #
 305 ##############
 306
 307 sub debug {
 308   shift->option('debug') || 0;
 309 }
 310
 311 sub api_get {
 312   my ($self, $path, $content) = @_;
 313   warn "$me GET $path\n" if $self->debug;
 314   my $url = URI->new( 'https://' .
 315     join('/', $self->host, $API_VERSION, 'accounts', $self->option('accountId'), $path)
 316   );
 317   $url->query_form($content);
 318   my $request = GET($url);
 319   $self->_request($request);
 320 }
 321
 322 sub api_post {
 323   my ($self, $path, $content) = @_;
 324   warn "$me POST $path\n" if $self->debug;
 325   my $url = URI->new( 'https://' .
 326     join('/', $self->host, $API_VERSION, 'accounts', $self->option('accountId'), $path)
 327   );
 328   my $request = POST($url, 'Content-Type' => 'application/xml',
 329                            'Content' => $self->xmlout($content));
 330   $self->_request($request);
 331 }
 332
 333 sub api_put {
 334   my ($self, $path, $content) = @_;
 335   warn "$me PUT $path\n" if $self->debug;
 336   my $url = URI->new( 'https://' .
 337     join('/', $self->host, $API_VERSION, 'accounts', $self->option('accountId'), $path)
 338   );
 339   my $request = PUT ($url, 'Content-Type' => 'application/xml',
 340                            'Content' => $self->xmlout($content));
 341   $self->_request($request);
 342 }
 343
 344 sub api_delete {
 345   my ($self, $path) = @_;
 346   warn "$me DELETE $path\n" if $self->debug;
 347   my $url = URI->new( 'https://' .
 348     join('/', $self->host, $API_VERSION, 'accounts', $self->option('accountId'), $path)
 349   );
 350   my $request = DELETE($url);
 351   $self->_request($request);
 352 }
 353
 354 sub xmlout {
 355   my ($self, $content) = @_;
 356   my $output;
 357   my $writer = XML::Writer->new( OUTPUT => \$output, ENCODING => 'utf-8' );
 358   my @queue = ($content);
 359   while ( @queue ) {
 360     my $obj = shift @queue;
 361     if (ref($obj) eq 'HASH') {
 362       foreach my $k (keys %$obj) {
 363         unshift @queue, "endTag $k";
 364         unshift @queue, $obj->{$k};
 365         unshift @queue, "startTag $k";
 366       }
 367     } elsif ( ref($obj) eq 'ARRAY' ) {
 368       unshift @queue, @$obj;
 369     } elsif ( $obj =~ /^startTag (.*)$/ ) {
 370       $writer->startTag($1);
 371     } elsif ( $obj =~ /^endTag (.*)$/ ) {
 372       $writer->endTag($1);
 373     } elsif ( defined($obj) ) {
 374       $writer->characters($obj);
 375     }
 376   }
 377   return $output;
 378 }
 379
 380 sub xmlin {
 381   # wrapper for XML::LibXML::Simple's XMLin, with auto-flattening of NodeLists
 382   my $self = shift;
 383   my @out;
 384   foreach my $node (@_) {
 385     if ($node->can('get_nodelist')) {
 386       push @out, map { XMLin($_, KeepRoot => 1) } $node->get_nodelist;
 387     } else {
 388       push @out, XMLin($node);
 389     }
 390   }
 391   @out;
 392 }
 393
 394 sub _request { # even lower level
 395   my ($self, $request) = @_;
 396   warn $request->as_string . "\n" if $self->debug > 1;
 397   my $response = $self->ua->request( $request );
 398   warn "$me received\n" . $response->as_string . "\n" if $self->debug > 1;
 399
 400   if ($response->content) {
 401
 402     my $xmldoc = XML::LibXML->load_xml(string => $response->content);
 403     # errors are found in at least two places: ResponseStatus/ErrorCode
 404     my $error;
 405     my ($ec) = $xmldoc->findnodes('//ErrorCode');
 406     if ($ec) {
 407       $error = $ec->parentNode->findvalue('Description');
 408     }
 409     # and ErrorList/Error
 410     $error ||= join("; ", $xmldoc->findnodes('//Error/Description')->to_literal_list);
 411     die "$error\n" if $error;
 412     return $xmldoc;
 413
 414   } elsif ($response->code eq '201') { # Created, response to a POST
 415
 416     return $response->header('Location');
 417
 418   } else {
 419
 420     die $response->status_line."\n";
 421
 422   }
 423 }
 424
 425 sub host {
 426   my $self = shift;
 427   $self->{_host} ||= do {
 428     my $host = 'dashboard.bandwidth.com';
 429     $host = "test.$host" if $self->option('test');
 430     $host;
 431   };
 432 }
 433
 434 sub ua {
 435   my $self = shift;
 436   $self->{_ua} ||= do {
 437     my $ua = LWP::UserAgent->new;
 438     $ua->credentials(
 439       $self->host . ':443',
 440       'Bandwidth API',
 441       $self->option('username'),
 442       $self->option('password')
 443     );
 444     $ua;
 445   }
 446 }
 447
 448
 449 1;