nsbin/http-auth.pl

235 lines
4.4 KiB
Perl
Raw Normal View History

#!/usr/bin/perl
# telmich / !eof
# 25C3
use strict;
use warnings;
use LWP;
use File::Temp qw/ tempfile tempdir /;
if ($#ARGV < 2 || $#ARGV > 3) {
die("Gib mir Essen, aber nicht zu viel!");
}
# ARGV / pid
my $url = shift;
my $realm = shift;
my $user = shift;
my $worte = shift;
my $ppid = $$;
# standard values: user changable
my $ua = LWP::UserAgent->new;
$ua->agent("C3/25"); # as you like
my $concurrent = 2; # number of forks testing http-auth
# reset: will be setup later
my $per_process = 0;
my $last_process = 0;
my $tempdir;
my @children;
my $domain = $url;
$domain =~ s,.*://,,;
$domain =~ s,/.*,,;
################################################################################
#
# Functions
#
sub child
{
my $instance = $_[0];
my $filename = $tempdir . "/" . $instance;
print "Child: " , $filename, " (" , $$, ":", $ppid, ")\n";
open(IN,"<$filename") || die("$filename");
while(<IN>) {
if(try_auth($_))) {
kill QUIT => $ppid;
}
}
close(IN);
exit 0;
}
sub forkus
{
for(my $i = 1; $i <= $concurrent; $i++) {
my $pid = fork();
if($pid == -1) {
print "Aiiiiiiiiyyyyyyyyy!!!!\n";
exit 42;
}
if($pid == 0) {
child $i;
} else {
push(@children, $pid);
}
}
}
sub init
{
my $template = $ENV{'HOME'} . "/http-auth.XXXXXXXXXXXXX";
my $tempdir = tempdir( $template, CLEANUP => 1 ) || die("$template");
#my $tempdir = tempdir( $template ) || die("$template");
return $tempdir;
}
sub splitfile
{
my $lines;
open(TMP,"<$worte") || die("wortliste");
$lines++ while <TMP>;
close(TMP);
$per_process = int($lines / $concurrent);
$last_process = $lines % $concurrent;
print "C/P (L): ", $lines, "/", $per_process, "(+", $last_process, ")\n";
# inputfile
open(IN2, "<$worte") || die("$worte");
my $offset = 0;
for(my $i = 1; $i <= $concurrent; $i++) {
my $filename = ">$tempdir/$i";
print "Creating $filename\n";
open(OUT, "$filename") || die("$filename");
my $count = 0;
while(<IN2>) {
my $line = $_;
print OUT $line;
$count++;
# last file, read the rest
if($i == $concurrent) {
next;
}
# end for normal files
if($count == $per_process) {
last;
}
}
close(OUT);
}
close(IN2);
}
sub try_auth
{
my $pw = $_[0];
chomp($pw);
print $user, ":", $pw, "\n";
$ua->credentials($domain, $realm, $user, $pw);
my $response = $ua->get($url);
if ($response->is_success) {
die "Found", $ $response->content, "\n";
return "found!";
} else {
print STDERR $response->header('WWW-Authenticate'), " ", $response->status_line, "\n";
return "";
}
}
sub kill_children()
{
foreach (@children) {
my $child = $_;
print "Killing child: ", $_, "\n";
kill 9 => $child;
}
}
sub siginthandler
{
print "Ich töte mich!!!\n";
kill_children();
exit(0);
}
sub sighandler
{
# sigint = killed by user -> kill children
# sigquit = child found password -> kill children, kill us
$SIG{'INT'} = 'siginthandler';
$SIG{'QUIT'} = 'siginthandler';
}
sub parent()
{
# install signal handler:
sighandler();
$tempdir = init();
print "Using ", $tempdir, "\n";
# prepare worldlist
splitfile();
# start ourself with different lists, give our PID
forkus();
exit(0);
}
################################################################################
parent();
# $response->header('WWW-Authenticate') || 'Error accessing',
# "\n ", $response->status_line,
# "\n at $url\n Aborting"
# unless $response->is_success;
#my $req = HTTP::Request->new(POST => 'http://search.cpan.org/search');
#print "This is libwww-perl-$LWP::VERSION\n";
#print $response->content;
=head1 NAME
http-auth -- test http-auth (401) security with a wordlist
=head1 SYNOPSIS
http-auth <url> <realm> <username> <wordlist>
=head1 DESCRIPTION
http-auth tries to authenticate at <url> with <realm> and given
<username> via http-auth (required by a 401 answer). It forks
$concurrent forks (normally 2, can be changed in the source), which
work on $lines/$concurrent lines of the <wordlist>.
=head1 AUTHOR
Nico Schottelius <nico-http-auth *at* schottelius.org>
=head1 SEE ALSO
curl(1), wget(1)