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