1 =head1 Description

     2 

     3 This is a wrapper interface to the DNS portions of the Tucows OpenSRS

     4 HTTPS XML API.

     5 

     6 The client library distributed by OpenSRS can be difficult to integrate

     7 into a custom environment, and their web interface becomes quickly

     8 tedious with heavy usage. This is a clean and relatively quick library

     9 to perform the most common API methods described in the OpenSRS API

    10 documentation.

    11 

    12 =head1 Examples

    13 

    14  use Net::OpenSRS;

    15 

    16  my $key = 'Your_API_Key_From_The_Reseller_Interface';

    17  my $srs = Net::OpenSRS->new();

    18 

    19  $srs->environment('live');

    20  $srs->set_key( $key );

    21 

    22  $srs->set_manage_auth( 'manage_username', 'manage_password' );

    23 

    24  my $cookie = $srs->get_cookie( 'spime.net' );

    25  if ($cookie) {

    26      print "Cookie:  $cookie\n";

    27  } else {

    28      print $srs->last_response() . "\n";

    29  }

    30 

    31  # do a batch of domain locks

    32  $srs->bulk_lock([ 'example.com', 'example.net', ... ]);

    33 

    34  # renew a domain

    35  my $result = $srs->renew_domain( 'example.com' );

    36  ...

    37 

    38 =head1 Notes

    39 

    40 =head2 Prerequisites

    41 

    42 This module requires some setup in the OpenSRS reseller environment

    43 before it will work correctly.

    44 

    45 =over 4

    46 

    47 =item Reseller account

    48 

    49 You need to have an OpenSRS account, of course.  If you aren't an

    50 OpenSRS reseller, this module will be of limited use to you. :)

    51 

    52 =item Script API network access

    53 

    54 The machine(s) using this module need to have their public IP addresses

    55 added to your 'Script API allow' list in the OpenSRS web interface.

    56 (You'll only need to do this once, assuming your IP doesn't change.)

    57 

    58 =item API key generation

    59 

    60 You'll need to pregenerate your API keys - also in the the OpenSRS web

    61 interface.  These keys are used for all reseller API authentication.

    62 

    63 =back

    64 

    65 =head2 Assumptions

    66 

    67 OpenSRS allows for a variety of ways to organize your domains.  Because

    68 of this, writing a 'one size fits all' module is rather difficult.

    69 Instead, we make a few assumptions regarding the way people use their

    70 OpenSRS reseller accounts.

    71 

    72 **** These assumptions will ultimately determine if this module is right for

    73 you!  Please read them carefully! ****

    74 

    75 =over 4

    76 

    77 =item Management 'master' account.

    78 

    79 We assume that all domains are under one global management owner

    80 account.  If customers want access to the management interface, we're

    81 operating under the idea that you create subaccounts for them -

    82 retainting the master account information for your own use.  (If you

    83 aren't doing this, it really makes things easier for you in the long

    84 run.)

    85 

    86 For example, 'spime.net' is my master management account.  Before doing

    87 any register_domain() calls, I call master_domain('spime.net') - then

    88 any transfers or registrations from that point forward are linked to

    89 'spime.net'.  If a customer wants access to the SRS web management

    90 interface, I can then just create a subaccount for just their domain,

    91 so I retain absolute control -- in the event a customer forgets their

    92 password, I'm covered.

    93 

    94 =item Usernames

    95 

    96 We assume that your management username 'master' account is identical to

    97 your reseller username, and just the passwords differ.

    98 

    99 =item Default registration info

   100 

   101 We assume you've properly set up default technical contact information,

   102 including your default nameservers, in the OpenSRS reseller web

   103 interface.

   104 

   105 =item Return codes

   106 

   107 Unless otherwise noted, all methods return true on success, false on

   108 failure, and undefined on caller error.

   109 

   110 =back

   111 

   112 =head2 Default environment

   113 

   114 This library defaults to the TEST environment. (horizon.)  Many API

   115 methods don't work in the test environment (SET COOKIE being the most

   116 notable example, as any API method relying on a cookie doesn't work

   117 either.)  Neither does batch processing.  Most everything else should be

   118 ok.  ( See environment() )

   119 

   120 =head2 The '$c' variable

   121 

   122 Many methods require customer information.  I leave the method of

   123 fetching this information entirely to you.  All examples below that show

   124 a $c variable expect a hashref (or object) that contain these keys:

   125 

   126     my $c = {

   127         firstname => 'John',

   128         lastname  => 'Doe',

   129         city      => 'Portland',

   130         state     => 'Oregon',

   131         country   => 'US',

   132         address   => '555 Someplace Street',

   133         email     => 'john@example.com',

   134         phone     => '503-555-1212',

   135         company   => 'n/a'

   136     };

   137 

   138 =cut

   139 

   140 package Net::OpenSRS;

   141 

   142 use strict;

   143 use warnings;

   144 use LWP::UserAgent;

   145 use XML::Simple;

   146 use Digest::MD5;

   147 use Date::Calc qw/ Add_Delta_Days Today This_Year /;

   148 

   149 our $VERSION = '0.02';

   150 my $rv;

   151 *hash = \&Digest::MD5::md5_hex;

   152 

   153 #----------------------------------------------------------------------

   154 # utility methods

   155 #----------------------------------------------------------------------

   156 

   157 =head1 Utility methods

   158 

   159 =over 4

   160 

   161 =item new()

   162 

   163  my $srs = Net::OpenSRS->new();

   164 

   165 Create a new Net::OpenSRS object.  There are no options for this

   166 method.

   167 

   168 =cut

   169 

   170 sub new

   171 {

   172     my ($class, %opts) = @_;

   173     my $self = {};

   174     bless $self, $class;

   175 

   176     $self->{config} = {

   177         use_test_env  => 1,

   178         debug         => 0,

   179         master_domain => undef,

   180 

   181         bulkhost => 'https://batch.opensrs.net:55443',

   182 

   183         # reseller auth keys, as generated via the reseller website.

   184         live => {

   185             key  => undef,

   186             host => 'https://rr-n1-tor.opensrs.net:55443',

   187         },

   188         test => {

   189             key  => undef,

   190             host => 'https://horizon.opensrs.net:55443',

   191         }

   192     };

   193 

   194     return $self;

   195 }

   196 

   197 sub debug

   198 {

   199     my $self = shift;

   200     return unless $self->debug_level;

   201     print STDERR shift() . "\n";

   202 }

   203 

   204 =item debug_level()

   205 

   206 Setting the debug level will print various pieces of information to

   207 STDERR when connecting to OpenSRS.  Use this if something isn't working

   208 the way you think it should be.

   209 

   210 =item 0

   211 

   212 Disable debugging.

   213 

   214 =item 1

   215 

   216 Print current environment, host, and HTTP response.

   217 

   218 =item 2

   219 

   220 Add XML request and response to output.

   221 

   222 =item 3

   223 

   224 Add SSL debugging to output.

   225 

   226 Debugging is off by default.  When called without an argument, returns

   227 the current debug level.

   228 

   229 =cut

   230 

   231 sub debug_level

   232 {

   233     my ($self, $level) = @_;

   234     return $self->{config}->{debug} unless $level;

   235     $self->{config}->{debug} = $level;

   236     return;

   237 }

   238 

   239 =item last_response()

   240 

   241 All Net::OpenSRS methods set the last OpenSRS API reply in a temporary

   242 variable.  You can view the contents of this variable using the

   243 last_response() method.

   244 

   245 Note that it is reset on each method call.

   246 

   247 Returns the last OpenSRS return code and result string, or if passed any

   248 true value, instead returns the full XML (parsed into a hashref) of the

   249 last OpenSRS return. (perfect for Data::Dumper)

   250 

   251 Examples:

   252    200: Command Successful

   253    400: Domain example.com does not exist with OpenSRS

   254 

   255 =cut

   256 

   257 sub last_response

   258 {

   259     my ($self, $obj) = @_;

   260     return $obj ? $rv : $self->{last_response} || '';

   261 }

   262 

   263 =item set_manage_auth()

   264 

   265  $srs->set_manage_auth( $username, $password );

   266 

   267 Set the owner management username and password.  This is used to fetch

   268 cookies, and perform any API methods that require the management cookie.

   269 For specifics on this, see the OpenSRS API documentation.

   270 

   271 =cut

   272 

   273 sub set_manage_auth

   274 {

   275     my ($self, $user, $pass) = @_;

   276     return undef unless $user && $pass;

   277     $self->{config}->{username} = $user;

   278     $self->{config}->{password} = $pass;

   279     return 1;

   280 }

   281 

   282 =item set_key()

   283 

   284 Tell the OpenSRS object what secret key to use for authentication.

   285 You can generate a new secret key by using the OpenSRS reseller web

   286 interface.  This key is required to perform any API functions.

   287 

   288 set_key() is affected by the current environment().  Calling the

   289 set_key() method while in the test environment only sets the key for the

   290 test environment - likewise for the live environment.  To set a key for

   291 the live environment, you need to call environment('live') B<first>.

   292 

   293 =cut

   294 

   295 sub set_key

   296 {

   297     my ($self, $key) = @_;

   298     return undef unless $key;

   299     $self->{config}->{ $self->environment }->{key} = $key;

   300     return 1;

   301 }

   302 

   303 =item environment()

   304 

   305  my $env = $srs->environment;

   306  $srs->environment('live');

   307 

   308 Without an argument, returns a string - either 'test', or 'live',

   309 depending on the environment the object is currently using.

   310 

   311 The test environment is the default.

   312 

   313 If passed an argument (either 'test' or 'live') - switches into the

   314 desired environment.  You will need to set_key() if you were previously

   315 using a different environment, or if you hadn't set_key() yet.

   316 

   317 =cut

   318 

   319 sub environment

   320 {

   321     my ($self, $env) = @_;

   322     return ($self->{config}->{use_test_env} ? 'test' : 'live')

   323         unless $env && $env =~ /(test|live)/i;

   324     $self->{config}->{use_test_env} = 

   325         $1 eq 'test' ? 1 : 0;

   326     return;

   327 }

   328 

   329 =item master_domain()

   330 

   331  my $master = $srs->master_domain;

   332  $srs->master_domain('spime.net');

   333 

   334 Without an argument, returns the currently set 'master domain' account.

   335 Otherwise, it sets the master domain.

   336 

   337 New transfers and registrations are linked under this domain, for

   338 centralized management.  See the 'Assumptions' section, above.

   339 

   340 =cut

   341 

   342 sub master_domain

   343 {

   344     my ($self, $domain) = @_;

   345     return $self->{config}->{master_domain} unless $domain;

   346     $self->{config}->{master_domain} = $domain;

   347     return;

   348 }

   349 

   350 # set last status messages/codes in $self,

   351 # for the benefit of the caller.

   352 sub _set_response

   353 {

   354     my $self = shift;

   355     $rv->{response_text} =~ s/Error: //;

   356     $self->{last_response} = $rv->{response_code} . ": " . $rv->{response_text};

   357     return;

   358 }

   359 

   360 #----------------------------------------------------------------------

   361 # SRS API methods

   362 #----------------------------------------------------------------------

   363 

   364 =back

   365 

   366 =head1 OpenSRS API methods

   367 

   368 =over 4

   369 

   370 =item bulk_lock() / bulk_unlock()

   371 

   372 Locks or unlocks up to 1000 domains at a time.

   373 

   374  my $result = $srs->bulk_lock([ 'example.com', 'example.net' ]);

   375 

   376 Returns remote bulk queue id on successful batch submission.

   377 

   378 =cut

   379 

   380 sub bulk_lock

   381 {

   382     my $self = shift;

   383     return $self->_bulk_action( 'lock', @_ );

   384 }

   385 

   386 sub bulk_unlock

   387 {

   388     my $self = shift;

   389     return $self->_bulk_action( 'unlock', @_ );

   390 }

   391 

   392 sub _bulk_action

   393 {

   394     my ( $self, $toggle, $domains ) = @_;

   395     return undef unless $toggle =~ /lock|unlock/i && 

   396                         ref $domains;

   397     return undef if scalar @$domains >= 1000;

   398 

   399     $rv = $self->make_request(

   400         {

   401             batch   => 1,

   402             action  => 'submit',

   403             object  => 'bulk_change',

   404             attributes => {

   405                 change_type => 'domain_lock',

   406                 change_items => $domains,

   407                 op_type => lc $toggle,

   408             }

   409         }

   410     );

   411     return undef unless $rv;

   412 

   413     $self->_set_response;

   414     return $rv->{is_success} ? $rv->{bulk_change_req_id} : 0;

   415 }

   416 

   417 =item check_queued_request()

   418 

   419  my $result = $srs->check_queued_request( $queue_id );

   420 

   421 Requires queue id - returned from batch methods such as bulk_lock().

   422 Always returns hashref of queue command on success.  

   423 Check $srs->last_response() for status progress.

   424 

   425 =cut

   426 

   427 sub check_queued_request

   428 {

   429     my ( $self, $id ) = @_;

   430     return undef unless $id;

   431 

   432     $rv = $self->make_request(

   433         {

   434             action  => 'query_queued_request',

   435             object  => 'domain',

   436             attributes => {

   437                 request_id => $id,

   438             }

   439         }

   440     );

   441     return undef unless $rv;

   442 

   443     $self->_set_response;

   444     return $rv->{attributes}->{request_data};

   445 }

   446 

   447 =item check_transfer()

   448 

   449  my $result = $srs->check_transfer( 'example.com' );

   450 

   451 Checks the status of a transfer in progress.  Returns hashref of

   452 'contact_email', 'status', and 'last_update_time' for a given domain

   453 transfer.  The 'status' key is always one of the following:

   454 

   455         pending_owner  (waiting on owner confirmation)

   456         pending_admin  (waiting on opensrs staff confirmation)

   457         pending_registry  (waiting on register to complete)

   458         completed  (transfer done)

   459         cancelled  (reseller cancelled transfer in progress)

   460         undefined  (no transfer in progress)

   461 

   462 If the domain in question has no transfer in progress - instead checks

   463 to see if the domain is capable of transfer.  Returns hashref of

   464 'transferrable' (boolean) and 'reason' (string).

   465 

   466 =cut

   467 

   468 sub check_transfer

   469 {

   470     my ( $self, $domain ) = @_;

   471     return undef unless $domain;

   472 

   473     $rv = $self->make_request(

   474         {

   475             action     => 'check_transfer',

   476             object     => 'domain',

   477             attributes => {

   478                 domain              => $domain,

   479                 get_request_address => 1,

   480             }

   481         }

   482     );

   483     return undef unless $rv;

   484 

   485     $self->_set_response;

   486     if ( $rv->{attributes}->{status} ) {

   487         return {

   488             status           => $rv->{attributes}->{status},

   489             last_update_time => $rv->{attributes}->{unixtime},

   490             contact_email    => $rv->{attributes}->{request_address}

   491         };

   492     }

   493     else {

   494         return $rv->{attributes}; #(transferrable bool and reason)

   495     }

   496 }

   497 

   498 =item get_cookie()

   499 

   500 OpenSRS management APIs require a cookie to be generated, and sent along

   501 with the API request.

   502 

   503  $cookie = $srs->get_cookie( 'example.com ');

   504  ($cookie, $expiration_date) = $srs->get_cookie( 'example.com ');

   505 

   506 Make sure you've set_manage_auth() before attempting any cookie required

   507 APIs.

   508 

   509 Returns cookie on success, undefined on error.  (Check error with

   510 last_response())

   511 

   512 In array context, returns cookie and expiration date of the domain.

   513 

   514 =cut

   515 

   516 sub get_cookie

   517 {

   518     my ($self, $domain) = @_;

   519     return undef unless $domain;

   520     $rv = $self->make_request(

   521         {

   522             action     => 'set',

   523             object     => 'cookie',

   524             attributes => {

   525                 reg_username => $self->{config}->{username},

   526                 reg_password => $self->{config}->{password},

   527                 domain => $domain

   528             }

   529         }

   530     );

   531     return undef unless $rv;

   532 

   533     $self->_set_response;

   534     if ($rv->{is_success}) {

   535         return

   536           wantarray

   537           ? ( $rv->{attributes}->{cookie}, $rv->{attributes}->{expiredate} )

   538           : $rv->{attributes}->{cookie};

   539     }

   540     return undef;

   541 }

   542 

   543 =item get_expiring_domains()

   544 

   545  my $results = $srs->get_expiring_domains( 60 );

   546 

   547  Fetch and return OpenSRS hashref of expiring domains, within

   548  the specified timeperiod.  (In days.)

   549 

   550  Time period defaults to 30 days.

   551 

   552 =cut

   553 

   554 sub get_expiring_domains

   555 {

   556     my ($self, $timeframe) = @_;

   557     $timeframe ||= 30;

   558 

   559     my $today   = join '-', map { sprintf( "%02d", $_ ) } Date::Calc::Today();

   560     my $expdate = join '-', map { sprintf( "%02d", $_ ) }

   561       Date::Calc::Add_Delta_Days( ( split '-', $today ), $timeframe );

   562 

   563     $rv = $self->make_request(

   564         {

   565             action     => 'get_domains_by_expiredate',

   566             object     => 'domain',

   567             attributes => {

   568                 limit    => 1000,

   569                 exp_from => $today,

   570                 exp_to   => $expdate,

   571             }

   572         }

   573     );

   574     return undef unless $rv;

   575 

   576     $self->_set_response;

   577     return $rv->{attributes}->{exp_domains} if $rv->{is_success};

   578     return undef;

   579 }

   580 

   581 =item is_available()

   582 

   583 Hey OpenSRS! Is this domain registered, or is it available?

   584 

   585  my $result = $srs->is_available( 'example.com ');

   586 

   587 Returns true if the domain is available, false if it is already

   588 registered.

   589 

   590 =cut

   591 

   592 sub is_available

   593 {

   594     my ($self, $domain) = @_;

   595     return undef unless $domain;

   596     $rv = $self->make_request(

   597         {

   598             action     => 'lookup',

   599             object     => 'domain',

   600             attributes => {

   601                 domain => $domain

   602             }

   603         }

   604     );

   605     return undef unless $rv;

   606     $self->_set_response;

   607     return undef unless $rv->{is_success};

   608     return $rv->{response_code} == 210 ? 1 : 0;

   609 }

   610 

   611 =item register_domain()

   612 

   613  my $result = $srs->register_domain( 'example.com', $c );

   614 

   615 Register a new domain.  Default nameserver and tech info used from

   616 OpenSRS settings.

   617 

   618 =cut

   619 

   620 sub register_domain

   621 {

   622     my ($self, $domain, $c, $transfer) = @_;

   623     return undef unless $domain;

   624 

   625     # sanity checks

   626     unless ($self->{config}->{username}) {

   627         $self->debug("Management auth not set.");

   628         return undef;

   629     }

   630     unless (ref $c) {

   631         $self->debug("2nd arg must be a reference to customer info.");

   632         return undef;

   633     }

   634 

   635     my $epp_phone = $c->{phone};

   636     $epp_phone =~ s/[\.\-]//g;

   637     $epp_phone = '+1.' . $epp_phone;

   638 

   639     # blah, this sucks.

   640     # it would be really nice if OpenSRS figured out the country -> code

   641     # conversion on their end of things.

   642     my %country_codes = (

   643         'Afghanistan'                            => 'AF',

   644         'Albania'                                => 'AL',

   645         'Algeria'                                => 'DZ',

   646         'American Samoa'                         => 'AS',

   647         'Andorra'                                => 'AD',

   648         'Angola'                                 => 'AO',

   649         'Anguilla'                               => 'AI',

   650         'Antarctica'                             => 'AQ',

   651         'Antigua And Barbuda'                    => 'AG',

   652         'Argentina'                              => 'AR',

   653         'Armenia'                                => 'AM',

   654         'Aruba'                                  => 'AW',

   655         'Australia'                              => 'AU',

   656         'Austria'                                => 'AT',

   657         'Azerbaijan'                             => 'AZ',

   658         'Bahamas'                                => 'BS',

   659         'Bahrain'                                => 'BH',

   660         'Bangladesh'                             => 'BD',

   661         'Barbados'                               => 'BB',

   662         'Belarus'                                => 'BY',

   663         'Belgium'                                => 'BE',

   664         'Belize'                                 => 'BZ',

   665         'Benin'                                  => 'BJ',

   666         'Bermuda'                                => 'BM',

   667         'Bhutan'                                 => 'BT',

   668         'Bolivia'                                => 'BO',

   669         'Bosnia Hercegovina'                     => 'BA',

   670         'Botswana'                               => 'BW',

   671         'Bouvet Island'                          => 'BV',

   672         'Brazil'                                 => 'BR',

   673         'British Indian Ocean Territory'         => 'IO',

   674         'Brunei Darussalam'                      => 'BN',

   675         'Bulgaria'                               => 'BG',

   676         'Burkina Faso'                           => 'BF',

   677         'Burundi'                                => 'BI',

   678         'Cambodia'                               => 'KH',

   679         'Cameroon'                               => 'CM',

   680         'Canada'                                 => 'CA',

   681         'Cape Verde'                             => 'CV',

   682         'Cayman Islands'                         => 'KY',

   683         'Central African Republic'               => 'CF',

   684         'Chad'                                   => 'TD',

   685         'Chile'                                  => 'CL',

   686         'China'                                  => 'CN',

   687         'Christmas Island'                       => 'CX',

   688         'Cocos (Keeling) Islands'                => 'CC',

   689         'Colombia'                               => 'CO',

   690         'Comoros'                                => 'KM',

   691         'Congo'                                  => 'CG',

   692         'Congo The Democratic Republic Of'       => 'CD',

   693         'Cook Islands'                           => 'CK',

   694         'Costa Rica'                             => 'CR',

   695         'Cote D\'Ivoire'                         => 'CI',

   696         'Croatia'                                => 'HR',

   697         'Cuba'                                   => 'CU',

   698         'Cyprus'                                 => 'CY',

   699         'Czech Republic'                         => 'CZ',

   700         'Denmark'                                => 'DK',

   701         'Djibouti'                               => 'DJ',

   702         'Dominica'                               => 'DM',

   703         'Dominican Republic'                     => 'DO',

   704         'Ecuador'                                => 'EC',

   705         'Egypt'                                  => 'EG',

   706         'El Salvador'                            => 'SV',

   707         'Equatorial Guinea'                      => 'GQ',

   708         'Eritrea'                                => 'ER',

   709         'Estonia'                                => 'EE',

   710         'Ethiopia'                               => 'ET',

   711         'Falkland Islands (Malvinas)'            => 'FK',

   712         'Faroe Islands'                          => 'FO',

   713         'Fiji'                                   => 'FJ',

   714         'Finland'                                => 'FI',

   715         'France'                                 => 'FR',

   716         'French Guiana'                          => 'GF',

   717         'French Polynesia'                       => 'PF',

   718         'French Southern Territories'            => 'TF',

   719         'Gabon'                                  => 'GA',

   720         'Gambia'                                 => 'GM',

   721         'Georgia'                                => 'GE',

   722         'Germany'                                => 'DE',

   723         'Ghana'                                  => 'GH',

   724         'Gibraltar'                              => 'GI',

   725         'Greece'                                 => 'GR',

   726         'Greenland'                              => 'GL',

   727         'Grenada'                                => 'GD',

   728         'Guadeloupe'                             => 'GP',

   729         'Guam'                                   => 'GU',

   730         'Guatemela'                              => 'GT',

   731         'Guinea'                                 => 'GN',

   732         'Guinea-Bissau'                          => 'GW',

   733         'Guyana'                                 => 'GY',

   734         'Haiti'                                  => 'HT',

   735         'Heard and McDonald Islands'             => 'HM',

   736         'Honduras'                               => 'HN',

   737         'Hong Kong'                              => 'HK',

   738         'Hungary'                                => 'HU',

   739         'Iceland'                                => 'IS',

   740         'India'                                  => 'IN',

   741         'Indonesia'                              => 'ID',

   742         'Iran (Islamic Republic Of)'             => 'IR',

   743         'Iraq'                                   => 'IQ',

   744         'Ireland'                                => 'IE',

   745         'Israel'                                 => 'IL',

   746         'Italy'                                  => 'IT',

   747         'Jamaica'                                => 'JM',

   748         'Japan'                                  => 'JP',

   749         'Jordan'                                 => 'JO',

   750         'Kazakhstan'                             => 'KZ',

   751         'Kenya'                                  => 'KE',

   752         'Kiribati'                               => 'KI',

   753         'Korea, Democratic People\'s Republic Of' => 'KP',

   754         'Korea, Republic Of'                     => 'KR',

   755         'Kuwait'                                 => 'KW',

   756         'Kyrgyzstan'                             => 'KG',

   757         'Lao People\'s Democratic Republic'      => 'LA',

   758         'Latvia'                                 => 'LV',

   759         'Lebanon'                                => 'LB',

   760         'Lesotho'                                => 'LS',

   761         'Liberia'                                => 'LR',

   762         'Libyan Arab Jamahiriya'                 => 'LY',

   763         'Liechtenstein'                          => 'LI',

   764         'Lithuania'                              => 'LT',

   765         'Luxembourg'                             => 'LU',

   766         'Macau'                                  => 'MO',

   767         'Macedonia'                              => 'MK',

   768         'Madagascar'                             => 'MG',

   769         'Malawi'                                 => 'MW',

   770         'Malaysia'                               => 'MY',

   771         'Maldives'                               => 'MV',

   772         'Mali'                                   => 'ML',

   773         'Malta'                                  => 'MT',

   774         'Marshall Islands'                       => 'MH',

   775         'Martinique'                             => 'MQ',

   776         'Mauritania'                             => 'MR',

   777         'Mauritius'                              => 'MU',

   778         'Mayotte'                                => 'YT',

   779         'Mexico'                                 => 'MX',

   780         'Micronesia, Federated States Of'        => 'FM',

   781         'Moldova, Republic Of'                   => 'MD',

   782         'Monaco'                                 => 'MC',

   783         'Mongolia'                               => 'MN',

   784         'Montserrat'                             => 'MS',

   785         'Morocco'                                => 'MA',

   786         'Mozambique'                             => 'MZ',

   787         'Myanmar'                                => 'MM',

   788         'Namibia'                                => 'NA',

   789         'Nauru'                                  => 'NR',

   790         'Nepal'                                  => 'NP',

   791         'Netherlands'                            => 'NL',

   792         'Netherlands Antilles'                   => 'AN',

   793         'New Caledonia'                          => 'NC',

   794         'New Zealand'                            => 'NZ',

   795         'Nicaragua'                              => 'NI',

   796         'Niger'                                  => 'NE',

   797         'Nigeria'                                => 'NG',

   798         'Niue'                                   => 'NU',

   799         'Norfolk Island'                         => 'NF',

   800         'Northern Mariana Islands'               => 'MP',

   801         'Norway'                                 => 'NO',

   802         'Oman'                                   => 'OM',

   803         'Pakistan'                               => 'PK',

   804         'Palau'                                  => 'PW',

   805         'Palestine'                              => 'PS',

   806         'Panama'                                 => 'PA',

   807         'Papua New Guinea'                       => 'PG',

   808         'Paraguay'                               => 'PY',

   809         'Peru'                                   => 'PE',

   810         'Philippines'                            => 'PH',

   811         'Pitcairn'                               => 'PN',

   812         'Poland'                                 => 'PL',

   813         'Portugal'                               => 'PT',

   814         'Puerto Rico'                            => 'PR',

   815         'Qatar'                                  => 'QA',

   816         'Reunion'                                => 'RE',

   817         'Romania'                                => 'RO',

   818         'Russian Federation'                     => 'RU',

   819         'Rwanda'                                 => 'RW',

   820         'Saint Helena'                           => 'SH',

   821         'Saint Kitts And Nevis'                  => 'KN',

   822         'Saint Lucia'                            => 'LC',

   823         'Saint Pierre and Miquelon'              => 'PM',

   824         'Saint Vincent and The Grenadines'       => 'VC',

   825         'Samoa'                                  => 'WS',

   826         'San Marino'                             => 'SM',

   827         'Sao Tome and Principe'                  => 'ST',

   828         'Saudi Arabia'                           => 'SA',

   829         'Senegal'                                => 'SN',

   830         'Serbia and Montenegro'                  => 'CS',

   831         'Seychelles'                             => 'SC',

   832         'Sierra Leone'                           => 'SL',

   833         'Singapore'                              => 'SG',

   834         'Slovakia'                               => 'SK',

   835         'Slovenia'                               => 'SI',

   836         'Solomon Islands'                        => 'SB',

   837         'Somalia'                                => 'SO',

   838         'South Africa'                           => 'ZA',

   839         'South Georgia and The Sandwich Islands' => 'GS',

   840         'Spain'                                  => 'ES',

   841         'Sri Lanka'                              => 'LK',

   842         'Sudan'                                  => 'SD',

   843         'Suriname'                               => 'SR',

   844         'Svalbard and Jan Mayen Islands'         => 'SJ',

   845         'Swaziland'                              => 'SZ',

   846         'Sweden'                                 => 'SE',

   847         'Switzerland'                            => 'CH',

   848         'Syrian Arab Republic'                   => 'SY',

   849         'Taiwan'                                 => 'TW',

   850         'Tajikista'                              => 'TJ',

   851         'Tanzania, United Republic Of'           => 'TZ',

   852         'Thailand'                               => 'TH',

   853         'Timor-Leste'                            => 'TL',

   854         'Togo'                                   => 'TG',

   855         'Tokelau'                                => 'TK',

   856         'Tonga'                                  => 'TO',

   857         'Trinidad and Tobago'                    => 'TT',

   858         'Tunisia'                                => 'TN',

   859         'Turkey'                                 => 'TR',

   860         'Turkmenistan'                           => 'TM',

   861         'Turks and Caicos Islands'               => 'TC',

   862         'Tuvalu'                                 => 'TV',

   863         'Uganda'                                 => 'UG',

   864         'Ukraine'                                => 'UA',

   865         'United Arab Emirates'                   => 'AE',

   866         'United Kingdom (GB)'                    => 'GB',

   867         'United Kingdom (UK)'                    => 'UK',

   868         'United States'                          => 'US',

   869         'United States Minor Outlying Islands'   => 'UM',

   870         'Uruguay'                                => 'UY',

   871         'Uzbekistan'                             => 'UZ',

   872         'Vanuatu'                                => 'VU',

   873         'Vatican City State'                     => 'VA',

   874         'Venezuela'                              => 'VE',

   875         'Vietnam'                                => 'VN',

   876         'Virgin Islands (British)'               => 'VG',

   877         'Virgin Islands (U.S.)'                  => 'VI',

   878         'Wallis and Futuna Islands'              => 'WF',

   879         'Western Sahara'                         => 'EH',

   880         'Yemen Republic of'                      => 'YE',

   881         'Zambia'                                 => 'ZM',

   882         'Zimbabwe'                               => 'ZW'

   883     );  # end suckage

   884 

   885     # attempt countryname translation if needed

   886     if ( $c->{country} !~ m/^[A-Z]{2,3}$/ ) {

   887     	$c->{country} = $country_codes{$c->{country}};

   888 

   889         unless ( defined( $c->{country} ) ) {

   890             $self->debug("Invalid country.");

   891             return undef;

   892         }

   893     }

   894 

   895     # build contact hashref from customer info.

   896     my $contact_info = {

   897         first_name  => $c->{firstname},

   898         last_name   => $c->{lastname},

   899         city        => $c->{city},

   900         state       => $c->{state},

   901         country     => $c->{country},

   902         address1    => $c->{address},

   903         postal_code => $c->{zip},

   904         email       => $c->{email},

   905         phone       => $epp_phone,

   906         org_name    => $c->{company} || 'n/a',

   907     };

   908 

   909     $rv = $self->make_request(

   910         {

   911             action     => 'sw_register',

   912             object     => 'domain',

   913             attributes => {

   914                 domain              => $domain,

   915                 custom_nameservers  => 0,

   916                 custom_tech_contact => 0,

   917                 auto_renew          => 0,

   918                 period              => 1,

   919                 f_lock_domain       => 1,

   920                 contact_set         => {

   921                     admin   => $contact_info,

   922                     billing => $contact_info,

   923                     owner   => $contact_info

   924                 },

   925                 reg_username => $self->{config}->{username},

   926                 reg_password => $self->{config}->{password},

   927                 reg_type   => $transfer ? 'transfer' : 'new',

   928                 reg_domain => $self->{config}->{master_domain}, # link domain to the 'master' account

   929             }

   930         }

   931     );

   932     $self->_set_response;

   933     return $rv->{is_success};

   934 }

   935 

   936 =item renew_domain()

   937 

   938  my $result = $srs->renew_domain( 'example.com', 1 );

   939 

   940 Renew a domain for a period of time in years. 1 year is the default.

   941 

   942 =cut

   943 

   944 sub renew_domain

   945 {

   946     my ($self, $domain, $years) = @_;

   947     return undef unless $domain;

   948     $years ||= 1;

   949 

   950     # sanity checks

   951     unless ($self->{config}->{username}) {

   952         $self->debug("Management auth not set.");

   953         return undef;

   954     }

   955 

   956     # get current expiration year (why do they need this, again?)

   957     my (undef, $expiration) = $self->get_cookie( $domain );

   958     $expiration = $1 if $expiration =~ /^(\d{4})-/;

   959     $expiration ||= Date::Calc::This_Year();

   960     

   961     $rv = $self->make_request(

   962         {

   963             action     => 'renew',

   964             object     => 'domain',

   965             attributes => {

   966                 domain                => $domain,

   967                 auto_renew            => 0,

   968                 handle                => 'process',

   969                 period                => $years,

   970                 currentexpirationyear => $expiration,

   971             }

   972         }

   973     );

   974     $self->_set_response;

   975     return $rv->{is_success};

   976 }

   977 

   978 =item revoke_domain()

   979 

   980 Revoke a previously registered domain.  This only works if the domain is

   981 still within the grace period as defined by the registrar.

   982 Requires you to have called set_manage_auth() B<first>.

   983 

   984  my $result = $srs->revoke_domain( 'example.com' );

   985 

   986 Returns true if the revoke is successful, false otherwise.

   987 Returns undefined on error.

   988 

   989 =cut

   990 

   991 sub revoke_domain

   992 {

   993     my ($self, $domain) = @_;

   994     return undef unless $domain;

   995     unless ($self->{config}->{username}) {

   996         $self->debug("Management auth not set.");

   997         return undef;

   998     }

   999     $rv = $self->make_request(

  1000         {

  1001             action     => 'revoke',

  1002             object     => 'domain',

  1003             attributes => {

  1004                 reseller => $self->{config}->{username},

  1005                 domain => $domain,

  1006             }

  1007         }

  1008     );

  1009     $self->_set_response;

  1010     return $rv->{is_success};

  1011 }

  1012 

  1013 =item transfer_domain()

  1014 

  1015  my $result = $srs->transfer_domain( 'example.com', $c );

  1016 

  1017 Transfer a domain under your control.

  1018 Returns true on success, false on failure, and undefined on caller error.

  1019 

  1020 =cut

  1021 

  1022 sub transfer_domain

  1023 {

  1024     my $self = shift;

  1025     return $self->register_domain( @_, 1 );

  1026 }

  1027 

  1028 =item make_request()

  1029 

  1030 This method is the real workhorse of this module.  If any OpenSRS API

  1031 isn't explicity implemented in this module as a method call (such as

  1032 get_cookie(), bulk_lock(), etc), you can use make_request() to build and send

  1033 the API yourself.

  1034 

  1035 Examples:

  1036 

  1037  my $result = $srs->make_request(

  1038      {

  1039          batch   => 1,

  1040          action  => 'submit',

  1041          object  => 'bulk_change',

  1042          attributes => {

  1043              change_type => 'domain_lock',

  1044              change_items => [ 'example.com', 'example.net' ],

  1045              op_type => 'lock',

  1046          }

  1047      }

  1048  );

  1049 

  1050  my $result = $srs->make_request(

  1051      {

  1052          action     => 'lookup',

  1053          object     => 'domain',

  1054          attributes => {

  1055              domain => 'example.com'

  1056          }

  1057      }

  1058  );

  1059 

  1060 Returns a hashref containing parsed XML results from OpenSRS.

  1061 

  1062 Example return:

  1063 

  1064  {

  1065      'protocol' => 'XCP',

  1066      'object' => 'DOMAIN',

  1067      'response_text' => 'Domain taken',

  1068      'action' => 'REPLY',

  1069      'response_code' => '211',

  1070      'attributes' => {

  1071          'status' => 'taken',

  1072          'match' => {}

  1073      },

  1074      'is_success' => '1'

  1075  }

  1076 

  1077 =cut

  1078 

  1079 # build opensrs xml protocol string.  submit.

  1080 # convert xml response to data structure, and return.

  1081 sub make_request

  1082 {

  1083     my ($self, $data) = @_;

  1084     return undef unless ref $data;

  1085 

  1086     $self->debug("Using " . $self->environment . " environment.");

  1087 

  1088     my $key  = $self->{config}->{ $self->environment }->{key};

  1089     my $host = $self->{config}->{ $self->environment }->{host};

  1090     $ENV{HTTPS_DEBUG} = 1 if $self->debug_level > 2;

  1091 

  1092     unless ($key) {

  1093         $self->debug("Authentication key not set.");

  1094         return undef;

  1095     }

  1096 

  1097     my $action = uc $data->{action};

  1098     my $object = uc $data->{object};

  1099 

  1100     # build our XML request.

  1101     # lets not bother with anything super fancy, 

  1102     # everything but the item keys are always static anyway.

  1103     my $xml;

  1104     $xml = <<XML;

  1105 <?xml version='1.0' encoding="UTF-8" standalone="no" ?>

  1106 <!DOCTYPE OPS_envelope SYSTEM "ops.dtd">

  1107 <OPS_envelope>

  1108 <header><version>0.9</version></header>

  1109 <body>

  1110 <data_block>

  1111 <dt_assoc>

  1112   <item key="protocol">XCP</item>

  1113   <item key="action">$action</item>

  1114   <item key="object">$object</item>

  1115 XML

  1116 

  1117     $xml .= "  <item key=\"cookie\">$data->{cookie}</item>\n" if $data->{cookie};

  1118 

  1119 $xml .= <<XML;

  1120   <item key="attributes">

  1121     <dt_assoc>

  1122 XML

  1123 

  1124     foreach (sort keys %{ $data->{attributes} }) {

  1125         my $val = $data->{attributes}->{$_};

  1126         $xml .= $self->_format( $val, 4 );

  1127     }

  1128     $xml .= <<XML;

  1129     </dt_assoc>

  1130   </item>

  1131 </dt_assoc>

  1132 </data_block>

  1133 </body>

  1134 </OPS_envelope>

  1135 XML