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