FS/FS/part_export/domreg_opensrs.pm

   1 package FS::part_export::domreg_opensrs;
   2
   3 use vars qw(@ISA %info %options $conf $me $DEBUG);
   4 use Tie::IxHash;
   5 use DateTime;
   6 use FS::Record qw(qsearchs qsearch);
   7 use FS::Conf;
   8 use FS::part_export::null;
   9 use FS::svc_domain;
  10 use FS::part_pkg;
  11
  12 =head1 NAME
  13
  14 FS::part_export::domreg_opensrs - Register or transfer domains with Tucows OpenSRS
  15
  16 =head1 DESCRIPTION
  17
  18 This module handles registering and transferring domains using a registration service provider (RSP) account
  19 at Tucows OpenSRS, an ICANN-approved domain registrar.
  20
  21 As a part_export, this module can be designated for use with svc_domain services.  When the svc_domain object
  22 is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending
  23 on the setting of the svc_domain's action field.
  24
  25 =over 4
  26
  27 =item N - Register the domain
  28
  29 =item M - Transfer the domain
  30
  31 =item I - Ignore the domain for registration purposes
  32
  33 =back
  34
  35 This export uses Net::OpenSRS.  Registration and transfer attempts will fail unless Net::OpenSRS is installed
  36 and LWP::UserAgent is able to make HTTPS posts.  You can turn on debugging messages and use the OpenSRS test
  37 gateway when setting up this export.
  38
  39 =cut
  40
  41 @ISA = qw(FS::part_export::null);
  42 $me = '[' .  __PACKAGE__ . ']';
  43 $DEBUG = 0;
  44
  45 my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us asn.au com.au id.au net.au org.au/;
  46
  47 tie %options, 'Tie::IxHash',
  48   'username'     => { label => 'Reseller user name at OpenSRS',
  49                       },
  50   'privatekey'   => { label => 'Private key',
  51                       },
  52   'password'     => { label => 'Password for management account',
  53                       },
  54   'masterdomain' => { label => 'Master domain at OpenSRS',
  55                       },
  56   'wait_for_pay' => { label => 'Do not provision until payment is received',
  57                       type => 'checkbox',
  58                       default => '0',
  59                     },
  60   'debug_level'  => { label => 'Net::OpenSRS debug level',
  61                       type => 'select',
  62                       options => [ 0, 1, 2, 3 ],
  63                       default => 0 },
  64 #  'register'     => { label => 'Use for registration',
  65 #                      type => 'checkbox',
  66 #                      default => '1' },
  67 #  'transfer'     => { label => 'Use for transfer',
  68 #                      type => 'checkbox',
  69 #                      default => '1' },
  70   'tlds'         => { label => 'Use this export for these top-level domains (TLDs)',
  71                       type => 'select',
  72                       multi => 1,
  73                       size => scalar(@tldlist),
  74                       options => [ @tldlist ],
  75                       default => 'com net org' },
  76   'auoptions'    => { label => 'Enable AU-specific registration fields',
  77                       type => 'checkbox'
  78                     },
  79 ;
  80
  81 %info = (
  82   'svc'     => 'svc_domain',
  83   'desc'    => 'Domain registration via Tucows OpenSRS',
  84   'options' => \%options,
  85   'notes'   => <<'END'
  86 Registers and transfers domains via the <a href="http://opensrs.com/">Tucows OpenSRS</a> registrar (using <a href="http://search.cpan.org/dist/Net-OpenSRS">Net::OpenSRS</a>).
  87 All of the Net::OpenSRS restrictions apply:
  88 <UL>
  89   <LI>You must have a reseller account with Tucows.
  90   <LI>You must add the public IP address of the Freeside server to the 'Script API allow' list in the OpenSRS web interface.
  91   <LI>You must generate an API access key in the OpenSRS web interface and enter it below.
  92   <LI>All domains are managed using the same user name and password, but you can create sub-accounts for clients.
  93   <LI>The user name must be the same as your OpenSRS reseller ID.
  94   <LI>You must enter a master domain that all other domains are associated with.  That domain must be registered through your OpenSRS account.
  95 </UL>
  96 Some top-level domains offered by OpenSRS have additional business rules not supported by this export. These TLDs cannot be registered or transfered with this export.
  97 <BR><BR>Use these buttons for some useful presets:
  98 <UL>
  99   <LI>
 100     <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick='
 101       document.dummy.machine.value = "rr-n1-tor.opensrs.net";
 102       this.form.machine.value = "rr-n1-tor.opensrs.net";
 103     '>
 104   <LI>
 105     <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick='
 106       document.dummy.machine.value = "horizon.opensrs.net";
 107       this.form.machine.value = "horizon.opensrs.net";
 108     '>
 109 </UL>
 110 END
 111 );
 112
 113 install_callback FS::UID sub {
 114   $conf = new FS::Conf;
 115 };
 116
 117 =head1 METHODS
 118
 119 =over 4
 120
 121 =item format_tel
 122
 123 Reformats a phone number according to registry rules.  Currently Freeside stores phone numbers
 124 in NANPA format and the registry prefers "+CCC.NPANPXNNNN"
 125
 126 =cut
 127
 128 sub format_tel {
 129   my $tel = shift;
 130
 131   #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})( x(\d+))?$/) {
 132   if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) {
 133     $tel = "+1.$1$2$3";
 134 #    if $tel .= "$4" if $4;
 135   }
 136   return $tel;
 137 }
 138
 139 =item gen_contact_info
 140
 141 Generates contact data for the domain based on the customer data.
 142
 143 Currently relies on Net::OpenSRS to format the telephone number for OpenSRS.
 144
 145 =cut
 146
 147 sub gen_contact_info
 148 {
 149   my ($co)=@_;
 150
 151   my @invoicing_list = $co->invoicing_list_emailonly;
 152   if ( $conf->exists('emailinvoiceautoalways')
 153        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
 154        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
 155     push @invoicing_list, $co->all_emails;
 156   }
 157
 158   my $email = ($conf->exists('business-onlinepayment-email-override'))
 159               ? $conf->config('business-onlinepayment-email-override')
 160               : $invoicing_list[0];
 161
 162   my $c = {
 163     firstname => $co->first,
 164     lastname  => $co->last,
 165     company   => $co->company,
 166     address   => $co->address1,
 167     city      => $co->city(),
 168     state     => $co->state(),
 169     zip       => $co->zip(),
 170     country   => uc($co->country()),
 171     email     => $email,
 172     #phone     => format_tel($co->daytime()),
 173     phone     => $co->daytime() || $co->night,
 174   };
 175   return $c;
 176 }
 177
 178 =item validate_contact_info
 179
 180 Attempts to validate contact data for the domain based on OpenSRS rules.
 181
 182 Returns undef if the contact data is acceptable, an error message if the contact
 183 data lacks one or more required fields.
 184
 185 =cut
 186
 187 sub validate_contact_info {
 188   my $c = shift;
 189
 190   my %fields = (
 191     firstname => "first name",
 192     lastname => "last name",
 193     address => "street address",
 194     city => "city",
 195     state => "state",
 196     zip => "ZIP/postal code",
 197     country => "country",
 198     email => "email address",
 199     phone => "phone number",
 200   );
 201   my @err = ();
 202   foreach (keys %fields) {
 203     if (!defined($c->{$_}) || !$c->{$_}) {
 204       push @err, $fields{$_};
 205     }
 206   }
 207   if (scalar(@err) > 0) {
 208     return "Contact information needs: " . join(', ', @err);
 209   }
 210   undef;
 211 }
 212
 213 =item testmode
 214
 215 Returns the Net::OpenSRS-required test mode string based on whether the export
 216 is configured to use the live or the test gateway.
 217
 218 =cut
 219
 220 sub testmode {
 221   my $self = shift;
 222
 223   return 'live' if $self->machine eq "rr-n1-tor.opensrs.net";
 224   return 'test' if $self->machine eq "horizon.opensrs.net";
 225   undef;
 226
 227 }
 228
 229 =item _export_insert
 230
 231 Attempts to "export" the domain, i.e. register or transfer it if the user selected
 232 that option when editing the domain.
 233
 234 Returns an error message on failure or undef on success.
 235
 236 May also return an error message if it cannot load the required Perl module Net::OpenSRS,
 237 or if the domain is not registerable, or if insufficient data is provided in the customer
 238 record to generate the required contact information to register or transfer the domain.
 239
 240 =cut
 241
 242 sub _export_insert {
 243   my( $self, $svc_domain ) = ( shift, shift );
 244
 245   return if $svc_domain->action eq 'I';  # Ignoring registration, just doing DNS
 246
 247   if ($svc_domain->action eq 'N') {
 248     return $self->register( $svc_domain );
 249   } elsif ($svc_domain->action eq 'M') {
 250     return $self->transfer( $svc_domain );
 251   }
 252   return "Unknown domain action " . $svc_domain->action;
 253 }
 254
 255 sub _export_insert_on_payment {
 256   my( $self, $svc_domain ) = ( shift, shift );
 257   warn "$me:_export_insert_on_payment called\n" if $DEBUG;
 258   return '' unless $self->option('wait_for_pay');
 259
 260   my $queue = new FS::queue {
 261     'svcnum' => $svc_domain->svcnum,
 262     'job'    => 'FS::part_export::domreg_opensrs::renew_through',
 263   };
 264   $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action?
 265 }
 266
 267 ## Domain registration exports do nothing on replace.  Mainly because we haven't decided what they should do.
 268 #sub _export_replace {
 269 #  my( $self, $new, $old ) = (shift, shift, shift);
 270 #
 271 #  return '';
 272 #
 273 #}
 274
 275 ## Domain registration exports do nothing on delete.  You're just removing the domain from Freeside, not the registry
 276 #sub _export_delete {
 277 #  my( $self, $svc_domain ) = ( shift, shift );
 278 #
 279 #  return '';
 280 #}
 281
 282 =item is_supported_domain
 283
 284 Return undef if the domain name uses a TLD or SLD that is supported by this registrar.
 285 Otherwise return an error message explaining what's wrong.
 286
 287 =cut
 288
 289 sub is_supported_domain {
 290   my $self = shift;
 291   my $svc_domain = shift;
 292
 293   # Get the TLD of the new domain
 294   my @bits = split /\./, $svc_domain->domain;
 295
 296   return "Can't register subdomains: " . $svc_domain->domain
 297     if (scalar(@bits) != 2 && scalar(@bits) != 3);
 298
 299   my $tld = pop @bits;
 300   my $sld = pop @bits;
 301
 302   # See if it's one this export supports
 303   my @tlds = split /\s+/, $self->option('tlds');
 304   @tlds =  map { s/\.//; $_ } @tlds;
 305   return "Can't register top-level domain $tld, restricted to: "
 306             . $self->option('tlds') if ! grep { $_ eq $tld || $_ eq "$sld$tld" } @tlds;
 307   return undef;
 308 }
 309
 310 =item get_srs
 311
 312 =cut
 313
 314 sub get_srs {
 315   my $self = shift;
 316
 317   my $srs = Net::OpenSRS->new();
 318
 319   $srs->debug_level( $self->option('debug_level') ); # Output should be in the Apache error log
 320
 321   $srs->environment( $self->testmode() );
 322   $srs->set_key( $self->option('privatekey') );
 323
 324   $srs->set_manage_auth( $self->option('username'), $self->option('password') );
 325   return $srs;
 326 }
 327
 328 =item get_status
 329
 330 Returns a reference to a hashref containing information on the domain's status.  The keys
 331 defined depend on the status.
 332
 333 'unregistered' means the domain is not registered.
 334
 335 Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state
 336 of that operation.
 337
 338 Otherwise returns a value indicating if the domain can be managed through our reseller account.
 339
 340 =cut
 341
 342 sub get_status {
 343   my ( $self, $svc_domain ) = @_;
 344   my $rslt = {};
 345
 346   eval "use Net::OpenSRS;";
 347   return $@ if $@;
 348
 349   my $srs = $self->get_srs;
 350
 351   if ($srs->is_available( $svc_domain->domain )) {
 352     $rslt->{'unregistered'} = 1;
 353   } else {
 354     $rslt = $srs->check_transfer( $svc_domain->domain );
 355     if (defined($rslt->{'reason'})) {
 356       my $rv = $srs->make_request(
 357         {
 358           action     => 'belongs_to_rsp',
 359           object     => 'domain',
 360           attributes => {
 361             domain => $svc_domain->domain
 362           }
 363         }
 364       );
 365       if ($rv) {
 366         $self->_set_response;
 367         if ( $rv->{attributes}->{'domain_expdate'} ) {
 368           $rslt->{'expdate'} = $rv->{attributes}->{'domain_expdate'};
 369         }
 370       }
 371     }
 372   }
 373
 374   return $rslt; # Success
 375 }
 376
 377 =item register
 378
 379 Attempts to register the domain through the reseller account associated with this export.
 380
 381 Like most export functions, returns an error message on failure or undef on success.
 382
 383 =cut
 384
 385 sub register {
 386   my ( $self, $svc_domain, $years ) = @_;
 387
 388   $years = 1 unless $years; #default to 1 year since we don't seem to pass it
 389
 390   return "Net::OpenSRS does not support period other than 1 year" if $years != 1;
 391
 392   eval "use Net::OpenSRS;";
 393   return $@ if $@;
 394
 395   my $err = $self->is_supported_domain( $svc_domain );
 396   return $err if $err;
 397
 398   my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
 399
 400   my $c = gen_contact_info($cust_main);
 401
 402   if ( $svc_domain->domain =~ /\.au$/ ) {
 403         $c->{'registrant_name'} = $svc_domain->au_registrant_name;
 404         $c->{'eligibility_type'} = $svc_domain->au_eligibility_type;
 405   }
 406
 407   $err = validate_contact_info($c);
 408   return $err if $err;
 409
 410   my $srs = $self->get_srs;
 411
 412 #  cookie not required for registration
 413 #  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 414 #  if (!$cookie) {
 415 #     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 416 #  }
 417
 418 #  return "Domain registration not enabled" if !$self->option('register');
 419   return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
 420
 421   return ''; # Should only get here if register succeeded
 422 }
 423
 424 =item transfer
 425
 426 Attempts to transfer the domain into the reseller account associated with this export.
 427
 428 Like most export functions, returns an error message on failure or undef on success.
 429
 430 =cut
 431
 432 sub transfer {
 433   my ( $self, $svc_domain ) = @_;
 434
 435   eval "use Net::OpenSRS;";
 436   return $@ if $@;
 437
 438   my $err = $self->is_supported_domain( $svc_domain );
 439   return $err if $err;
 440
 441   my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
 442
 443   my $c = gen_contact_info($cust_main);
 444
 445   $err = validate_contact_info($c);
 446   return $err if $err;
 447
 448   my $srs = $self->get_srs;
 449
 450   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 451   if (!$cookie) {
 452      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 453   }
 454
 455 #  return "Domain transfer not enabled" if !$self->option('transfer');
 456   return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c);
 457
 458   return ''; # Should only get here if transfer succeeded
 459 }
 460
 461 =item renew
 462
 463 Attempts to renew the domain for the specified number of years.
 464
 465 Like most export functions, returns an error message on failure or undef on success.
 466
 467 =cut
 468
 469 sub renew {
 470   my ( $self, $svc_domain, $years ) = @_;
 471
 472   eval "use Net::OpenSRS;";
 473   return $@ if $@;
 474
 475   my $err = $self->is_supported_domain( $svc_domain );
 476   return $err if $err;
 477
 478   my $srs = $self->get_srs;
 479
 480   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 481   if (!$cookie) {
 482      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 483   }
 484
 485 #  return "Domain renewal not enabled" if !$self->option('renew');
 486   return $srs->last_response() if !$srs->renew_domain( $svc_domain->domain, $years );
 487
 488   return ''; # Should only get here if renewal succeeded
 489 }
 490
 491 =item renew_through [ EPOCH_DATE ]
 492
 493 Attempts to renew the domain through the specified date.  If no date is
 494 provided it is gleaned from the associated cust_pkg bill date
 495
 496 Like some export functions, dies on failure or returns undef on success.
 497 It is always called from the queue.
 498
 499 =cut
 500
 501 sub renew_through {
 502   my ( $self, $svc_domain, $date ) = @_;
 503
 504   warn "$me: renew_through called\n" if $DEBUG;
 505   eval "use Net::OpenSRS;";
 506   die $@ if $@;
 507
 508   unless ( $date ) {
 509     my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
 510     die "Can't renew: no date specified and domain is not in a package."
 511       unless $cust_pkg;
 512     $date = $cust_pkg->bill;
 513   }
 514
 515   my $err = $self->is_supported_domain( $svc_domain );
 516   die $err if $err;
 517
 518   warn "$me: checking status\n" if $DEBUG;
 519   my $rv = $self->get_status($svc_domain);
 520   die "Domain ". $svc_domain->domain. " is not renewable"
 521     unless $rv->{expdate};
 522
 523   die "Can't parse expiration date for ". $svc_domain->domain
 524     unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/;
 525
 526   my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
 527   my $exp = DateTime->new( year   => $year,
 528                            month  => $month,
 529                            day    => $day,
 530                            hour   => $hour,
 531                            minute => $minute,
 532                            second => $second,
 533                            time_zone => 'America/New_York',#timezone of opensrs
 534                          );
 535
 536   my $bill = DateTime->
 537    from_epoch( 'epoch'     => $date,
 538                'time_zone' => DateTime::TimeZone->new( name => 'local' ),
 539   );
 540
 541   my $years = 0;
 542   while ( DateTime->compare( $bill, $exp ) > 0 ) {
 543     $years++;
 544     $exp->add( 'years' => 1 );
 545
 546     die "Can't renew ". $svc_domain->domain. " for more than 10 years."
 547       if $years > 10; #no infinite loop
 548   }
 549
 550   return '' unless $years;
 551
 552   warn "$me: renewing ". $svc_domain->domain. " for $years years\n" if $DEBUG;
 553   my $srs = $self->get_srs;
 554   $rv = $srs->make_request(
 555     {
 556       action     => 'renew',
 557       object     => 'domain',
 558       attributes => {
 559         domain                => $svc_domain->domain,
 560         auto_renew            => 0,
 561         handle                => 'process',
 562         period                => $years,
 563         currentexpirationyear => $year,
 564       }
 565     }
 566   );
 567   die $rv->{response_text} unless $rv->{is_success};
 568
 569   return ''; # Should only get here if renewal succeeded
 570 }
 571
 572 =item revoke
 573
 574 Attempts to revoke the domain registration.  Only succeeds if invoked during the OpenSRS
 575 grace period immediately after registration.
 576
 577 Like most export functions, returns an error message on failure or undef on success.
 578
 579 =cut
 580
 581 sub revoke {
 582   my ( $self, $svc_domain ) = @_;
 583
 584   eval "use Net::OpenSRS;";
 585   return $@ if $@;
 586
 587   my $err = $self->is_supported_domain( $svc_domain );
 588   return $err if $err;
 589
 590   my $srs = $self->get_srs;
 591
 592   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 593   if (!$cookie) {
 594      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 595   }
 596
 597 #  return "Domain registration revocation not enabled" if !$self->option('revoke');
 598   return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain);
 599
 600   return ''; # Should only get here if transfer succeeded
 601 }
 602
 603 =item registrar
 604
 605 Should return a full-blown object representing OpenSRS, but current just returns a hashref
 606 containing the registrar name.
 607
 608 =cut
 609
 610 sub registrar {
 611   return {
 612         name => 'OpenSRS',
 613   };
 614 }
 615
 616 =back
 617
 618 =head1 SEE ALSO
 619
 620 L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
 621 L<FS::Record>, schema.html from the base documentation.
 622
 623
 624 =cut
 625
 626 1;
 627