diff options
author | cvs2git <cvs2git> | 2009-10-11 02:42:17 +0000 |
---|---|---|
committer | cvs2git <cvs2git> | 2009-10-11 02:42:17 +0000 |
commit | a83a000a027d1272e813259d09230d701d84df64 (patch) | |
tree | 71500c957e6d7db3e1ad3d59e74ca7bbb14e44ff /FS/FS/part_export/domreg_opensrs.pm | |
parent | 097a12385d80ef52f37d4cc2bb93bc3f81e6f8e6 (diff) | |
parent | 0b69c091543b56a45f2ae6b8718fc67f381a6686 (diff) |
This commit was manufactured by cvs2svn to create branchfreeside_1_9_1
'FREESIDE_1_9_BRANCH'.
Diffstat (limited to 'FS/FS/part_export/domreg_opensrs.pm')
-rw-r--r-- | FS/FS/part_export/domreg_opensrs.pm | 512 |
1 files changed, 512 insertions, 0 deletions
diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm new file mode 100644 index 0000000..1799ed0 --- /dev/null +++ b/FS/FS/part_export/domreg_opensrs.pm @@ -0,0 +1,512 @@ +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; + +=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 + +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); + +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; +} + +=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)=@_; + + 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; +} + +=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; + + my %fields = ( + firstname => "first name", + lastname => "last name", + address => "street address", + city => "city", + state => "state", + zip => "ZIP/postal code", + country => "country", + email => "email address", + phone => "phone number", + ); + my @err = (); + foreach (keys %fields) { + if (!defined($c->{$_}) || !$c->{$_}) { + push @err, $fields{$_}; + } + } + if (scalar(@err) > 0) { + return "Contact information needs: " . join(', ', @err); + } + 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; +} + +## 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; + + 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; + return undef; +} + +=item get_srs + +=cut + +sub get_srs { + my $self = shift; + + 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') ); + 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(); + } + +# 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 "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 "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 { + name => 'OpenSRS', + }; +} + +=back + +=head1 SEE ALSO + +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; + |