#!/usr/bin/perl -w

# Copyright (c) 2008 Christian Laursen <xi@borderworlds.dk>

# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation
# files (the "Software"), to deal in the Software without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following
# conditions:

# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.

use strict;
use Net::TCP::Server;
use POSIX;
use MIME::Base64;

my $flags = {};
my $file;

if (@ARGV == 3 && $ARGV[0] eq '-s') {
	if ($ARGV[1] =~ /^\d+\.\d+\.\d+\.\d+$/) {
		$flags->{thishost} = $ARGV[1];
		$file = $ARGV[2];
	} else {
		die "$ARGV[1] is not a valid address";
	}
} elsif (@ARGV == 1) {
	$file = $ARGV[0];
} else {
	print STDERR "Usage: pls-proxy.pl [-s src_address] <playlist>\n";
	exit;
}

print STDERR "pls-proxy.pl 0.1\nCopyright (c) 2008 Christian Laursen <xi\@borderworlds.dk>\n\n";

# Pick playlist url
my @urls = ();

open (FILE, $file) or die "Couldn't open $file for reading: $!";
while (defined (my $line = <FILE>)) {
	$line =~ s/\r?\n$//;
	if ($line =~ /^File\d+=(.*)$/) {
		push @urls, $1;
	}
}
close FILE;

my $urlno = floor(rand(scalar(@urls)));
my $url = $urls[$urlno];

print "Playlist contains ", scalar(@urls), " entries, picking number $urlno\n";
print "URL: $url\n\n";

my $auth;
my $get;
my $host;

if ($url =~ m!^http://(([^:]+:[^@]+)\@)?([^:]+:\d+)(/.*)?$!) {
	($auth, $host, $get) = ($2, $3, $4);

	$get = '/' unless defined $get;
} else {
	die "Couldn't parse URL\n";
}

$SIG{ALRM} = sub {print STDERR scalar(localtime), "  Sorry, the world has ended\n"; exit 1;};

my $lh = 'Net::TCP::Server'->new(8020) or die "Couldn't listen on port 8020";
print STDERR "Waiting for client to connect on port 8020...\n";

if (my $sh = $lh->accept) {
	print STDERR "Client connected\n";

	$sh->autoflush;

	my $header;
	my @headers = ();
	do {
		$header = <$sh>;
		$header =~ s/\r?\n//;

		$header =~ s/^(GET\s+)\S*(\s+HTTP\/\d+\.\d+)$/$1$get$2/;
		$header =~ s/^(Host:\s+).*$/$1$host/;

		push @headers, $header unless $header =~ /^$/
	} while ($header !~ /^$/);

	if (defined $auth) {
		my $authheader = "Authorization: Basic " . encode_base64($auth);
		chomp $authheader;
		push @headers, $authheader;
	}

	if ($host =~ /^([^:]+):(\d+)$/) {
		my ($addr, $port) = ($1, $2);

		my $con = new Net::TCP($addr, $port, $flags) or die "Unable to connect: $!";

		print STDERR "Connected to $host\n\n";

		alarm 120;

		print "Headers:\n";
		for $header (@headers) {
			print "$header\n";
			print $con $header, "\r\n";
		}
		print "\n";
		print $con "\r\n";

		my $buffer;
		my $total = 0;
		my $nextstatus = time + 10;
		while (my $r = read($con, $buffer, 8192)) {
			print $sh $buffer;

			$total += $r;
			if (time >= $nextstatus) {
				print scalar(localtime), "  Bytes received: $total\n";
				$nextstatus += 60;
				alarm 120;
			}
		}
	} else {
		die "Couldn't parse host\n";
	}

} else {
	print STDERR "Accept failed\n";
}