#!/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 () { 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'}); } }