lib/Net/OpenSRS.pm

   1 =head1 NAME
   2
   3 Net::OpenSRS - Domain registration via the Tucows OpenSRS HTTPS XML API
   4
   5 =head1 Description
   6
   7 This is a wrapper interface to the DNS portions of the Tucows OpenSRS
   8 HTTPS XML API.
   9
  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
  14 documentation.
  15
  16 =head1 Examples
  17
  18  use Net::OpenSRS;
  19
  20  my $key = 'Your_API_Key_From_The_Reseller_Interface';
  21  my $srs = Net::OpenSRS->new();
  22
  23  $srs->environment('live');
  24  $srs->set_key( $key );
  25
  26  $srs->set_manage_auth( 'manage_username', 'manage_password' );
  27
  28  my $cookie = $srs->get_cookie( 'spime.net' );
  29  if ($cookie) {
  30      print "Cookie:  $cookie\n";
  31  } else {
  32      print $srs->last_response() . "\n";
  33  }
  34
  35  # do a batch of domain locks
  36  $srs->bulk_lock([ 'example.com', 'example.net', ... ]);
  37
  38  # renew a domain
  39  my $result = $srs->renew_domain( 'example.com' );
  40  ...
  41
  42 =head1 Notes
  43
  44 =head2 Prerequisites
  45
  46 This module requires some setup in the OpenSRS reseller environment
  47 before it will work correctly.
  48
  49 =over 4
  50
  51 =item Reseller account
  52
  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. :)
  55
  56 =item Script API network access
  57
  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.)
  61
  62 =item API key generation
  63
  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.
  66
  67 =back
  68
  69 =head2 Assumptions
  70
  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.
  75
  76 **** These assumptions will ultimately determine if this module is right for
  77 you!  Please read them carefully! ****
  78
  79 =over 4
  80
  81 =item Management 'master' account.
  82
  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
  88 run.)
  89
  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.
  97
  98 =item Usernames
  99
 100 We assume that your management username 'master' account is identical to
 101 your reseller username, and just the passwords differ.
 102
 103 =item Default registration info
 104
 105 We assume you've properly set up default technical contact information,
 106 including your default nameservers, in the OpenSRS reseller web
 107 interface.
 108
 109 =item Return codes
 110
 111 Unless otherwise noted, all methods return true on success, false on
 112 failure, and undefined on caller error.
 113
 114 =back
 115
 116 =head2 Default environment
 117
 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() )
 123
 124 =head2 The '$c' variable
 125
 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:
 129
 130     my $c = {
 131         firstname => 'John',
 132         lastname  => 'Doe',
 133         city      => 'Portland',
 134         state     => 'Oregon',
 135         country   => 'US',
 136         address   => '555 Someplace Street',
 137         email     => 'john@example.com',
 138         phone     => '503-555-1212',
 139         company   => 'n/a'
 140     };
 141
 142 =cut
 143
 144 package Net::OpenSRS;
 145
 146 use strict;
 147 use warnings;
 148 use LWP::UserAgent;
 149 use XML::Simple;
 150 use Digest::MD5;
 151 use Date::Calc qw/ Add_Delta_Days Today This_Year /;
 152
 153 our $VERSION = '0.03';
 154 my $rv;
 155 *hash = \&Digest::MD5::md5_hex;
 156
 157 #----------------------------------------------------------------------
 158 # utility methods
 159 #----------------------------------------------------------------------
 160
 161 =head1 Utility methods
 162
 163 =over 4
 164
 165 =item new()
 166
 167  my $srs = Net::OpenSRS->new();
 168
 169 Create a new Net::OpenSRS object.  There are no options for this
 170 method.
 171
 172 =cut
 173
 174 sub new
 175 {
 176     my ($class, %opts) = @_;
 177     my $self = {};
 178     bless $self, $class;
 179
 180     $self->{config} = {
 181         use_test_env  => 1,
 182         debug         => 0,
 183         master_domain => undef,
 184
 185         bulkhost => 'https://batch.opensrs.net:55443',
 186
 187         # reseller auth keys, as generated via the reseller website.
 188         live => {
 189             key  => undef,
 190             host => 'https://rr-n1-tor.opensrs.net:55443',
 191         },
 192         test => {
 193             key  => undef,
 194             host => 'https://horizon.opensrs.net:55443',
 195         }
 196     };
 197
 198     return $self;
 199 }
 200
 201 sub debug
 202 {
 203     my $self = shift;
 204     return unless $self->debug_level;
 205     print STDERR shift() . "\n";
 206 }
 207
 208 =item debug_level()
 209
 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.
 213
 214 =item 0
 215
 216 Disable debugging.
 217
 218 =item 1
 219
 220 Print current environment, host, and HTTP response.
 221
 222 =item 2
 223
 224 Add XML request and response to output.
 225
 226 =item 3
 227
 228 Add SSL debugging to output.
 229
 230 Debugging is off by default.  When called without an argument, returns
 231 the current debug level.
 232
 233 =cut
 234
 235 sub debug_level
 236 {
 237     my ($self, $level) = @_;
 238     return $self->{config}->{debug} unless $level;
 239     $self->{config}->{debug} = $level;
 240     return;
 241 }
 242
 243 =item last_response()
 244
 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.
 248
 249 Note that it is reset on each method call.
 250
 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)
 254
 255 Examples:
 256    200: Command Successful
 257    400: Domain example.com does not exist with OpenSRS
 258
 259 =cut
 260
 261 sub last_response
 262 {
 263     my ($self, $obj) = @_;
 264     return $obj ? $rv : $self->{last_response} || '';
 265 }
 266
 267 =item set_manage_auth()
 268
 269  $srs->set_manage_auth( $username, $password );
 270
 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.
 274
 275 =cut
 276
 277 sub set_manage_auth
 278 {
 279     my ($self, $user, $pass) = @_;
 280     return undef unless $user && $pass;
 281     $self->{config}->{username} = $user;
 282     $self->{config}->{password} = $pass;
 283     return 1;
 284 }
 285
 286 =item set_key()
 287
 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.
 291
 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>.
 296
 297 =cut
 298
 299 sub set_key
 300 {
 301     my ($self, $key) = @_;
 302     return undef unless $key;
 303     $self->{config}->{ $self->environment }->{key} = $key;
 304     return 1;
 305 }
 306
 307 =item environment()
 308
 309  my $env = $srs->environment;
 310  $srs->environment('live');
 311
 312 Without an argument, returns a string - either 'test', or 'live',
 313 depending on the environment the object is currently using.
 314
 315 The test environment is the default.
 316
 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.
 320
 321 =cut
 322
 323 sub environment
 324 {
 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;
 330     return;
 331 }
 332
 333 =item master_domain()
 334
 335  my $master = $srs->master_domain;
 336  $srs->master_domain('spime.net');
 337
 338 Without an argument, returns the currently set 'master domain' account.
 339 Otherwise, it sets the master domain.
 340
 341 New transfers and registrations are linked under this domain, for
 342 centralized management.  See the 'Assumptions' section, above.
 343
 344 =cut
 345
 346 sub master_domain
 347 {
 348     my ($self, $domain) = @_;
 349     return $self->{config}->{master_domain} unless $domain;
 350     $self->{config}->{master_domain} = $domain;
 351     return;
 352 }
 353
 354 # set last status messages/codes in $self,
 355 # for the benefit of the caller.
 356 sub _set_response
 357 {
 358     my $self = shift;
 359     $rv->{response_text} =~ s/Error: //;
 360     $self->{last_response} = $rv->{response_code} . ": " . $rv->{response_text};
 361     return;
 362 }
 363
 364 #----------------------------------------------------------------------
 365 # SRS API methods
 366 #----------------------------------------------------------------------
 367
 368 =back
 369
 370 =head1 OpenSRS API methods
 371
 372 =over 4
 373
 374 =item bulk_lock() / bulk_unlock()
 375
 376 Locks or unlocks up to 1000 domains at a time.
 377
 378  my $result = $srs->bulk_lock([ 'example.com', 'example.net' ]);
 379
 380 Returns remote bulk queue id on successful batch submission.
 381
 382 =cut
 383
 384 sub bulk_lock
 385 {
 386     my $self = shift;
 387     return $self->_bulk_action( 'lock', @_ );
 388 }
 389
 390 sub bulk_unlock
 391 {
 392     my $self = shift;
 393     return $self->_bulk_action( 'unlock', @_ );
 394 }
 395
 396 sub _bulk_action
 397 {
 398     my ( $self, $toggle, $domains ) = @_;
 399     return undef unless $toggle =~ /lock|unlock/i &&
 400                         ref $domains;
 401     return undef if scalar @$domains >= 1000;
 402
 403     $rv = $self->make_request(
 404         {
 405             batch   => 1,
 406             action  => 'submit',
 407             object  => 'bulk_change',
 408             attributes => {
 409                 change_type => 'domain_lock',
 410                 change_items => $domains,
 411                 op_type => lc $toggle,
 412             }
 413         }
 414     );
 415     return undef unless $rv;
 416
 417     $self->_set_response;
 418     return $rv->{is_success} ? $rv->{bulk_change_req_id} : 0;
 419 }
 420
 421 =item check_queued_request()
 422
 423  my $result = $srs->check_queued_request( $queue_id );
 424
 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.
 428
 429 =cut
 430
 431 sub check_queued_request
 432 {
 433     my ( $self, $id ) = @_;
 434     return undef unless $id;
 435
 436     $rv = $self->make_request(
 437         {
 438             action  => 'query_queued_request',
 439             object  => 'domain',
 440             attributes => {
 441                 request_id => $id,
 442             }
 443         }
 444     );
 445     return undef unless $rv;
 446
 447     $self->_set_response;
 448     return $rv->{attributes}->{request_data};
 449 }
 450
 451 =item check_transfer()
 452
 453  my $result = $srs->check_transfer( 'example.com' );
 454
 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:
 458
 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)
 465
 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).
 469
 470 =cut
 471
 472 sub check_transfer
 473 {
 474     my ( $self, $domain ) = @_;
 475     return undef unless $domain;
 476
 477     $rv = $self->make_request(
 478         {
 479             action     => 'check_transfer',
 480             object     => 'domain',
 481             attributes => {
 482                 domain              => $domain,
 483                 get_request_address => 1,
 484             }
 485         }
 486     );
 487     return undef unless $rv;
 488
 489     $self->_set_response;
 490     if ( $rv->{attributes}->{status} ) {
 491         return {
 492             status           => $rv->{attributes}->{status},
 493             last_update_time => $rv->{attributes}->{unixtime},
 494             contact_email    => $rv->{attributes}->{request_address}
 495         };
 496     }
 497     else {
 498         return $rv->{attributes}; #(transferrable bool and reason)
 499     }
 500 }
 501
 502 =item get_cookie()
 503
 504 OpenSRS management APIs require a cookie to be generated, and sent along
 505 with the API request.
 506
 507  $cookie = $srs->get_cookie( 'example.com ');
 508  ($cookie, $expiration_date) = $srs->get_cookie( 'example.com ');
 509
 510 Make sure you've set_manage_auth() before attempting any cookie required
 511 APIs.
 512
 513 Returns cookie on success, undefined on error.  (Check error with
 514 last_response())
 515
 516 In array context, returns cookie and expiration date of the domain.
 517
 518 =cut
 519
 520 sub get_cookie
 521 {
 522     my ($self, $domain) = @_;
 523     return undef unless $domain;
 524     $rv = $self->make_request(
 525         {
 526             action     => 'set',
 527             object     => 'cookie',
 528             attributes => {
 529                 reg_username => $self->{config}->{username},
 530                 reg_password => $self->{config}->{password},
 531                 domain => $domain
 532             }
 533         }
 534     );
 535     return undef unless $rv;
 536
 537     $self->_set_response;
 538     if ($rv->{is_success}) {
 539         return
 540           wantarray
 541           ? ( $rv->{attributes}->{cookie}, $rv->{attributes}->{expiredate} )
 542           : $rv->{attributes}->{cookie};
 543     }
 544     return undef;
 545 }
 546
 547 =item get_expiring_domains()
 548
 549  my $results = $srs->get_expiring_domains( 60 );
 550
 551  Fetch and return OpenSRS hashref of expiring domains, within
 552  the specified timeperiod.  (In days.)
 553
 554  Time period defaults to 30 days.
 555
 556 =cut
 557
 558 sub get_expiring_domains
 559 {
 560     my ($self, $timeframe) = @_;
 561     $timeframe ||= 30;
 562
 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 );
 566
 567     $rv = $self->make_request(
 568         {
 569             action     => 'get_domains_by_expiredate',
 570             object     => 'domain',
 571             attributes => {
 572                 limit    => 1000,
 573                 exp_from => $today,
 574                 exp_to   => $expdate,
 575             }
 576         }
 577     );
 578     return undef unless $rv;
 579
 580     $self->_set_response;
 581     return $rv->{attributes}->{exp_domains} if $rv->{is_success};
 582     return undef;
 583 }
 584
 585 =item is_available()
 586
 587 Hey OpenSRS! Is this domain registered, or is it available?
 588
 589  my $result = $srs->is_available( 'example.com ');
 590
 591 Returns true if the domain is available, false if it is already
 592 registered.
 593
 594 =cut
 595
 596 sub is_available
 597 {
 598     my ($self, $domain) = @_;
 599     return undef unless $domain;
 600     $rv = $self->make_request(
 601         {
 602             action     => 'lookup',
 603             object     => 'domain',
 604             attributes => {
 605                 domain => $domain
 606             }
 607         }
 608     );
 609     return undef unless $rv;
 610     $self->_set_response;
 611     return undef unless $rv->{is_success};
 612     return $rv->{response_code} == 210 ? 1 : 0;
 613 }
 614
 615 =item register_domain()
 616
 617  my $result = $srs->register_domain( 'example.com', $c );
 618
 619 Register a new domain.  Default nameserver and tech info used from
 620 OpenSRS settings.
 621
 622 =cut
 623
 624 sub register_domain
 625 {
 626     my ($self, $domain, $c, $transfer) = @_;
 627     return undef unless $domain;
 628
 629     # sanity checks
 630     unless ($self->{config}->{username}) {
 631         $self->debug("Management auth not set.");
 632         return undef;
 633     }
 634     unless (ref $c) {
 635         $self->debug("2nd arg must be a reference to customer info.");
 636         return undef;
 637     }
 638
 639     my $epp_phone = $c->{phone};
 640     $epp_phone =~ s/[\.\-]//g;
 641     $epp_phone = '+1.' . $epp_phone;
 642
 643     # blah, this sucks.
 644     # it would be really nice if OpenSRS figured out the country -> code
 645     # conversion on their end of things.
 646     my %country_codes = (
 647         'Afghanistan'                            => 'AF',
 648         'Albania'                                => 'AL',
 649         'Algeria'                                => 'DZ',
 650         'American Samoa'                         => 'AS',
 651         'Andorra'                                => 'AD',
 652         'Angola'                                 => 'AO',
 653         'Anguilla'                               => 'AI',
 654         'Antarctica'                             => 'AQ',
 655         'Antigua And Barbuda'                    => 'AG',
 656         'Argentina'                              => 'AR',
 657         'Armenia'                                => 'AM',
 658         'Aruba'                                  => 'AW',
 659         'Australia'                              => 'AU',
 660         'Austria'                                => 'AT',
 661         'Azerbaijan'                             => 'AZ',
 662         'Bahamas'                                => 'BS',
 663         'Bahrain'                                => 'BH',
 664         'Bangladesh'                             => 'BD',
 665         'Barbados'                               => 'BB',
 666         'Belarus'                                => 'BY',
 667         'Belgium'                                => 'BE',
 668         'Belize'                                 => 'BZ',
 669         'Benin'                                  => 'BJ',
 670         'Bermuda'                                => 'BM',
 671         'Bhutan'                                 => 'BT',
 672         'Bolivia'                                => 'BO',
 673         'Bosnia Hercegovina'                     => 'BA',
 674         'Botswana'                               => 'BW',
 675         'Bouvet Island'                          => 'BV',
 676         'Brazil'                                 => 'BR',
 677         'British Indian Ocean Territory'         => 'IO',
 678         'Brunei Darussalam'                      => 'BN',
 679         'Bulgaria'                               => 'BG',
 680         'Burkina Faso'                           => 'BF',
 681         'Burundi'                                => 'BI',
 682         'Cambodia'                               => 'KH',
 683         'Cameroon'                               => 'CM',
 684         'Canada'                                 => 'CA',
 685         'Cape Verde'                             => 'CV',
 686         'Cayman Islands'                         => 'KY',
 687         'Central African Republic'               => 'CF',
 688         'Chad'                                   => 'TD',
 689         'Chile'                                  => 'CL',
 690         'China'                                  => 'CN',
 691         'Christmas Island'                       => 'CX',
 692         'Cocos (Keeling) Islands'                => 'CC',
 693         'Colombia'                               => 'CO',
 694         'Comoros'                                => 'KM',
 695         'Congo'                                  => 'CG',
 696         'Congo The Democratic Republic Of'       => 'CD',
 697         'Cook Islands'                           => 'CK',
 698         'Costa Rica'                             => 'CR',
 699         'Cote D\'Ivoire'                         => 'CI',
 700         'Croatia'                                => 'HR',
 701         'Cuba'                                   => 'CU',
 702         'Cyprus'                                 => 'CY',
 703         'Czech Republic'                         => 'CZ',
 704         'Denmark'                                => 'DK',
 705         'Djibouti'                               => 'DJ',
 706         'Dominica'                               => 'DM',
 707         'Dominican Republic'                     => 'DO',
 708         'Ecuador'                                => 'EC',
 709         'Egypt'                                  => 'EG',
 710         'El Salvador'                            => 'SV',
 711         'Equatorial Guinea'                      => 'GQ',
 712         'Eritrea'                                => 'ER',
 713         'Estonia'                                => 'EE',
 714         'Ethiopia'                               => 'ET',
 715         'Falkland Islands (Malvinas)'            => 'FK',
 716         'Faroe Islands'                          => 'FO',
 717         'Fiji'                                   => 'FJ',
 718         'Finland'                                => 'FI',
 719         'France'                                 => 'FR',
 720         'French Guiana'                          => 'GF',
 721         'French Polynesia'                       => 'PF',
 722         'French Southern Territories'            => 'TF',
 723         'Gabon'                                  => 'GA',
 724         'Gambia'                                 => 'GM',
 725         'Georgia'                                => 'GE',
 726         'Germany'                                => 'DE',
 727         'Ghana'                                  => 'GH',
 728         'Gibraltar'                              => 'GI',
 729         'Greece'                                 => 'GR',
 730         'Greenland'                              => 'GL',
 731         'Grenada'                                => 'GD',
 732         'Guadeloupe'                             => 'GP',
 733         'Guam'                                   => 'GU',
 734         'Guatemela'                              => 'GT',
 735         'Guinea'                                 => 'GN',
 736         'Guinea-Bissau'                          => 'GW',
 737         'Guyana'                                 => 'GY',
 738         'Haiti'                                  => 'HT',
 739         'Heard and McDonald Islands'             => 'HM',
 740         'Honduras'                               => 'HN',
 741         'Hong Kong'                              => 'HK',
 742         'Hungary'                                => 'HU',
 743         'Iceland'                                => 'IS',
 744         'India'                                  => 'IN',
 745         'Indonesia'                              => 'ID',
 746         'Iran (Islamic Republic Of)'             => 'IR',
 747         'Iraq'                                   => 'IQ',
 748         'Ireland'                                => 'IE',
 749         'Israel'                                 => 'IL',
 750         'Italy'                                  => 'IT',
 751         'Jamaica'                                => 'JM',
 752         'Japan'                                  => 'JP',
 753         'Jordan'                                 => 'JO',
 754         'Kazakhstan'                             => 'KZ',
 755         'Kenya'                                  => 'KE',
 756         'Kiribati'                               => 'KI',
 757         'Korea, Democratic People\'s Republic Of' => 'KP',
 758         'Korea, Republic Of'                     => 'KR',
 759         'Kuwait'                                 => 'KW',
 760         'Kyrgyzstan'                             => 'KG',
 761         'Lao People\'s Democratic Republic'      => 'LA',
 762         'Latvia'                                 => 'LV',
 763         'Lebanon'                                => 'LB',
 764         'Lesotho'                                => 'LS',
 765         'Liberia'                                => 'LR',
 766         'Libyan Arab Jamahiriya'                 => 'LY',
 767         'Liechtenstein'                          => 'LI',
 768         'Lithuania'                              => 'LT',
 769         'Luxembourg'                             => 'LU',
 770         'Macau'                                  => 'MO',
 771         'Macedonia'                              => 'MK',
 772         'Madagascar'                             => 'MG',
 773         'Malawi'                                 => 'MW',
 774         'Malaysia'                               => 'MY',
 775         'Maldives'                               => 'MV',
 776         'Mali'                                   => 'ML',
 777         'Malta'                                  => 'MT',
 778         'Marshall Islands'                       => 'MH',
 779         'Martinique'                             => 'MQ',
 780         'Mauritania'                             => 'MR',
 781         'Mauritius'                              => 'MU',
 782         'Mayotte'                                => 'YT',
 783         'Mexico'                                 => 'MX',
 784         'Micronesia, Federated States Of'        => 'FM',
 785         'Moldova, Republic Of'                   => 'MD',
 786         'Monaco'                                 => 'MC',
 787         'Mongolia'                               => 'MN',
 788         'Montserrat'                             => 'MS',
 789         'Morocco'                                => 'MA',
 790         'Mozambique'                             => 'MZ',
 791         'Myanmar'                                => 'MM',
 792         'Namibia'                                => 'NA',
 793         'Nauru'                                  => 'NR',
 794         'Nepal'                                  => 'NP',
 795         'Netherlands'                            => 'NL',
 796         'Netherlands Antilles'                   => 'AN',
 797         'New Caledonia'                          => 'NC',
 798         'New Zealand'                            => 'NZ',
 799         'Nicaragua'                              => 'NI',
 800         'Niger'                                  => 'NE',
 801         'Nigeria'                                => 'NG',
 802         'Niue'                                   => 'NU',
 803         'Norfolk Island'                         => 'NF',
 804         'Northern Mariana Islands'               => 'MP',
 805         'Norway'                                 => 'NO',
 806         'Oman'                                   => 'OM',
 807         'Pakistan'                               => 'PK',
 808         'Palau'                                  => 'PW',
 809         'Palestine'                              => 'PS',
 810         'Panama'                                 => 'PA',
 811         'Papua New Guinea'                       => 'PG',
 812         'Paraguay'                               => 'PY',
 813         'Peru'                                   => 'PE',
 814         'Philippines'                            => 'PH',
 815         'Pitcairn'                               => 'PN',
 816         'Poland'                                 => 'PL',
 817         'Portugal'                               => 'PT',
 818         'Puerto Rico'                            => 'PR',
 819         'Qatar'                                  => 'QA',
 820         'Reunion'                                => 'RE',
 821         'Romania'                                => 'RO',
 822         'Russian Federation'                     => 'RU',
 823         'Rwanda'                                 => 'RW',
 824         'Saint Helena'                           => 'SH',
 825         'Saint Kitts And Nevis'                  => 'KN',
 826         'Saint Lucia'                            => 'LC',
 827         'Saint Pierre and Miquelon'              => 'PM',
 828         'Saint Vincent and The Grenadines'       => 'VC',
 829         'Samoa'                                  => 'WS',
 830         'San Marino'                             => 'SM',
 831         'Sao Tome and Principe'                  => 'ST',
 832         'Saudi Arabia'                           => 'SA',
 833         'Senegal'                                => 'SN',
 834         'Serbia and Montenegro'                  => 'CS',
 835         'Seychelles'                             => 'SC',
 836         'Sierra Leone'                           => 'SL',
 837         'Singapore'                              => 'SG',
 838         'Slovakia'                               => 'SK',
 839         'Slovenia'                               => 'SI',
 840         'Solomon Islands'                        => 'SB',
 841         'Somalia'                                => 'SO',
 842         'South Africa'                           => 'ZA',
 843         'South Georgia and The Sandwich Islands' => 'GS',
 844         'Spain'                                  => 'ES',
 845         'Sri Lanka'                              => 'LK',
 846         'Sudan'                                  => 'SD',
 847         'Suriname'                               => 'SR',
 848         'Svalbard and Jan Mayen Islands'         => 'SJ',
 849         'Swaziland'                              => 'SZ',
 850         'Sweden'                                 => 'SE',
 851         'Switzerland'                            => 'CH',
 852         'Syrian Arab Republic'                   => 'SY',
 853         'Taiwan'                                 => 'TW',
 854         'Tajikista'                              => 'TJ',
 855         'Tanzania, United Republic Of'           => 'TZ',
 856         'Thailand'                               => 'TH',
 857         'Timor-Leste'                            => 'TL',
 858         'Togo'                                   => 'TG',
 859         'Tokelau'                                => 'TK',
 860         'Tonga'                                  => 'TO',
 861         'Trinidad and Tobago'                    => 'TT',
 862         'Tunisia'                                => 'TN',
 863         'Turkey'                                 => 'TR',
 864         'Turkmenistan'                           => 'TM',
 865         'Turks and Caicos Islands'               => 'TC',
 866         'Tuvalu'                                 => 'TV',
 867         'Uganda'                                 => 'UG',
 868         'Ukraine'                                => 'UA',
 869         'United Arab Emirates'                   => 'AE',
 870         'United Kingdom (GB)'                    => 'GB',
 871         'United Kingdom (UK)'                    => 'UK',
 872         'United States'                          => 'US',
 873         'United States Minor Outlying Islands'   => 'UM',
 874         'Uruguay'                                => 'UY',
 875         'Uzbekistan'                             => 'UZ',
 876         'Vanuatu'                                => 'VU',
 877         'Vatican City State'                     => 'VA',
 878         'Venezuela'                              => 'VE',
 879         'Vietnam'                                => 'VN',
 880         'Virgin Islands (British)'               => 'VG',
 881         'Virgin Islands (U.S.)'                  => 'VI',
 882         'Wallis and Futuna Islands'              => 'WF',
 883         'Western Sahara'                         => 'EH',
 884         'Yemen Republic of'                      => 'YE',
 885         'Zambia'                                 => 'ZM',
 886         'Zimbabwe'                               => 'ZW'
 887     );  # end suckage
 888
 889     # attempt countryname translation if needed
 890     if ( $c->{country} !~ m/^[A-Z]{2,3}$/ ) {
 891         $c->{country} = $country_codes{$c->{country}};
 892
 893         unless ( defined( $c->{country} ) ) {
 894             $self->debug("Invalid country.");
 895             return undef;
 896         }
 897     }
 898
 899     # build contact hashref from customer info.
 900     my $contact_info = {
 901         first_name  => $c->{firstname},
 902         last_name   => $c->{lastname},
 903         city        => $c->{city},
 904         state       => $c->{state},
 905         country     => $c->{country},
 906         address1    => $c->{address},
 907         postal_code => $c->{zip},
 908         email       => $c->{email},
 909         phone       => $epp_phone,
 910         org_name    => $c->{company} || 'n/a',
 911     };
 912
 913     $rv = $self->make_request(
 914         {
 915             action     => 'sw_register',
 916             object     => 'domain',
 917             attributes => {
 918                 domain              => $domain,
 919                 custom_nameservers  => 0,
 920                 custom_tech_contact => 0,
 921                 auto_renew          => 0,
 922                 period              => 1,
 923                 f_lock_domain       => 1,
 924                 contact_set         => {
 925                     admin   => $contact_info,
 926                     billing => $contact_info,
 927                     owner   => $contact_info
 928                 },
 929                 reg_username => $self->{config}->{username},
 930                 reg_password => $self->{config}->{password},
 931                 reg_type   => $transfer ? 'transfer' : 'new',
 932                 reg_domain => $self->{config}->{master_domain}, # link domain to the 'master' account
 933             }
 934         }
 935     );
 936     $self->_set_response;
 937     return $rv->{is_success};
 938 }
 939
 940 =item renew_domain()
 941
 942  my $result = $srs->renew_domain( 'example.com', 1 );
 943
 944 Renew a domain for a period of time in years. 1 year is the default.
 945
 946 =cut
 947
 948 sub renew_domain
 949 {
 950     my ($self, $domain, $years) = @_;
 951     return undef unless $domain;
 952     $years ||= 1;
 953
 954     # sanity checks
 955     unless ($self->{config}->{username}) {
 956         $self->debug("Management auth not set.");
 957         return undef;
 958     }
 959
 960     # get current expiration year (why do they need this, again?)
 961     my (undef, $expiration) = $self->get_cookie( $domain );
 962     $expiration = $1 if $expiration =~ /^(\d{4})-/;
 963     $expiration ||= Date::Calc::This_Year();
 964
 965     $rv = $self->make_request(
 966         {
 967             action     => 'renew',
 968             object     => 'domain',
 969             attributes => {
 970                 domain                => $domain,
 971                 auto_renew            => 0,
 972                 handle                => 'process',
 973                 period                => $years,
 974                 currentexpirationyear => $expiration,
 975             }
 976         }
 977     );
 978     $self->_set_response;
 979     return $rv->{is_success};
 980 }
 981
 982 =item revoke_domain()
 983
 984 Revoke a previously registered domain.  This only works if the domain is
 985 still within the grace period as defined by the registrar.
 986 Requires you to have called set_manage_auth() B<first>.
 987
 988  my $result = $srs->revoke_domain( 'example.com' );
 989
 990 Returns true if the revoke is successful, false otherwise.
 991 Returns undefined on error.
 992
 993 =cut
 994
 995 sub revoke_domain
 996 {
 997     my ($self, $domain) = @_;
 998     return undef unless $domain;
 999     unless ($self->{config}->{username}) {
1000         $self->debug("Management auth not set.");
1001         return undef;
1002     }
1003     $rv = $self->make_request(
1004         {
1005             action     => 'revoke',
1006             object     => 'domain',
1007             attributes => {
1008                 reseller => $self->{config}->{username},
1009                 domain => $domain,
1010             }
1011         }
1012     );
1013     $self->_set_response;
1014     return $rv->{is_success};
1015 }
1016
1017 =item transfer_domain()
1018
1019  my $result = $srs->transfer_domain( 'example.com', $c );
1020
1021 Transfer a domain under your control.
1022 Returns true on success, false on failure, and undefined on caller error.
1023
1024 =cut
1025
1026 sub transfer_domain
1027 {
1028     my $self = shift;
1029     return $self->register_domain( @_, 1 );
1030 }
1031
1032 =item make_request()
1033
1034 This method is the real workhorse of this module.  If any OpenSRS API
1035 isn't explicity implemented in this module as a method call (such as
1036 get_cookie(), bulk_lock(), etc), you can use make_request() to build and send
1037 the API yourself.
1038
1039 Examples:
1040
1041  my $result = $srs->make_request(
1042      {
1043          batch   => 1,
1044          action  => 'submit',
1045          object  => 'bulk_change',
1046          attributes => {
1047              change_type => 'domain_lock',
1048              change_items => [ 'example.com', 'example.net' ],
1049              op_type => 'lock',
1050          }
1051      }
1052  );
1053
1054  my $result = $srs->make_request(
1055      {
1056          action     => 'lookup',
1057          object     => 'domain',
1058          attributes => {
1059              domain => 'example.com'
1060          }
1061      }
1062  );
1063
1064 Returns a hashref containing parsed XML results from OpenSRS.
1065
1066 Example return:
1067
1068  {
1069      'protocol' => 'XCP',
1070      'object' => 'DOMAIN',
1071      'response_text' => 'Domain taken',
1072      'action' => 'REPLY',
1073      'response_code' => '211',
1074      'attributes' => {
1075          'status' => 'taken',
1076          'match' => {}
1077      },
1078      'is_success' => '1'
1079  }
1080
1081 =cut
1082
1083 # build opensrs xml protocol string.  submit.
1084 # convert xml response to data structure, and return.
1085 sub make_request
1086 {
1087     my ($self, $data) = @_;
1088     return undef unless ref $data;
1089
1090     $self->debug("Using " . $self->environment . " environment.");
1091
1092     my $key  = $self->{config}->{ $self->environment }->{key};
1093     my $host = $self->{config}->{ $self->environment }->{host};
1094     $ENV{HTTPS_DEBUG} = 1 if $self->debug_level > 2;
1095
1096     unless ($key) {
1097         $self->debug("Authentication key not set.");
1098         return undef;
1099     }
1100
1101     my $action = uc $data->{action};
1102     my $object = uc $data->{object};
1103
1104     # build our XML request.
1105     # lets not bother with anything super fancy,
1106     # everything but the item keys are always static anyway.
1107     my $xml;
1108     $xml = <<XML;
1109 <?xml version='1.0' encoding="UTF-8" standalone="no" ?>
1110 <!DOCTYPE OPS_envelope SYSTEM "ops.dtd">
1111 <OPS_envelope>
1112 <header><version>0.9</version></header>
1113 <body>
1114 <data_block>
1115 <dt_assoc>
1116   <item key="protocol">XCP</item>
1117   <item key="action">$action</item>
1118   <item key="object">$object</item>
1119 XML
1120
1121     $xml .= "  <item key=\"cookie\">$data->{cookie}</item>\n" if $data->{cookie};
1122
1123 $xml .= <<XML;
1124   <item key="attributes">
1125     <dt_assoc>
1126 XML
1127
1128     foreach (sort keys %{ $data->{attributes} }) {
1129         my $val = $data->{attributes}->{$_};
1130         $xml .= $self->_format( $val, 4 );
1131     }
1132     $xml .= <<XML;
1133     </dt_assoc>
1134   </item>
1135 </dt_assoc>
1136 </data_block>
1137 </body>
1138 </OPS_envelope>
1139 XML
1140
1141     # whoof, ok.  got our request built.  lets ship it off.
1142     if ($self->debug_level > 1) {
1143         $self->debug("\nClient Request XML:\n" . '-' x 30);
1144         $self->debug($xml);
1145     }
1146
1147     $host = $self->{config}->{bulkhost} if $data->{batch};
1148     $self->debug("Making request to $host...");
1149     my $ua = LWP::UserAgent->new( timeout => 20, agent => "Net::OpenSRS/$VERSION" );
1150     unless ($ua) {
1151         $self->debug("Unable to contact remote host.");
1152         return undef;
1153     }
1154
1155     my $res = $ua->post(
1156         $host,
1157         'Content-Type' => 'text/xml',
1158         'X-Username'   => $self->{config}->{username},
1159         'X-Signature'  => hash( hash( $xml, $key ), $key ),
1160         'Content'      => $xml
1161     );
1162
1163     my $struct;
1164     if ( $res->is_success ) {
1165         $self->debug("HTTP result: " . $res->status_line);
1166         my $rslt = $res->content;
1167         # OpenSRS renew response triggers Expat parser error due to spaces in element name
1168         $rslt =~ s/registration expiration date/registration_expiration_date/g;
1169
1170         eval { $struct = XML::Simple::XMLin(
1171                  $rslt,
1172                  'KeyAttr' => [ 'dt_assoc' ],
1173                  'GroupTags' => { 'dt_assoc' => 'item',  'dt_array' => 'item' },
1174                );
1175         };
1176
1177         if ($self->debug_level > 1) {
1178             $self->debug("\nOpenSRS Response XML:\n" . '-' x 30);
1179             $self->debug($res->content);
1180             $self->debug('');
1181         }
1182
1183         # get the struct looking just how we want it.
1184         # (de-nastify it.)
1185         (undef, $struct) = _denastify( $struct->{body}->{data_block} );
1186     }
1187     else {
1188         $self->debug("HTTP error: " . $res->status_line);
1189         return undef;
1190     }
1191
1192     $rv = $struct;
1193     $self->_set_response;
1194     return $self->last_response(1);
1195 }
1196
1197 # format perl structs into opensrs XML
1198 sub _format
1199 {
1200     my ($self, $val, $indent) = @_;
1201     my $xml;
1202
1203     $indent ||= 6;
1204     my $sp = ' ' x $indent;
1205
1206     if ( ref $val eq 'ARRAY' ) {
1207         my $c = 0;
1208         $xml .= "$sp<item key=\"$_\">\n";
1209         $xml .= "$sp  <dt_array>\n";
1210         foreach (sort @$val) {
1211             $xml .= "$sp    <item key=\"$c\">$_</item>\n";
1212             $c++;
1213         }
1214         $xml .= "$sp  </dt_array>\n";
1215         $xml .= "$sp</item>\n";
1216     }
1217
1218     elsif ( ref $val eq 'HASH' ) {
1219         $xml .= "$sp<item key=\"$_\">\n";
1220         $xml .= "$sp<dt_assoc>\n";
1221         foreach (sort keys %$val) {
1222             $xml .= $self->_format( $val->{$_} );
1223         }
1224         $xml .= "$sp</dt_assoc>\n";
1225         $xml .= "$sp</item>\n";
1226     }
1227
1228     else {
1229         $xml .= "$sp<item key=\"$_\">$val</item>\n";
1230     }
1231
1232     return $xml;
1233 }
1234
1235 sub _denastify {
1236     my ($arg) = ( shift );
1237
1238     if ( 0 ) {
1239       eval { use Data::Dumper };
1240       warn $@ if $@;
1241       warn "_denastify\n". Dumper($arg) unless $@;
1242     }
1243
1244     if ( ref($arg) eq 'HASH' ) {
1245         my $value;
1246         if ( exists( $arg->{content} ) ) {
1247             $value = $arg->{content};
1248         } elsif ( exists( $arg->{dt_array} ) ) {
1249             my $array = $arg->{dt_array};
1250             $array = [ $array ] unless ref($array) eq 'ARRAY';
1251             $value = [ map {
1252                                { map { _denastify($_) } @{ $_->{dt_assoc} } }
1253                            }
1254                        @$array
1255                      ];
1256         } elsif ( exists( $arg->{dt_assoc} ) ) {
1257             $value = { map { _denastify($_) } @{ $arg->{dt_assoc} } };
1258         }
1259         return ( $arg->{key} => $value );
1260     }
1261     ();
1262 }
1263
1264 =back
1265
1266 =head1 Author
1267
1268 Mahlon E. Smith I<mahlon@martini.nu> for Spime Solutions Group
1269 I<(www.spime.net)>
1270
1271 =cut
1272
1273 1;