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
 155   my $self = shift;
 156   my %opt = @_;
 157
 158   my ($exportnum) = $self->exportnum =~ /^(\d+)$/;
 159
 160   try {
 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   } catch {
 193     die "$me $_\n";
 194   }
 195
 196 }
 197
 198 #########
 199 # CACHE #
 200 #########
 201
 202 =item peer_cache
 203
 204 Returns a hashref of information on peer addresses. Currently has one key,
 205 'hostname', pointing to a hash of (IP address => peer ID).
 206
 207 =cut
 208
 209 sub peer_cache {
 210   my $self = shift;
 211   my $peer_table = $self->cache->get('peers');
 212   if (!$peer_table) {
 213     $peer_table = { hostname => {} };
 214     my $result = $self->api_get('sites');
 215     my @site_ids = $result->findnodes('//Site/Id')->to_literal_list;
 216     foreach my $site_id (@site_ids) {
 217       $result = $self->api_get("sites/$site_id/sippeers");
 218       my @peers = $result->findnodes('//SipPeer');
 219       foreach my $peer (@peers) {
 220         my $peer_id = $peer->findvalue('PeerId');
 221         my @hosts = $peer->findnodes('VoiceHosts/Host/HostName')->to_literal_list;
 222         foreach my $host (@hosts) {
 223           $peer_table->{hostname}->{ $host } = {
 224             PeerId => $peer_id,
 225             SiteId => $site_id,
 226           };
 227         }
 228         # any other peer info we need? I don't think so.
 229       } # foreach $peer
 230     } # foreach $site_id
 231     $self->cache->set('peers', $peer_table, $cache_timeout);
 232   }
 233   $peer_table;
 234 }
 235
 236 =item npanxx_cache NPA
 237
 238 Returns an arrayref of exchange prefixes in the areacode NPA. This will
 239 only work if the available prefixes in that areacode's state have already
 240 been loaded.
 241
 242 =cut
 243
 244 sub npanxx_cache {
 245   my $self = shift;
 246   my $npa = shift;
 247   my $exchanges = $self->cache->get("npanxx_$npa");
 248   if (!$exchanges) {
 249     warn "NPA $npa not yet loaded; returning nothing";
 250     return [];
 251   }
 252   $exchanges;
 253 }
 254
 255 =item npa_cache STATE
 256
 257 Returns an arrayref of area codes in the state. This will refresh the cache
 258 if necessary.
 259
 260 =cut
 261
 262 sub npa_cache {
 263   my $self = shift;
 264   my $state = shift;
 265
 266   my $npas = $self->cache->get("npa_$state");
 267   if (!$npas) {
 268     my $data = {}; # NPA => [ NPANXX, ... ]
 269     my $result = $self->api_get('availableNpaNxx', [ 'state' => $state ]);
 270     foreach my $entry ($result->findnodes('//AvailableNpaNxx')) {
 271       my $npa = $entry->findvalue('Npa');
 272       my $nxx = $entry->findvalue('Nxx');
 273       my $city = $entry->findvalue('City');
 274       push @{ $data->{$npa} ||= [] }, "$city ($npa-$nxx-XXXX)";
 275     }
 276     $npas = [ sort keys %$data ];
 277     $self->cache->set("npa_$state", $npas);
 278     foreach (@$npas) {
 279       # sort by city, then NXX
 280       $data->{$_} = [ sort @{ $data->{$_} } ];
 281       $self->cache->set("npanxx_$_", $data->{$_});
 282     }
 283   }
 284   return $npas;
 285 }
 286
 287 =item cache
 288
 289 Returns the Cache::FileCache object for this export. Each instance of the
 290 export gets a separate cache.
 291
 292 =cut
 293
 294 sub cache {
 295   my $self = shift;
 296
 297   my $exportnum = $self->get('exportnum');
 298   $CACHE{$exportnum} ||= Cache::FileCache->new({
 299     'cache_root' => $FS::UID::cache_dir.'/cache.'.$FS::UID::datasrc,
 300     'namespace'  => __PACKAGE__ . '_' . $exportnum,
 301     'default_expires_in' => $cache_timeout,
 302   });
 303
 304 }
 305
 306 ##############
 307 # API ACCESS #
 308 ##############
 309
 310 sub debug {
 311   shift->option('debug') || 0;
 312 }
 313
 314 sub api_get {
 315   my ($self, $path, $content) = @_;
 316   warn "$me GET $path\n" if $self->debug;
 317   my $url = URI->new( 'https://' .
 318     join('/', $self->host, $API_VERSION, 'accounts', $self->option('accountId'), $path)
 319   );
 320   $url->query_form($content);
 321   my $request = GET($url);
 322   $self->_request($request);
 323 }
 324
 325 sub api_post {
 326   my ($self, $path, $content) = @_;
 327   warn "$me POST $path\n" if $self->debug;
 328   my $url = URI->new( 'https://' .
 329     join('/', $self->host, $API_VERSION, 'accounts', $self->option('accountId'), $path)
 330   );
 331   my $request = POST($url, 'Content-Type' => 'application/xml',
 332                            'Content' => $self->xmlout($content));
 333   $self->_request($request);
 334 }
 335
 336 sub api_put {
 337   my ($self, $path, $content) = @_;
 338   warn "$me PUT $path\n" if $self->debug;
 339   my $url = URI->new( 'https://' .
 340     join('/', $self->host, $API_VERSION, 'accounts', $self->option('accountId'), $path)
 341   );
 342   my $request = PUT ($url, 'Content-Type' => 'application/xml',
 343                            'Content' => $self->xmlout($content));
 344   $self->_request($request);
 345 }
 346
 347 sub api_delete {
 348   my ($self, $path) = @_;
 349   warn "$me DELETE $path\n" if $self->debug;
 350   my $url = URI->new( 'https://' .
 351     join('/', $self->host, $API_VERSION, 'accounts', $self->option('accountId'), $path)
 352   );
 353   my $request = DELETE($url);
 354   $self->_request($request);
 355 }
 356
 357 sub xmlout {
 358   my ($self, $content) = @_;
 359   my $output;
 360   my $writer = XML::Writer->new( OUTPUT => \$output, ENCODING => 'utf-8' );
 361   my @queue = ($content);
 362   while ( @queue ) {
 363     my $obj = shift @queue;
 364     if (ref($obj) eq 'HASH') {
 365       foreach my $k (keys %$obj) {
 366         unshift @queue, "endTag $k";
 367         unshift @queue, $obj->{$k};
 368         unshift @queue, "startTag $k";
 369       }
 370     } elsif ( ref($obj) eq 'ARRAY' ) {
 371       unshift @queue, @$obj;
 372     } elsif ( $obj =~ /^startTag (.*)$/ ) {
 373       $writer->startTag($1);
 374     } elsif ( $obj =~ /^endTag (.*)$/ ) {
 375       $writer->endTag($1);
 376     } elsif ( defined($obj) ) {
 377       $writer->characters($obj);
 378     }
 379   }
 380   return $output;
 381 }
 382
 383 sub xmlin {
 384   # wrapper for XML::LibXML::Simple's XMLin, with auto-flattening of NodeLists
 385   my $self = shift;
 386   my @out;
 387   foreach my $node (@_) {
 388     if ($node->can('get_nodelist')) {
 389       push @out, map { XMLin($_, KeepRoot => 1) } $node->get_nodelist;
 390     } else {
 391       push @out, XMLin($node);
 392     }
 393   }
 394   @out;
 395 }
 396
 397 sub _request { # even lower level
 398   my ($self, $request) = @_;
 399   warn $request->as_string . "\n" if $self->debug > 1;
 400   my $response = $self->ua->request( $request );
 401   warn "$me received\n" . $response->as_string . "\n" if $self->debug > 1;
 402
 403   if ($response->content) {
 404
 405     my $xmldoc = XML::LibXML->load_xml(string => $response->content);
 406     # errors are found in at least two places: ResponseStatus/ErrorCode
 407     my $error;
 408     my ($ec) = $xmldoc->findnodes('//ErrorCode');
 409     if ($ec) {
 410       $error = $ec->parentNode->findvalue('Description');
 411     }
 412     # and ErrorList/Error
 413     $error ||= join("; ", $xmldoc->findnodes('//Error/Description')->to_literal_list);
 414     die "$error\n" if $error;
 415     return $xmldoc;
 416
 417   } elsif ($response->code eq '201') { # Created, response to a POST
 418
 419     return $response->header('Location');
 420
 421   } else {
 422
 423     die $response->status_line."\n";
 424
 425   }
 426 }
 427
 428 sub host {
 429   my $self = shift;
 430   $self->{_host} ||= do {
 431     my $host = 'dashboard.bandwidth.com';
 432     $host = "test.$host" if $self->option('test');
 433     $host;
 434   };
 435 }
 436
 437 sub ua {
 438   my $self = shift;
 439   $self->{_ua} ||= do {
 440     my $ua = LWP::UserAgent->new;
 441     $ua->credentials(
 442       $self->host . ':443',
 443       'Bandwidth API',
 444       $self->option('username'),
 445       $self->option('password')
 446     );
 447     $ua;
 448   }
 449 }
 450
 451
 452 1;