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   $years = 1 unless $years; #default to 1 year since we don't seem to pass it
 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 some export functions, dies on failure or returns undef on success.
 486 It is always called from the queue.
 487
 488 =cut
 489
 490 sub renew_through {
 491   my ( $self, $svc_domain, $date ) = @_;
 492
 493   warn "$me: renew_through called\n" if $DEBUG;
 494   eval "use Net::OpenSRS;";
 495   die $@ if $@;
 496
 497   unless ( $date ) {
 498     my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
 499     die "Can't renew: no date specified and domain is not in a package."
 500       unless $cust_pkg;
 501     $date = $cust_pkg->bill;
 502   }
 503
 504   my $err = $self->is_supported_domain( $svc_domain );
 505   die $err if $err;
 506
 507   warn "$me: checking status\n" if $DEBUG;
 508   my $rv = $self->get_status($svc_domain);
 509   die "Domain ". $svc_domain->domain. " is not renewable"
 510     unless $rv->{expdate};
 511
 512   die "Can't parse expiration date for ". $svc_domain->domain
 513     unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/;
 514
 515   my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
 516   my $exp = DateTime->new( year   => $year,
 517                            month  => $month,
 518                            day    => $day,
 519                            hour   => $hour,
 520                            minute => $minute,
 521                            second => $second,
 522                            time_zone => 'America/New_York',#timezone of opensrs
 523                          );
 524
 525   my $bill = DateTime->
 526    from_epoch( 'epoch'     => $date,
 527                'time_zone' => DateTime::TimeZone->new( name => 'local' ),
 528   );
 529
 530   my $years = 0;
 531   while ( DateTime->compare( $bill, $exp ) > 0 ) {
 532     $years++;
 533     $exp->add( 'years' => 1 );
 534
 535     die "Can't renew ". $svc_domain->domain. " for more than 10 years."
 536       if $years > 10; #no infinite loop
 537   }
 538
 539   return '' unless $years;
 540
 541   warn "$me: renewing ". $svc_domain->domain. " for $years years\n" if $DEBUG;
 542   my $srs = $self->get_srs;
 543   $rv = $srs->make_request(
 544     {
 545       action     => 'renew',
 546       object     => 'domain',
 547       attributes => {
 548         domain                => $svc_domain->domain,
 549         auto_renew            => 0,
 550         handle                => 'process',
 551         period                => $years,
 552         currentexpirationyear => $year,
 553       }
 554     }
 555   );
 556   die $rv->{response_text} unless $rv->{is_success};
 557
 558   return ''; # Should only get here if renewal succeeded
 559 }
 560
 561 =item revoke
 562
 563 Attempts to revoke the domain registration.  Only succeeds if invoked during the OpenSRS
 564 grace period immediately after registration.
 565
 566 Like most export functions, returns an error message on failure or undef on success.
 567
 568 =cut
 569
 570 sub revoke {
 571   my ( $self, $svc_domain ) = @_;
 572
 573   eval "use Net::OpenSRS;";
 574   return $@ if $@;
 575
 576   my $err = $self->is_supported_domain( $svc_domain );
 577   return $err if $err;
 578
 579   my $srs = $self->get_srs;
 580
 581   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
 582   if (!$cookie) {
 583      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
 584   }
 585
 586 #  return "Domain registration revocation not enabled" if !$self->option('revoke');
 587   return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain);
 588
 589   return ''; # Should only get here if transfer succeeded
 590 }
 591
 592 =item registrar
 593
 594 Should return a full-blown object representing OpenSRS, but current just returns a hashref
 595 containing the registrar name.
 596
 597 =cut
 598
 599 sub registrar {
 600   return {
 601         name => 'OpenSRS',
 602   };
 603 }
 604
 605 =back
 606
 607 =head1 SEE ALSO
 608
 609 L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
 610 L<FS::Record>, schema.html from the base documentation.
 611
 612
 613 =cut
 614
 615 1;
 616