X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fdomreg_opensrs.pm;h=4d6ea8f913fea30952717921d8858093bdcffcaf;hb=7b125e587a4d1ee0aca692e23ea7897f671855ae;hp=5d5c59530ae62c1d1352af86201fe08ccefa3ec2;hpb=4f1256b03a041ddf12faa8e7891065ad5e1e9399;p=freeside.git

diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm
index 5d5c59530..4d6ea8f91 100644
--- a/FS/FS/part_export/domreg_opensrs.pm
+++ b/FS/FS/part_export/domreg_opensrs.pm
@@ -1,13 +1,13 @@
 package FS::part_export::domreg_opensrs;
 
-use vars qw(@ISA %info %options $conf);
+use vars qw(@ISA %info %options $conf $me $DEBUG);
 use Tie::IxHash;
+use DateTime;
 use FS::Record qw(qsearchs qsearch);
 use FS::Conf;
 use FS::part_export::null;
 use FS::svc_domain;
 use FS::part_pkg;
-use Net::OpenSRS;
 
 =head1 NAME
 
@@ -32,9 +32,15 @@ on the setting of the svc_domain's action field.
 
 =back
 
+This export uses Net::OpenSRS.  Registration and transfer attempts will fail unless Net::OpenSRS is installed
+and LWP::UserAgent is able to make HTTPS posts.  You can turn on debugging messages and use the OpenSRS test
+gateway when setting up this export.
+
 =cut
 
 @ISA = qw(FS::part_export::null);
+$me = '[' .  __PACKAGE__ . ']';
+$DEBUG = 0;
 
 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/;
 
@@ -47,6 +53,10 @@ tie %options, 'Tie::IxHash',
                       },
   'masterdomain' => { label => 'Master domain at OpenSRS',
                       },
+  'wait_for_pay' => { label => 'Do not provision until payment is received',
+                      type => 'checkbox',
+                      default => '0',
+                    },
   'debug_level'  => { label => 'Net::OpenSRS debug level',
                       type => 'select',
                       options => [ 0, 1, 2, 3 ],
@@ -123,6 +133,14 @@ sub format_tel {
   return $tel;
 }
 
+=item gen_contact_info
+
+Generates contact data for the domain based on the customer data.
+
+Currently relies on Net::OpenSRS to format the telephone number for OpenSRS.
+
+=cut
+
 sub gen_contact_info
 {
   my ($co)=@_;
@@ -154,6 +172,15 @@ sub gen_contact_info
   return $c;
 }
 
+=item validate_contact_info
+
+Attempts to validate contact data for the domain based on OpenSRS rules.
+
+Returns undef if the contact data is acceptable, an error message if the contact
+data lacks one or more required fields.
+
+=cut
+
 sub validate_contact_info {
   my $c = shift;
 
@@ -180,19 +207,88 @@ sub validate_contact_info {
   undef;
 }
 
+=item testmode
+
+Returns the Net::OpenSRS-required test mode string based on whether the export
+is configured to use the live or the test gateway.
+
+=cut
+
 sub testmode {
   my $self = shift;
 
   return 'live' if $self->machine eq "rr-n1-tor.opensrs.net";
   return 'test' if $self->machine eq "horizon.opensrs.net";
   undef;
+
 }
 
+=item _export_insert
+
+Attempts to "export" the domain, i.e. register or transfer it if the user selected
+that option when editing the domain.
+
+Returns an error message on failure or undef on success.
+
+May also return an error message if it cannot load the required Perl module Net::OpenSRS,
+or if the domain is not registerable, or if insufficient data is provided in the customer
+record to generate the required contact information to register or transfer the domain.
+
+=cut
+
 sub _export_insert {
   my( $self, $svc_domain ) = ( shift, shift );
 
   return if $svc_domain->action eq 'I';  # Ignoring registration, just doing DNS
 
+  if ($svc_domain->action eq 'N') {
+    return $self->register( $svc_domain );
+  } elsif ($svc_domain->action eq 'M') {
+    return $self->transfer( $svc_domain );
+  } 
+  return "Unknown domain action " . $svc_domain->action;
+}
+
+sub _export_insert_on_payment {
+  my( $self, $svc_domain ) = ( shift, shift );
+  warn "$me:_export_insert_on_payment called\n" if $DEBUG;
+  return '' unless $self->option('wait_for_pay');
+
+  my $queue = new FS::queue {
+    'svcnum' => $svc_domain->svcnum,
+    'job'    => 'FS::part_export::domreg_opensrs::renew_through',
+  };
+  $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action?
+
+  return '';
+}
+
+## Domain registration exports do nothing on replace.  Mainly because we haven't decided what they should do.
+#sub _export_replace {
+#  my( $self, $new, $old ) = (shift, shift, shift);
+#
+#  return '';
+#
+#}
+
+## Domain registration exports do nothing on delete.  You're just removing the domain from Freeside, not the registry
+#sub _export_delete {
+#  my( $self, $svc_domain ) = ( shift, shift );
+#
+#  return '';
+#}
+
+=item is_supported_domain
+
+Return undef if the domain name uses a TLD or SLD that is supported by this registrar.
+Otherwise return an error message explaining what's wrong.
+
+=cut
+
+sub is_supported_domain {
+  my $self = shift;
+  my $svc_domain = shift;
+
   # Get the TLD of the new domain
   my @bits = split /\./, $svc_domain->domain;
 
@@ -204,13 +300,15 @@ sub _export_insert {
   my @tlds = split /\s+/, $self->option('tlds');
   @tlds =  map { s/\.//; $_ } @tlds;
   return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds;
+  return undef;
+}
 
-  my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
+=item get_srs
 
-  my $c = gen_contact_info($cust_main);
+=cut
 
-  my $err = validate_contact_info($c);
-  return $err if $err;
+sub get_srs {
+  my $self = shift;
 
   my $srs = Net::OpenSRS->new();
 
@@ -220,40 +318,280 @@ sub _export_insert {
   $srs->set_key( $self->option('privatekey') );
 
   $srs->set_manage_auth( $self->option('username'), $self->option('password') );
+  return $srs;
+}
+
+=item get_status
+
+Returns a reference to a hashref containing information on the domain's status.  The keys
+defined depend on the status.
+
+'unregistered' means the domain is not registered.
+
+Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state
+of that operation.
+
+Otherwise returns a value indicating if the domain can be managed through our reseller account.
+
+=cut
+
+sub get_status {
+  my ( $self, $svc_domain ) = @_;
+  my $rslt = {};
+
+  eval "use Net::OpenSRS;";
+  return $@ if $@;
+
+  my $srs = $self->get_srs;
+
+  if ($srs->is_available( $svc_domain->domain )) {
+    $rslt->{'unregistered'} = 1;
+  } else {
+    $rslt = $srs->check_transfer( $svc_domain->domain );
+    if (defined($rslt->{'reason'})) {
+      my $rv = $srs->make_request(
+        {
+          action     => 'belongs_to_rsp',
+          object     => 'domain',
+          attributes => {
+            domain => $svc_domain->domain
+          }
+        }
+      );
+      if ($rv) {
+        $self->_set_response;
+        if ( $rv->{attributes}->{'domain_expdate'} ) {
+	  $rslt->{'expdate'} = $rv->{attributes}->{'domain_expdate'};
+        }
+      }
+    }
+  }
+
+  return $rslt; # Success
+}
+
+=item register
+
+Attempts to register the domain through the reseller account associated with this export.
+
+Like most export functions, returns an error message on failure or undef on success.
+
+=cut
+
+sub register {
+  my ( $self, $svc_domain, $years ) = @_;
+
+  return "Net::OpenSRS does not support period other than 1 year" if $years != 1;
+
+  eval "use Net::OpenSRS;";
+  return $@ if $@;
+
+  my $err = $self->is_supported_domain( $svc_domain );
+  return $err if $err;
+
+  my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
+
+  my $c = gen_contact_info($cust_main);
+
+  $err = validate_contact_info($c);
+  return $err if $err;
+
+  my $srs = $self->get_srs;
+
+#  cookie not required for registration
+#  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
+#  if (!$cookie) {
+#     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
+#  }
+
+#  return "Domain registration not enabled" if !$self->option('register');
+  return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
+
+  return ''; # Should only get here if register succeeded
+}
+
+=item transfer
+
+Attempts to transfer the domain into the reseller account associated with this export.
+
+Like most export functions, returns an error message on failure or undef on success.
+
+=cut
+
+sub transfer {
+  my ( $self, $svc_domain ) = @_;
+
+  eval "use Net::OpenSRS;";
+  return $@ if $@;
+
+  my $err = $self->is_supported_domain( $svc_domain );
+  return $err if $err;
+
+  my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
+
+  my $c = gen_contact_info($cust_main);
+
+  $err = validate_contact_info($c);
+  return $err if $err;
+
+  my $srs = $self->get_srs;
 
   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
   if (!$cookie) {
      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
   }
 
-  if ($svc_domain->action eq 'N') {
-#    return "Domain registration not enabled" if !$self->option('register');
-    return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
-  } elsif ($svc_domain->action eq 'M') {
-#    return "Domain transfer not enabled" if !$self->option('transfer');
-    return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c);
-  } else {
-    return "Unknown domain action " . $svc_domain->action;
+#  return "Domain transfer not enabled" if !$self->option('transfer');
+  return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c);
+
+  return ''; # Should only get here if transfer succeeded
+}
+
+=item renew
+
+Attempts to renew the domain for the specified number of years.
+
+Like most export functions, returns an error message on failure or undef on success.
+
+=cut
+
+sub renew {
+  my ( $self, $svc_domain, $years ) = @_;
+
+  eval "use Net::OpenSRS;";
+  return $@ if $@;
+
+  my $err = $self->is_supported_domain( $svc_domain );
+  return $err if $err;
+
+  my $srs = $self->get_srs;
+
+  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
+  if (!$cookie) {
+     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
   }
 
-  return ''; # Should only get here if register or transfer succeeded
+#  return "Domain renewal not enabled" if !$self->option('renew');
+  return $srs->last_response() if !$srs->renew_domain( $svc_domain->domain, $years );
 
+  return ''; # Should only get here if renewal succeeded
 }
 
-## Domain registration exports do nothing on replace.  Mainly because we haven't decided what they should do.
-#sub _export_replace {
-#  my( $self, $new, $old ) = (shift, shift, shift);
-#
-#  return '';
-#
-#}
+=item renew_through [ EPOCH_DATE ]
 
-## Domain registration exports do nothing on delete.  You're just removing the domain from Freeside, not the registry
-#sub _export_delete {
-#  my( $self, $svc_domain ) = ( shift, shift );
-#
-#  return '';
-#}
+Attempts to renew the domain through the specified date.  If no date is
+provided it is gleaned from the associated cust_pkg bill date
+
+Like most export functions, returns an error message on failure or undef on success.
+
+=cut
+
+sub renew_through {
+  my ( $self, $svc_domain, $date ) = @_;
+
+  warn "$me: renew_through called\n" if $DEBUG;
+  eval "use Net::OpenSRS;";
+  return $@ if $@;
+
+  unless ( $date ) {
+    my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
+    return "Can't renew: no date specified and domain is not in a package."
+      unless $cust_pkg;
+    $date = $cust_pkg->bill;
+  }
+
+  my $err = $self->is_supported_domain( $svc_domain );
+  return $err if $err;
+
+  warn "$me: checking status\n" if $DEBUG;
+  my $rv = $self->get_status($svc_domain);
+  return "Domain ". $svc_domain->domain. " is not renewable"
+    unless $rv->{expdate};
+
+  return "Can't parse expiration date for ". $svc_domain->domain
+    unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/;
+
+  my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
+  my $exp = DateTime->new( year   => $year,
+                           month  => $month,
+                           day    => $day,
+                           hour   => $hour,
+                           minute => $minute,
+                           second => $second,
+                           time_zone => 'America/New_York',#timezone of opensrs
+                         );
+
+  my $bill = DateTime->
+   from_epoch( 'epoch'     => $date,
+               'time_zone' => DateTime::TimeZone->new( name => 'local' ),
+  );
+
+  my $years = 0;
+  while ( DateTime->compare( $bill, $exp ) > 0 ) {
+    $years++;
+    $exp->add( 'years' => 1 );
+
+    return "Can't renew ". $svc_domain->domain. " for more than 10 years."
+      if $years > 10; #no infinite loop
+  }
+
+  warn "$me: renewing ". $svc_domain->domain. "for $years years\n" if $DEBUG;
+  my $srs = $self->get_srs;
+  $rv = $srs->make_request(
+    {
+      action     => 'renew',
+      object     => 'domain',
+      attributes => {
+        domain                => $svc_domain->domain,
+        auto_renew            => 0,
+        handle                => 'process',
+        period                => $years,
+        currentexpirationyear => $year,
+      }
+    }
+  );
+  return $rv->{response_text} unless $rv->{is_success};
+
+  return ''; # Should only get here if renewal succeeded
+}
+
+=item revoke
+
+Attempts to revoke the domain registration.  Only succeeds if invoked during the OpenSRS
+grace period immediately after registration.
+
+Like most export functions, returns an error message on failure or undef on success.
+
+=cut
+
+sub revoke {
+  my ( $self, $svc_domain ) = @_;
+
+  eval "use Net::OpenSRS;";
+  return $@ if $@;
+
+  my $err = $self->is_supported_domain( $svc_domain );
+  return $err if $err;
+
+  my $srs = $self->get_srs;
+
+  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
+  if (!$cookie) {
+     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
+  }
+
+#  return "Domain registration revocation not enabled" if !$self->option('revoke');
+  return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain);
+
+  return ''; # Should only get here if transfer succeeded
+}
+
+=item registrar
+
+Should return a full-blown object representing OpenSRS, but current just returns a hashref
+containing the registrar name.
+
+=cut
 
 sub registrar {
   return {
@@ -265,9 +603,10 @@ sub registrar {
 
 =head1 SEE ALSO
 
-L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
+L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
 L<FS::Record>, schema.html from the base documentation.
 
+
 =cut
 
 1;