#!/usr/bin/env perl
# http-mosaic-proxy -- a hack to strip charset from HTTP/1.1 Content-Type
#  (which otherwise crashes Mosaic 3 for Windows). Requires an upstream HTTP proxy.

use warnings;
use strict;
use Data::Dumper;
use IO::Socket::INET;
use IO::Select;
use URI;

sub rchomp($) {
	my $str = shift;
	chomp $str;
	$str =~ s/\r$//;
	return $str;
}

sub forked(&) { fork || exit shift->(); }

sub handle_client {
	my $client = shift;

	my ($buf, $hdr, $oldhdr);

	my $upstream = IO::Socket::INET->new(
			PeerHost => "127.0.0.1",
			PeerPort => 8123);

	if (!$upstream) {
		my $err = "$!";
		my $reply = "Cannot connect to upstream: $err\r\n";
		$client->print("HTTP/1.0 502 Bad Gateway\r\n");
		$client->print("Content-Length: ".length($reply)."\r\n");
		$client->print("\r\n");
		$client->print($reply);
		$client->flush;
		die "cannot connect to upstream: $err\n";
	}

	my $n = 0;
	my ($method, $address);

	$upstream->autoflush(0);
	while ($buf = <$client>) {
		$hdr = rchomp($buf);
		if (!$n++) {
			warn "$hdr\n";
			($method, $address) = split(/ /, $hdr);
		}
		if (!length $hdr) {
			$upstream->print("Connection: close\r\n");
		}
		elsif ($hdr =~ /^(Proxy-)?Connection:/i) {
			next;
		}
		$upstream->print($hdr."\r\n");
		last if !length $hdr;
	}
	$upstream->flush;
	$upstream->autoflush(1);

	unless ($method eq 'HEAD' || $method eq 'GET') {
		my $reply = "Method $method not supported by fooproxy.\r\n";
		$client->print("HTTP/1.0 501 Not Implemented\r\n");
		$client->print("Content-Length: ".length($reply)."\r\n");
		$client->print("\r\n");
		$client->print($reply);
		$client->flush;
		exit;
	}

	#while (length $buf) {
	#	print "waiting for more...";
	#	$buf = <$client>;
	#	print "raw in: $buf";
	#	$upstream->print($buf);
	#}

	$client->autoflush(0);
	while ($buf = <$upstream>) {
		$hdr = $oldhdr = rchomp($buf);
		if (!length $hdr) {
			$client->print("Via: 1.0 fooproxy\r\n");
		}
		elsif ($hdr =~ /^Content-Type:/i) {
			$hdr =~ s/\s*;.*$//;
		}
		$client->print($hdr."\r\n");
		$client->print("X-Original-".$hdr."\r\n") if $hdr ne $oldhdr;
		last if !length $hdr;
	}
	$client->flush;
	$client->autoflush(1);
	while ($buf = <$upstream>) {
		$client->print($buf);
		last if !length $buf;
	}

	$client->close;
	$upstream->close;
}

$SIG{CHLD} = "IGNORE";

$SIG{ALRM} = sub {
	warn "idle, exiting\n";
	exit 0;
};

my $mode	= "daemon";
my $port	= 37213;
my $fd		= undef;
my $idletime	= 120;

for (shift @ARGV) {
	if (!defined $_) {
		$mode = "daemon";
	}
	elsif ($_ =~ /^--inetd(-nowait)?$/) {
		$mode = "fdclient"; $fd = 0;
	}
	elsif ($_ eq "--inetd-wait") {
		$mode = "fdlisten"; $fd = 0;
	}
	elsif ($_ eq "--systemd") {
		$mode = "fdlisten"; $fd = 3;
	}
	elsif ($_ =~ /^--listen-fd=(\d+)$/) {
		$mode = "fdlisten"; $fd = int $1;
	}
	else {
		warn "Unknown option: $_\n";
		exit 2;
	}
}

for ($mode) {
	if ($_ eq "fdclient") {
		my $client = IO::Handle->new;
		$client->fdopen($fd, "r+");
		handle_client($client);
	}
	elsif ($_ eq "fdlisten") {
		my $listener = IO::Socket::INET->new;
		$listener->fdopen($fd, "r+");
		alarm($idletime);
		while (my $client = $listener->accept || $!{EINTR}) {
			next if $!{EINTR};
			alarm($idletime);
			forked { handle_client($client) };
		}
		warn "accept failed: $!\n";
	}
	elsif ($_ eq "daemon") {
		my $listener = IO::Socket::INET->new(
						LocalHost => "0.0.0.0",
						LocalPort => $port,
						Listen => 1,
						ReuseAddr => 1);
		if (!$listener) { die "cannot listen: $!\n"; }
		print "listening on $port\n";
		while (my $client = $listener->accept || $!{EINTR}) {
			next if $!{EINTR};
			forked { handle_client($client) };
		}
		warn "accept failed: $!\n";
	}
}
