FS/FS/part_export/sipwise.pm

   1 package FS::part_export::sipwise;
   2
   3 use base qw( FS::part_export );
   4 use strict;
   5
   6 use FS::Record qw(qsearch qsearchs dbh);
   7 use Tie::IxHash;
   8 use LWP::UserAgent;
   9 use URI;
  10 use Cpanel::JSON::XS;
  11 use HTTP::Request::Common qw(GET POST PUT DELETE);
  12 use FS::Misc::DateTime qw(parse_datetime);
  13 use DateTime;
  14 use Number::Phone;
  15 use Try::Tiny;
  16
  17 our $me = '[sipwise]';
  18 our $DEBUG = 0;
  19
  20 tie my %options, 'Tie::IxHash',
  21   'port'            => { label => 'Port' },
  22   'username'        => { label => 'API username', },
  23   'password'        => { label => 'API password', },
  24   'debug'           => { label => 'Enable debugging', type => 'checkbox', value => 1 },
  25   'billing_profile' => {
  26     label             => 'Billing profile handle',
  27     default           => 'default',
  28   },
  29   'subscriber_profile_set' => {
  30     label             => 'Subscriber profile set name (optional)',
  31   },
  32   'reseller_id'     => { label => 'Reseller ID' },
  33   'ssl_no_verify'   => { label => 'Skip SSL certificate validation',
  34                          type  => 'checkbox',
  35                        },
  36 ;
  37
  38 tie my %roles, 'Tie::IxHash',
  39   'subscriber'    => {  label     => 'Subscriber',
  40                         svcdb     => 'svc_acct',
  41                         multiple  => 1,
  42                      },
  43   'did'           => {  label     => 'DID',
  44                         svcdb     => 'svc_phone',
  45                         multiple  => 1,
  46                      },
  47 ;
  48
  49 our %info = (
  50   'svc'      => [qw( svc_acct svc_phone )],
  51   'desc'     => 'Provision to a Sipwise sip:provider server',
  52   'options'  => \%options,
  53   'roles'    => \%roles,
  54   'notes'    => <<'END'
  55 <P>Export to a <b>sip:provider</b> server.</P>
  56 <P>This requires two service definitions to be configured on the same package:
  57   <OL>
  58     <LI>An account service for a SIP client account ("subscriber"). The
  59     <i>username</i> will be the SIP username. The <i>domsvc</i> should point
  60     to a domain service to use as the SIP domain name.</LI>
  61     <LI>A phone service for a DID. The <i>phonenum</i> here will be a PSTN
  62     number. The <i>forward_svcnum</i> field should be set to the account that
  63     will receive calls at this number.
  64   </OL>
  65 </P>
  66 END
  67 );
  68
  69 sub export_insert {
  70   my($self, $svc_x) = (shift, shift);
  71
  72   local $SIG{__DIE__};
  73   my $error;
  74   my $role = $self->svc_role($svc_x);
  75   if ( $role eq 'subscriber' ) {
  76
  77     try { $self->insert_subscriber($svc_x) }
  78     catch { $error = $_ };
  79
  80   } elsif ( $role eq 'did' ) {
  81
  82     try { $self->export_did($svc_x) }
  83     catch { $error = $_ };
  84
  85   }
  86   return "$me $error" if $error;
  87   '';
  88 }
  89
  90 sub export_replace {
  91   my ($self, $svc_new, $svc_old) = @_;
  92   local $SIG{__DIE__};
  93
  94   my $role = $self->svc_role($svc_new);
  95
  96   my $error;
  97   if ( $role eq 'subscriber' ) {
  98
  99     try { $self->replace_subscriber($svc_new, $svc_old) }
 100     catch { $error = $_ };
 101
 102   } elsif ( $role eq 'did' ) {
 103
 104     try { $self->export_did($svc_new, $svc_old) }
 105     catch { $error = $_ };
 106
 107   }
 108   return "$me $error" if $error;
 109   '';
 110 }
 111
 112 sub export_delete {
 113   my ($self, $svc_x) = (shift, shift);
 114   local $SIG{__DIE__};
 115
 116   my $role = $self->svc_role($svc_x);
 117   my $error;
 118
 119   if ( $role eq 'subscriber' ) {
 120
 121     # no need to remove DIDs from it, just drop the subscriber record
 122     try { $self->delete_subscriber($svc_x) }
 123     catch { $error = $_ };
 124
 125   } elsif ( $role eq 'did' ) {
 126
 127     try { $self->export_did($svc_x) }
 128     catch { $error = $_ };
 129
 130   }
 131   return "$me $error" if $error;
 132   '';
 133 }
 134
 135 # logic to set subscribers to locked/active is in replace_subscriber
 136
 137 sub export_suspend {
 138   my $self = shift;
 139   my $svc_x = shift;
 140   my $role = $self->svc_role($svc_x);
 141   my $error;
 142   if ( $role eq 'subscriber' ) {
 143     try { $self->replace_subscriber($svc_x, $svc_x) }
 144     catch { $error = $_ };
 145   }
 146   return "$me $error" if $error;
 147   '';
 148 }
 149
 150 sub export_unsuspend {
 151   my $self = shift;
 152   my $svc_x = shift;
 153   my $role = $self->svc_role($svc_x);
 154   my $error;
 155   if ( $role eq 'subscriber' ) {
 156     $svc_x->set('unsuspended', 1);
 157     try { $self->replace_subscriber($svc_x, $svc_x) }
 158     catch { $error = $_ };
 159   }
 160   return "$me $error" if $error;
 161   '';
 162 }
 163
 164 #############
 165 # CUSTOMERS #
 166 #############
 167
 168 =item get_customer SERVICE
 169
 170 Returns the Sipwise customer record that should belong to SERVICE. This is
 171 based on the pkgnum field.
 172
 173 =cut
 174
 175 sub get_customer {
 176   my $self = shift;
 177   my $svc = shift;
 178   my $pkgnum = $svc->cust_svc->pkgnum;
 179   my $custid = "cust_pkg#$pkgnum";
 180
 181   my @cust = $self->api_query('customers', [ external_id => $custid ]);
 182   warn "$me multiple customers for external_id $custid.\n" if scalar(@cust) > 1;
 183   $cust[0];
 184 }
 185
 186 sub find_or_create_customer {
 187   my $self = shift;
 188   my $svc = shift;
 189   my $cust = $self->get_customer($svc);
 190   return $cust if $cust;
 191
 192   my $cust_pkg = $svc->cust_svc->cust_pkg;
 193   my $cust_main = $cust_pkg->cust_main;
 194   my $cust_location = $cust_pkg->cust_location;
 195   my ($email) = $cust_main->invoicing_list_emailonly;
 196   die "Customer contact email required\n" if !$email;
 197   my $custid = 'cust_pkg#' . $cust_pkg->pkgnum;
 198
 199   # find the billing profile
 200   my ($billing_profile) = $self->api_query('billingprofiles',
 201     [
 202       'handle'        => $self->option('billing_profile'),
 203       'reseller_id'   => $self->option('reseller_id'),
 204     ]
 205   );
 206   if (!$billing_profile) {
 207     die "can't find billing profile '". $self->option('billing_profile') . "'\n";
 208   }
 209   my $bpid = $billing_profile->{id};
 210
 211   # contacts unfortunately have no searchable external_id or other field
 212   # like that, so we can't go location -> package -> service
 213   my $contact = $self->api_create('customercontacts',
 214     {
 215       'city'          => $cust_location->city,
 216       'company'       => $cust_main->company,
 217       'country'       => $cust_location->country,
 218       'email'         => $email,
 219       'faxnumber'     => $cust_main->fax,
 220       'firstname'     => $cust_main->first,
 221       'lastname'      => $cust_main->last,
 222       'mobilenumber'  => $cust_main->mobile,
 223       'phonenumber'   => ($cust_main->daytime || $cust_main->night),
 224       'postcode'      => $cust_location->zip,
 225       'reseller_id'   => $self->option('reseller_id'),
 226       'street'        => $cust_location->address1,
 227     }
 228   );
 229
 230   $cust = $self->api_create('customers',
 231     {
 232       'status'      => 'active',
 233       'type'        => 'sipaccount',
 234       'contact_id'  => $contact->{id},
 235       'external_id' => $custid,
 236       'billing_profile_id' => $bpid,
 237     }
 238   );
 239
 240   $cust;
 241 }
 242
 243 ###########
 244 # DOMAINS #
 245 ###########
 246
 247 =item find_or_create_domain DOMAIN
 248
 249 Returns the record for the domain object named DOMAIN. If necessary, will
 250 create it first.
 251
 252 =cut
 253
 254 sub find_or_create_domain {
 255   my $self = shift;
 256   my $domainname = shift;
 257   my ($domain) = $self->api_query('domains', [ 'domain' => $domainname ]);
 258   return $domain if $domain;
 259
 260   $self->api_create('domains',
 261     {
 262       'domain'        => $domainname,
 263       'reseller_id'   => $self->option('reseller_id'),
 264     }
 265   );
 266 }
 267
 268 ########
 269 # DIDS #
 270 ########
 271
 272 =item acct_for_did SVC_PHONE
 273
 274 Returns the subscriber svc_acct linked to SVC_PHONE.
 275
 276 =cut
 277
 278 sub acct_for_did {
 279   my $self = shift;
 280   my $svc_phone = shift;
 281   my $svcnum = $svc_phone->forward_svcnum or return;
 282   my $svc_acct = FS::svc_acct->by_key($svcnum) or return;
 283   $self->svc_role($svc_acct) eq 'subscriber' or return;
 284   $svc_acct;
 285 }
 286
 287 =item export_did NEW, OLD
 288
 289 Refreshes the subscriber information for the service the DID was linked to
 290 previously, and the one it's linked to now.
 291
 292 =cut
 293
 294 sub export_did {
 295   my $self = shift;
 296   my ($new, $old) = @_;
 297   if ( $old and $new->forward_svcnum ne $old->forward_svcnum ) {
 298     my $old_svc_acct = $self->acct_for_did($old);
 299     $self->replace_subscriber( $old_svc_acct ) if $old_svc_acct;
 300   }
 301   my $new_svc_acct = $self->acct_for_did($new);
 302   $self->replace_subscriber( $new_svc_acct ) if $new_svc_acct;
 303 }
 304
 305 ###############
 306 # SUBSCRIBERS #
 307 ###############
 308
 309 =item get_subscriber SVC
 310
 311 Gets the subscriber record for SVC, if there is one.
 312
 313 =cut
 314
 315 sub get_subscriber {
 316   my $self = shift;
 317   my $svc = shift;
 318
 319   my $svcnum = $svc->svcnum;
 320   my $svcid = "svc#$svcnum";
 321
 322   my $pkgnum = $svc->cust_svc->pkgnum;
 323   my $custid = "cust_pkg#$pkgnum";
 324
 325   my @subscribers = grep { $_->{external_id} eq $svcid }
 326     $self->api_query('subscribers',
 327       [ 'customer_external_id' => $custid ]
 328     );
 329   warn "$me multiple subscribers for external_id $svcid.\n"
 330     if scalar(@subscribers) > 1;
 331
 332   $subscribers[0];
 333 }
 334
 335 # internal method: find DIDs that forward to this service
 336
 337 sub did_numbers_for_svc {
 338   my $self = shift;
 339   my $svc = shift;
 340   my @numbers;
 341   my @dids = qsearch({
 342       'table'     => 'svc_phone',
 343       'hashref'   => { 'forward_svcnum' => $svc->svcnum }
 344   });
 345   foreach my $did (@dids) {
 346     # only include them if they're interesting to this export
 347     if ( $self->svc_role($did) eq 'did' ) {
 348       my $phonenum;
 349       if ($did->countrycode) {
 350         $phonenum = Number::Phone->new('+' . $did->countrycode . $did->phonenum);
 351       } else {
 352         # the long way
 353         my $country = $did->cust_svc->cust_pkg->cust_location->country;
 354         $phonenum = Number::Phone->new($country, $did->phonenum);
 355       }
 356       if (!$phonenum) {
 357         die "Can't process phonenum ".$did->countrycode . $did->phonenum . "\n";
 358       }
 359       push @numbers,
 360         { 'cc' => $phonenum->country_code,
 361           'ac' => $phonenum->areacode,
 362           'sn' => $phonenum->subscriber
 363         };
 364     }
 365   }
 366   @numbers;
 367 }
 368
 369 sub get_subscriber_profile_set_id {
 370   my $self = shift;
 371   if ( my $setname = $self->option('subscriber_profile_set') ) {
 372     my ($set) = $self->api_query('subscriberprofilesets',
 373       [ name => $setname ]
 374     );
 375     die "Subscriber profile set '$setname' not found" unless $set;
 376     return $set->{id};
 377   }
 378   '';
 379 }
 380
 381 sub insert_subscriber {
 382   my $self = shift;
 383   my $svc = shift;
 384
 385   my $cust = $self->find_or_create_customer($svc);
 386   my $svcid = "svc#" . $svc->svcnum;
 387   my $status = $svc->cust_svc->cust_pkg->susp ? 'locked' : 'active';
 388   $status = 'active' if $svc->get('unsuspended');
 389   my $domain = $self->find_or_create_domain($svc->domain);
 390
 391   my @numbers = $self->did_numbers_for_svc($svc);
 392   my $first_number = shift @numbers;
 393
 394   my $profile_set_id = $self->get_subscriber_profile_set_id;
 395   my $subscriber = $self->api_create('subscribers',
 396     {
 397       'alias_numbers'   => \@numbers,
 398       'customer_id'     => $cust->{id},
 399       'display_name'    => $svc->finger,
 400       'domain_id'       => $domain->{id},
 401       'external_id'     => $svcid,
 402       'password'        => $svc->_password,
 403       'primary_number'  => $first_number,
 404       'profile_set_id'  => $profile_set_id,
 405       'status'          => $status,
 406       'username'        => $svc->username,
 407     }
 408   );
 409 }
 410
 411 sub replace_subscriber {
 412   my $self = shift;
 413   my $svc = shift;
 414   my $old = shift || $svc->replace_old;
 415   my $svcid = "svc#" . $svc->svcnum;
 416
 417   my $cust = $self->find_or_create_customer($svc);
 418   my $status = $svc->cust_svc->cust_pkg->susp ? 'locked' : 'active';
 419   $status = 'active' if $svc->get('unsuspended');
 420   my $domain = $self->find_or_create_domain($svc->domain);
 421
 422   my @numbers = $self->did_numbers_for_svc($svc);
 423   my $first_number = shift @numbers;
 424
 425   my $subscriber = $self->get_subscriber($svc);
 426
 427   if ( $subscriber ) {
 428     my $id = $subscriber->{id};
 429     if ( $svc->username ne $old->username ) {
 430       # have to delete and recreate
 431       $self->api_delete("subscribers/$id");
 432       $self->insert_subscriber($svc);
 433     } else {
 434       my $profile_set_id = $self->get_subscriber_profile_set_id;
 435       $self->api_update("subscribers/$id",
 436         {
 437           'alias_numbers'   => \@numbers,
 438           'customer_id'     => $cust->{id},
 439           'display_name'    => $svc->finger,
 440           'domain_id'       => $domain->{id},
 441           'email'           => $svc->email,
 442           'external_id'     => $svcid,
 443           'password'        => $svc->_password,
 444           'primary_number'  => $first_number,
 445           'profile_set_id'  => $profile_set_id,
 446           'status'          => $status,
 447           'username'        => $svc->username,
 448         }
 449       );
 450     }
 451   } else {
 452     warn "$me subscriber not found for $svcid; creating new\n";
 453     $self->insert_subscriber($svc);
 454   }
 455 }
 456
 457 sub delete_subscriber {
 458   my $self = shift;
 459   my $svc = shift;
 460   my $svcid = "svc#" . $svc->svcnum;
 461   my $pkgnum = $svc->cust_svc->pkgnum;
 462   my $custid = "cust_pkg#$pkgnum";
 463
 464   my $subscriber = $self->get_subscriber($svc);
 465
 466   if ( $subscriber ) {
 467     my $id = $subscriber->{id};
 468     $self->api_delete("subscribers/$id");
 469   } else {
 470     warn "$me subscriber not found for $svcid (would be deleted)\n";
 471   }
 472
 473   my (@other_subs) = $self->api_query('subscribers',
 474     [ 'customer_external_id' => $custid ]
 475   );
 476   if (! @other_subs) {
 477     # then it's safe to remove the customer
 478     my ($cust) = $self->api_query('customers', [ 'external_id' => $custid ]);
 479     if (!$cust) {
 480       warn "$me customer not found for $custid\n";
 481       return;
 482     }
 483     my $id = $cust->{id};
 484     my $contact_id = $cust->{contact_id};
 485     if ( $cust->{'status'} ne 'terminated' ) {
 486       # can't delete customers, have to cancel them
 487       $cust->{'status'} = 'terminated';
 488       $cust->{'external_id'} = ""; # dissociate it from this pkgnum
 489       $cust->{'contact_id'} = 1; # set to the system default contact
 490       $self->api_update("customers/$id", $cust);
 491     }
 492     # can and should delete contacts though
 493     $self->api_delete("customercontacts/$contact_id");
 494   }
 495 }
 496
 497 ################
 498 # CALL DETAILS #
 499 ################
 500
 501 =item import_cdrs START, END
 502
 503 Retrieves CDRs for calls in the date range from START to END and inserts them
 504 as a CDR batch. On success, returns a new cdr_batch object. On failure,
 505 returns an error message. If there are no new CDRs, returns nothing.
 506
 507 =cut
 508
 509 sub import_cdrs {
 510   my ($self, $start, $end) = @_;
 511   $start ||= 0;
 512   $end ||= time;
 513
 514   my $oldAutoCommit = $FS::UID::AutoCommit;
 515   local $FS::UID::AutoCommit = 0;
 516
 517   ($start, $end) = ($end, $start) if $end < $start;
 518   $start = DateTime->from_epoch(epoch => $start, time_zone => 'local');
 519   $end = DateTime->from_epoch(epoch => $end, time_zone => 'local');
 520   $end->subtract(seconds => 1); # filter by >= and <= only, so...
 521
 522   # a little different from the usual: we have to fetch these subscriber by
 523   # subscriber, not all at once.
 524   my @svcs = qsearch({
 525       'table'     => 'svc_acct',
 526       'addl_from' => ' JOIN cust_svc USING (svcnum)' .
 527                      ' JOIN export_svc USING (svcpart)',
 528       'extra_sql' => ' WHERE export_svc.role = \'subscriber\''.
 529                      ' AND export_svc.exportnum = '.$self->exportnum
 530   });
 531   my $cdr_batch;
 532   my @args = ( 'start_ge' => $start->iso8601,
 533                'start_le' => $end->iso8601,
 534               );
 535
 536   my $error;
 537   SVC: foreach my $svc (@svcs) {
 538     my $subscriber = $self->get_subscriber($svc);
 539     if (!$subscriber) {
 540       warn "$me user ".$svc->label." is not configured on the SIP server.\n";
 541       next;
 542     }
 543     my $id = $subscriber->{id};
 544     my @calls;
 545     try {
 546       # alias_field tells "calllists" which field from the source and
 547       # destination to use as the "own_cli" and "other_cli" of the call.
 548       # "user" = username@domain.
 549       @calls = $self->api_query('calllists', [
 550           'subscriber_id' => $id,
 551           'alias_field'   => 'user',
 552           @args
 553       ]);
 554     } catch {
 555       $error = "$me $_ (retrieving records for ".$svc->label.")";
 556     };
 557
 558     if (@calls and !$cdr_batch) {
 559       # create a cdr_batch if needed
 560       my $cdrbatchname = 'sipwise-' . $self->exportnum . '-' . $end->epoch;
 561       $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname });
 562       $error = $cdr_batch->insert;
 563     }
 564
 565     last SVC if $error;
 566
 567     foreach my $c (@calls) {
 568       # avoid double-importing
 569       my $uniqueid = $c->{call_id};
 570       if ( FS::cdr->row_exists("uniqueid = ?", $uniqueid) ) {
 571         warn "skipped call with uniqueid = '$uniqueid' (already imported)\n"
 572           if $DEBUG;
 573         next;
 574       }
 575       my $src = $c->{own_cli};
 576       my $dst = $c->{other_cli};
 577       if ( $c->{direction} eq 'in' ) { # then reverse them
 578         ($src, $dst) = ($dst, $src);
 579       }
 580       # parse duration from H:MM:SS format
 581       my $duration;
 582       if ( $c->{duration} =~ /^(\d+):(\d+):(\d+)$/ ) {
 583         $duration = $3 + (60 * $2) + (3600 * $1);
 584       } else {
 585         $error = "call $uniqueid: unparseable duration '".$c->{duration}."'";
 586       }
 587
 588       # use the username@domain label for src and/or dst if possible
 589       my $cdr = FS::cdr->new({
 590           uniqueid        => $uniqueid,
 591           upstream_price  => $c->{customer_cost},
 592           startdate       => parse_datetime($c->{start_time}),
 593           disposition     => $c->{status},
 594           duration        => $duration,
 595           billsec         => $duration,
 596           src             => $src,
 597           dst             => $dst,
 598       });
 599       $error ||= $cdr->insert;
 600       last SVC if $error;
 601     }
 602   } # foreach $svc
 603
 604   if ( $error ) {
 605     dbh->rollback if $oldAutoCommit;
 606     return $error;
 607   } elsif ( $cdr_batch ) {
 608     dbh->commit if $oldAutoCommit;
 609     return $cdr_batch;
 610   } else { # no CDRs
 611     return;
 612   }
 613 }
 614
 615 ##############
 616 # API ACCESS #
 617 ##############
 618
 619 =item api_query RESOURCE, CONTENT
 620
 621 Makes a GET request to RESOURCE, the name of a resource type (like
 622 'customers'), with query parameters in CONTENT, unpacks the embedded search
 623 results, and returns them as a list.
 624
 625 Sipwise ignores invalid query parameters rather than throwing an error, so if
 626 the parameters are misspelled or make no sense for this type of query, it will
 627 probably return all of the objects.
 628
 629 =cut
 630
 631 sub api_query {
 632   my $self = shift;
 633   my ($resource, $content) = @_;
 634   if ( ref $content eq 'HASH' ) {
 635     $content = [ %$content ];
 636   }
 637   my $page = 1;
 638   push @$content, ('rows' => 100, 'page' => 1); # 'page' is always last
 639   my $result = $self->api_request('GET', $resource, $content);
 640   my @records;
 641   # depaginate
 642   while ( my $things = $result->{_embedded}{"ngcp:$resource"} ) {
 643     if ( ref($things) eq 'ARRAY' ) {
 644       push @records, @$things;
 645     } else {
 646       push @records, $things;
 647     }
 648     if ( my $linknext = $result->{_links}{next} ) {
 649       # unfortunately their HAL isn't entirely functional
 650       # it returns "next" links that contain "page" and "rows" but no other
 651       # parameters. so just count the pages:
 652       $page++;
 653       $content->[-1] = $page;
 654
 655       warn "$me continued: $page\n" if $DEBUG;
 656       $result = $self->api_request('GET', $resource, $content);
 657     } else {
 658       last;
 659     }
 660   }
 661   return @records;
 662 }
 663
 664 =item api_create RESOURCE, CONTENT
 665
 666 Makes a POST request to RESOURCE, the name of a resource type (like
 667 'customers'), to create a new object of that type. CONTENT must be a hashref of
 668 the object's fields.
 669
 670 On success, will then fetch and return the newly created object. On failure,
 671 will throw the "message" parameter from the request as an exception.
 672
 673 =cut
 674
 675 sub api_create {
 676   my $self = shift;
 677   my ($resource, $content) = @_;
 678   my $result = $self->api_request('POST', $resource, $content);
 679   if ( $result->{location} ) {
 680     return $self->api_request('GET', $result->{location});
 681   } else {
 682     die $result->{message} . "\n";
 683   }
 684 }
 685
 686 =item api_update ENDPOINT, CONTENT
 687
 688 Makes a PUT request to ENDPOINT, the name of a specific record (like
 689 'customers/11'), to replace it with the data in CONTENT (a hashref of the
 690 object's fields). On failure, will throw an exception. On success,
 691 returns nothing.
 692
 693 =cut
 694
 695 sub api_update {
 696   my $self = shift;
 697   my ($endpoint, $content) = @_;
 698   my $result = $self->api_request('PUT', $endpoint, $content);
 699   if ( $result->{message} ) {
 700     die $result->{message} . "\n";
 701   }
 702   return;
 703 }
 704
 705 =item api_delete ENDPOINT
 706
 707 Makes a DELETE request to ENDPOINT. On failure, will throw an exception.
 708
 709 =cut
 710
 711 sub api_delete {
 712   my $self = shift;
 713   my $endpoint = shift;
 714   my $result = $self->api_request('DELETE', $endpoint);
 715   if ( $result->{code} and $result->{code} eq '404' ) {
 716     # special case: this is harmless. we tried to delete something and it
 717     # was already gone.
 718     warn "$me api_delete $endpoint: does not exist\n";
 719     return;
 720   } elsif ( $result->{message} ) {
 721     die $result->{message} . "\n";
 722   }
 723   return;
 724 }
 725
 726 =item api_request METHOD, ENDPOINT, CONTENT
 727
 728 Makes a REST request with HTTP method METHOD, to path ENDPOINT, with content
 729 CONTENT. If METHOD is GET, the content can be an arrayref or hashref to append
 730 as the query argument. If it's POST or PUT, the content will be JSON-serialized
 731 and sent as the request body. If it's DELETE, content will be ignored.
 732
 733 =cut
 734
 735 sub api_request {
 736   my $self = shift;
 737   my ($method, $endpoint, $content) = @_;
 738   $DEBUG ||= 1 if $self->option('debug');
 739   my $url;
 740   if ($endpoint =~ /^http/) {
 741     # allow directly using URLs returned from the API
 742     $url = $endpoint;
 743   } else {
 744     $endpoint =~ s[/api/][]; # allow using paths returned in Location headers
 745     $url = 'https://' . $self->host . '/api/' . $endpoint;
 746     $url .= '/' unless $url =~ m[/$];
 747   }
 748   my $request;
 749   if ( lc($method) eq 'get' ) {
 750     $url = URI->new($url);
 751     $url->query_form($content);
 752     $request = GET($url,
 753       'Accept'        => 'application/json'
 754     );
 755   } elsif ( lc($method) eq 'post' ) {
 756     $request = POST($url,
 757       'Accept'        => 'application/json',
 758       'Content'       => encode_json($content),
 759       'Content-Type'  => 'application/json',
 760     );
 761   } elsif ( lc($method) eq 'put' ) {
 762     $request = PUT($url,
 763       'Accept'        => 'application/json',
 764       'Content'       => encode_json($content),
 765       'Content-Type'  => 'application/json',
 766     );
 767   } elsif ( lc($method) eq 'delete' ) {
 768     $request = DELETE($url);
 769   }
 770
 771   warn "$me $method $endpoint\n" if $DEBUG;
 772   warn $request->as_string ."\n" if $DEBUG > 1;
 773   my $response = $self->ua->request($request);
 774   warn "$me received\n" . $response->as_string ."\n" if $DEBUG > 1;
 775
 776   my $decoded_response = {};
 777   if ( $response->content ) {
 778     local $@;
 779     $decoded_response = eval { decode_json($response->content) };
 780     if ( $@ ) {
 781       # then it can't be parsed; probably a low-level error of some kind.
 782       warn "$me Parse error.\n".$response->content."\n\n";
 783       die "$me Parse error:".$response->content . "\n";
 784     }
 785   }
 786   if ( $response->header('Location') ) {
 787     $decoded_response->{location} = $response->header('Location');
 788   }
 789   return $decoded_response;
 790 }
 791
 792 # a little false laziness with aradial.pm
 793 sub host {
 794   my $self = shift;
 795   my $port = $self->option('port') || 1443;
 796   $self->machine . ":$port";
 797 }
 798
 799 sub ua {
 800   my $self = shift;
 801   $self->{_ua} ||= do {
 802     my @opt;
 803     if ( $self->option('ssl_no_verify') ) {
 804       push @opt, ssl_opts => { verify_hostname => 0 };
 805     }
 806     my $ua = LWP::UserAgent->new(@opt);
 807     $ua->credentials(
 808       $self->host,
 809       'api_admin_http',
 810       $self->option('username'),
 811       $self->option('password')
 812     );
 813     $ua;
 814   }
 815 }
 816
 817
 818 1;