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 ## 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 if scalar(@bits) != 2;
 294
 295   my $tld = pop @bits;
 296
 297   # See if it's one this export supports
 298   my @tlds = split /\s+/, $self->option('tlds');
 299   @tlds =  map { s/\.//; $_ } @tlds;
 300   return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds;
 301   return undef;
 302 }
 303
 304 =item get_srs
 305
 306 =cut
 307
 308 sub get_srs {
 309   my $self = shift;
 310
 311   my $srs = Net::OpenSRS->new();
 312
 313   $srs->debug_level( $self->option('debug_level') ); # Output should be in the Apache error log
 314
 315   $srs->environment( $self->testmode() );
 316   $srs->set_key( $self->option('privatekey') );
 317
 318   $srs->set_manage_auth( $self->option('username'), $self->option('password') );
 319   return $srs;
 320 }
 321
 322 =item get_status
 323
 324 Returns a reference to a hashref containing information on the domain's status.  The keys
 325 defined depend on the status.
 326
 327 'unregistered' means the domain is not registered.
 328
 329 Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state
 330 of that operation.
 331
 332 Otherwise returns a value indicating if the domain can be managed through our reseller account.
 333
 334 =cut
 335
 336 sub get_status {
 337   my ( $self, $svc_domain ) = @_;
 338   my $rslt = {};
 339
 340   eval "use Net::OpenSRS;";
 341   return $@ if $@;
 342
 343   my $srs = $self->get_srs;
 344
 345   if ($srs->is_available( $svc_domain->domain )) {
 346     $rslt->{'unregistered'} = 1;
 347   } else {
 348     $rslt = $srs->check_transfer( $svc_domain->domain );
 349     if (defined($rslt->{'reason'})) {
 350       my $rv = $srs->make_request(
 351         {
 352           action     => 'belongs_to_rsp',
 353           object     => 'domain',
 354           attributes => {
 355             domain => $svc_domain->domain
 356           }
 357         }
 358       );
 359       if ($rv) {
 360         $self->_set_response;
 361         if ( $rv->{attributes}->{'domain_expdate'} ) {
 362           $rslt->{'expdate'} = $rv->{attributes}->{'domain_expdate'};
 363         }
 364       }
 365     }
 366   }
 367
 368   return $rslt; # Success
 369 }
 370
 371 =item register
 372
 373 Attempts to register the domain through the reseller account associated with this export.
 374
 375 Like most export functions, returns an error message on failure or undef on success.
 376
 377 =cut
 378
 379 sub register {
 380   my ( $self, $svc_domain, $years ) = @_;
 381
 382   return "Net::OpenSRS does not support period other than 1 year" if $years != 1;
 383
 384   eval "use Net::OpenSRS;";
 385   return $@ if $@;
 386
 387   my $err = $self->is_supported_domain( $svc_domain );
 388   return $err if $err;
 389
 390   my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
 391
 392   my $c = gen_contact_info($cust_main);
 393
 394   $err = validate_contact_info($c);
 395   return $err if $err;
 396
 397   my $srs = $self->get_srs;
 398
 399 #  cookie not required for registration
 400 #  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 401 #  if (!$cookie) {
 402 #     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 403 #  }
 404
 405 #  return "Domain registration not enabled" if !$self->option('register');
 406   return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
 407
 408   return ''; # Should only get here if register succeeded
 409 }
 410
 411 =item transfer
 412
 413 Attempts to transfer the domain into the reseller account associated with this export.
 414
 415 Like most export functions, returns an error message on failure or undef on success.
 416
 417 =cut
 418
 419 sub transfer {
 420   my ( $self, $svc_domain ) = @_;
 421
 422   eval "use Net::OpenSRS;";
 423   return $@ if $@;
 424
 425   my $err = $self->is_supported_domain( $svc_domain );
 426   return $err if $err;
 427
 428   my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
 429
 430   my $c = gen_contact_info($cust_main);
 431
 432   $err = validate_contact_info($c);
 433   return $err if $err;
 434
 435   my $srs = $self->get_srs;
 436
 437   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 438   if (!$cookie) {
 439      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 440   }
 441
 442 #  return "Domain transfer not enabled" if !$self->option('transfer');
 443   return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c);
 444
 445   return ''; # Should only get here if transfer succeeded
 446 }
 447
 448 =item renew
 449
 450 Attempts to renew the domain for the specified number of years.
 451
 452 Like most export functions, returns an error message on failure or undef on success.
 453
 454 =cut
 455
 456 sub renew {
 457   my ( $self, $svc_domain, $years ) = @_;
 458
 459   eval "use Net::OpenSRS;";
 460   return $@ if $@;
 461
 462   my $err = $self->is_supported_domain( $svc_domain );
 463   return $err if $err;
 464
 465   my $srs = $self->get_srs;
 466
 467   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 468   if (!$cookie) {
 469      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 470   }
 471
 472 #  return "Domain renewal not enabled" if !$self->option('renew');
 473   return $srs->last_response() if !$srs->renew_domain( $svc_domain->domain, $years );
 474
 475   return ''; # Should only get here if renewal succeeded
 476 }
 477
 478 =item renew_through [ EPOCH_DATE ]
 479
 480 Attempts to renew the domain through the specified date.  If no date is
 481 provided it is gleaned from the associated cust_pkg bill date
 482
 483 Like some export functions, dies on failure or returns undef on success.
 484 It is always called from the queue.
 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   die $@ if $@;
 494
 495   unless ( $date ) {
 496     my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
 497     die "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   die $err if $err;
 504
 505   warn "$me: checking status\n" if $DEBUG;
 506   my $rv = $self->get_status($svc_domain);
 507   die "Domain ". $svc_domain->domain. " is not renewable"
 508     unless $rv->{expdate};
 509
 510   die "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     die "Can't renew ". $svc_domain->domain. " for more than 10 years."
 534       if $years > 10; #no infinite loop
 535   }
 536
 537   return '' unless $years;
 538
 539   warn "$me: renewing ". $svc_domain->domain. " for $years years\n" if $DEBUG;
 540   my $srs = $self->get_srs;
 541   $rv = $srs->make_request(
 542     {
 543       action     => 'renew',
 544       object     => 'domain',
 545       attributes => {
 546         domain                => $svc_domain->domain,
 547         auto_renew            => 0,
 548         handle                => 'process',
 549         period                => $years,
 550         currentexpirationyear => $year,
 551       }
 552     }
 553   );
 554   die $rv->{response_text} unless $rv->{is_success};
 555
 556   return ''; # Should only get here if renewal succeeded
 557 }
 558
 559 =item revoke
 560
 561 Attempts to revoke the domain registration.  Only succeeds if invoked during the OpenSRS
 562 grace period immediately after registration.
 563
 564 Like most export functions, returns an error message on failure or undef on success.
 565
 566 =cut
 567
 568 sub revoke {
 569   my ( $self, $svc_domain ) = @_;
 570
 571   eval "use Net::OpenSRS;";
 572   return $@ if $@;
 573
 574   my $err = $self->is_supported_domain( $svc_domain );
 575   return $err if $err;
 576
 577   my $srs = $self->get_srs;
 578
 579   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 580   if (!$cookie) {
 581      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 582   }
 583
 584 #  return "Domain registration revocation not enabled" if !$self->option('revoke');
 585   return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain);
 586
 587   return ''; # Should only get here if transfer succeeded
 588 }
 589
 590 =item registrar
 591
 592 Should return a full-blown object representing OpenSRS, but current just returns a hashref
 593 containing the registrar name.
 594
 595 =cut
 596
 597 sub registrar {
 598   return {
 599         name => 'OpenSRS',
 600   };
 601 }
 602
 603 =back
 604
 605 =head1 SEE ALSO
 606
 607 L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
 608 L<FS::Record>, schema.html from the base documentation.
 609
 610
 611 =cut
 612
 613 1;
 614