1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
#!/usr/bin/perl -w
=head1 NAME
connection_test.pl - Test UDP/TCP/UNIX/UNIX_DGRAM connections
=head1 SERVER SYNOPSIS
# in a separate terminal window
perl connection_test.pl
=head1 CLIENT SYNOPSIS
perl connection_test.pl UDP
# or
perl connection_test.pl TCP
# or
perl connection_test.pl UNIX <UNIX socket directory>
# or
perl connection_test.pl UNIX_DGRAM <UNIX socket directory>
=cut
package MyPack;
use strict;
use warnings;
use base qw(Net::Server);
use IO::Socket ();
use File::Temp qw(tempdir);
use File::Spec::Functions qw(catdir);
use Socket qw(SOCK_DGRAM SOCK_STREAM);
sub post_bind_hook {
my $self = shift;
foreach my $sock ( @{ $self->{server}->{sock} } ){
$self->log(2,$sock->show);
}
}
my $socket_dir = $ARGV[1] || tempdir(CLEANUP => 1);
my $socket_file = catdir($socket_dir, 'mysocket.file');
my $socket_file2 = catdir($socket_dir, 'mysocket.file2');
my $udp_port = 20204;
my $tcp_port = 20204;
print "\$Net::Server::VERSION = $Net::Server::VERSION\n";
print "UNIX socket directory = $socket_dir\n";
if( @ARGV ){
if( uc($ARGV[0]) eq 'UDP' ){
print "Testing UDP\n";
my $sock = IO::Socket::INET->new(PeerAddr => 'localhost',
PeerPort => $udp_port,
Proto => 'udp',
) || die "Can't connect [$!]";
### send a packet, get a packet
$sock->send("Are you there?",0);
my $data = undef;
$sock->recv($data,4096,0);
print $data,"\n";
exit;
}
if( uc($ARGV[0]) eq 'TCP' ){
print "Testing TCP\n";
my $sock = IO::Socket::INET->new(PeerAddr => 'localhost',
PeerPort => $tcp_port,
Proto => 'tcp',
) || die "Can't connect [$!]";
print $sock "hi\n";
my $line = $sock->getline();
print $line;
exit;
}
if( uc($ARGV[0]) eq 'UNIX' ){
print "Testing UNIX (File socket with SOCK_STREAM)\n";
my $sock = IO::Socket::UNIX->new(Peer => $socket_file) || die "Can't connect [$!]";
print $sock "hi\n";
my $line = $sock->getline();
print $line;
exit;
}
if( uc($ARGV[0]) eq 'UNIX_DGRAM' ){
print "Testing UNIX_DGRAM\n";
my $sock = IO::Socket::UNIX->new(Peer => $socket_file2,
Type => SOCK_DGRAM,
) || die "Can't connect [$!]";
### send a packet, get a packet
$sock->send("Are you there?",0);
### The server receives the data just fine
### however, the default arguments don't seem to work for
### sending it back. If anybody knows why, let me know.
my $data = undef;
$sock->recv($data,4096,0);
print $data,"\n";
exit;
}
print "USAGE: $0 UDP|TCP|UNIX|UNIX_DGRAM
(If no arguments are passed, the server will start.
You should start the server in one window, and connect
in another window).
";
exit;
}
### set up servers doing
## SOCK_DGRAM on INET (udp)
## SOCK_STREAM on INET (tcp)
## SOCK_DGRAM on UNIX
## SOCK_STREAM on UNIX
MyPack->run(port => "$udp_port|udp",
port => "$tcp_port|tcp",
port => "$socket_file|unix", # default is SOCK_STREAM
port => join("|",$socket_file2,SOCK_DGRAM,"unix"),
log_level => 4,
);
|
