view release on metacpan or  search on metacpan

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

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


=head1 METHODS

All methods except the ones listed below are completely the same as L<IO::EPP::RIPN>

=head2 new

Method is rewritten because of verify mode/hostname

=cut

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

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

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

    $sock_params->{SSL_verify_mode} = SSL_VERIFY_NONE; # there are no words
    $sock_params->{verify_hostname} = 0;

    # Further all as in the RIPN

    my $host          = $sock_params->{PeerHost};
    my $port          = $sock_params->{PeerPort};
    my $url           = "https://$host:$port";
    my $local_address = $sock_params->{LocalAddr};
    my $timeout       = $sock_params->{Timeout} || 5;

    my %ua_params = ( ssl_opts => $sock_params );
    $ua_params{local_address} = $local_address if $local_address;

    if ( $timeout ) {
        # LWP feature: first param for LWP, second - for IO::Socket
        $ua_params{timeout} = $timeout;
        $ua_params{Timeout} = $timeout;
    }

    my $cookie;
    if ( $params->{alien_conn} ) {
        $cookie = HTTP::Cookies->new( autosave => 0 );

        unless ( $cookie->load( $params->{load_cook_from} ) ) {
            $msg = "load cooker is fail";
            $code = 0;

            goto ERR;
        }
    }
    else {
        $cookie = HTTP::Cookies->new;
    }

    my $ua = LWP::UserAgent->new(
        agent      => 'EppBot/7.02 (Perl; Linux i686; ru, en_US)',
        parse_head =>  0,
        keep_alive => 30,
        cookie_jar => $cookie,
        %ua_params,
    );

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

        goto ERR;
    }

    $self = bless {
        sock     => $ua,
        user     => $params->{user},
        url      => $url,
        cookies  => $cookie,
        no_logs  => delete $params->{no_logs},
        alien    => $params->{alien_conn} ? 1 : 0,
    };

    $self->set_urn();

    $self->set_log_vars( $params );

    if ( $self->{alien} ) {
        return wantarray ? ( $self, 1000, 'ok' ) : $self;
    }

    # Get HEADER only
    $self->epp_log( "HEAD connect to $url from $local_address" );

    my $request = HTTP::Request->new( HEAD => $url ); # не POST
    my $response = $ua->request( $request );

    my $rcode = $response->code;
    $self->epp_log( "header answ code: $rcode" );

    unless ( $rcode == 200 ) {
        $code = 0;
        $msg  = "Can't open socket";

        goto ERR;
    }

    my $headers = $response->headers;

    my $length = $headers->content_length;
    $self->epp_log( "header content-length == $length" );

    if ( $length == 0 ) {
        $code = 0;
        $msg  = "Can't open socket";

        goto ERR;
    }

    my ( undef, $c0, $m0 ) = $self->hello();

    unless ( $c0  &&  $c0 == 1000 ) {
        $code = 0;