File Coverage

blib/lib/IO/EPP/Verisign.pm

Criterion	Covered	Total	%
statement	116	236	49.1
branch	31	110	28.1
condition	23	54	42.5
subroutine	21	29	72.4
pod	24	25	96.0
total	215	454	47.3

package IO::EPP::Verisign;

=encoding utf8

=head1 NAME

IO::EPP::Verisign

=head1 SYNOPSIS

    use IO::EPP::Verisign;

    # Parameters for IO::Socket::SSL
    my %sock_params = (
        PeerHost        => 'epp.verisign-grs.com',
        PeerPort        => 700,
        SSL_key_file    => 'key_file.pem',
        SSL_cert_file   => 'cert_file.pem',
        Timeout         => 30,
    );

    # Create object, get greeting and call login()
    my $conn = IO::EPP::Verisign->new( {
        user => 'login',
        pass => 'XXXXX',
        sock_params => \%sock_params,
        server => 'Core', # or NameStore, or  DotName
        test_mode => 0, # real connect
    } );

    # Check domain
    my ( $answ, $code, $msg ) = $conn->check_domains( { domains => [ 'org.info' ] } );

    # Call logout() and destroy object
    undef $conn;

=head1 DESCRIPTION

Work with Verisign EPP API

Features:
Very mach extension, verisign here is leader. Absolutely all extensions have not yet been implemented

docs:
L,
L (need white IP)

for .name:
L

=cut

use IO::EPP::Base;
use parent qw( IO::EPP::Base );

use strict;
use warnings;

# not to change formatting:
our $sub_product_ext_begin =
'
    ';
our $sub_product_ext_end =
'
   ';
our $rgp_ext =
'xmlns:rgp="urn:ietf:params:xml:ns:rgp-1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:ietf:params:xml:ns:rgp-1.0 rgp-1.0.xsd"';

sub make_request {
    my ( $action, $params ) = @_;

    my ( $self, $code, $msg, $answ );

    unless ( $params->{conn} ) {
        $params->{sock_params}{PeerHost} ||= 'epp.verisign-grs.com';
        $params->{sock_params}{PeerPort} ||= 700;

        ( $self, $code, $msg ) = __PACKAGE__->new( $params );

        unless ( $code  and  $code == 1000 ) {
            goto END_MR;
        }
    }
    else {
        $self = $params->{conn};
    }


    # You can change the zone if you do not change the server
    # com <-> net <-> edu
    # cc <-> tv <-> jobs <-> name <-> ... new gtld
    my $tld = $self->{tld} || '';

    if ( not $tld  and  $params->{dname} ) {
        ( $tld ) = $params->{dname} =~ /\.([^.]+)$/;
    }

    if ( $tld ) {
        if ( lc ( $tld ) eq 'name' ) {
            $self->{dzone} = 'name';
        }
        else {
            $self->{dzone} = 'dot' . uc( $tld );
        }

        $self->{namestore_ext} = $sub_product_ext_begin . $self->{dzone} . $sub_product_ext_end ."\n";
    }


    $self->{critical_error} = '';

    if ( $self->can( $action ) ) {
        ( $answ, $code, $msg ) = $self->$action( $params );
    }
    else {
        $msg = "undefined command <$action>, request cancelled";
        $code = 0;
    }


END_MR:

    $msg .= '; ' . $self->{critical_error} if $self->{critical_error};

    my $full_answ = "code: $code\nmsg: $msg";

    $answ = {} unless $answ && ref $answ;

    $answ->{code} = $code;
    $answ->{msg}  = $msg;

    return wantarray ? ( $answ, $full_answ, $self ) : $answ;
}


sub req_test {
    my ( $self, $out_data, $info ) = @_;

    $self->epp_log( "$info request:\n$out_data" ) if $out_data;

    my $answ;

    if ( $self->{server} eq 'Core' ) {
        require IO::EPP::Test::VerisignCore;

        eval{
            $answ = IO::EPP::Test::VerisignCore::req( @_ );
            1;
        }
        or do {
            $self->{critical_error} = "$info req error: $@";
            return;
        };
    }
    else { # DotName, NameStore
        require IO::EPP::Test::VerisignName;

        eval{
            $answ = IO::EPP::Test::VerisignName::req( @_ );
            1;
        }
        or do {
            $self->{critical_error} = "$info req error: $@";
            return;
        };
    }

    $self->epp_log( "$info answer:\n$answ" );

    return $answ;
}


=head2 new

See description in L

Requires the C field to be specified, which can have values: C for .com/.net/.edu, C for .name, C for cctld and new gtlds.

=cut

sub new {
    my ( $package, $params ) = @_;

    unless ( $params->{server}  ||  $params->{dname}  ||  $params->{tld} ) {
        if ( $params->{sock_params}{PeerHost} =~ 'epp.verisign-grs.com' ) {
            $params->{server} = 'Core';
        }
        elsif ( $params->{sock_params}{PeerHost} eq 'namestoressl.verisign-grs.com' ) {
            $params->{server} = 'NameStore';
        }
    }

    unless ( $params->{server}  or  $params->{tld}  or  $params->{dname} ) {
        return wantarray ? ( 0, 0, 'unknown server: Core or DotName, need set server, tld or dname field' ) : 0 ;
    }

    $params->{dname} = lc $params->{dname} if $params->{dname};

    my $tld = $params->{tld} || '';

    if ( not $tld  and  $params->{dname} ) {
        ( $tld ) = $params->{dname} =~ /\.([^.]+)$/;
    }

    if ( $params->{server}  and  not $tld ) {
        if ( $params->{server} eq 'Core' ) {
            $tld = 'com';
        }
        elsif ( $params->{server} eq 'DotName' ) {
            $tld = 'name';
        }
        else {
            $tld = 'tv';
        }
    }

    if ( $tld  and  not $params->{server} ) {
        if ( $tld eq 'name' ) {
            $params->{server} = 'DotName';
        }
        elsif ( $tld =~ /^(com|net|edu)$/ ) {
            $params->{server} = 'Core';
        }
        else {
            $params->{server} = 'NameStore';
        }
    }

    $params->{server} = 'DotName' if $tld eq 'name' && $params->{server} ne 'DotName';


    my ( $self, $code, $msg ) = $package->SUPER::new( $params );

    unless ( $code  and  $code == 1000 ) {
        return wantarray ? ( 0, $code, $msg ) : 0;
    }

    if ( $tld ) {
        if ( lc ( $tld ) eq 'name' ) {
            $self->{dzone} = 'name';
        }
        else {
            $self->{dzone} = 'dot' . uc( $tld );
        }

        $self->{namestore_ext} = $sub_product_ext_begin . $self->{dzone} . $sub_product_ext_end ."\n";
    }

    return wantarray ? ( $self, $code, $msg ) : $self;
}


=head1 METHODS

далее перекрываем те функции, где у провайдера есть особенности

=head2 login

залогиниться

=cut

sub login {
    my ( $self, $pw ) = @_;

    my $svcs = '
    urn:ietf:params:xml:ns:domain-1.0
    urn:ietf:params:xml:ns:host-1.0
    urn:ietf:params:xml:ns:contact-1.0
    http://www.verisign.com/epp/lowbalance-poll-1.0';

    my $extension = '
     urn:ietf:params:xml:ns:secDNS-1.1
     http://www.verisign.com/epp/idnLang-1.0
     http://www.verisign-grs.com/epp/namestoreExt-1.1
     urn:ietf:params:xml:ns:rgp-1.0';

    if ( $self->{server} eq 'Core' ) {

        $svcs .= '
    http://www.verisign.com/epp/registry-1.0
    http://www.verisign.com/epp/rgp-poll-1.0';
        $extension .= '
     http://www.verisign.com/epp/whoisInf-1.0
     urn:ietf:params:xml:ns:coa-1.0
     http://www.verisign.com/epp/sync-1.0
     http://www.verisign.com/epp/relatedDomain-1.0
     urn:ietf:params:xml:ns:changePoll-1.0';

    }
    elsif ( $self->{server} eq 'DotName' ) {
        # moved to NameStore but extension in use
        # https://www.verisign.com/assets/email-forwarding-mapping.pdf
        $svcs .= '
    http://www.nic.name/epp/nameWatch-1.0
    http://www.nic.name/epp/emailFwd-1.0
    http://www.nic.name/epp/defReg-1.0';
        $extension .= '
     http://www.nic.name/epp/persReg-1.0';

    }
    elsif ( $self->{server} eq 'NameStore' ) {

        $svcs .= '
    http://www.verisign.com/epp/rgp-poll-1.0
    http://www.verisign.com/epp/balance-1.0
    http://www.verisign-grs.com/epp/suggestion-1.1
    http://www.verisign.com/epp/registry-1.0';
        $extension .= '
     http://www.verisign.com/epp/sync-1.0
     http://www.verisign.com/epp/jobsContact-1.0
     http://www.verisign.com/epp/premiumdomain-1.0
     urn:ietf:params:xml:ns:launch-1.0
     urn:ietf:params:xml:ns:verificationCode-1.0
     urn:ietf:params:xml:ns:fee-0.9';

    }

    return $self->SUPER::login( $pw, $svcs, $extension );
}


sub check_contacts {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::check_contacts( $params );
}

=head2 create_contact

For .jobs need additional parameters:
C, C, C, C.

About .jobs parameters see L.

=cut

sub create_contact {
    my ( $self, $params ) = @_;

    $params->{cont_id} ||= IO::EPP::Base::gen_id( 16 );

    $params->{authinfo} = IO::EPP::Base::gen_pw( 16 );

    my $extension = '';

    if ( $self->{dzone} eq 'dotJOBS' ) {
        $extension .= q|   \n|;
        $extension .=  "    $$params{jobs_title}\n";
        $extension .=  "    $$params{jobs_website}\n";
        $extension .=  "    $$params{jobs_industry_type}\n";
        $extension .=  "    $$params{is_admin}\n";
        $extension .=  "    No\n";
        $extension .=  "   \n";
    }

    $params->{extension} = $extension . $self->{namestore_ext};

    return $self->SUPER::create_contact( $params );
}


sub get_contact_info {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::get_contact_info( $params );
}


sub update_contact {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::update_contact( $params );
}


sub delete_contact {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::delete_contact( $params );
}


sub check_nss {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::check_nss( $params );
}


sub create_ns {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::create_ns( $params );
}


sub get_ns_info {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::get_ns_info( $params );
}


sub update_ns {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    $params->{no_empty_chg} = 1 unless $params->{chg};

    return $self->SUPER::update_ns( $params );
}


sub delete_ns {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::delete_ns( $params );
}

sub check_domains {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::check_domains( $params );
}

=head2 create_domain

For IDN domains you need to specify the language code in the C field

See L,
and L for .com, .net

=cut

sub create_domain {
    my ( $self, $params ) = @_;

    $params->{authinfo} ||= IO::EPP::Base::gen_pw( 16 );

    # Do not change the order of records
    my $extension = $self->{namestore_ext};

    if ( $params->{idn_lang} ) {
        $extension .=
'   ' .
        $params->{idn_lang} .
        "\n";
    }

    $params->{extension} = $extension;

    return $self->SUPER::create_domain( $params );
}


sub transfer {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    if ( defined $params->{authinfo} ) {
        $params->{authinfo} =~ s/&/&/g;
        $params->{authinfo} =~ s/
        $params->{authinfo} =~ s/>/>/g;
    }

    return $self->SUPER::transfer( $params );
}


sub get_domain_info {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::get_domain_info( $params );
}


sub renew_domain {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::renew_domain( $params );
}


sub update_domain {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::update_domain( $params );
}


sub delete_domain {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext};

    return $self->SUPER::delete_domain( $params );
}


=head2 restore_domain

First call of restore — request

=cut

sub restore_domain {
    my ( $self, $params ) = @_;

    $params->{extension} = $self->{namestore_ext} .
"


";

    return $self->SUPER::update_domain( $params );
}


=head2 confirmations_restore_domain

Secont call of restore — confirmation

C   — whois before delete, may be none;
C  — whois now, may be none;
C   — domain delete datetime in UTC;
C  — restore request call datetime in UTC.

The following fields already contain the required value, they do not need to be passed:
C — restore reason;
C — need to write what it is for the client;
C     — additional information, may be empty.

=cut

sub confirmations_restore_domain {
    my ( $self, $params ) = @_;

    my $extension = $self->{namestore_ext};

    $params->{pre_data}  ||= 'none';
    $params->{post_data} ||= 'none';

    $params->{extension} = <
$extension



          $$params{pre_data}
          $$params{post_data}
          $$params{del_time}
          $$params{rest_time}
          Customer forgot to renew.
          I agree that the Domain Name has not been restored in order to assume the rights to use or sell the name to myself or for any third party.
          I agree that the information provided in this Restore Report is true to the best of my knowledge, and acknowledge that intentionally supplying false information in the Restore Report shall constitute an incurable material breach of the Registry-Registrar Agreement.




RGPEXT

    return $self->SUPER::update_domain( $params );
}


sub req_poll_ext {
    my ( $self, $ext ) = @_;

    my %info;

    if ( $ext =~ m|]+>(.+)|s ) {
        $info{change}{'state'} = $1;
        my $row = $2;

        if ( $row =~ s|([^<>]+)|| ) {
            $info{change}{date} = $1;

            $info{change}{date} =~ s/T/ /;
            $info{change}{date} =~ s/Z$//;
        }

        if ( $row =~ s|([^<>]+)|| ) {
            $info{change}{who} = $1;
        }

        if ( $row =~ s|([^<>]+)|| ) {
            $info{change}{svtrid} = $1;
        }

        if ( $row =~ s|([^<>]+)|| ) {
            $info{change}{reason} = $1;
        }

        $info{change}{row_msg} = $row;
    }
    else {
        $info{ext} = $ext;
    }

    return \%info;
}


=head2 get_registry_info

Registry information for the specified zone

key in params: C

An Example:

    my ( $answ, $code, $msg ) = $conn->get_registry_info( { tld => 'net' } );

    # answer

    {
          'alphaNumStart' => 'true',
          'max' => [
                     '13',
                     '13'
                   ],
          'language code' => [
                               'ARG',
                               'ASM',
                               'AST',
                               'AVE',
                               'AWA',
                               'BAK',
                               'BAL',
                               'BAN',
                               'BAS',
                               'BEL',
                               'BOS',
                               'CAR',
                               'CHE',
                               'CHV',
                               'COP',
                               'COS',
                               'WEL',
                               'DIV',
                               'DOI',
                               'FIJ',
                               'FRY',
                               'GLA',
                               'GLE',
                               'GON',
                               'INC',
                               'IND',
                               'INH',
                               'JAV',
                               'KAS',
                               'KAZ',
                               'KHM',
                               'KIR',
                               'LTZ',
                               'MAO',
                               'MAY',
                               'MLT',
                               'MOL',
                               'MON',
                               'OSS',
                               'PUS',
                               'SIN',
                               'SMO',
                               'SOM',
                               'SRD',
                               'TGK',
                               'YID',
                               'AFR',
                               'ALB',
                               'ARA',
                               'ARM',
                               'AZE',
                               'BAQ',
                               'BEN',
                               'BHO',
                               'TIB',
                               'BUL',
                               'BUR',
                               'CAT',
                               'CZE',
                               'CHI',
                               'DAN',
                               'GER',
                               'DUT',
                               'GRE',
                               'ENG',
                               'EST',
                               'FAO',
                               'PER',
                               'FIN',
                               'FRE',
                               'GEO',
                               'GUJ',
                               'HEB',
                               'HIN',
                               'SCR',
                               'HUN',
                               'ICE',
                               'ITA',
                               'JPN',
                               'KOR',
                               'KUR',
                               'LAO',
                               'LAV',
                               'LIT',
                               'MAC',
                               'MAL',
                               'NEP',
                               'NOR',
                               'ORI',
                               'PAN',
                               'POL',
                               'POR',
                               'RAJ',
                               'RUM',
                               'RUS',
                               'SAN',
                               'SCC',
                               'SLO',
                               'SLV',
                               'SND',
                               'SPA',
                               'SWA',
                               'SWE',
                               'SYR',
                               'TAM',
                               'TEL',
                               'THA',
                               'TUR',
                               'UKR',
                               'URD',
                               'UZB',
                               'VIE'
                             ],
          'gracePeriod command:transfer unit:d' => '5',
          'gracePeriod command:create unit:d' => '5',
          'default unit:y' => [
                                '1',
                                '1',
                                '1'
                              ],
          'gracePeriod command:autorenew unit:d' => '45',
          'subProduct' => 'NET',
          'idnVersion' => '1.1',
          'expression' => [
                            '[a-zA-Z0-9]([a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?',
                            '^(?=.*\\\\d)(?=.*[a-zA-Z])(?=.*[\\\\x21-\\\\x2F\\\\x3A-\\\\x40\\\\x5B-\\\\x60\\\\x7B-\\\\x7E])[\\\\x21-\\\\x7e]{8,32}$',
                            '^([\\-|\\w])+\\.([\\-|\\w])+\\s{0,}$)$'
                          ],
          'redemptionPeriod unit:d' => '30',
          'encoding' => 'PunyCode',
          'max unit:y' => [
                            '10',
                            '10',
                            '1'
                          ],
          'name' => 'NET',
          'maxCheckHost' => '20',
          'urgent' => 'false',
          'default' => '604800',
          'onlyDnsChars' => 'true',
          'maxCheckDomain' => '20',
          'transferHoldPeriod unit:d' => '5',
          'digestType' => [
                            'SHA-1',
                            'SHA-256',
                            'GOST R 34.11-94',
                            'SHA-384'
                          ],
          'alg' => [
                     'RSAMD5',
                     'DH',
                     'DSA',
                     'RSASHA1',
                     'DSA-NSEC3-SHA1',
                     'RSASHA1-NSEC3-SHA1',
                     'RSASHA256',
                     'RSASHA512',
                     'ECC-GOST',
                     'ECDSAP256SHA256',
                     'ECDSAP384SHA384'
                   ],
          'startDate' => '2000-01-01T00:00:00Z',
          'minLength' => '3',
          'status' => [
                        'ok',
                        'serverHold',
                        'serverRenewProhibited',
                        'serverTransferProhibited',
                        'serverUpdateProhibited',
                        'serverDeleteProhibited',
                        'redemptionPeriod',
                        'pendingRestore',
                        'pendingDelete',
                        'clientRenewProhibited',
                        'clientTransferProhibited',
                        'clientUpdateProhibited',
                        'clientDeleteProhibited',
                        'pendingTransfer',
                        'clientHold',
                        'ok',
                        'pendingDelete',
                        'pendingTransfer',
                        'serverUpdateProhibited',
                        'serverDeleteProhibited',
                        'clientUpdateProhibited',
                        'clientDeleteProhibited',
                        'linked'
                      ],
          'zoneMember type:equal' => 'NET',
          'group' => 'THIN',
          'clientDefined' => 'false',
          'pendingRestore unit:d' => '7',
          'minIP' => [
                       '1',
                       '0'
                     ],
          'extURI required:true' => [
                                      'urn:ietf:params:xml:ns:coa-1.0',
                                      'http://www.verisign.com/epp/idnLang-1.0',
                                      'urn:ietf:params:xml:ns:secDNS-1.1',
                                      'http://www.verisign-grs.com/epp/namestoreExt-1.1',
                                      'urn:ietf:params:xml:ns:rgp-1.0',
                                      'http://www.verisign.com/epp/whoisInf-1.0',
                                      'http://www.verisign.com/epp/sync-1.0',
                                      'http://www.verisign.com/epp/relatedDomain-1.0',
                                      'urn:ietf:params:xml:ns:launch-1.0'
                                    ],
          'upDate' => '2013-08-10T21:16:01Z',
          'min unit:y' => [
                            '1',
                            '1',
                            '1'
                          ],
          'unicodeVersion' => '6.0',
          'commingleAllowed' => 'false',
          'pendingDelete unit:d' => '5',
          'sharePolicy' => [
                             'perSystem',
                             'perSystem'
                           ],
          'min' => [
                     '0',
                     '0',
                     '1'
                   ],
          'idnaVersion' => 'IDNA 2008',
          'objURI required:true' => [
                                      'urn:ietf:params:xml:ns:domain-1.0',
                                      'urn:ietf:params:xml:ns:contact-1.0',
                                      'urn:ietf:params:xml:ns:host-1.0',
                                      'http://www.verisign.com/epp/registry-1.0',
                                      'http://www.verisign.com/epp/lowbalance-poll-1.0',
                                      'http://www.verisign.com/epp/rgp-poll-1.0'
                                    ],
          'crDate' => '2000-01-01T00:00:00Z',
          'premiumSupport' => 'false',
          'alphaNumEnd' => 'true',
          'gracePeriod command:renew unit:d' => '5',
          'maxLength' => '63',
          'maxIP' => [
                       '13',
                       '0'
                     ],
          'contactsSupported' => 'false'
    };

=cut

sub get_registry_info {
    my ( $self, $params ) = @_;

    my $tld = uc( $params->{tld} );

    my $cltrid = IO::EPP::Base::get_cltrid();

my $body = <
$$self{urn}{head}



    $tld


  $cltrid


RINFO

    my $content = $self->req( $body, 'get_registry_info' );

    if ( $content =~ /result code=['"](\d+)['"]/ ) {
        my $rcode = $1 + 0;

        my $msg = '';
        if ( $content =~ /]*>(.+)<\/msg>.+\/result>/s ) {
            $msg = $1;
        }

        my %info;

        # take the main part and disassemble
        if ( $content =~ /(.+)<\/resData>/s ) {
            my $rdata = $1;

            my @list = $rdata =~ m|(]+>[^<>]+]+>)|g;

            foreach my $row ( @list ) {
                if ( $row =~ m|([^<>]+)]+>| ) {
                    my $k = $1;

                    push @{$info{$k}}, $2;
                }
                elsif ( $row =~ m|([^<>]+)]+>| ) {
                    my $k = "$1 $2:$3";

                    push @{$info{$k}}, $4;
                }
                elsif ( $row =~ m|([^<>]+)]+>| ) {
                    my $k = "$1 $2:$3 $4:$5";

                    push @{$info{$k}}, $6;
                }
            }

            @list = $rdata =~ m|(]+/>)|g;

            foreach my $row ( @list ) {
                if ( $row =~ m|| ) {
                    my $k .= "$1 $2";

                    push @{$info{$k}}, "$3";
                }
            }

            foreach my $k ( keys %info ) {
                if ( ( scalar @{$info{$k}} ) == 1 ) {
                    $info{$k} = $info{$k}[0];
                }
            }
        }
        else {
            return wantarray ? ( 0, $rcode, $msg ) : 0 ;
        }

        return wantarray ? ( \%info, $rcode, $msg ) : \%info;
    }

    return wantarray ? ( 0, 0, 'empty answer' ) : 0 ;
}


1;


__END__