From: rsiddall Date: Fri, 15 May 2009 19:41:34 +0000 (+0000) Subject: Simple domain registration at Tucows OpenSRS using an export based on Net::OpenSRS. X-Git-Tag: root_of_svc_elec_features~1198 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=ad84bf7cfdb56aa1fe268ea315b7a2f7dd768db2 Simple domain registration at Tucows OpenSRS using an export based on Net::OpenSRS. When a domain is added and the export runs, it will register the domain or initiate a transfer. You can also choose no action. There's currently no provision for revoking domains or renewing registrations. Depending on the settings at OpenSRS, orders may look like they've succeeded in Freeside but actually be queued pending input by the reseller at OpenSRS. The part_export CGIs were modified to allow a multi-valued select to be used to control which TLDs are enabled for registration. --- diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm new file mode 100644 index 000000000..ec73d3ce5 --- /dev/null +++ b/FS/FS/part_export/domreg_opensrs.pm @@ -0,0 +1,245 @@ +package FS::part_export::domreg_opensrs; + +use vars qw(@ISA %info %options $conf); +use Tie::IxHash; +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 + +FS::part_export::domreg_opensrs - Register or transfer domains with Tucows OpenSRS + +=head1 DESCRIPTION + +This module handles registering and transferring domains using a registration service provider (RSP) account +at Tucows OpenSRS, an ICANN-approved domain registrar. + +As a part_export, this module can be designated for use with svc_domain services. When the svc_domain object +is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending +on the setting of the svc_domain's action field. + +=over 4 + +=item N - Register the domain + +=item M - Transfer the domain + +=item I - Ignore the domain for registration purposes + +=back + +=cut + +@ISA = qw(FS::part_export::null); + +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/; + +tie %options, 'Tie::IxHash', + 'username' => { label => 'Reseller user name at OpenSRS', + }, + 'privatekey' => { label => 'Private key', + }, + 'password' => { label => 'Password for management account', + }, + 'masterdomain' => { label => 'Master domain at OpenSRS', + }, + 'debug_level' => { label => 'Net::OpenSRS debug level', + type => 'select', + options => [ 0, 1, 2, 3 ], + default => 0 }, + 'register' => { label => 'Use for registration', + type => 'checkbox', + default => '1' }, + 'transfer' => { label => 'Use for transfer', + type => 'checkbox', + default => '1' }, + 'tlds' => { label => 'Use this export for these top-level domains (TLDs)', + type => 'select', + multi => 1, + size => scalar(@tldlist), + options => [ @tldlist ], + default => 'com net org' }, +; + +%info = ( + 'svc' => 'svc_domain', + 'desc' => 'Domain registration via Tucows OpenSRS', + 'options' => \%options, + 'notes' => <<'END' +Registers and transfers domains via the Tucows OpenSRS registrar (using Net::OpenSRS). +All of the Net::OpenSRS restrictions apply: + +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. +

Use these buttons for some useful presets: + +END +); + +install_callback FS::UID sub { + $conf = new FS::Conf; +}; + +=head1 METHODS + +=over 4 + +=item format_tel + +Reformats a phone number according to registry rules. Currently Freeside stores phone numbers +in NANPA format and the registry prefers "+CCC.NPANPXNNNN" + +=cut + +sub format_tel { + my $tel = shift; + + #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})( x(\d+))?$/) { + if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) { + $tel = "+1.$1$2$3"; +# if $tel .= "$4" if $4; + } + return $tel; +} + +sub gen_contact_info +{ + my ($co)=@_; + + my @invoicing_list = $co->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $co->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $c = { + firstname => $co->first, + lastname => $co->last, + company => $co->company, + address => $co->address1, + city => $co->city(), + state => $co->state(), + zip => $co->zip(), + country => uc($co->country()), + email => $email, + #phone => format_tel($co->daytime()), + phone => $co->daytime() || $co->night, + }; + return $c; +} + +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; +} + +sub _export_insert { + my( $self, $svc_domain ) = ( shift, shift ); + + return if $svc_domain->action eq 'I'; # Ignoring registration, just doing DNS + + # Get the TLD of the new domain + my @bits = split /\./, $svc_domain->domain; + + return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2; + + my $tld = pop @bits; + + # See if it's one this export supports + 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; + + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $c = gen_contact_info($cust_main); + + my $srs = Net::OpenSRS->new(); + + $srs->debug_level( $self->option('debug_level') ); # Output should be in the Apache error log + + $srs->environment( $self->testmode() ); + $srs->set_key( $self->option('privatekey') ); + + $srs->set_manage_auth( $self->option('username'), $self->option('password') ); + + 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 ''; # Should only get here if register or 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 ''; +# +#} + +## 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 ''; +#} + +sub registrar { + return { + name => 'OpenSRS', + }; +} + +=back + +=head1 SEE ALSO + +L, L, L, +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 47aa8f32e..dd4f2c52f 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -388,7 +388,6 @@ sub check { or $self->ut_numbern('setup_date') or $self->ut_numbern('renewal_interval') or $self->ut_numbern('expiration_date') - or $self->ut_textn('purpose') or $self->SUPER::check; } diff --git a/httemplate/edit/part_export.cgi b/httemplate/edit/part_export.cgi index d57979751..8b697e142 100644 --- a/httemplate/edit/part_export.cgi +++ b/httemplate/edit/part_export.cgi @@ -79,13 +79,28 @@ my $widget = new HTML::Widgets::SelectLayers( ); $html .= qq!$label!; if ( $type eq 'select' ) { - $html .= qq!!; + my @values = split '\s+', $value if $multi; + my @options; + if (defined($optinfo->{option_values})) { + my $valsub = $optinfo->{option_values}; + @options = &$valsub(); + } elsif (defined($optinfo->{options})) { + @options = @{$optinfo->{options}}; + } + foreach my $select_option ( @options ) { #if ( ref($select_option) ) { #} else { - my $selected = $select_option eq $value ? ' SELECTED' : ''; + my $selected = ($multi ? grep {$_ eq $select_option} @values : $select_option eq $value ) ? ' SELECTED' : ''; + my $label = $select_option; + if (defined($optinfo->{option_label})) { + my $labelsub = $optinfo->{option_label}; + $label = &$labelsub($select_option); + } $html .= qq!!; + qq!$label!; #} } $html .= ''; diff --git a/httemplate/edit/process/part_export.cgi b/httemplate/edit/process/part_export.cgi index b5f82e892..209419f0b 100644 --- a/httemplate/edit/process/part_export.cgi +++ b/httemplate/edit/process/part_export.cgi @@ -16,7 +16,8 @@ my $old = qsearchs('part_export', { 'exportnum'=>$exportnum } ) if $exportnum; #fixup options #warn join('-', split(',',$cgi->param('options'))); my %options = map { - my $value = $cgi->param($_); + my @values = $cgi->param($_); + my $value = scalar(@values) > 1 ? join (' ', @values) : $values[0]; $value =~ s/\r\n/\n/g; #browsers? (textarea) $_ => $value; } split(',', $cgi->param('options')); diff --git a/httemplate/edit/process/svc_domain.cgi b/httemplate/edit/process/svc_domain.cgi index 9993a879e..59b518097 100755 --- a/httemplate/edit/process/svc_domain.cgi +++ b/httemplate/edit/process/svc_domain.cgi @@ -18,8 +18,8 @@ my $svcnum = $1; my $new = new FS::svc_domain ( { map { $_, scalar($cgi->param($_)); - #} qw(svcnum pkgnum svcpart domain action purpose) - } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) ) + #} qw(svcnum pkgnum svcpart domain action) + } ( fields('svc_domain'), qw( pkgnum svcpart action ) ) } ); my $error = ''; diff --git a/httemplate/edit/svc_domain.cgi b/httemplate/edit/svc_domain.cgi index 56ba604bf..10079ce98 100755 --- a/httemplate/edit/svc_domain.cgi +++ b/httemplate/edit/svc_domain.cgi @@ -7,17 +7,31 @@ ->New +<% ntable("#cccccc",2) %> + +

Domain
+% if ($export) { +Available top-level domains: <% $export->option('tlds') %> + ->Transfer + +>Register at <% $registrar->{'name'} %> +
-

Domain +>Transfer to <% $registrar->{'name'} %> +
-
Purpose/Description: +>Registered elsewhere -

+ + +% } + +

+ + <% include('/elements/footer.html') %> @@ -27,7 +41,7 @@ die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Provision customer service'); #something else more specific? -my($svcnum, $pkgnum, $svcpart, $kludge_action, $purpose, $part_svc, +my($svcnum, $pkgnum, $svcpart, $kludge_action, $part_svc, $svc_domain); if ( $cgi->param('error') ) { @@ -38,7 +52,6 @@ if ( $cgi->param('error') ) { $pkgnum = $cgi->param('pkgnum'); $svcpart = $cgi->param('svcpart'); $kludge_action = $cgi->param('action'); - $purpose = $cgi->param('purpose'); $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); die "No part_svc entry!" unless $part_svc; @@ -61,7 +74,6 @@ if ( $cgi->param('error') ) { } else { #editing $kludge_action = ''; - $purpose = ''; my($query) = $cgi->keywords; $query =~ /^(\d+)$/ or die "unparsable svcnum"; $svcnum=$1; @@ -82,6 +94,20 @@ my $action = $svcnum ? 'Edit' : 'Add'; my $svc = $part_svc->getfield('svc'); +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 $otaker = getotaker; my $domain = $svc_domain->domain;