#!/usr/bin/perl
#
# git-tunnel.pl	
#
# Usage: git-tunnel.pl ssl-proxy port destination_host port
#
# This script can be used by git as a "core.gitproxy" to 
# traverse a www-proxy/firewall that supports the http CONNECT 
# command described in
# http://home.netscape.com/newsref/std/tunneling_ssl.html
#
# It uses the http_proxy (or HTTP_PROXY) variable to determine the
# proxy to connect to.  Put the path to this script in the environment
# variable GIT_PROXY_COMMAND, or better yet, insert the core.gitproxy
# definition in .git/config.
#
#      .
#      .
#      [core]
#          gitproxy = /path/to/git-tunnel.pl
#      .
#      .
#
# Written by Urban Kaveus <urban@statt.ericsson.se>
# Modified to use http_proxy by Joel Becker <joel.becker@oracle.com>

use Socket;

# Parse command line arguments

if ( $#ARGV != 1 ) {
    print STDERR "Usage: $0 destination port\n";
    print STDERR $#ARGV, "\n";
    exit(1);
}

$proxy_url = $ENV{'http_proxy'};
if (!$proxy_url) {
    $proxy_url = $ENV{'HTTP_PROXY'};
}

$proxyport = 80;
if ($proxy_url =~ /^https?:\/\/([^:]+)\/$/) {
    $sslproxy = $1;
} elsif ($proxy_url =~ /^https?:\/\/([^:]+):([1-9][0-9]*)\/$/) {
    $sslproxy = $1;
    $proxyport = $2;
} else {
    print STDERR "Invalid proxy specification: \"$proxy_url\"\n";
    exit(1);
}

$destination = shift;
$destport    = shift;

# Set up network communication

($protocol) = (getprotobyname("tcp"))[2];
($proxyip)  = (gethostbyname($sslproxy))[4];
$localaddr  = pack('S n a4 x8', &AF_INET, 0, "\0\0\0\0");
$proxyaddr  = pack('S n a4 x8', &AF_INET, $proxyport, $proxyip);

socket (PROXY, &AF_INET, &SOCK_STREAM, $protocol) or
    die("Failed to create cocket");
bind (PROXY, $localaddr) or
    die("Failed to bind socket");
connect (PROXY, $proxyaddr) or
    die("Failed to connect to $sslproxy port $proxyport");

# Force flushing of socket buffers

select (PROXY);  $| = 1; 
select (STDOUT); $| = 1;

# Send a "CONNECT" command to proxy:

print PROXY "CONNECT $destination:$destport HTTP/1.1\r\n\r\n";

# Wait for HTTP status code, bail out if you don't get back a 2xx code.

$_ = <PROXY>;
($status) = (split())[1];

die("Received a bad status code \"$status\" from proxy server") 
    if ( int($status/100) != 2 );

# Skip through remaining part of MIME header

while(<PROXY>) {
    chomp;   # Strip <LF>
    last if /^[\r]*$/;		# Empty line or a single <CR> left
}

# Start copying packets in both directions.

$parent = $$;
if($child = fork) { # Parent process
    while (sysread(STDIN,$_,4096)) {
        print PROXY;
    }
    sleep 2;
    kill(15,$child) if $child;
}

else { # Child process
    while (sysread(PROXY,$_,4096)) {
        print STDOUT;
    }
    sleep 2;
    kill(15,$parent);
}