3 Net::OpenSRS - Domain registration via the Tucows OpenSRS HTTPS XML API
7 This is a wrapper interface to the DNS portions of the Tucows OpenSRS
10 The client library distributed by OpenSRS can be difficult to integrate
11 into a custom environment, and their web interface becomes quickly
12 tedious with heavy usage. This is a clean and relatively quick library
13 to perform the most common API methods described in the OpenSRS API
20 my $key = 'Your_API_Key_From_The_Reseller_Interface';
21 my $srs = Net::OpenSRS->new();
23 $srs->environment('live');
24 $srs->set_key( $key );
26 $srs->set_manage_auth( 'manage_username', 'manage_password' );
28 my $cookie = $srs->get_cookie( 'spime.net' );
30 print "Cookie: $cookie\n";
32 print $srs->last_response() . "\n";
35 # do a batch of domain locks
36 $srs->bulk_lock([ 'example.com', 'example.net', ... ]);
39 my $result = $srs->renew_domain( 'example.com' );
46 This module requires some setup in the OpenSRS reseller environment
47 before it will work correctly.
51 =item Reseller account
53 You need to have an OpenSRS account, of course. If you aren't an
54 OpenSRS reseller, this module will be of limited use to you. :)
56 =item Script API network access
58 The machine(s) using this module need to have their public IP addresses
59 added to your 'Script API allow' list in the OpenSRS web interface.
60 (You'll only need to do this once, assuming your IP doesn't change.)
62 =item API key generation
64 You'll need to pregenerate your API keys - also in the the OpenSRS web
65 interface. These keys are used for all reseller API authentication.
71 OpenSRS allows for a variety of ways to organize your domains. Because
72 of this, writing a 'one size fits all' module is rather difficult.
73 Instead, we make a few assumptions regarding the way people use their
74 OpenSRS reseller accounts.
76 **** These assumptions will ultimately determine if this module is right for
77 you! Please read them carefully! ****
81 =item Management 'master' account.
83 We assume that all domains are under one global management owner
84 account. If customers want access to the management interface, we're
85 operating under the idea that you create subaccounts for them -
86 retainting the master account information for your own use. (If you
87 aren't doing this, it really makes things easier for you in the long
90 For example, 'spime.net' is my master management account. Before doing
91 any register_domain() calls, I call master_domain('spime.net') - then
92 any transfers or registrations from that point forward are linked to
93 'spime.net'. If a customer wants access to the SRS web management
94 interface, I can then just create a subaccount for just their domain,
95 so I retain absolute control -- in the event a customer forgets their
96 password, I'm covered.
100 We assume that your management username 'master' account is identical to
101 your reseller username, and just the passwords differ.
103 =item Default registration info
105 We assume you've properly set up default technical contact information,
106 including your default nameservers, in the OpenSRS reseller web
111 Unless otherwise noted, all methods return true on success, false on
112 failure, and undefined on caller error.
116 =head2 Default environment
118 This library defaults to the TEST environment. (horizon.) Many API
119 methods don't work in the test environment (SET COOKIE being the most
120 notable example, as any API method relying on a cookie doesn't work
121 either.) Neither does batch processing. Most everything else should be
122 ok. ( See environment() )
124 =head2 The '$c' variable
126 Many methods require customer information. I leave the method of
127 fetching this information entirely to you. All examples below that show
128 a $c variable expect a hashref (or object) that contain these keys:
136 address => '555 Someplace Street',
137 email => 'john@example.com',
138 phone => '503-555-1212',
144 package Net::OpenSRS;
151 use Date::Calc qw/ Add_Delta_Days Today This_Year /;
153 our $VERSION = '0.07_01';
155 *hash = \&Digest::MD5::md5_hex;
157 #----------------------------------------------------------------------
159 #----------------------------------------------------------------------
161 =head1 Utility methods
167 my $srs = Net::OpenSRS->new();
169 Create a new Net::OpenSRS object. There are no options for this
176 my ($class, %opts) = @_;
183 master_domain => undef,
185 bulkhost => 'https://batch.opensrs.net:55443',
187 # reseller auth keys, as generated via the reseller website.
190 host => 'https://rr-n1-tor.opensrs.net:55443',
194 host => 'https://horizon.opensrs.net:55443',
204 return unless $self->debug_level;
205 print STDERR shift() . "\n";
210 Setting the debug level will print various pieces of information to
211 STDERR when connecting to OpenSRS. Use this if something isn't working
212 the way you think it should be.
220 Print current environment, host, and HTTP response.
224 Add XML request and response to output.
228 Add SSL debugging to output.
230 Debugging is off by default. When called without an argument, returns
231 the current debug level.
237 my ($self, $level) = @_;
238 return $self->{config}->{debug} unless $level;
239 $self->{config}->{debug} = $level;
243 =item last_response()
245 All Net::OpenSRS methods set the last OpenSRS API reply in a temporary
246 variable. You can view the contents of this variable using the
247 last_response() method.
249 Note that it is reset on each method call.
251 Returns the last OpenSRS return code and result string, or if passed any
252 true value, instead returns the full XML (parsed into a hashref) of the
253 last OpenSRS return. (perfect for Data::Dumper)
256 200: Command Successful
257 400: Domain example.com does not exist with OpenSRS
263 my ($self, $obj) = @_;
264 return $obj ? $rv : $self->{last_response} || '';
267 =item set_manage_auth()
269 $srs->set_manage_auth( $username, $password );
271 Set the owner management username and password. This is used to fetch
272 cookies, and perform any API methods that require the management cookie.
273 For specifics on this, see the OpenSRS API documentation.
279 my ($self, $user, $pass) = @_;
280 return undef unless $user && $pass;
281 $self->{config}->{username} = $user;
282 $self->{config}->{password} = $pass;
288 Tell the OpenSRS object what secret key to use for authentication.
289 You can generate a new secret key by using the OpenSRS reseller web
290 interface. This key is required to perform any API functions.
292 set_key() is affected by the current environment(). Calling the
293 set_key() method while in the test environment only sets the key for the
294 test environment - likewise for the live environment. To set a key for
295 the live environment, you need to call environment('live') B<first>.
301 my ($self, $key) = @_;
302 return undef unless $key;
303 $self->{config}->{ $self->environment }->{key} = $key;
309 my $env = $srs->environment;
310 $srs->environment('live');
312 Without an argument, returns a string - either 'test', or 'live',
313 depending on the environment the object is currently using.
315 The test environment is the default.
317 If passed an argument (either 'test' or 'live') - switches into the
318 desired environment. You will need to set_key() if you were previously
319 using a different environment, or if you hadn't set_key() yet.
325 my ($self, $env) = @_;
326 return ($self->{config}->{use_test_env} ? 'test' : 'live')
327 unless $env && $env =~ /(test|live)/i;
328 $self->{config}->{use_test_env} =
329 $1 eq 'test' ? 1 : 0;
333 =item master_domain()
335 my $master = $srs->master_domain;
336 $srs->master_domain('spime.net');
338 Without an argument, returns the currently set 'master domain' account.
339 Otherwise, it sets the master domain.
341 New transfers and registrations are linked under this domain, for
342 centralized management. See the 'Assumptions' section, above.
348 my ($self, $domain) = @_;
349 return $self->{config}->{master_domain} unless $domain;
350 $self->{config}->{master_domain} = $domain;
354 # set last status messages/codes in $self,
355 # for the benefit of the caller.
359 $rv->{response_text} =~ s/Error: //;
360 $self->{last_response} = $rv->{response_code} . ": " . $rv->{response_text};
364 #----------------------------------------------------------------------
366 #----------------------------------------------------------------------
370 =head1 OpenSRS API methods
374 =item bulk_lock() / bulk_unlock()
376 Locks or unlocks up to 1000 domains at a time.
378 my $result = $srs->bulk_lock([ 'example.com', 'example.net' ]);
380 Returns remote bulk queue id on successful batch submission.
387 return $self->_bulk_action( 'lock', @_ );
393 return $self->_bulk_action( 'unlock', @_ );
398 my ( $self, $toggle, $domains ) = @_;
399 return undef unless $toggle =~ /lock|unlock/i &&
401 return undef if scalar @$domains >= 1000;
403 $rv = $self->make_request(
407 object => 'bulk_change',
409 change_type => 'domain_lock',
410 change_items => $domains,
411 op_type => lc $toggle,
415 return undef unless $rv;
417 $self->_set_response;
418 return $rv->{is_success} ? $rv->{bulk_change_req_id} : 0;
421 =item check_queued_request()
423 my $result = $srs->check_queued_request( $queue_id );
425 Requires queue id - returned from batch methods such as bulk_lock().
426 Always returns hashref of queue command on success.
427 Check $srs->last_response() for status progress.
431 sub check_queued_request
433 my ( $self, $id ) = @_;
434 return undef unless $id;
436 $rv = $self->make_request(
438 action => 'query_queued_request',
445 return undef unless $rv;
447 $self->_set_response;
448 return $rv->{attributes}->{request_data};
451 =item check_transfer()
453 my $result = $srs->check_transfer( 'example.com' );
455 Checks the status of a transfer in progress. Returns hashref of
456 'contact_email', 'status', and 'last_update_time' for a given domain
457 transfer. The 'status' key is always one of the following:
459 pending_owner (waiting on owner confirmation)
460 pending_admin (waiting on opensrs staff confirmation)
461 pending_registry (waiting on register to complete)
462 completed (transfer done)
463 cancelled (reseller cancelled transfer in progress)
464 undefined (no transfer in progress)
466 If the domain in question has no transfer in progress - instead checks
467 to see if the domain is capable of transfer. Returns hashref of
468 'transferrable' (boolean) and 'reason' (string).
474 my ( $self, $domain ) = @_;
475 return undef unless $domain;
477 $rv = $self->make_request(
479 action => 'check_transfer',
483 get_request_address => 1,
487 return undef unless $rv;
489 $self->_set_response;
490 if ( $rv->{attributes}->{status} ) {
492 status => $rv->{attributes}->{status},
493 last_update_time => $rv->{attributes}->{unixtime},
494 contact_email => $rv->{attributes}->{request_address}
498 return $rv->{attributes}; #(transferrable bool and reason)
504 OpenSRS management APIs require a cookie to be generated, and sent along
505 with the API request.
507 $cookie = $srs->get_cookie( 'example.com ');
508 ($cookie, $expiration_date) = $srs->get_cookie( 'example.com ');
510 Make sure you've set_manage_auth() before attempting any cookie required
513 Returns cookie on success, undefined on error. (Check error with
516 In array context, returns cookie and expiration date of the domain.
522 my ($self, $domain) = @_;
523 return undef unless $domain;
524 $rv = $self->make_request(
529 reg_username => $self->{config}->{username},
530 reg_password => $self->{config}->{password},
535 return undef unless $rv;
537 $self->_set_response;
538 if ($rv->{is_success}) {
541 ? ( $rv->{attributes}->{cookie}, $rv->{attributes}->{expiredate} )
542 : $rv->{attributes}->{cookie};
547 =item get_expiring_domains()
549 my $results = $srs->get_expiring_domains( 60 );
551 Fetch and return OpenSRS hashref of expiring domains, within
552 the specified timeperiod. (In days.)
554 Time period defaults to 30 days.
558 sub get_expiring_domains
560 my ($self, $timeframe) = @_;
563 my $today = join '-', map { sprintf( "%02d", $_ ) } Date::Calc::Today();
564 my $expdate = join '-', map { sprintf( "%02d", $_ ) }
565 Date::Calc::Add_Delta_Days( ( split '-', $today ), $timeframe );
567 $rv = $self->make_request(
569 action => 'get_domains_by_expiredate',
578 return undef unless $rv;
580 $self->_set_response;
581 return $rv->{attributes}->{exp_domains} if $rv->{is_success};
587 Hey OpenSRS! Is this domain registered, or is it available?
589 my $result = $srs->is_available( 'example.com ');
591 Returns true if the domain is available, false if it is already
598 my ($self, $domain) = @_;
599 return undef unless $domain;
600 $rv = $self->make_request(
609 return undef unless $rv;
610 $self->_set_response;
611 return undef unless $rv->{is_success};
612 return $rv->{response_code} == 210 ? 1 : 0;
615 =item register_domain()
617 my $result = $srs->register_domain( 'example.com', $c );
619 Register a new domain. Default nameserver and tech info used from
626 my ($self, $domain, $c, $transfer) = @_;
627 return undef unless $domain;
630 unless ($self->{config}->{username}) {
631 $self->debug("Management auth not set.");
635 $self->debug("2nd arg must be a reference to customer info.");
639 # attempt countryname translation if needed
640 if ( $c->{country} !~ m/^[A-Z]{2,3}$/ ) {
642 $c->{country} = uc( Locales->new->get_code_from_territory($c->{country}) );
644 unless ( defined( $c->{country} ) ) {
645 $self->debug("Invalid country.");
650 my $epp_phone = _parse_phone($c->{phone});
651 unless ( defined( $epp_phone ) ) {
652 $self->debug("Invalid phone number.");
656 # build contact hashref from customer info.
658 first_name => $c->{first_name} || $c->{firstname},
659 last_name => $c->{last_name} || $c->{lastname},
661 state => $c->{state},
662 country => $c->{country},
663 address1 => $c->{address1} || $c->{address},
664 $c->{address2} ? ( address2 => $c->{address2} ) : (),
665 postal_code => $c->{postal_code} || $c->{zip},
666 email => $c->{email},
668 org_name => $c->{org_name} || $c->{company} || 'n/a',
672 action => 'sw_register',
676 custom_nameservers => exists $c->{nameserver_list} ? 1 : 0,
677 exists $c->{nameserver_list} ? ( nameserver_list => $c->{nameserver_list} ) : (),
678 custom_tech_contact => 0,
679 auto_renew => $c->{auto_renew} || 0,
680 period => $c->{period} || 1,
683 admin => $contact_info,
684 billing => $contact_info,
685 owner => $contact_info
687 reg_username => $self->{config}->{username},
688 reg_password => $self->{config}->{password},
689 reg_type => $transfer ? 'transfer' : 'new',
690 reg_domain => $self->{config}->{master_domain}, # link domain to the 'master' account
694 if ( $domain =~ /\.au$/ ) {
695 $hashref->{'attributes'}->{'custom_tech_contact'} = 1;
696 $hashref->{'attributes'}->{'contact_set'}->{'tech'} = $contact_info;
697 my $au_registrant_info = { 'registrant_name' => $c->{'registrant_name'},
698 'eligibility_type' => $c->{'eligibility_type'},
700 $hashref->{'attributes'}->{'tld_data'}->{'au_registrant_info'} = $au_registrant_info;
703 $rv = $self->make_request($hashref);
704 $self->_set_response;
705 return $rv->{is_success};
710 my $result = $srs->renew_domain( 'example.com', 1 );
712 Renew a domain for a period of time in years. 1 year is the default.
718 my ($self, $domain, $years) = @_;
719 return undef unless $domain;
723 unless ($self->{config}->{username}) {
724 $self->debug("Management auth not set.");
728 # get current expiration year (why do they need this, again?)
729 my (undef, $expiration) = $self->get_cookie( $domain );
730 $expiration = $1 if $expiration =~ /^(\d{4})-/;
731 $expiration ||= Date::Calc::This_Year();
733 $rv = $self->make_request(
742 currentexpirationyear => $expiration,
746 $self->_set_response;
747 return $rv->{is_success};
750 =item revoke_domain()
752 Revoke a previously registered domain. This only works if the domain is
753 still within the grace period as defined by the registrar.
754 Requires you to have called set_manage_auth() B<first>.
756 my $result = $srs->revoke_domain( 'example.com' );
758 Returns true if the revoke is successful, false otherwise.
759 Returns undefined on error.
765 my ($self, $domain) = @_;
766 return undef unless $domain;
767 unless ($self->{config}->{username}) {
768 $self->debug("Management auth not set.");
771 $rv = $self->make_request(
776 reseller => $self->{config}->{username},
781 $self->_set_response;
782 return $rv->{is_success};
785 =item transfer_domain()
787 my $result = $srs->transfer_domain( 'example.com', $c );
789 Transfer a domain under your control.
790 Returns true on success, false on failure, and undefined on caller error.
797 return $self->register_domain( @_, 1 );
802 This method is the real workhorse of this module. If any OpenSRS API
803 isn't explicity implemented in this module as a method call (such as
804 get_cookie(), bulk_lock(), etc), you can use make_request() to build and send
809 my $result = $srs->make_request(
813 object => 'bulk_change',
815 change_type => 'domain_lock',
816 change_items => [ 'example.com', 'example.net' ],
822 my $result = $srs->make_request(
827 domain => 'example.com'
832 Returns a hashref containing parsed XML results from OpenSRS.
838 'object' => 'DOMAIN',
839 'response_text' => 'Domain taken',
841 'response_code' => '211',
851 # build opensrs xml protocol string. submit.
852 # convert xml response to data structure, and return.
855 my ($self, $data) = @_;
856 return undef unless ref $data;
858 $self->debug("Using " . $self->environment . " environment.");
860 my $key = $self->{config}->{ $self->environment }->{key};
861 my $host = $self->{config}->{ $self->environment }->{host};
862 $ENV{HTTPS_DEBUG} = 1 if $self->debug_level > 2;
865 $self->debug("Authentication key not set.");
869 my $action = uc $data->{action};
870 my $object = uc $data->{object};
872 # build our XML request.
873 # lets not bother with anything super fancy,
874 # everything but the item keys are always static anyway.
877 <?xml version='1.0' encoding="UTF-8" standalone="no" ?>
878 <!DOCTYPE OPS_envelope SYSTEM "ops.dtd">
880 <header><version>0.9</version></header>
884 <item key="protocol">XCP</item>
885 <item key="action">$action</item>
886 <item key="object">$object</item>
889 $xml .= " <item key=\"cookie\">$data->{cookie}</item>\n" if $data->{cookie};
892 <item key="attributes">
896 foreach (sort keys %{ $data->{attributes} }) {
897 my $val = $data->{attributes}->{$_};
898 $xml .= $self->_format( $val, 4 );
909 # whoof, ok. got our request built. lets ship it off.
910 if ($self->debug_level > 1) {
911 $self->debug("\nClient Request XML:\n" . '-' x 30);
915 $host = $self->{config}->{bulkhost} if $data->{batch};
916 $self->debug("Making request to $host...");
917 my $ua = LWP::UserAgent->new( timeout => 20, agent => "Net::OpenSRS/$VERSION" );
919 $self->debug("Unable to contact remote host.");
925 'Content-Type' => 'text/xml',
926 'X-Username' => $self->{config}->{username},
927 'X-Signature' => hash( hash( $xml, $key ), $key ),
932 if ( $res->is_success ) {
933 $self->debug("HTTP result: " . $res->status_line);
934 my $rslt = $res->content;
935 # OpenSRS renew response triggers Expat parser error due to spaces in element name
936 $rslt =~ s/registration expiration date/registration_expiration_date/g;
938 eval { $struct = XML::Simple::XMLin(
940 'KeyAttr' => [ 'dt_assoc' ],
941 'GroupTags' => { 'dt_assoc' => 'item', 'dt_array' => 'item' },
945 if ($self->debug_level > 1) {
946 $self->debug("\nOpenSRS Response XML:\n" . '-' x 30);
947 $self->debug($res->content);
951 # get the struct looking just how we want it.
953 (undef, $struct) = _denastify( $struct->{body}->{data_block} );
956 $self->debug("HTTP error: " . $res->status_line);
961 $self->_set_response;
962 return $self->last_response(1);
965 # encode special characters
978 return $arg unless ($arg =~/\<|\>|\'|\"|\&/);
979 $arg =~ s/(\<|\>|\'|\"|\&)/$encode_hash{$1}/ge;
983 # format perl structs into opensrs XML
986 my ($self, $val, $indent) = @_;
990 my $sp = ' ' x $indent;
992 if ( ref $val eq 'ARRAY' ) {
994 $xml .= "$sp<item key=\"$_\">\n";
995 $xml .= "$sp <dt_array>\n";
996 foreach (map { _encode($_) } sort @$val) {
997 # $xml .= "$sp <item key=\"$c\">$_</item>\n";
998 $xml .= "$sp <item key=\"$c\">\n";
999 $xml .= $self->_format($_);
1000 $xml .= "$sp </item>\n";
1003 $xml .= "$sp </dt_array>\n";
1004 $xml .= "$sp</item>\n";
1007 elsif ( ref $val eq 'HASH' ) {
1008 $xml .= "$sp<item key=\"$_\">\n" unless /^HASH/;
1009 $xml .= "$sp<dt_assoc>\n";
1010 foreach (sort keys %$val) {
1011 $xml .= $self->_format( $val->{$_} );
1013 $xml .= "$sp</dt_assoc>\n";
1014 $xml .= "$sp</item>\n" unless /^HASH/;
1018 $val = _encode($val);
1019 $xml .= "$sp<item key=\"$_\">$val</item>\n";
1026 my ($arg) = ( shift );
1029 eval { use Data::Dumper };
1031 warn "_denastify\n". Dumper($arg) unless $@;
1034 if ( ref($arg) eq 'HASH' ) {
1036 if ( exists( $arg->{content} ) ) {
1037 $value = $arg->{content};
1038 } elsif ( exists( $arg->{dt_array} ) ) {
1039 my $array = $arg->{dt_array};
1040 $array = [ $array ] unless ref($array) eq 'ARRAY';
1042 { map { _denastify($_) } @{ $_->{dt_assoc} } }
1046 } elsif ( exists( $arg->{dt_assoc} ) ) {
1047 my $array = $arg->{dt_assoc};
1048 $array = [ $array ] unless ref($array) eq 'ARRAY';
1049 $value = { map { _denastify($_) } @$array };
1051 return ( $arg->{key} => $value );
1057 require Number::Phone;
1058 my ($phone) = shift;
1059 my ($country, $idd) = Number::Phone::Country::phone2country_and_idd($phone);
1060 return undef unless $country;
1061 my $np = Number::Phone->new($phone);
1062 $np = Number::Phone->new($country, $phone) unless defined $np;
1063 return undef unless defined $np;
1064 (my $epp = $np->format) =~ s/\s+/\./;
1073 Original author: Mahlon E. Smith I<mahlon@martini.nu> for Spime Solutions Group
1076 Contributors: Sten Spans, Jeff Finucane and Richard Siddall for Freeside
1077 Internet Services I<(www.freeside.biz)>, Justin Hunter.
1079 Current maintainer: Ivan Kohler <ivan-opensrs@freeside.biz>