#!perl -w use Socket; use IO::Socket; use Getopt::Std; use strict; $| = 1; my %opts; getopts("e:", \%opts); if ($opts{e}) { showerrs($opts{e}); } my $socklisten = IO::Socket::INET->new(LocalPort => 0, Listen => 2, Reuse => 1, Proto => 'tcp') or die "Cannot open socket: $!\n"; my ($port, $myaddr) = sockaddr_in(getsockname($socklisten)); print "port = $port\n"; # Here we start the error process system("start perl $0 -e $port\n"); # should put alarm() timeout around this section if (my $readport = $socklisten->accept) { print "reading from port\n"; chomp(my $portback = <$readport>); print "Connecting to $portback\n"; close($readport); *STDERR = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "localhost:$portback", Timeout => 30, ) or die "cannot create socketremote: $!\n"; } close($socklisten); # warn "this is a test"; sleep(3); print "program exiting\n"; die "I died!!!\n"; sub showerrs { my $port1 = shift; my $socklisten = IO::Socket::INET->new(LocalPort => 0, Listen => 2, Reuse => 1, Proto => 'tcp') or die "Cannot open socket: $!\n"; my ($port, $myaddr) = sockaddr_in(getsockname($socklisten)); my $out = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "localhost:$port1", Timeout => 30, ) or die "cannot create socketremote: $!\n"; print $out "$port\n"; close($out); if (my $readport = $socklisten->accept) { print while <$readport>; } print "Program terminated\n"; # Unless your DOS box is already configured to wait: print "Press Enter to exit ..."; $_ = <>; exit(0); }