internetee-epp_proxy/epptelnet.pl

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;