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