view release on metacpan or  search on metacpan

Client/httunnel  view on Meta::CPAN

#!/usr/bin/perl

use strict ;
use FindBin ;
use lib "$FindBin::Bin" ;
use Getopt::Long qw(:config no_ignore_case) ;
use IO::Socket::INET ;
use IO::Select ;
use IO::Pipe ;
use IO::Handle ;
BEGIN { eval { require Sys::Syslog } }
use HTTunnel::Client ;
use Data::Dumper ;
use POSIX qw(setsid) ;


$SIG{CHLD} = 'IGNORE' ;


my %opts = () ;
GetOptions(\%opts,
	"h",		# help
	"v",		# version
	"V",		# verbose
	"VV",		# very verbose (may include binary data)
	"d",		# daemon
) ;

if ($opts{v}){
	print "httunnel version $HTTunnel::Client::VERSION\n" ;
	exit() ;
}

sub usage {
	print STDERR <<USAGE;
Usage: httunnel path [-V] [-VV] [-d] | -v | -h

    path   Configuration file or directory. Please the httunnel(1) 
           manual page for details on the configuration file format.
     -V    Verbose output.
     -VV   Very verbose output, which may include binary output.
     -d    Runs in daemon mode with logging to syslog if 
           available.
     -v    Prints version and exits.
     -h    Prints this usage information.
USAGE
	exit(1) ;
}
usage() if (($opts{h})||(! @ARGV[0])) ;
$opts{V} = 2 if $opts{VV} ;
my $DEBUG = $opts{V} || 0 ;
my $SYSLOG = 0 ;

if (($opts{d})&&(Sys::Syslog->can('openlog'))){
    Sys::Syslog::setlogsock('unix') ;
    Sys::Syslog::openlog('httunnel', 'pid', 'user') or die("Can't open syslog: $!") ;
	$SYSLOG = 1 ;
}

my $config = get_conf(@ARGV[0]) ;
my ($select, $listeners) = start_listeners($config) ;

if ($opts{d}){
    chdir('/') or sdie("Can't chdir to /: $!") ;
    open(STDIN, '</dev/null') or sdie("Can't open /dev/null for reading: $!") ;
    open(STDOUT, '>>/dev/null') or sdie("Can't open /dev/null for appending: $!") ;
    open(STDERR, '>>/dev/null') or sdie("Can't open /dev/null for appending: $!") ;
    setsid() or sdie("Can't start a new session: $!") ;
    umask(0) ;

	my $pid = fork() ;
	sdie("Can't fork: $!") unless defined($pid) ;
	exit(0) if ($pid != 0) ;
}


while (1){
	my @ready = $select->can_read() ;
	foreach my $fh (@ready){
		my $cfg = $config->{$listeners->{$fh}} ;
		$DEBUG = $cfg->{verbose} ;

		my $client = undef ;
		if ($cfg->{protocol} eq 'udp'){
			$client = $fh ;
			$select->remove($fh) ;
		}
		else {
			$client = $fh->accept() ;
		}
		next if ! defined($client) ;

		slog('notice', "Accepted connection on " . $fh->sockhost() . ':' . $fh->sockport()) ;

		my $pid = fork() ;
		sdie("Can't fork: $!") unless defined($pid) ;
		next if ($pid) ;

		# child
		undef $listeners ;
		undef $select ;

		$pid = undef ;
		my $reader = undef ;
		my $hc = new My::HTTunnel::Client($cfg, keep_alive => $cfg->{http_keep_alive}) ;
		eval {
			local $SIG{TERM} = 'IGNORE' if $cfg->{protocol} ne 'udp' ;

			$hc->proxy(['http'], $cfg->{http_proxy}) if $cfg->{http_proxy} ;
			$hc->connect($cfg->{protocol}, $cfg->{remote_host}, $cfg->{remote_port}) ;
			sdebug("Remote connection to $cfg->{remote_host}:$cfg->{remote_port} established") ;
		
			my $lifeline = new IO::Pipe() ;
			($reader, $pid) = start_reader($hc, $cfg, $lifeline) ;
			if (! $reader){