• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!/usr/bin/perl
2#
3# inet6to4:  Act as an ipv6-to-ipv4 relay for tcp applications that
4#            do not support ipv6.
5#
6# Usage:     inet6to4    <ipv6-listen-port> <ipv4-host:port>
7#            inet6to4 -r <ipv4-listen-port> <ipv6-host:port>
8#
9# Examples:  inet6to4 5900 localhost:5900
10#            inet6to4 8080 web1:80
11#            inet6to4 -r 5900 fe80::217:f2ff:fee6:6f5a%eth0:5900
12#
13# The -r option reverses the direction of translation (e.g. for ipv4
14# clients that need to connect to ipv6 servers.)  Reversing is the default
15# if this script is named 'inet4to6' (e.g. by a symlink.)
16#
17# Use Ctrl-C to stop this program.  You can also supply '-c n' as the
18# first option to only handle that many connections.
19#
20# Also set the env. vars INET6TO4_LOOP=1 or INET6TO4_LOOP=BG
21# to have an outer loop restarting this program (BG means do that
22# in the background), and INET6TO4_LOGFILE for a log file.
23# Also set INET6TO4_VERBOSE to verbosity level and INET6TO4_WAITTIME
24# and INET6TO4_PIDFILE (see below.)
25#
26
27#-------------------------------------------------------------------------
28# Copyright (c) 2010 by Karl J. Runge <runge@karlrunge.com>
29#
30# inet6to4 is free software; you can redistribute it and/or modify
31# it under the terms of the GNU General Public License as published by
32# the Free Software Foundation; either version 2 of the License, or (at
33# your option) any later version.
34#
35# inet6to4 is distributed in the hope that it will be useful,
36# but WITHOUT ANY WARRANTY; without even the implied warranty of
37# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
38# GNU General Public License for more details.
39#
40# You should have received a copy of the GNU General Public License
41# along with inet6to4; if not, write to the Free Software
42# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA
43# or see <http://www.gnu.org/licenses/>.
44#-------------------------------------------------------------------------
45
46my $program = "inet6to4";
47
48# Set up logging:
49#
50if (exists $ENV{INET6TO4_LOGFILE}) {
51	close STDOUT;
52	if (!open(STDOUT, ">>$ENV{INET6TO4_LOGFILE}")) {
53	        die "$program: $ENV{INET6TO4_LOGFILE} $!\n";
54	}
55	close STDERR;
56	open(STDERR, ">&STDOUT");
57}
58select(STDERR); $| = 1;
59select(STDOUT); $| = 1;
60
61# interrupt handler:
62#
63my $looppid = '';
64my $pidfile = '';
65my $listen_sock = '';	# declared here for get_out()
66#
67sub get_out {
68	print STDERR "$_[0]:\t$$ looppid=$looppid\n";
69	close $listen_sock if $listen_sock;
70	if ($looppid) {
71		kill 'TERM', $looppid;
72		fsleep(0.2);
73	}
74	unlink $pidfile if $pidfile;
75	exit 0;
76}
77$SIG{INT}  = \&get_out;
78$SIG{TERM} = \&get_out;
79
80# pidfile:
81#
82sub open_pidfile {
83	if (exists $ENV{INET6TO4_PIDFILE}) {
84		my $pf = $ENV{INET6TO4_PIDFILE};
85		if (open(PID, ">$pf")) {
86			print PID "$$\n";
87			close PID;
88			$pidfile = $pf;
89		} else {
90			print STDERR "could not open pidfile: $pf - $! - continuing...\n";
91		}
92		delete $ENV{INET6TO4_PIDFILE};
93	}
94}
95
96####################################################################
97# Set INET6TO4_LOOP=1 to have this script create an outer loop
98# restarting itself if it ever exits.  Set INET6TO4_LOOP=BG to
99# do this in the background as a daemon.
100
101if (exists $ENV{INET6TO4_LOOP}) {
102	my $csl = $ENV{INET6TO4_LOOP};
103	if ($csl ne 'BG' && $csl ne '1') {
104		die "$program: invalid INET6TO4_LOOP.\n";
105	}
106	if ($csl eq 'BG') {
107		# go into bg as "daemon":
108		setpgrp(0, 0);
109		my $pid = fork();
110		if (! defined $pid) {
111			die "$program: $!\n";
112		} elsif ($pid) {
113			wait;
114			exit 0;
115		}
116		if (fork) {
117			exit 0;
118		}
119		setpgrp(0, 0);
120		close STDIN;
121		if (! $ENV{INET6TO4_LOGFILE}) {
122			close STDOUT;
123			close STDERR;
124		}
125	}
126	delete $ENV{INET6TO4_LOOP};
127
128	if (exists $ENV{INET6TO4_PIDFILE}) {
129		open_pidfile();
130	}
131
132	print STDERR "$program: starting service at ", scalar(localtime), " master-pid=$$\n";
133	while (1) {
134		$looppid = fork;
135		if (! defined $looppid) {
136			sleep 10;
137		} elsif ($looppid) {
138			wait;
139		} else {
140			exec $0, @ARGV;
141			exit 1;
142		}
143		print STDERR "$program: re-starting service at ", scalar(localtime), " master-pid=$$\n";
144		sleep 1;
145	}
146	exit 0;
147}
148if (exists $ENV{INET6TO4_PIDFILE}) {
149	open_pidfile();
150}
151
152use IO::Socket::INET6;
153use strict;
154use warnings;
155
156# some settings:
157#
158my $verbose = 1;	# set to 0 for no messages, 2 for more.
159my $killpid = 1;	# does kill(2) at end of connection.
160my $waittime = 0.25;	# time to wait between connections.
161my $reverse = 0;	# -r switch (or file named inet4to6)
162
163if (exists $ENV{INET6TO4_VERBOSE}) {
164	$verbose = $ENV{INET6TO4_VERBOSE};
165}
166if (exists $ENV{INET6TO4_WAITTIME}) {
167	$waittime = $ENV{INET6TO4_WAITTIME};
168}
169
170# process command line args:
171
172if (! @ARGV || $ARGV[0] =~ '^-+h') {	# -help
173	open(ME, "<$0");
174	while (<ME>) {
175		last unless /^#/;
176		next if /usr.bin.perl/;
177		$_ =~ s/# ?//;
178		print;
179	}
180	exit;
181}
182
183my $cmax = 0;
184if ($ARGV[0] eq '-c') {			# -c
185	shift;
186	$cmax = shift;
187}
188
189if ($ARGV[0] eq '-r') {			# -r
190	shift;
191	$reverse = 1;
192} elsif ($0 =~ /inet4to6$/) {
193	$reverse = 1;
194}
195
196my $listen_port = shift;		# ipv6-listen-port
197my $connect_to  = shift;		# ipv4-host:port
198
199die "no listen port or connect-to-host:port\n" if ! $listen_port || ! $connect_to;
200
201# connect to host:
202#
203my $host = '';
204my $port = '';
205if ($connect_to =~ /^(.*):(\d+)$/) {
206	$host = $1;
207	$port = $2;
208}
209die "invalid connect-to-host:port\n" if ! $host || ! $port;
210
211setpgrp(0, 0);
212
213# create listening socket:
214#
215my %opts;
216$opts{Listen}    = 10;
217$opts{Proto}     = "tcp";
218$opts{ReuseAddr} = 1;
219if ($listen_port =~ /^(.*):(\d+)$/) {
220	$opts{LocalAddr} = $1;
221	$listen_port = $2;
222}
223$opts{LocalPort} = $listen_port;
224
225if (!$reverse) {
226	# force ipv6 interface:
227	$opts{Domain} = AF_INET6;
228	$listen_sock = IO::Socket::INET6->new(%opts);
229} else {
230	$listen_sock = IO::Socket::INET->new(%opts);
231	if (! $listen_sock && $! =~ /invalid/i) {
232		warn "$program: $!, retrying with AF_UNSPEC:\n";
233		$opts{Domain} = AF_UNSPEC;
234		$listen_sock = IO::Socket::INET6->new(%opts);
235	}
236}
237if (! $listen_sock) {
238	die "$program: $!\n";
239}
240
241# for use by the xfer helper processes' interrupt handlers:
242#
243my $current_fh1 = '';
244my $current_fh2 = '';
245
246# connection counter:
247#
248my $conn = 0;
249
250# loop forever waiting for connections:
251#
252while (1) {
253	$conn++;
254	if ($cmax > 0 && $conn > $cmax) {
255		print STDERR "last connection ($cmax)\n" if $verbose;
256		last;
257	}
258	print STDERR "listening for connection: $conn\n" if $verbose;
259	my ($client, $ip) = $listen_sock->accept();
260
261	if ($client && !$reverse && $port == $listen_port) {
262		# This happens on Darwin 'tcp46'
263		if ($client->peerhost() =~ /^::ffff:/) {
264			print STDERR "closing client we think is actually us: ",
265			    $client->peerhost(), "\n";
266			close $client;
267			$client = undef;
268		}
269	}
270	if (! $client) {
271		# to throttle runaways
272		fsleep(2 * $waittime);
273		next;
274	}
275	print STDERR "conn: $conn -- ", $client->peerhost(), " at ", scalar(localtime), "\n" if $verbose;
276
277	# spawn helper:
278	#
279	my $pid = fork();
280	if (! defined $pid) {
281		die "$program: $!\n";
282	} elsif ($pid) {
283		wait;
284		# to throttle runaways
285		fsleep($waittime);
286		next;
287	} else {
288		# this is to avoid zombies:
289		close $listen_sock;
290		if (fork) {
291			exit 0;
292		}
293		setpgrp(0, 0);
294		handle_conn($client);
295	}
296}
297
298exit 0;
299
300sub handle_conn {
301	my $client = shift;
302
303	my $start = time();
304
305	print STDERR "connecting to: $host:$port\n" if $verbose;
306
307	my $sock = '';
308	my %opts;
309	$opts{PeerAddr} = $host;
310	$opts{PeerPort} = $port;
311	$opts{Proto}    = "tcp";
312	if (!$reverse) {
313		$sock = IO::Socket::INET->new(%opts);
314	} else {
315		$opts{Domain} = AF_INET6;
316		$sock = IO::Socket::INET6->new(%opts);
317	}
318	if (! $sock) {
319		warn "$program: $!, retrying with AF_UNSPEC:\n";
320		$opts{Domain} = AF_UNSPEC;
321		$sock = IO::Socket::INET6->new(%opts);
322	}
323
324	if (! $sock) {
325		close $client;
326		die "$program: $!\n";
327	}
328
329	$current_fh1 = $client;
330	$current_fh2 = $sock;
331
332	# interrupt handler:
333	#
334	$SIG{TERM} = sub {print STDERR "got sigterm\[$$]\n" if $verbose; close $current_fh1; close $current_fh2; exit 0};
335
336	# spawn another helper and transfer the data:
337	#
338	my $parent = $$;
339	if (my $child = fork()) {
340		xfer($sock, $client, 'S->C');
341		if ($killpid) {
342			fsleep(0.5);
343			kill 'TERM', $child;
344		}
345	} else {
346		xfer($client, $sock, 'C->S');
347		if ($killpid) {
348			fsleep(0.75);
349			kill 'TERM', $parent;
350		}
351	}
352
353	# done.
354	#
355	if ($verbose > 1) {
356		my $dt = time() - $start;
357		print STDERR "dt\[$$]: $dt\n";
358	}
359	exit 0;
360}
361
362# transfers data in one direction:
363#
364sub xfer {
365	my($in, $out, $lab) = @_;
366	my ($RIN, $WIN, $EIN, $ROUT);
367	$RIN = $WIN = $EIN = "";
368	$ROUT = "";
369	vec($RIN, fileno($in), 1) = 1;
370	vec($WIN, fileno($in), 1) = 1;
371	$EIN = $RIN | $WIN;
372	my $buf;
373
374	while (1) {
375		my $nf = 0;
376		while (! $nf) {
377			$nf = select($ROUT=$RIN, undef, undef, undef);
378		}
379		my $len = sysread($in, $buf, 8192);
380		if (! defined($len)) {
381			next if $! =~ /^Interrupted/;
382			print STDERR "$program\[$lab/$conn/$$]: $!\n";
383			last;
384		} elsif ($len == 0) {
385			print STDERR "$program\[$lab/$conn/$$]: "
386			    . "Input is EOF.\n";
387			last;
388		}
389
390		if ($verbose > 4) {
391			# verbose debugging of data:
392			syswrite(STDERR , "\n$lab: ", 6);
393			syswrite(STDERR , $buf, $len);
394		}
395
396		my $offset = 0;
397		my $quit = 0;
398		while ($len) {
399			my $written = syswrite($out, $buf, $len, $offset);
400			if (! defined $written) {
401				print STDERR "$program\[$lab/$conn/$$]: "
402				    . "Output is EOF. $!\n";
403				$quit = 1;
404				last;
405			}
406			$len -= $written;
407			$offset += $written;
408		}
409		last if $quit;
410	}
411	close($in);
412	close($out);
413}
414
415# sleep a fraction of a second:
416#
417sub fsleep {
418	my ($time) = @_;
419	select(undef, undef, undef, $time) if $time;
420}
421