FS/FS/part_export/domreg_opensrs.pm

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