mirror of
https://github.com/internetee/epp_proxy.git
synced 2025-08-14 19:43:48 +02:00
232 lines
5.9 KiB
Perl
Executable file
232 lines
5.9 KiB
Perl
Executable file
#!/usr/bin/perl -w
|
|
#
|
|
# Simple EPP/TCP client to talk to an EPP server using the EPP over TCP layer
|
|
#
|
|
# Basically, this program prefixes each data block with a 4-byte prefix.
|
|
# Input blocks are terminated by a double newline.
|
|
#
|
|
# Written by Otmar Lendl <lendl@nic.at>
|
|
|
|
# Copyright (c) 2002 NIC.at Internet Verwaltungs- und
|
|
# Betriebsgesellschaft m. b. H. All rights reserved.
|
|
#
|
|
# Written by Otmar Lendl <lendl@nic.at>
|
|
#
|
|
# Redistribution and use in source and binary forms, with or without
|
|
# modification, are permitted provided that the following conditions
|
|
# are met:
|
|
#
|
|
# 1. Redistributions of source code must retain the above copyright
|
|
# notice, this list of conditions and the following disclaimer.
|
|
#
|
|
# 2. Redistributions in binary form must reproduce the above copyright
|
|
# notice, this list of conditions and the following disclaimer in
|
|
# the documentation and/or other materials provided with the
|
|
# distribution.
|
|
#
|
|
# 3. The end-user documentation included with the redistribution,
|
|
# if any, must include the following acknowledgment:
|
|
# "This product includes software developed by the
|
|
# NIC.at Internet Verwaltungs- und Betriebsgesellschaft m. b. H."
|
|
# Alternately, this acknowledgment may appear in the software itself,
|
|
# if and wherever such third-party acknowledgments normally appear.
|
|
#
|
|
# 4. The names "`mod_epp`" and "NIC.at" must
|
|
# not be used to endorse or promote products derived from this
|
|
# software without prior written permission. For written
|
|
# permission, please contact lendl@nic.at
|
|
#
|
|
# 5. Products derived from this software may not be called "`mod_epp`",
|
|
# nor may "`mod_epp`" appear in their name, without prior written
|
|
# permission of NIC.at.
|
|
#
|
|
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
|
|
# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
|
|
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
|
# DISCLAIMED. IN NO EVENT SHALL NIC.AT INTERNET VERWALTUNGS- UND
|
|
# BETRIEBSGESELLSCHAFT M.B.H. OR
|
|
# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
|
|
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
|
|
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
|
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
|
|
# OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
# SUCH DAMAGE.
|
|
|
|
use Socket;
|
|
use strict;
|
|
use Getopt::Long;
|
|
|
|
$| = 1; # no buffering, please
|
|
|
|
my ($opt_d, $opt_2);
|
|
|
|
my $cert_path = "";
|
|
my $key_path = "";
|
|
|
|
my $opt_ssl = 0;
|
|
|
|
GetOptions("delay|d", \$opt_d, "duplicate|2", \$opt_2, "ssl|s", \$opt_ssl,
|
|
"k=s", \$key_path, "c=s", \$cert_path);
|
|
|
|
|
|
if ($opt_ssl)
|
|
{
|
|
use Net::SSLeay qw(die_now die_if_ssl_error);
|
|
Net::SSLeay::load_error_strings();
|
|
Net::SSLeay::SSLeay_add_ssl_algorithms();
|
|
Net::SSLeay::randomize();
|
|
}
|
|
|
|
|
|
sub usage
|
|
{
|
|
print STDERR <<EOM;
|
|
Usage:
|
|
|
|
$0 [-2] [-d] [-s] [-k keyfile] [-c certfile] host port
|
|
|
|
Connect via TCP to the specified host an port.
|
|
Wait for a complete paragraph of text on STDIN, then send it
|
|
as an EPP/TCP frame to the host.
|
|
|
|
Options:
|
|
-2 Duplicate each message without waiting for an answer.
|
|
-d delay sending.
|
|
-s use SSL.
|
|
-k file use this client key.
|
|
-c file use this cert file.
|
|
|
|
Remarks:
|
|
You cannot use -s and one of -d or -2.
|
|
|
|
This is a simple half-duplex implementation.
|
|
|
|
/ol/2k2/12/04/
|
|
EOM
|
|
|
|
exit 0;
|
|
}
|
|
|
|
&usage if ($#ARGV != 1);
|
|
&usage if ($opt_ssl and ($opt_2 or $opt_d));
|
|
|
|
my $host = shift;
|
|
my $port = shift;
|
|
|
|
&usage if ($host !~ /^[\a-z0-9-.]+$/);
|
|
&usage if ($port !~ /^\d+$/);
|
|
|
|
# input by paragraph.
|
|
|
|
$/ = "\n\n";
|
|
|
|
|
|
my $ip = gethostbyname($host);
|
|
my $host_params = sockaddr_in($port,$ip);
|
|
|
|
socket(S, &AF_INET, &SOCK_STREAM, 0) or die "socket: $!";
|
|
connect(S, $host_params) or die "connect: $!";
|
|
select(S); $| = 1; select (STDOUT);
|
|
|
|
print STDERR "Connected.\n";
|
|
|
|
my ($ctx, $ssl);
|
|
if ($opt_ssl)
|
|
{
|
|
# The network connection is now open, lets fire up SSL
|
|
$ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
|
|
Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
|
|
and die_if_ssl_error("ssl ctx set options");
|
|
|
|
print STDERR "using cert/key $cert_path, $key_path\n";
|
|
Net::SSLeay::set_cert_and_key($ctx, $cert_path, $key_path)
|
|
or die_if_ssl_error("SSL cert/key");
|
|
|
|
$ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
|
|
Net::SSLeay::set_fd($ssl, fileno(S)); # Must use fileno
|
|
Net::SSLeay::connect($ssl) and die_if_ssl_error("ssl connect");
|
|
print STDERR "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
|
|
print STDERR "Server CERT `" . Net::SSLeay::dump_peer_certificate($ssl) . "'\n";
|
|
}
|
|
|
|
my $len;
|
|
my $header;
|
|
my $in;
|
|
|
|
while(1)
|
|
{
|
|
#
|
|
# read the frame
|
|
#
|
|
if ($opt_ssl)
|
|
{
|
|
$header = Net::SSLeay::read($ssl,4);
|
|
if (!defined($header) or (length($header) != 4))
|
|
{ die "Can't read EPP/TCP header.";}
|
|
}
|
|
else
|
|
{ if (sysread(S,$header,4) != 4) { die "Can't read EPP/TCP header.";} }
|
|
|
|
$len = unpack("N",$header) - 4;
|
|
|
|
print STDERR "EPP/TCP Header: expecting $len bytes of XML\n";
|
|
|
|
while($len > 0)
|
|
{
|
|
if ($opt_ssl)
|
|
{ $in = Net::SSLeay::read($ssl,4096); $len -= length($in); }
|
|
else
|
|
{ $len -= sysread(S,$in,4096);}
|
|
|
|
print $in;
|
|
}
|
|
print "\n---- Enter EPP frame terminated by a double newline ----\n";
|
|
|
|
|
|
# get input from user;
|
|
last unless defined($_ = <>);
|
|
|
|
$len = length($_) + 4;
|
|
print STDERR "got input: $len bytes.\n";
|
|
$header = pack("N",$len);
|
|
|
|
if ($opt_2)
|
|
{
|
|
print S $header, $_, $header, $_;
|
|
}
|
|
elsif ($opt_d)
|
|
{
|
|
my $tmp = $header . $_;
|
|
my $i;
|
|
|
|
foreach $i (0 .. length($tmp))
|
|
{
|
|
print S substr($tmp,$i,1);
|
|
print STDERR ".";
|
|
sleep 1;
|
|
}
|
|
print STDERR "\n";
|
|
}
|
|
else
|
|
{
|
|
if ($opt_ssl)
|
|
{
|
|
Net::SSLeay::write($ssl, ($header . $_));
|
|
}
|
|
else
|
|
{ print S $header, $_; }
|
|
}
|
|
|
|
print STDERR "Sent $len bytes.\n";
|
|
}
|
|
|
|
|
|
if ($opt_ssl)
|
|
{
|
|
Net::SSLeay::free ($ssl); # Tear down connection
|
|
Net::SSLeay::CTX_free ($ctx);
|
|
}
|
|
|
|
close S;
|