Varios Protocolos

El siguiente ejemplo esta tomado de la distribución de Net::Server .

casiano@mserver:~/src/perl/netserver$ cat -n ./connection_test.pl
  1  #!/usr/bin/perl -w
  2
  3  package MyPack;
  4
  5  use strict;
  6  use vars qw(@ISA);
  7  use Net::Server ();
  8  use IO::Socket ();
  9  use IO::Prompt;
 10  use File::Temp qw(tmpnam);
 11  use Socket qw(SOCK_DGRAM SOCK_STREAM);
 12
 13  sub post_bind_hook {
 14    my $self = shift;
 15    foreach my $sock ( @{ $self->{server}->{sock} } ){
 16      $self->log(2,$sock->show);
 17    }
 18  }
 19
 20  sub process_request {
 21      my $self = shift;
 22      eval {
 23
 24          local $SIG{'ALRM'} = sub { die "Timed Out!\n" };
 25          my $timeout = 30; # give the user 30 seconds to type some lines
 26
 27          my $previous_alarm = alarm($timeout);
 28          while (<STDIN>) {
 29              s/\r?\n$//;
 30              print "You said '$_'\r\n";
 31              alarm($timeout);
 32          }
 33          alarm($previous_alarm);
 34
 35      };
 36
 37      if ($@ =~ /timed out/i) {
 38          print STDOUT "Timed Out.\r\n";
 39          return;
 40      }
 41  }
 42
 43  my $socket_file  = tmpnam();
 44  $socket_file =~ s|/[^/]+$|/mysocket.file|;
 45  my $socket_file2 = $socket_file ."2";
 46  my $udp_port    = 1024;
 47  my $tcp_port    = 1024;
 48  my $host = 'mserver';
 49
 50  print "\$Net::Server::VERSION = $Net::Server::VERSION\n";
 51  @ISA = qw(Net::Server);
 52
 53  if( @ARGV ){
 54    if( uc($ARGV[0]) eq 'UDP' ){
 55      my $sock = IO::Socket::INET->new(PeerAddr => $host,
 56                                       PeerPort => $udp_port,
 57                                       Proto    => 'udp',
 58                                       ) || die "Can't connect [$!]";
 59      ### send a packet, get a packet
 60      $sock->send("Are you there?",0);
 61      my $data = undef;
 62      $sock->recv($data,4096,0);
 63      print $data,"\n";
 64      exit;
 65    }
 66
 67    if( uc($ARGV[0]) eq 'TCP' ){
 68      my $sock = IO::Socket::INET->new(PeerAddr => $host,
 69                                       PeerPort => $tcp_port,
 70                                       Proto    => 'tcp',
 71                                       ) || die "Can't connect [$!]";
 72      my $phrase = prompt "Write your phrase: ";
 73      print $sock "$phrase\n";
 74      my $line = $sock->getline();
 75      print $line;
 76      exit;
 77    }
 78
 79    if( uc($ARGV[0]) eq 'UNIX' ){
 80      my $sock = IO::Socket::UNIX->new(Peer => $socket_file) || die "Can't connect [$!]";
 81
 82      my $phrase = prompt "Write your phrase: ";
 83      my $line = $sock->getline();
 84      print $line;
 85      exit;
 86    }
 87
 88    if( uc($ARGV[0]) eq 'UNIX_DGRAM' ){
 89      my $sock = IO::Socket::UNIX->new(Peer => $socket_file2,
 90                                       Type => SOCK_DGRAM,
 91                                       ) || die "Can't connect [$!]";
 92
 93      ### send a packet, get a packet
 94      $sock->send("Are you there?",0);
 95      ### The server receives the data just fine
 96      ### however, the default arguments don't seem to work for
 97      ### sending it back.  If anybody knows why, let me know.
 98      my $data = undef;
 99      $sock->recv($data,4096,0);
100      print $data,"\n";
101      exit;
102    }
103
104    print "USAGE: $0 UDP|TCP|UNIX|UNIX_DGRAM
105  (If no arguments are passed, the server will start.
106  You should start the server in one window, and connect
107  in another window).
108  ";
109    exit;
110  }
111
112  ### set up servers doing
113  ## SOCK_DGRAM  on INET (udp)
114  ## SOCK_STREAM on INET (tcp)
115  ## SOCK_DGRAM  on UNIX
116  ## SOCK_STREAM on UNIX
117
118  MyPack->run(port => "$udp_port|udp",
119              port => "$tcp_port|tcp",
120              port => "$socket_file|unix", # default is SOCK_STREAM
121              port => join("|",$socket_file2,SOCK_DGRAM,"unix"),
122              log_level => 4,
123              );

Servidor en mserver

casiano@mserver:~/src/perl/netserver$ ./connection_test.pl
$Net::Server::VERSION = 0.96
2007/04/04-12:23:20 MyPack (type Net::Server) starting! pid(12312)
Binding to UDP port 1024 on host *
Binding to TCP port 1024 on host *
Binding to UNIX socket file /tmp/mysocket.file using SOCK_STREAM
Binding to UNIX socket file /tmp/mysocket.file2 using SOCK_DGRAM
Ref = "Net::Server::Proto::UDP"
  NS_proto = "UDP"
  NS_port = "1024"
  NS_host = "*"
Ref = "Net::Server::Proto::TCP"
  NS_proto = "TCP"
  NS_port = "1024"
  NS_host = "*"
Ref = "Net::Server::Proto::UNIX"
  NS_proto = "UNIX"
  NS_unix_path = "/tmp/mysocket.file"
  NS_unix_type = SOCK_STREAM
Ref = "Net::Server::Proto::UNIX"
  NS_proto = "UNIX"
  NS_unix_path = "/tmp/mysocket.file2"
  NS_unix_type = SOCK_DGRAM
Group Not Defined.  Defaulting to EGID '1001 1001'
User Not Defined.  Defaulting to EUID '1001'
2007/04/04-12:23:27 CONNECT TCP Peer: "189.132.105.252:42405" Local: "189.132.102.240:1024"

Cliente en mcliente

mcliente:/tmp> ./connection_test.pl TCP
$Net::Server::VERSION = 0.96
Write your phrase: Hola mserver, mcliente te saluda!
You said 'Hola mserver, mcliente te saluda!'

pp2@nereida:~/src/perl/NET_SERVER$ ./connection_test.pl UDP
$Net::Server::VERSION = 0.97
Testing UDP
You said "Are you there?"

pp2@nereida:~/src/perl/NET_SERVER$ ./connection_test.pl UNIX
$Net::Server::VERSION = 0.97
Testing UNIX (File socket with SOCK_STREAM)
Welcome to "MyPack" (29808)