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/;
  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   return '';
 264 }
 265
 266 ## Domain registration exports do nothing on replace.  Mainly because we haven't decided what they should do.
 267 #sub _export_replace {
 268 #  my( $self, $new, $old ) = (shift, shift, shift);
 269 #
 270 #  return '';
 271 #
 272 #}
 273
 274 ## Domain registration exports do nothing on delete.  You're just removing the domain from Freeside, not the registry
 275 #sub _export_delete {
 276 #  my( $self, $svc_domain ) = ( shift, shift );
 277 #
 278 #  return '';
 279 #}
 280
 281 =item is_supported_domain
 282
 283 Return undef if the domain name uses a TLD or SLD that is supported by this registrar.
 284 Otherwise return an error message explaining what's wrong.
 285
 286 =cut
 287
 288 sub is_supported_domain {
 289   my $self = shift;
 290   my $svc_domain = shift;
 291
 292   # Get the TLD of the new domain
 293   my @bits = split /\./, $svc_domain->domain;
 294
 295   return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2;
 296
 297   my $tld = 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: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds;
 303   return undef;
 304 }
 305
 306 =item get_srs
 307
 308 =cut
 309
 310 sub get_srs {
 311   my $self = shift;
 312
 313   my $srs = Net::OpenSRS->new();
 314
 315   $srs->debug_level( $self->option('debug_level') ); # Output should be in the Apache error log
 316
 317   $srs->environment( $self->testmode() );
 318   $srs->set_key( $self->option('privatekey') );
 319
 320   $srs->set_manage_auth( $self->option('username'), $self->option('password') );
 321   return $srs;
 322 }
 323
 324 =item get_status
 325
 326 Returns a reference to a hashref containing information on the domain's status.  The keys
 327 defined depend on the status.
 328
 329 'unregistered' means the domain is not registered.
 330
 331 Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state
 332 of that operation.
 333
 334 Otherwise returns a value indicating if the domain can be managed through our reseller account.
 335
 336 =cut
 337
 338 sub get_status {
 339   my ( $self, $svc_domain ) = @_;
 340   my $rslt = {};
 341
 342   eval "use Net::OpenSRS;";
 343   return $@ if $@;
 344
 345   my $srs = $self->get_srs;
 346
 347   if ($srs->is_available( $svc_domain->domain )) {
 348     $rslt->{'unregistered'} = 1;
 349   } else {
 350     $rslt = $srs->check_transfer( $svc_domain->domain );
 351     if (defined($rslt->{'reason'})) {
 352       my $rv = $srs->make_request(
 353         {
 354           action     => 'belongs_to_rsp',
 355           object     => 'domain',
 356           attributes => {
 357             domain => $svc_domain->domain
 358           }
 359         }
 360       );
 361       if ($rv) {
 362         $self->_set_response;
 363         if ( $rv->{attributes}->{'domain_expdate'} ) {
 364           $rslt->{'expdate'} = $rv->{attributes}->{'domain_expdate'};
 365         }
 366       }
 367     }
 368   }
 369
 370   return $rslt; # Success
 371 }
 372
 373 =item register
 374
 375 Attempts to register the domain through the reseller account associated with this export.
 376
 377 Like most export functions, returns an error message on failure or undef on success.
 378
 379 =cut
 380
 381 sub register {
 382   my ( $self, $svc_domain, $years ) = @_;
 383
 384   return "Net::OpenSRS does not support period other than 1 year" if $years != 1;
 385
 386   eval "use Net::OpenSRS;";
 387   return $@ if $@;
 388
 389   my $err = $self->is_supported_domain( $svc_domain );
 390   return $err if $err;
 391
 392   my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
 393
 394   my $c = gen_contact_info($cust_main);
 395
 396   $err = validate_contact_info($c);
 397   return $err if $err;
 398
 399   my $srs = $self->get_srs;
 400
 401 #  cookie not required for registration
 402 #  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 403 #  if (!$cookie) {
 404 #     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 405 #  }
 406
 407 #  return "Domain registration not enabled" if !$self->option('register');
 408   return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
 409
 410   return ''; # Should only get here if register succeeded
 411 }
 412
 413 =item transfer
 414
 415 Attempts to transfer the domain into the reseller account associated with this export.
 416
 417 Like most export functions, returns an error message on failure or undef on success.
 418
 419 =cut
 420
 421 sub transfer {
 422   my ( $self, $svc_domain ) = @_;
 423
 424   eval "use Net::OpenSRS;";
 425   return $@ if $@;
 426
 427   my $err = $self->is_supported_domain( $svc_domain );
 428   return $err if $err;
 429
 430   my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
 431
 432   my $c = gen_contact_info($cust_main);
 433
 434   $err = validate_contact_info($c);
 435   return $err if $err;
 436
 437   my $srs = $self->get_srs;
 438
 439   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 440   if (!$cookie) {
 441      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 442   }
 443
 444 #  return "Domain transfer not enabled" if !$self->option('transfer');
 445   return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c);
 446
 447   return ''; # Should only get here if transfer succeeded
 448 }
 449
 450 =item renew
 451
 452 Attempts to renew the domain for the specified number of years.
 453
 454 Like most export functions, returns an error message on failure or undef on success.
 455
 456 =cut
 457
 458 sub renew {
 459   my ( $self, $svc_domain, $years ) = @_;
 460
 461   eval "use Net::OpenSRS;";
 462   return $@ if $@;
 463
 464   my $err = $self->is_supported_domain( $svc_domain );
 465   return $err if $err;
 466
 467   my $srs = $self->get_srs;
 468
 469   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 470   if (!$cookie) {
 471      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 472   }
 473
 474 #  return "Domain renewal not enabled" if !$self->option('renew');
 475   return $srs->last_response() if !$srs->renew_domain( $svc_domain->domain, $years );
 476
 477   return ''; # Should only get here if renewal succeeded
 478 }
 479
 480 =item renew_through [ EPOCH_DATE ]
 481
 482 Attempts to renew the domain through the specified date.  If no date is
 483 provided it is gleaned from the associated cust_pkg bill date
 484
 485 Like most export functions, returns an error message on failure or undef on success.
 486
 487 =cut
 488
 489 sub renew_through {
 490   my ( $self, $svc_domain, $date ) = @_;
 491
 492   warn "$me: renew_through called\n" if $DEBUG;
 493   eval "use Net::OpenSRS;";
 494   return $@ if $@;
 495
 496   unless ( $date ) {
 497     my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
 498     return "Can't renew: no date specified and domain is not in a package."
 499       unless $cust_pkg;
 500     $date = $cust_pkg->bill;
 501   }
 502
 503   my $err = $self->is_supported_domain( $svc_domain );
 504   return $err if $err;
 505
 506   warn "$me: checking status\n" if $DEBUG;
 507   my $rv = $self->get_status($svc_domain);
 508   return "Domain ". $svc_domain->domain. " is not renewable"
 509     unless $rv->{expdate};
 510
 511   return "Can't parse expiration date for ". $svc_domain->domain
 512     unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/;
 513
 514   my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
 515   my $exp = DateTime->new( year   => $year,
 516                            month  => $month,
 517                            day    => $day,
 518                            hour   => $hour,
 519                            minute => $minute,
 520                            second => $second,
 521                            time_zone => 'America/New_York',#timezone of opensrs
 522                          );
 523
 524   my $bill = DateTime->
 525    from_epoch( 'epoch'     => $date,
 526                'time_zone' => DateTime::TimeZone->new( name => 'local' ),
 527   );
 528
 529   my $years = 0;
 530   while ( DateTime->compare( $bill, $exp ) > 0 ) {
 531     $years++;
 532     $exp->add( 'years' => 1 );
 533
 534     return "Can't renew ". $svc_domain->domain. " for more than 10 years."
 535       if $years > 10; #no infinite loop
 536   }
 537
 538   warn "$me: renewing ". $svc_domain->domain. "for $years years\n" if $DEBUG;
 539   my $srs = $self->get_srs;
 540   $rv = $srs->make_request(
 541     {
 542       action     => 'renew',
 543       object     => 'domain',
 544       attributes => {
 545         domain                => $svc_domain->domain,
 546         auto_renew            => 0,
 547         handle                => 'process',
 548         period                => $years,
 549         currentexpirationyear => $year,
 550       }
 551     }
 552   );
 553   return $rv->{response_text} unless $rv->{is_success};
 554
 555   return ''; # Should only get here if renewal succeeded
 556 }
 557
 558 =item revoke
 559
 560 Attempts to revoke the domain registration.  Only succeeds if invoked during the OpenSRS
 561 grace period immediately after registration.
 562
 563 Like most export functions, returns an error message on failure or undef on success.
 564
 565 =cut
 566
 567 sub revoke {
 568   my ( $self, $svc_domain ) = @_;
 569
 570   eval "use Net::OpenSRS;";
 571   return $@ if $@;
 572
 573   my $err = $self->is_supported_domain( $svc_domain );
 574   return $err if $err;
 575
 576   my $srs = $self->get_srs;
 577
 578   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 579   if (!$cookie) {
 580      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 581   }
 582
 583 #  return "Domain registration revocation not enabled" if !$self->option('revoke');
 584   return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain);
 585
 586   return ''; # Should only get here if transfer succeeded
 587 }
 588
 589 =item registrar
 590
 591 Should return a full-blown object representing OpenSRS, but current just returns a hashref
 592 containing the registrar name.
 593
 594 =cut
 595
 596 sub registrar {
 597   return {
 598         name => 'OpenSRS',
 599   };
 600 }
 601
 602 =back
 603
 604 =head1 SEE ALSO
 605
 606 L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
 607 L<FS::Record>, schema.html from the base documentation.
 608
 609
 610 =cut
 611
 612 1;
 613