git.maemo.org Git - pkg-perl/blob - deb-src/libnet-ssleay-perl/libnet-ssleay-perl-1.35/examples/tcpecho.pl

   1 #!/usr/bin/perl -w
   2 # tcpecho.pl - Echo server using TCP
   3 #
   4 # Copyright (c) 2003 Sampo Kellomaki <sampo@iki.fi>, All Rights Reserved.
   5 # $Id: tcpecho.pl,v 1.2 2003/08/17 07:44:47 sampo Exp $
   6 # 17.8.2003, created --Sampo
   7 #
   8 # Usage: ./tcpecho.pl *port*
   9 #
  10 # This server always binds to localhost as this is all that is needed
  11 # for tests.
  12
  13 die "Usage: ./tcpecho.pl *port*\n" unless $#ARGV == 0;
  14 ($port) = @ARGV;
  15 $our_ip = "\x7F\0\0\x01";
  16
  17 $trace = 2;
  18 use Socket;
  19 use Net::SSLeay;
  20
  21 #
  22 # Create the socket and open a connection
  23 #
  24
  25 $our_serv_params = pack ('S n a4 x8', &AF_INET, $port, $our_ip);
  26 socket (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
  27 bind (S, $our_serv_params)             or die "bind:   $! (port=$port)";
  28 listen (S, 5)                          or die "listen: $!";
  29
  30 #while (1) {     # uncomment to turn off "one shot" behaviour
  31     print "tcpecho $$: Accepting connections on port $port...\n" if $trace>1;
  32     ($addr = accept(Net::SSLeay::SSLCAT_S, S)) or die "accept: $!";
  33     $old_out = select(Net::SSLeay::SSLCAT_S); $| = 1; select ($old_out);  # Piping hot!
  34
  35     if ($trace) {
  36         ($af,$client_port,$client_ip) = unpack('S n a4 x8',$addr);
  37         @inetaddr = unpack('C4',$client_ip);
  38         print "$af connection from " . join ('.', @inetaddr)
  39             . ":$client_port\n" if $trace;;
  40     }
  41
  42     #
  43     # Connected. Exchange some data.
  44     #
  45
  46     $got = Net::SSLeay::tcp_read_all() or die "$$: read failed";
  47     print "tcpecho $$: got " . length($got) . " bytes\n" if $trace==2;
  48     print "tcpecho: Got `$got' (" . length ($got) . " chars)\n" if $trace>2;
  49     $got = uc $got;
  50     Net::SSLeay::tcp_write_all($got) or die "$$: write failed";
  51     $got = '';  # in case it was huge
  52
  53     print "tcpecho: Tearing down the connection.\n\n" if $trace>1;
  54     close Net::SSLeay::SSLCAT_S;
  55 #}
  56 close S;
  57
  58 __END__