#!/usr/local/bin/perl
#
#
#
#
use LWP::UserAgent;

if ($#ARGV != 3) {
        print "Usage: $0 <target host> <script name> <input file> <output file>\n";
        exit(1);
}

my $host = $ARGV[0];
my $script = $ARGV[1];
my $infile = $ARGV[2];
my $outfile = $ARGV[3];

open (OUT, ">$outfile") or die("unable to open $outfile: $!");
open (IN, "$infile") or die("unable to open $infile: $!");
@Dirs=<IN>;

print OUT "Starting Directory Execute Check...\n\n";
foreach $dir (@Dirs) {
	chomp $dir;
	print OUT "$dir: \t";
	if (&PutEXE($host, $dir, $script)) { 
		&CallEXE($host, $dir, $script);
		&DelEXE($host, $dir, $script);
	}
}
print OUT "\n\nFinished Directory Execute Check\n";

sub PutEXE {
	my ($host, $dir, $script) = @_;
	my $success = 0;
        my $blah = "HTTP/1.0\nHost: $host\nContent-length: 29\nprint 'execute successfull!';\n";

	chomp $dir; chomp $script;
        $dir =~ s/ /%20/g;
        my $repl = echoToNc(qq(PUT /$dir/$script $blah));

	print OUT "Upload: ";
        if ($repl =~ /not allowed/i) { print OUT "Not Allowed \n"; }
        elsif ($repl =~ /Write Access Forbidden/i) { print OUT "Write Access Forbidden \n"; }
        elsif ($repl =~ /Unauthorized due to ACL on resource/i) { print OUT "Unauthorized due to ACL on resource \n"; }
        else { print OUT "*** SUCCESSFULL PUT ***\t"; $success=1; }

	return($success);
}

sub CallEXE {
	my ($host, $dir, $script) = @_;
	my $target = "http://" . $host . "//" . $dir . "//" . $script;
	my $success = 0;

	my $ua = new LWP::UserAgent;
	my $req = new HTTP::Request GET => "$target";
	my $res = $ua->request($req);

	print OUT "\tExecute: ";
	if ($res->content =~ /Execute Access Forbidden/) { print OUT "Execute Access Forbidden"; }
	elsif ($res->content =~ /Read Access Forbidden/) { print OUT "Execute, but no PERL?"; }
	elsif ($res->content =~ /print '/) { print OUT "Read, but no Execute"; }
	else { print OUT "*** SUCCESS ***"; $success=1; }
	
	return($success);
}


sub DelEXE {
	my ($host, $dir, $script) = @_;
	my $success = 0;
        my $blah = "HTTP/1.0\nHost: $host\n";

	chomp $dir; chomp $script;
        $dir =~ s/ /%20/g;
        my $repl = echoToNc(qq(DELETE /$dir/$script $blah));

	print OUT "\tDelete: ";
	if ($repl =~ /The parameter is incorrect/) { print OUT "The parameter is incorrect\n"; }
        else { print OUT "*** SUCCESSFULL DELETE ***\n"; $success=1; }

	return($success);
}

sub echoToNc {
        my($cmd) = @_;
	my $port=80;
        open (CMD, ">/tmp/puttestin.$$.txt") or die "Can't open /tmp/puttestin.$$.txt: $!";
        print CMD "$cmd\n";
        print "== Sending the following:\n$cmd";
        print `nc $host $port < /tmp/puttestin.$$.txt > /tmp/puttestout.$$.txt`;
        print "== Got the response:\n";
        open (TMPOUT, "/tmp/puttestout.$$.txt") or die "Can't open /tmp/puttestout.$$.txt: $!";
        my(@lines) = (<TMPOUT>);
        my($lines) = join("",@lines);
        print $lines;
        return $lines;
}