view release on metacpan or  search on metacpan

lib/IO/EPP/Base.pm  view on Meta::CPAN

                SSL_key_file    => 'key.pem',
                SSL_cert_file   => 'cert.pem',
                Timeout         => 30,
            );

            $params->{user} = 'login';
            $params->{pass} = 'xxxxx';

            $params->{sock_params} = \%sock_params;

            $params->{test_mode} = 1; # use emulator

            # $params->{no_log} = 1; # 1 if no logging

            # enter a name if you need to specify a file for the log
            # $params->{log_name} = '/var/log/comm_epp_example.log';

            # use our function for logging
            $params->{log_fn} = sub { print "epp.example.com logger:\n$_[0]\n" };
        }

        return IO::EPP::Base::make_request( $action, $params );
    }

    my ( $answ, $msg, $conn_obj ) = make_request( 'check_domains', { domains => [ 'xyz.com', 'com.xyz', 'reged.xyz' ] } );

    print Dumper $answ;

Result:

    $VAR1 = {
          'msg' => 'Command completed successfully.',
          'xyz.com' => {
                         'avail' => '1'
                       },
          'reged.xyz' => {
                           'reason' => 'in use',
                           'avail' => '0'
                         },
          'code' => '1000',
          'com.xyz' => {
                         'avail' => '1'
                       }
        };
}

=head1 DESCRIPTION

Module for common EPP-functions, without extension (dnssec only).

The module can be used to work with any provider,
if the requests do not use extensions and the provider does not have its own features

It has two options: using a separate function call or working as an object

=cut

use Digest::MD5 qw(md5_hex);
use Time::HiRes qw(time);
use IO::Socket;
use IO::Socket::SSL;

use strict;
use warnings;

# common chunks for all standard queries
our $epp_head = '<?xml version="1.0" encoding="UTF-8"?>
<epp xmlns="urn:ietf:params:xml:ns:epp-1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:ietf:params:xml:ns:epp-1.0 epp-1.0.xsd">';
our $epp_cont_urn =
'xmlns:contact="urn:ietf:params:xml:ns:contact-1.0" xsi:schemaLocation="urn:ietf:params:xml:ns:contact-1.0 contact-1.0.xsd"';
our $epp_host_urn =
'xmlns:host="urn:ietf:params:xml:ns:host-1.0" xsi:schemaLocation="urn:ietf:params:xml:ns:host-1.0 host-1.0.xsd"';
our $epp_dom_urn  =
'xmlns:domain="urn:ietf:params:xml:ns:domain-1.0" xsi:schemaLocation="urn:ietf:params:xml:ns:domain-1.0 domain-1.0.xsd"';
our $epp_dnssec =
'xmlns:secDNS="urn:ietf:params:xml:ns:secDNS-1.1" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:ietf:params:xml:ns:secDNS-1.1 secDNS-1.1.xsd"';


our %id = ( crID => 'creater', clID => 'owner', upID => 'updater', reID => 'requestors_id', acID => 'senders_id' );
our %dt = ( crDate => 'cre_date', upDate => 'upd_date', trDate => 'trans_date', exDate => 'exp_date', reDate => 'request_date', acDate => 'send_date'  );


=head1 FUNCTIONS

=head2 make_request

See L<IO:EPP> for description

An example of working with functions is presented in the synopsis

Work checked on CentralNic server

INPUT:

action name;

parameters of query

OUTPUT:

io::epp object

or, in list context:

( full answer with code and message, string with code and message, io::epp object )

An Example:

    my ( $answer, $message, $conn_object ) = make_request( 'hello', \%login_params );

A more complete example is found in L<IO::EPP>

=cut

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

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

    if ( !$params->{tld}  &&  $params->{dname} ) {
        ( $params->{tld} ) = $params->{dname} =~ /^[0-9a-z\-]+\.(.+)$/;

lib/IO/EPP/Base.pm  view on Meta::CPAN

    return $pw;
}


# Generation transaction id

sub get_cltrid {
    return md5_hex( time() . $$ . rand(1000000) );
}


# recursive removal of utf8 flag

sub recursive_utf8_unflaged {
    my $root = shift;

    if ( ref $root eq 'HASH' ) {
        foreach my $k ( keys %$root ) {
            my $key = $k;
            utf8::decode( $key );
            utf8::decode( $key );
            utf8::encode( $key );
            # work if $root->{with_utf8_flag} ne $root->{without_utf8_flag}
            $root->{$key} = recursive_utf8_unflaged( delete $root->{$k} ) ;
        }
    }
    elsif ( ref $root eq 'ARRAY' ) {
        $_ = recursive_utf8_unflaged($_) foreach @$root;
    }
    elsif ( $root  &&  ref $root eq '' ) {
        utf8::decode( $root );
        utf8::decode( $root );
        utf8::encode( $root );
    }

    return $root;
}

# clear date-time

sub cldate {
    my ( $dt ) = @_;

    $dt =~ s/T/ /;
    $dt =~ s/\.\d+Z$//;
    $dt =~ s/Z$//;

    return $dt;
}


=head1 METHODS

=head2 new

Create new IO::EPP object, аutomatically connects to the provider and logins.

Example of a call

    # Parameters for IO::Socket::SSL
    my %sock_params = (
        PeerHost => 'epp.example.com',
        PeerPort => 700,
        SSL_key_file  => $path_to_ssl_key_file,
        SSL_cert_file => $path_to_ssl_cert_file,
        Timeout  => 30,
    );

    # initialization of an object, during which login is called
    my $o = IO::EPP::Base->new( {
        sock_params => \%sock_params,
        user        => $login_name,
        pass        => $login_password,
        log_name    => '/var/log/comm_epp_registry_name',
    } );

    # call check of domains
    my ( $answ, $code, $msg ) = $o->check_domains( { domains => [ 'kalinka.realty' ] } );

    undef $o; # call logout() и DESTROY() of object

INPUT:

package name, parameters.

Connection parameters:

C<user>        – login;

C<pass>        – password;

C<tld>         – zone for providers that have a binding in it, for example, verisign;

C<server>      – server name if the registry has different servers with different extensions, for example, pir/afilias for afilias;

C<sock_params> – hashref with L<IO::Socket::SSL> parameters;

C<test_mode>   – use a real connection or registry emulator.

Parameters for logging:

C<no_log>   – do not write anything to the log;

C<log_name> – write log in this file, not in STDOUT;

C<log_fn>   – ref on functions to write to the log.

OUTPUT:

io::epp object or array ( object, login code, login message )

If the connection or authorization failed, the response will contain zero instead of an object

=cut

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

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

    my $sock;

    my $sock_params = delete $params->{sock_params};

    my $test = delete $params->{test_mode};

    if ( $test ) {
        $sock = $sock_params->{PeerHost} . ':' . $sock_params->{PeerPort};
    }
    else {
        $sock = IO::Socket::SSL->new(
            PeerPort => 700,
            Timeout  => 30,
            %{$sock_params},
        );
    }

    unless ( $sock ) {
        $msg = "can not connect";
        $code = 0;

        goto ERR;
    }

    $self = bless {
        sock           => $sock,
        user           => delete $params->{user},
        tld            => $params->{tld} || '',
        server         => delete $params->{server} || '',
        #launch         => $params->{launch} || '',
        log_name       => delete $params->{log_name},
        log_fn         => delete $params->{log_fn},
        no_log         => delete $params->{no_log} || 0,
        test           => $test,
        critical_error => undef,
    }, $package;

    $self->set_urn();

    $self->set_log_vars( $params );

    $self->epp_log( "Connect to $$sock_params{PeerHost}:$$sock_params{PeerPort}\n" );

    my $hello = $self->req();

    if ( !$hello  ||  $self->{critical_error} ) {
        $msg = "Can't get greeting";
        $msg .= '; ' . $self->{critical_error} if $self->{critical_error};
        $code = 0;

        goto ERR;
    }

    my ( $svcs, $extension ) = ( '', '' );

    if ( ref( $self ) =~ /IO::EPP::Base/ ) {
        if ( $hello =~ /urn:ietf:params:xml:ns:contact-1.0/ ) {
            $svcs .= '
    <objURI>urn:ietf:params:xml:ns:contact-1.0</objURI>';
        }
        if ( $hello =~ /urn:ietf:params:xml:ns:domain-1.0/ ) {
            $svcs .= '
    <objURI>urn:ietf:params:xml:ns:domain-1.0</objURI>';
        }
        if ( $hello =~ /urn:ietf:params:xml:ns:host-1.0/ ) {
            # drs.ua not want host
            $svcs .= '
    <objURI>urn:ietf:params:xml:ns:host-1.0</objURI>';
        }

        if ( $hello =~ /urn:ietf:params:xml:ns:secDNS-1.1/ ) {