view release on metacpan or  search on metacpan

lib/Apache/HTTunnel/Handler.pm  view on Meta::CPAN

	} ;
	if ($@){
		if ($@ eq "timeout\n"){
			$slog->notice("HTTunnel Handler: Connection to $host:$port timed out " .
				"after $timeout seconds.") ;
			return (undef, 0) ;
		}
		else {
			alarm(0) ;
			die("$@\n") ;
		}
	}

	die("Can't connect to $host:$port: $!") unless $sock ;
	$slog->notice("HTTunnel Handler: Connected to $host:$port") ;

	$slog->notice("HTTunnel Handler: Putting filehandle...") ;
	my $fhid = $fdk->put($sock) ;
	$slog->notice("HTTunnel Handler: Filehandle '$fhid' put") ;

	return ($fhid, 0, $peer_info) ;
}


sub check_access {
	my $r = shift ;
	my $host = shift ;
	my $port = shift ;

	my $slog = $r->log() ;
	my $rules = $r->dir_config('HTTunnelAllowedTunnels') or die("HTTunnelAllowedTunnels not defined in Apache configuration file") ;
	$rules =~ s/^\s+// ;
	$rules =~ s/\s+$// ;
	my @rules = split(/\s*,\s*/, $rules) ;
	foreach my $r (@rules){
		$slog->debug("HTTunnel Handler: Allowed (raw): $r") ;
	}

	my %allowed = () ;
	foreach my $r (@rules){
		my ($hosts, $ports) = split(/\s*=>\s*/, $r) ;
		my @hosts = split(/\s*\|\s*/, $hosts) ;
		my @ports = split(/\s*\|\s*/, $ports) ;

		foreach my $h (@hosts){
			foreach my $p (@ports){
				my @addrs = ($h) ;
				if ($h ne '*'){
					my @info = gethostbyname($h) ;
					for (my $i = 4 ; $i < scalar(@info) ; $i++){
						push @addrs, inet_ntoa($info[$i]) ;
					}
				}
				foreach my $a (@addrs){
					$allowed{"$a:$p"} = 1 ;
				}
			}
		}
	}
	foreach my $r (@rules){
		$slog->debug("HTTunnel Handler: Allowed (expanded): $r") ;
	}

	if (($allowed{"$host:$port"})||($allowed{"$host:*"})||
		($allowed{"*:$port"})||($allowed{"*:*"})){
		$slog->notice("HTTunnel Handler: $host:$port is allowed by configuration") ;
	}
	else{
		die("Permission denied for $host:$port") ;
	}
}


sub read_cmd {
	my $r = shift ;
	my @params = @_ ;

	my $slog = $r->log() ;
	my $fhid = shift @params ;
	my $proto = shift @params ;
	my $len = shift @params ;
	my $timeout = shift @params || 15 ;
	my $max_len = $r->dir_config('HTTunnelMaxReadLength') || 131072 ;
	if ($len > $max_len){
		$slog->notice("HTTunnel Handler: Requested read length ($len) decreased " .
			"to HTTunnelMaxReadLength ($max_len)") ;
		$len = $max_len ;
	}
	my $max_timeout = $r->dir_config('HTTunnelMaxReadTimeout') || 15 ;
	if ($timeout > $max_timeout){
		$slog->notice("HTTunnel Handler: Requested read timeout ($timeout) decreased " .
			"to HTTunnelMaxReadTimeout ($max_timeout)") ;
		$timeout = $max_timeout ;
	}

	my $data = undef ;
	$slog->notice("HTTunnel Handler: Getting filehandle '$fhid'...") ;
	my $fh = $fdk->get($fhid) or die("Unknown filehandle '$fhid'") ;
	$slog->notice("HTTunnel Handler: Filehandle '$fhid' gotten") ;

	my $timed_out = 0 ;
	my $peer_info = undef ;
	eval {
		local $SIG{ALRM} = sub {die "timeout\n"} ;
		alarm($timeout) ;
		$slog->info("HTTunnel Handler: Reading up to $len bytes from filehandle '$fhid'") ;
		if ($proto eq 'udp'){
			my $peer = undef ;
			($peer, $data) = recv_from($fh, $len) ;
			my ($port, $addr) = sockaddr_in($peer) ;
			$peer_info = join(':', inet_ntoa($addr), $port) ;
		}
		else{
			$data = read_from($fh, $len) ;
		}
		if (! defined($data)){
			$slog->notice("HTTunnel Handler: EOF detected on filehandle '$fhid'") ;
		}
		else {
			my $l = length($data) ;
			$slog->notice("HTTunnel Handler: Read $l bytes from filehandle '$fhid'") ;