diff options
| -rw-r--r-- | FS/FS/part_export/domreg_opensrs.pm | 245 | ||||
| -rw-r--r-- | FS/FS/svc_domain.pm | 1 | ||||
| -rw-r--r-- | httemplate/edit/part_export.cgi | 23 | ||||
| -rw-r--r-- | httemplate/edit/process/part_export.cgi | 3 | ||||
| -rwxr-xr-x | httemplate/edit/process/svc_domain.cgi | 4 | ||||
| -rwxr-xr-x | httemplate/edit/svc_domain.cgi | 42 |
6 files changed, 302 insertions, 16 deletions
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 <a href="http://opensrs.com/">Tucows OpenSRS</a> registrar (using <a href="http://search.cpan.org/dist/Net-OpenSRS">Net::OpenSRS</a>). +All of the Net::OpenSRS restrictions apply: +<UL> + <LI>You must have a reseller account with Tucows. + <LI>You must add the public IP address of the Freeside server to the 'Script API allow' list in the OpenSRS web interface. + <LI>You must generate an API access key in the OpenSRS web interface and enter it below. + <LI>All domains are managed using the same user name and password, but you can create sub-accounts for clients. + <LI>The user name must be the same as your OpenSRS reseller ID. + <LI>You must enter a master domain that all other domains are associated with. That domain must be registered through your OpenSRS account. +</UL> +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. +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick=' + document.dummy.machine.value = "rr-n1-tor.opensrs.net"; + this.form.machine.value = "rr-n1-tor.opensrs.net"; + '> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick=' + document.dummy.machine.value = "horizon.opensrs.net"; + this.form.machine.value = "horizon.opensrs.net"; + '> +</UL> +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<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>, +L<FS::Record>, 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!<TR><TD ALIGN="right">$label</TD><TD>!; if ( $type eq 'select' ) { - $html .= qq!<SELECT NAME="$option">!; - foreach my $select_option ( @{$optinfo->{options}} ) { + my $size = defined($optinfo->{size}) ? " SIZE=" . $optinfo->{size} : ''; + my $multi = defined($optinfo->{multi}) ? ' MULTIPLE' : ''; + $html .= qq!<SELECT NAME="$option"$multi$size>!; + 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!<OPTION VALUE="$select_option"$selected>!. - qq!$select_option</OPTION>!; + qq!$label</OPTION>!; #} } $html .= '</SELECT>'; 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 @@ <INPUT TYPE="hidden" NAME="pkgnum" VALUE="<% $pkgnum %>"> <INPUT TYPE="hidden" NAME="svcpart" VALUE="<% $svcpart %>"> -<INPUT TYPE="radio" NAME="action" VALUE="N"<% $kludge_action eq 'N' ? ' CHECKED' : '' %>>New +<% ntable("#cccccc",2) %> +<TR> +<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="<% $domain %>" SIZE=28 MAXLENGTH=63> <BR> +% if ($export) { +Available top-level domains: <% $export->option('tlds') %> +</TR> -<INPUT TYPE="radio" NAME="action" VALUE="M"<% $kludge_action eq 'M' ? ' CHECKED' : '' %>>Transfer +<TR> +<INPUT TYPE="radio" NAME="action" VALUE="N"<% $kludge_action eq 'N' ? ' CHECKED' : '' %>>Register at <% $registrar->{'name'} %> +<BR> -<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="<% $domain %>" SIZE=28 MAXLENGTH=63> +<INPUT TYPE="radio" NAME="action" VALUE="M"<% $kludge_action eq 'M' ? ' CHECKED' : '' %>>Transfer to <% $registrar->{'name'} %> +<BR> -<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="<% $purpose %>" SIZE=64> +<INPUT TYPE="radio" NAME="action" VALUE="I"<% $kludge_action eq 'I' ? ' CHECKED' : '' %>>Registered elsewhere -<P><INPUT TYPE="submit" VALUE="Submit"> +</TR> + +% } +<TR> +<P><INPUT TYPE="submit" VALUE="Submit"> +</TR> +</TABLE> </FORM> <% 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; |