view release on metacpan or  search on metacpan

lib/Net/EPP/MITMProxy.pm  view on Meta::CPAN

package Net::EPP::MITMProxy;
# ABSTRACT: A generic EPP proxy server framework.
use IO::Socket::SSL;
use Mozilla::CA;
use Net::EPP::Protocol;
use Socket6;
use Socket;
use SUPER;
use XML::LibXML;
use base qw(Net::Server::PreFork);
use feature qw(state);
use vars qw($OPT_KEY $HELLO);
use bytes;
use strict;

my $OPT_KEY = __PACKAGE__.'::opts';
my $HELLO   = '<epp xmlns="urn:ietf:params:xml:ns:epp-1.0"><hello/></epp>';


sub run {
    my ($self, %args) = @_;

    $self->{$OPT_KEY} = {
        remote_server   => delete($args{remote_server}),
        remote_port     => delete($args{remote_port}) || 700,
        remote_key      => delete($args{remote_key}),
        remote_cert     => delete($args{remote_cert}),
    };

    super;
}

sub process_request {
    my ($self, $client) = @_;

    my $server = $self->connect_to_remote_server;
    return unless ($server);

    my $frame = $self->get_frame($server);
    if (!$frame) {
        $self->log(0, 'error getting <greeting> from remote server');
        return;
    }

    $self->send_frame($client, $self->rewrite_response($frame, $HELLO));

    while (1) {
        my $command = $self->get_frame($client);

        if (!$command) {
            $self->log(0, 'error getting command frame from client');
            last;
        }

        $self->send_frame($server, $self->rewrite_command($command));

        my $response = $self->get_frame($server);

        if (!$response) {
            $self->log(0, 'error getting response frame from remote server');
            last;
        }

        $self->send_frame($client, $self->rewrite_response($response, $command));
    }

    return;
}

sub connect_to_remote_server {
    my $self = shift;

    my %args = (
        PeerHost        => $self->{$OPT_KEY}->{remote_server},
        PeerPort        => $self->{$OPT_KEY}->{remote_port},
        SSL_verify_mode => SSL_VERIFY_PEER,
        SSL_ca_file     => Mozilla::CA::SSL_ca_file(),
    );

    if ($self->{$OPT_KEY}->{remote_key} && $self->{$OPT_KEY}->{remote_cert}) {
        $args{SSL_key_file}     = $self->{$OPT_KEY}->{remote_key};
        $args{SSL_cert_file}    = $self->{$OPT_KEY}->{remote_cert};
    }

    my $server = IO::Socket::SSL->new(%args);

    if (!$server) {
        $self->log(0, sprintf(
            'connection to [%s]:%u failed (error=%s, SSL error=%s)',
            $self->{$OPT_KEY}->{remote_server},
            $self->{$OPT_KEY}->{remote_port},
            $!,
            $SSL_ERROR
        ));
        return;
    }

    return $server;
}

sub get_frame {
    my ($self, $socket) = @_;

    return Net::EPP::Protocol->get_frame($socket);
}

sub send_frame {
    my $self = shift;

    return Net::EPP::Protocol->send_frame(@_);
}


sub rewrite_command {
    my ($self, $command_xml) = @_;

    return $command_xml;
}


sub rewrite_response {
    my ($self, $response_xml, $command_xml) = @_;

    return $response_xml;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Net::EPP::MITMProxy - A generic EPP proxy server framework.

=head1 VERSION

version 0.02

=head1 SYNOPSIS

    package My::Proxy::Server;