#!/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; } }