Untitled

#!/usr/bin/env perl

use strict;
use warnings;

use RPC::XML;
use RPC::XML::Client;
use URI::URL;
use LWP::UserAgent;
use HTTP::Headers;
use HTTP::Request;
use HTTP::Response;

my $c =  './krzysztof.wilczynski@cachelogic.com-certificate.pem';
my $s = '212.187.212.226:443';
my $t = '212.187.212.226';
my $r = 'https://212.187.212.226/xmlrpc';
my $p = '"NOC Trial"';
my $n = '92';
my $v = 'undef';
my $vx = './vxup';

my $debug = (($ENV{'DEBUG'}) ? 1 : 0) if exists $ENV{'DEBUG'};
my $remove = (($ENV{'REMOVE'}) ? 1 : 0) if exists $ENV{'REMOVE'};
my $sleep = $ENV{'SLEEP'} if exists $ENV{'SLEEP'} or 0;

$ENV{HTTPS_KEY_FILE} = $ENV{HTTPS_CERT_FILE} = $c;

my @u = (
	{ 'u' => "http://download.velocix.com/bt/%s/data", 'f' => 0, 's' => 0 },
	{ 'u' => "http://files.velocix.com/c$n/%s", 'f' => 1, 's' => 0 },
	{ 'u' => "http://$v/%s", 'f' => 1, 's' => 0 },
	{ 'u' => "http://download.velocix.com/bt/%s/peers", 'f' => 0, 's' => 0 },
	{ 'u' => "http://flash.velocix.com/c$n/%s?format=jscript", 'f' => 1, 's' => 1 }
);

my @f = (
	{ 'f' => 'a.flv', 'i' => '', 'o' => '-e 0' },
	{ 'f' => 'b.flv', 'i' => '', 'o' => '-e 1' },
	{ 'f' => 'c.flv', 'i' => '', 'o' => '-e 1 -R 1' },
	{ 'f' => 'd.flv', 'i' => '', 'o' => '-e 1 -B 0' },
	{ 'f' => 'e.flv', 'i' => '', 'o' => '-e 1 -H 0' },
	{ 'f' => 'f.flv', 'i' => '', 'o' => '-e 1 -T 0' }
);

my $F = scalar ((@f) - 1);
my $U = scalar ((@u) - 1);

for my $x ( 0 .. $F ) {
	print "File: " . $f[$x]->{'f'} . "\n";
	unlink $f[$x]->{'f'} if (-e $f[$x]->{'f'});
	open F, '>' . $f[$x]->{'f'} or die $!;
	for ( 1 .. 1024  ) {
		for ( 1 .. 1024) {
			print F chr (rand (255));
		}
	}
	close F;

	my $o = sprintf "%s add -X 1 -s %s -c %s %s %s %s %s",
	                $vx, $s, $c, $f[$x]->{'o'}, $f[$x]->{'f'}, $p, $f[$x]->{'f'};
	open V, $o . '|' or die $!; $| = 1;
	while (<V>) {
		if ($debug) { print "DEBUG: " . $_; }
		$f[$x]->{'i'} = $1 if m/^protohash\s+(.*)$/i;
	}
	close V;

	my $X = new RPC::XML::Client ($r);
	my $q = $X->send_request('xmlrpc.queryObject', { 'protohash' => "BT:" . $f[$x]->{'i'}, 'verbose' => 0 });
	die if ($q->is_fault); my $O = undef;
	for (keys %$q) {
	       	$O .= "Active: " . (($q->{$_}->value()) ? 'Yes' : 'No') . "\n" if m/status/i;
	        $O .= "Allow download via BitTorrent: " . (($q->{$_}->value()) ? 'Yes' : 'No') . "\n" if m/btallowed/i;
	        $O .= "Allow download via HTTP: " . (($q->{$_}->value()) ? 'Yes' : 'No') . "\n" if m/httpallowed/i;
        	$O .= "Allow download via RTMP: " . (($q->{$_}->value()) ? 'Yes' : 'No') . "\n" if m/rtmpallowed/i;
        	$O .= "Authorization Required: " . (($q->{$_}->value()) ? 'Yes' : 'No') . "\n" if m/authrequired/i;
	}
	print $O;

	if ($sleep) {
		print "Sleeping for $sleep seconds.\n"; sleep $sleep;
	}

	my $L = new LWP::UserAgent( 'max_redirect' => 0, 'agent' => 'Mozilla/5.0 (X11; U; Linux)' );
	for ( 0 .. $U ) {
		my $file = $f[$x]->{'f'}; $file =~ s/\.\w+// if ($u[$_]->{'s'});
		my $I = new URI::URL (sprintf "$u[$_]->{'u'}", ($u[$_]->{'f'}) ? $file : $f[$x]->{'i'});
		my $R = new HTTP::Request('GET' => 'http://' . $t . $I->path(), new HTTP::Headers ( 'Host' => $I->authority() ));
		$R = $L->request($R); print $I->abs() . ": " . $R->code() . "\n";
	}
}

if ($remove) {
	my $X = new RPC::XML::Client ($r);
	for ( 0 .. $F ) {
		my $q = $X->send_request('xmlrpc.deleteObject', { 'protohash' => "BT:" . $f[$_]->{'i'}} );
		die $! if ($q->is_fault); unlink $f[$_]->{'f'} if (-e $f[$_]->{'f'});
	}
}