File: sockets

package info (click to toggle)
perl-tk 1:800.025-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,444 kB
  • ctags: 19,081
  • sloc: ansic: 206,740; perl: 40,187; makefile: 4,371; sh: 2,373; yacc: 762
file content (83 lines) | stat: -rw-r--r-- 1,820 bytes parent folder | download | duplicates (6)
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
#!/usr/local/bin/perl -w

use IO::Socket;
use Tk::IO;
use Tk;
my $mw = MainWindow->new;

my $server = IO::Socket::INET->new(Listen => 5, LocalAddr => 'localhost', Proto => 'tcp');
Tk::IO::make_nonblock($server,$smode,$snew);
$mw->fileevent($server, 'readable', [\&server_acceptable,$server,'r']);
# $mw->fileevent($server, 'writeable', [\&server_acceptable,$server,'w']);

my $port = $server->sockport;

print "Port=$port\n";

my $client = IO::Socket::INET->new;

$client->socket(AF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]) || warn "Cannot socket:$!";
Tk::IO::make_nonblock($client,$cmode,$cnew);
$client->connect($port,'localhost') || warn "Cannot connect:$! ".($!+0);

my $h = IO::Socket::INET->new;
while (1)
 {
  last if accept($h,$server);
  warn "accept $! ".($!+0);
  $client->sockport;
  die "accept $! ".($!+0) unless ($! == 11);
  sleep(1);
 }


# my $h = $server->accept or warn "accept $! ".($!+0);
print 'h peer=',$h->peerport,' sock=',$h->sockport,"\n";
print 'c peer=',$client->peerport,' sock=',$client->sockport,"\n";

exit;

$mw->fileevent( $client, 'writeable', [\&client_writeable,$client]);
$mw->fileevent( $client, 'readable', [\&client_readable, $client]);

MainLoop;

sub client_readable
{
 print 'cr(',join(',',@_),")\n";
 my $data = <$client>;
 print "cr:$data";
 $client->close;
}

sub client_writable
{
 print 'cw(',join(',',@_),")\n";
 my $client = shift;
 print $client "Hello\n";
}

sub server_acceptable
{
 print 'sa(',join(',',@_),")\n";
 my $server = shift;
 my $h = $server->accept;
 $mw->fileevent($h, 'readable', [\&server_readable,$h]);
 print "New socket ",$h->fileno,"\n";
}

sub server_readable
{
 print 'sr(',join(',',@_),")\n";
 my $h = shift;
 my $data = <$client>;
 if (defined $data)
  {
   print "cr:$data";
   print $h "ACK:$data";
  }
 else
  {
   $h->close;
  }
}