FS/FS/part_export/voipnow_did.pm

   1 package FS::part_export::voipnow_did;
   2
   3 use vars qw(@ISA %info $DEBUG $CACHE);
   4 use Tie::IxHash;
   5 use FS::Record qw(qsearch qsearchs dbh);
   6 use FS::part_export;
   7 use FS::areacode;
   8 use XML::Simple 'XMLin';
   9 use Net::SSLeay 'post_https';
  10 use Cache::FileCache;
  11
  12 use strict;
  13
  14 $DEBUG = 0; # 1 = trace operations, 2 = dump XML
  15 @ISA = qw(FS::part_export);
  16
  17 tie my %options, 'Tie::IxHash',
  18   'login'         => { label=>'VoipNow client login' },
  19   'password'      => { label=>'VoipNow client password' },
  20   'country'       => { label=>'Country (two-letter code)' },
  21   'cache_time'    => { label=>'Cache lifetime (seconds)' },
  22 ;
  23
  24 %info = (
  25   'svc'     => 'svc_phone',
  26   'desc'    => 'Provision phone numbers to 4PSA VoipNow softswitch',
  27   'options' => \%options,
  28   'notes'   => <<'END'
  29 Requires installation of
  30 <a href="http://search.cpan.org/dist/XML-Writer">XML::Writer</a>
  31 from CPAN.
  32 END
  33 );
  34
  35 sub rebless { shift; }
  36
  37 sub did_cache {
  38   my $self = shift;
  39   $CACHE ||= new Cache::FileCache( {
  40       'namespace' => __PACKAGE__,
  41       'default_expires_in' => $self->option('cache_time') || 300,
  42       'cache_root' => $FS::UID::cache_dir.'/cache'.$FS::UID::datasrc,
  43     } );
  44   return $CACHE->get($self->exportnum) || $self->reload_cache;
  45 }
  46
  47 sub can_get_dids { 1; }
  48
  49 sub get_dids {
  50   my $self = shift;
  51   my %opt = @_;
  52
  53   return [] if $opt{'tollfree'}; # currently not supported
  54
  55   my %search = ( 'exportnum' => $self->exportnum );
  56
  57   my $dids = $self->did_cache;
  58
  59   my ($state, $npa, $nxx) = @opt{'state', 'areacode', 'exchange'};
  60   $state ||= (FS::areacode->locate($npa))[1];
  61
  62   if ($nxx) {
  63     return [ sort keys %{ $dids->{$state}->{$npa}->{"$npa-$nxx"} } ];
  64   }
  65   elsif ($npa) {
  66     return [ sort map { "($_-XXXX)" } keys %{ $dids->{$state}->{$npa} } ];
  67   }
  68   elsif ($state) {
  69     return [ sort keys %{ $dids->{$state} } ];
  70   }
  71   else {
  72     return []; # nothing really to do without state
  73   }
  74 }
  75
  76 sub reload_cache {
  77   my $self = shift;
  78   warn "updating DID cache\n" if $DEBUG;
  79
  80   my ($response, $error) =
  81     $self->voipnow_command('channel', 'GetPublicNoPoll',
  82       { 'userID' => $self->userID }
  83   );
  84
  85   warn "error updating DID cache: $error\n" if $error;
  86
  87   my $dids = {};
  88
  89   my $avail = $response->{'publicNo'}{'available'}
  90     or return []; # no available numbers
  91   foreach ( ref($avail) eq 'ARRAY' ? @{ $avail } : $avail ) {
  92     my $did = $_->{'externalNo'};
  93     $did =~ /^(\d{3})(\d{3})(\d{4})/ or die "unparseable did $did\n";
  94     my $state = (FS::areacode->locate($1))[1];
  95     $dids->{$state}->{$1}->{"$1-$2"}->{"$1-$2-$3"} = $_->{'ID'};
  96   }
  97
  98   $CACHE->set($self->exportnum, $dids);
  99   return $dids;
 100 }
 101
 102 sub _export_insert {
 103   my( $self, $svc_phone ) = (shift, shift);
 104
 105   # find remote DID name
 106   my $phonenum = $svc_phone->phonenum;
 107   $phonenum =~ /^(\d{3})(\d{3})(\d{4})/
 108     or die "unparseable phone number: $phonenum";
 109
 110   warn "checking DID $1-$2-$3\n" if $DEBUG;
 111   my $state = (FS::areacode->locate($1))[1];
 112
 113   my $dids = $self->did_cache;
 114   my $assign_did = $dids->{$state}->{$1}->{"$1-$2"}->{"$1-$2-$3"};
 115   if ( !defined($assign_did) ) {
 116     $self->reload_cache; # since it's clearly out of date
 117     return "phone number $phonenum not available";
 118   }
 119
 120   # need to check existence of parent objects?
 121   my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
 122   my $cust_main = $cust_pkg->cust_main;
 123
 124   # this is subject to change
 125   my %add_extension = (
 126     namespace('client_data',
 127       name      => $svc_phone->phone_name || $cust_main->contact_firstlast,
 128       company   => $cust_main->company,
 129 # to avoid collision with phone numbers, etc.--would be better to store the
 130 # remote identifier somewhere
 131       login     => 'S'.$svc_phone->svcnum,
 132       password  => $svc_phone->sip_password,
 133       phone     => $cust_main->phone,
 134       fax       => $cust_main->fax,
 135       addresss  => $cust_main->address1,
 136       city      => $cust_main->city,
 137       pcode     => $cust_main->zip,
 138       country   => $cust_main->country,
 139     ),
 140     parentID  => $self->userID,
 141     #region--this is a problem
 142     # Other options named in the documentation:
 143     #
 144     # passwordAuto passwordStrength forceUpdate
 145     # timezone interfaceLang notes serverID chargingIdentifier
 146     # phoneLang channelRuleId templateID extensionNo extensionType
 147     # parentIdentifier parentLogin fromUser fromUserIdentifier
 148     # chargingPlanID chargingPlanIdentifier verbose notifyOnly
 149     # scope dku accountFlag
 150   );
 151   my ($response, $error) =
 152     $self->voipnow_command('extension', 'AddExtension', \%add_extension);
 153   return "[AddExtension] $error" if $error;
 154
 155   my $eid = $response->{'ID'};
 156   warn "Extension created with id=$eid\n" if $DEBUG;
 157
 158   ($response, $error) =
 159     $self->voipnow_command('channel', 'AssignPublicNo',
 160       { didID => $assign_did, userID => $eid }
 161   );
 162   return "[AssignPublicNo] $error" if $error;
 163   '';
 164 }
 165
 166 sub _export_replace {
 167   my( $self, $new, $old ) = (shift, shift, shift);
 168
 169   # this could be implemented later
 170   '';
 171 }
 172
 173 sub _export_delete {
 174   my( $self, $svc_phone ) = (shift, shift);
 175
 176   my $eid = $self->extensionID($svc_phone);
 177   my ($response, $error) =
 178     $self->voipnow_command('extension', 'DelExtension', { ID => $eid });
 179   return "[DelExtension] $error" if $error;
 180   # don't need to de-assign the DID separately.
 181
 182   '';
 183 }
 184
 185 sub _export_suspend {
 186   my( $self, $svc_phone ) = (shift, shift);
 187   #nop for now
 188   '';
 189 }
 190
 191 sub _export_unsuspend {
 192   my( $self, $svc_phone ) = (shift, shift);
 193   #nop for now
 194   '';
 195 }
 196
 197 sub userID {
 198   my $self = shift;
 199   return $self->{'userID'} if $self->{'userID'};
 200
 201   my ($response, $error) = $self->voipnow_command('client', 'GetClients', {});
 202   # GetClients run on a client's login returns only that client.
 203   die "couldn't get userID: $error" if $error;
 204   die "non-Client login specified: ".$self->option('login') if
 205     ref($response->{'client'}) ne 'HASH'
 206       or $response->{'client'}->{'login'} ne $self->option('login');
 207   return $self->{'userID'} = $response->{'client'}->{'ID'};
 208 }
 209
 210 sub extensionID {
 211   # technically this returns the "extension user ID" rather than
 212   # "extension ID".
 213   my $self = shift;
 214   my $svc_phone = shift;
 215
 216   my $login = 'S'.$svc_phone->svcnum;
 217   my ($response, $error) =
 218     $self->voipnow_command('extension', 'GetExtensions',
 219       { 'filter'    => $login,
 220         'parentID'  => $self->userID }
 221   );
 222   die "couldn't get extensionID for $login: $error" if $error;
 223   my $extension = '';
 224
 225   if ( ref($response->{'extension'}) eq 'HASH' ) {
 226     $extension = $response->{'extension'};
 227   }
 228   elsif ( ref($response->{'extension'}) eq 'ARRAY' ) {
 229     ($extension) = grep { $_->{'login'} eq $login }
 230       @{ $response->{'extension'} };
 231   }
 232
 233   die "extension $login not found" if !$extension;
 234
 235   warn "[extensionID] found ID ".$response->{'extension'}->{'ID'}."\n"
 236     if $DEBUG;
 237   return $response->{'extension'}->{'ID'};
 238 }
 239
 240 my $API_VERSION = '2.5.1';
 241 my %namespaces = (
 242   'envelope'    => 'http://schemas.xmlsoap.org/soap/envelope/',
 243   'header'      => 'http://4psa.com/HeaderData.xsd/'.$API_VERSION,
 244   'channel'     => 'http://4psa.com/ChannelMessages.xsd/'.$API_VERSION,
 245   'extension'   => 'http://4psa.com/ExtensionMessages.xsd/'.$API_VERSION,
 246   'client'      => 'http://4psa.com/ClientMessages.xsd/'.$API_VERSION,
 247   'client_data' => 'http://4psa.com/ClientData.xsd/'.$API_VERSION,
 248 );
 249
 250 # Infrastructure
 251 # example:
 252 # ($result, $error) =
 253 #   $self->voipnow_command('endpoint', 'MethodFoo', { argument => 'value' });
 254 # The third argument will be enclosed in a MethodFooRequest and serialized.
 255 # $result is everything inside the MethodFooResponse element, as a tree.
 256
 257 sub voipnow_command {
 258   my $self = shift;
 259   my $endpoint = shift; # 'channel' or 'extension'
 260   my $method = shift;
 261   my $data = shift;
 262   my $host = $self->machine;
 263   my $path = "/soap2/${endpoint}_agent.php";
 264
 265   eval "use XML::Writer";
 266   die $@ if $@;
 267
 268   warn "[$method] constructing request\n" if $DEBUG;
 269   my $soap_request;
 270   my $writer = XML::Writer->new(
 271     OUTPUT => \$soap_request,
 272     NAMESPACES => 1,
 273     PREFIX_MAP => { reverse %namespaces },
 274     FORCED_NS_DECLS => [ values %namespaces ],
 275     ENCODING => 'utf-8',
 276   );
 277
 278   my $header = {
 279     '#NS' => 'header',
 280     'userCredentials' => {
 281       'username' => $self->option('login'),
 282       'password' => $self->option('password'),
 283     }
 284   };
 285   my $body = {
 286     '#NS' => $endpoint,
 287     $method.'Request' => $data,
 288   };
 289
 290   # build the request
 291   descend( $writer,
 292     { Envelope => { Header => $header, Body => $body } },
 293     'envelope' #start in this namespace
 294   );
 295
 296   warn "SENDING:\n$soap_request\n" if $DEBUG > 1;
 297   my ($soap_response, $status) =
 298     post_https($host, 443, $path, '', $soap_request);
 299   warn "STATUS: $status\nRECEIVED:\n$soap_response\n" if $DEBUG > 1;
 300   if ( !length($soap_response) ) {
 301     return undef, "No response ($status)";
 302   }
 303
 304   my $response = eval { strip_ns(XMLin($soap_response)) };
 305   # handle various errors
 306   if ( $@ ) {
 307     return undef, "Parse error: $@";
 308   }
 309   if ( !exists $response->{'Body'} ) {
 310     return undef, "Bad response (missing Body section)";
 311   }
 312   $body = $response->{'Body'};
 313   if ( exists $body->{'Fault'} ) {
 314     return undef, $body->{'Fault'}->{'faultstring'};
 315   }
 316   if ( !exists $body->{"${method}Response"} ) {
 317     return undef, "Bad response (missing ${method}Response section)";
 318   }
 319
 320   return $body->{"${method}Response"};
 321 }
 322
 323 # Infra-infrastructure
 324
 325 sub descend { # like XML::Simple, but more so
 326   my $writer = shift;
 327   my $tree = shift;
 328   my $branch_ns = delete($tree->{'#NS'}) || shift;
 329   while (my ($key, $val) = each %$tree) {
 330     my ($name, $key_ns) = reverse split(':', $key);
 331     $key_ns ||= $branch_ns;
 332     $name = [ $namespaces{$key_ns}, $name ];
 333     if ( ref($val) eq 'HASH' ) {
 334       $writer->startTag($name);
 335       descend($writer, $val, $key_ns);
 336       $writer->endTag;
 337     }
 338     elsif ( defined($val) ) {
 339       $writer->dataElement($name, $val);
 340     }
 341     else { #undef
 342       $writer->emptyTag($name);
 343     }
 344   }
 345 }
 346
 347 sub namespace {
 348   my $ns = shift;
 349   my %data = @_;
 350   map { $ns.':'.$_ , $data{$_} } keys(%data);
 351 }
 352
 353 sub strip_ns { # remove the namespace tags so that we can find stuff
 354   my $tree = shift;
 355   if ( ref $tree eq 'HASH' ) {
 356     return +{
 357       map {
 358         my $name = $_;
 359         $name =~ s/^.*://;
 360         $name => strip_ns($tree->{$_});
 361       } keys %$tree
 362     }
 363   }
 364   elsif ( ref $tree eq 'ARRAY' ) {
 365     return [
 366       map { strip_ns($_) } @$tree
 367     ]
 368   }
 369   else {
 370     return $tree;
 371   }
 372 }
 373
 374 1;
 375