diff options
| -rw-r--r-- | FS/FS/part_export/domreg_opensrs.pm | 287 | ||||
| -rwxr-xr-x | httemplate/edit/process/domreg.cgi | 62 | ||||
| -rwxr-xr-x | httemplate/view/svc_domain.cgi | 62 |
3 files changed, 383 insertions, 28 deletions
diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm index 0ef371a7b..1799ed09e 100644 --- a/FS/FS/part_export/domreg_opensrs.pm +++ b/FS/FS/part_export/domreg_opensrs.pm @@ -126,6 +126,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)=@_; @@ -157,6 +165,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; @@ -183,6 +200,13 @@ 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; @@ -191,13 +215,57 @@ sub testmode { 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 - eval "use Net::OpenSRS;"; - return $@ if $@; + 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; +} + +## 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; @@ -210,13 +278,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(); @@ -226,40 +296,201 @@ 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; 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 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(); } - return ''; # Should only get here if register or transfer succeeded +# 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 } -## 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 -## 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 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 "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 +} + +=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 { diff --git a/httemplate/edit/process/domreg.cgi b/httemplate/edit/process/domreg.cgi new file mode 100755 index 000000000..b643638f4 --- /dev/null +++ b/httemplate/edit/process/domreg.cgi @@ -0,0 +1,62 @@ +%if ($error) { +% $cgi->param('error', $error); +<% $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum") %> +%} else { +<% $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum") %> +%} +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Provision customer service'); #something else more specific? + +$cgi->param('op') =~ /^(register|transfer|revoke|renew)$/ or die "Illegal operation"; +my $operation = $1; +#my($query) = $cgi->keywords; +#$query =~ /^(\d+)$/; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +my $svcnum = $1; +my $svc_domain = qsearchs({ + 'select' => 'svc_domain.*', + 'table' => 'svc_domain', + 'addl_from' => ' LEFT JOIN cust_svc USING ( svcnum ) '. + ' LEFT JOIN cust_pkg USING ( pkgnum ) '. + ' LEFT JOIN cust_main USING ( custnum ) ', + 'hashref' => {'svcnum'=>$svcnum}, + 'extra_sql' => ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql, +}); +die "Unknown svcnum" unless $svc_domain; + +my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); +my $part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); +die "Unknown svcpart" unless $part_svc; + +my $error = ''; + +my @exports = $part_svc->part_export(); + +my $registrar; +my $export; + +# Find the first export that does domain registration +foreach (@exports) { + $export = $_ if $_->can('registrar'); +} + +my $period = 1; # Current OpenSRS export can only handle 1 year registrations + +# If we have a domain registration export, get the registrar object +if ($export) { + if ($operation eq 'register') { + $error = $export->register( $svc_domain, $period ); + } elsif ($operation eq 'transfer') { + $error = $export->transfer( $svc_domain ); + } elsif ($operation eq 'revoke') { + $error = $export->revoke( $svc_domain ); + } elsif ($operation eq 'renew') { + $cgi->param('period') =~ /^(\d+)$/ or die "Illegal renewal period!"; + $period = $1; + $error = $export->renew( $svc_domain, $period ); + } +} + +</%init> diff --git a/httemplate/view/svc_domain.cgi b/httemplate/view/svc_domain.cgi index 36577d39c..1e93b9461 100755 --- a/httemplate/view/svc_domain.cgi +++ b/httemplate/view/svc_domain.cgi @@ -7,9 +7,38 @@ ) )) %> +<% include('/elements/error.html') %> + Service #<% $svcnum %> <BR>Service: <B><% $part_svc->svc %></B> <BR>Domain name: <B><% $domain %></B> +% if ($export) { +<BR>Status: <B><% $status %></B> +% if ( $FS::CurrentUser::CurrentUser->access_right('Change customer service') ) { +% if ( defined($ops{'register'}) ) { + <A HREF="<% ${p} %>edit/process/domreg.cgi?op=register&svcnum=<% $svcnum %>">Register at <% $registrar->{'name'} %></A> +% } +% if ( defined($ops{'transfer'}) ) { + <A HREF="<% ${p} %>edit/process/domreg.cgi?op=transfer&svcnum=<% $svcnum %>">Transfer to <% $registrar->{'name'} %></A> +% } +% if ( defined($ops{'renew'}) ) { + <FORM NAME="Renew" METHOD="POST" ACTION="<% ${p} %>edit/process/domreg.cgi"> + <INPUT TYPE="hidden" NAME="svcnum" VALUE="<%$svcnum%>"> + <INPUT TYPE="hidden" NAME="op" VALUE="renew"> + <SELECT NAME="period"> +% foreach (1..10) { + <OPTION VALUE="<%$_%>"><%$_%> year<% $_ > 1 ? 's' : '' %></OPTION> +% } + </SELECT> + <INPUT TYPE="submit" VALUE="Renew"> + </FORM> +% } +% if ( defined($ops{'revoke'}) ) { + <A HREF="<% ${p} %>edit/process/domreg.cgi?op=revoke&svcnum=<% $svcnum %>">Revoke</A> +% } +% } +% } + % if ( $FS::CurrentUser::CurrentUser->access_right('Edit domain catchall') ) { <BR>Catch all email <A HREF="<% ${p} %>misc/catchall.cgi?<% $svcnum %>">(change)</A>: % } else { @@ -158,4 +187,37 @@ if ($svc_domain->catchall) { my $domain = $svc_domain->domain; +my $status = 'Unknown'; +my %ops = (); + +my @exports = $part_svc->part_export(); + +my $registrar; +my $export; + +# Find the first export that does domain registration +foreach (@exports) { + $export = $_ if $_->can('registrar'); +} +# If we have a domain registration export, get the registrar object +if ($export) { + $registrar = $export->registrar; + my $domstat = $export->get_status( $svc_domain ); + if (defined($domstat->{'message'})) { + $status = $domstat->{'message'}; + } elsif (defined($domstat->{'unregistered'})) { + $status = 'Not registered'; + $ops{'register'} = "Register"; + } elsif (defined($domstat->{'status'})) { + $status = $domstat->{'status'} . ' ' . $domstat->{'contact_email'} . ' ' . $domstat->{'last_update_time'}; + } elsif (defined($domstat->{'expdate'})) { + $status = "Expires " . $domstat->{'expdate'}; + $ops{'renew'} = "Renew"; + $ops{'revoke'} = "Revoke"; + } else { + $status = $domstat->{'reason'}; + $ops{'transfer'} = "Transfer"; + } +} + </%init> |