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