Initial check-in (somewhat belated).
[unet] / tests / vpn.ssh
1 #! /bin/perl
2
3 use Socket;
4
5 # --- Read the network interface to steal ---
6
7 $netif = shift;
8
9 # --- Start a child if so requested ---
10
11 if (@ARGV) {
12 socketpair(ONE, TOTHER, PF_UNIX, SOCK_STREAM, 0)
13 or die "socketpair: $!";
14 $kid = fork();
15 defined $kid or die "fork: $!";
16 if ($kid) {
17 close ONE;
18 open STDIN, ">&TOTHER" or die "dup stdin: $!";
19 open STDOUT, ">&TOTHER" or die "dup stdout: $!";
20 close TOTHER;
21 exec @ARGV;
22 die "exec: $!";
23 }
24 close TOTHER;
25 open STDIN, ">&ONE" or die "dup stdin: $!";
26 open STDOUT, ">&ONE" or die "dup stdout: $!";
27 close ONE;
28 }
29
30 # --- Now start work on this ---
31
32 open NETIF, "+> $netif" or die "open($netif): $!";
33
34 for (;;) {
35 $rfd = '';
36 vec($rfd, fileno(STDIN), 1) = 1;
37 vec($rfd, fileno(NETIF), 1) = 1;
38 select($rfd, undef, undef, undef) or die "select: $!";
39
40 if (vec($rfd, fileno(NETIF), 1)) {
41 sysread(NETIF, $pkt, 65536);
42 $pkt = pack("n", length($pkt)) . $pkt;
43 syswrite(STDOUT, $pkt, length($pkt));
44 }
45 if (vec($rfd, fileno(STDIN), 1)) {
46 sysread(STDIN, $clen, 2) or die "tunnel has vanished: $!";
47 $len = unpack("n", $clen);
48 sysread(STDIN, $pkt, $len);
49 syswrite(NETIF, $pkt, length($pkt));
50 }
51 }