#!/usr/bin/perl
# This program tries limited permutations
# on a htaccess password at a known address.
# It could be "improved" by using libwww-perl (libwww-perl5)
# for http protocol handling
# directly in perl.
#But I had lynx installed, and it serves the purpose wonderfully.
#never again shall I forget the password to a router.
#The Initialization,
#Set up some trial details (login name and site url)
my $login = "admin";
my $url = "http://192.168.0.1/";
#ESCAPE them for shell quoting.
$login =~ s/\\/\\\\/g;
$login =~ s/\"/\\\"/g;
$login =~ s/\$/\\\$/g;
$url =~ s/\\/\\\\/g;
$url =~ s/\"/\\\"/g;
$url =~ s/\$/\\\$/g;
#Name the output file in case of a success:
my $file = "";
#Whether or not to show the source of the file upon success:
my $display = 0;
#Only passwords matching each @only with be tried.
my @only = ();
#beginning password length
my $pwl = 1;
#Set up the allowable characters
my @chrs=qw/
? - = [ ] \ ; ' , . `
? _ + { } | : " < > ~
a b c d e f g h i j k l m n o p q r s t u v w x y z
A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
1 2 3 4 5 6 7 8 9 0
! @ # $ % ^ & * ( )
/;
$chrs[0]='/';
# THE FOLLOWING BLOCK is generated by the shuffle_chrs sub array.
# if you are working on one password for a while you won't want to regenerate
# this block so that you can easily pick up where you left off
my @chrs0 = qw/@ b v 5 O ? 9 + P M u U G : c o J r z w I t K N y Y [ ( C \
F h Z k 4 _ A & . d n ` a E m V x R W ~ Q L ? X < * 7 6 - B
! " > p # , $ ^ 1 q } g 2 e S T D ; ) j s l H % ] 0 { | i 8
= f ' 3 /;
$chrs0[5] = '/';
my @chrs1 = qw/2 x a ; 1 p V N i 5 _ ! % r + : j ? } O u v @ w D z ) ` o Q
E 9 G ' , d P A M T W g . Z Y H L X C J # 0 ? I R k ( 4 [ 8
S n F 3 l $ m U & K { ] * c s < t e h " | = - 6 > 7 b ^ f y
\ B q ~ /;
$chrs1[52] = '/';
my @chrs2 = qw/$ + ] L ? f ~ 4 h N ! v 9 w 2 | F : j z u 1 s i * . ^ B C Y
k 8 o H ` I A ' < a O E S = R p U _ 6 m " x r V 3 Q g 5 ) 7
& 0 ; [ \ - } n q { ( X @ T J c > b P , t # e K ? % y d W l
M Z G D /;
$chrs2[4] = '/';
my @chrs3 = qw/, ) c h L z M ' i j [ l 8 n G q P 6 ? . S w C v x B \ H } ]
% ~ + = k > 7 t g N O d W D _ # U V 1 X @ o F y - J A e E ?
K I ^ Y R $ b * 9 & Z ; 3 5 " ! T u Q ( 2 { : a 0 p s | ` r
< 4 f m /;
$chrs3[59] = '/';
my @chrs4 = qw/I ) $ d J t . _ z ; F M n Q X p * { | x f ~ U & 9 K ! k 7 D
Z G # ? m 3 r - 2 s O g o w b + R @ ' < 4 W % H N ` 5 6 8 =
A h e a B V \ E c u } P j C [ ] ( L 0 q 1 , v l T ? Y ^ : "
i > y S /;
$chrs4[33] = '/';
my @chrs5 = qw/O a b ^ g 6 M R = j | l 0 : 2 ] % , 1 o . ~ T c D * ! I ; `
h & G H z d { \ w N W t P ' + [ r V i X x A Q s ) 4 E L y -
7 # ? @ > S 8 q F $ ( f U u e < C n Y v 9 m p _ J K } k B "
Z 3 ? 5 /;
$chrs5[62] = '/';
my @chrs6 = qw/" U [ r } i = . G j k | : n o P @ l ; T J > w V * N W - C m
E ( 0 e I Y L v d a O g ? + u % t $ 7 X M ^ F 6 A < 5 2 , f
b 9 Q _ s & 3 p ] K # 8 1 c ) z \ ? x S q { ` D R B ~ Z ! '
4 h y H /;
$chrs6[42] = '/';
my @chrs7 = qw/B j q d h + g n & X k 9 a f M \ ' " ? t A 6 w R Q z S D e L
T V I 7 b ] 3 | K N C P H p r E { % c ~ . ^ 2 O 0 # Z x , J
$ l ! 1 8 } W < _ * v ) - = [ 4 F ; i 5 > u s y m Y @ ` : o
G ( ? U /;
$chrs7[18] = '/';
my @chrs8 = qw/K _ c a ? | g h 9 O ^ o m u n b < ' ~ V z 5 w Y v i l R C W
e H U s 2 B I + M ? 0 t Q N 6 } ( L G X J q - p y A Z % r \
4 3 ! @ f $ # T ) & E 1 j = ; 7 ] k 8 > P : D x d { ` [ S .
F , * " /;
$chrs8[4] = '/';
my @chrs9 = qw/W \ " < P ` x A i ; k - ' 0 o & K 7 g m 1 M w ) H d Z a N ?
b $ D y I s 8 Y z 5 O 6 . C ( J B ! S X } n u % > G # Q r f
c , E @ = U 2 R _ * q 3 v p [ ] t { j F L : | 9 T e ~ h V l
+ ^ ? 4 /;
$chrs9[29] = '/';
my @perms=(\@chrs0,\@chrs1,\@chrs2,\@chrs3,\@chrs4,\@chrs5,\@chrs6,\@chrs7,\@chrs8,\@chrs9);
my @i=(0,0,0,0,0,0,0,0,0,0);
my $maxpwl=10;
#THE END OF THE BLOCK that was generated by shuffle_chrs
%flags = (
'--help' => \&help, '-h' => \&help, '?' => \&help,
'--login' => \&set_login, '-l' => \&set_login,
'--url' => \&set_url, '-u' => \&set_url,
'--plength' => \&set_pwl, '-p' => \&set_pwl,
'--maxplen' => \&set_maxpwl, '-m' => \&set_maxpwl,
'--file' => \&set_file, '-f' => \&set_file,
'--onlytry' => \&set_only, '-o' => \&set_only,
'--resume' => \&set_str, '-r' => \&set_str,
'--indices' => \&set_i, '-i' => \&set_i,
'--display' => \&set_display, '-d' => \&set_display,
'--shuffle' => \&shuffle_chrs, '-s' => \&shuffle_chrs );
sub set_login {
my $l = shift;
if ("" eq $l) {
print STDERR
"ERROR: login flag was not clearly initialized; i.e. -l=admin\n\n";
exit;
}
$l =~ s/\\/\\\\/g;
$l =~ s/\"/\\\"/g;
$l =~ s/\$/\\\$/g;
$login=$l;
print "-Initializing login to: $login\n";
}
sub set_url {
my $u = shift @_;
if ("" eq $u) {
print STDERR
"ERROR: url flag was not clearly initialized; i.e. -u=http://192.168.0.1/\n\n";
exit;
}
$u =~ s/\\/\\\\/g;
$u =~ s/\"/\\\"/g;
$u =~ s/\$/\\\$/g;
$url = $u;
print "-Initializing url to: $url\n";
}
sub set_only {
my $o = shift @_;
if ("" eq $o) {
print STDERR
"ERROR: onlytry flag was not clearly initialized; i.e. '-o=.*[0-9].*'\n\n";
exit;
}
push @only, $o;
if (scalar @only > 1) {
print '-Trials now must further match: ';
} else {
print '-Trials now must match: ';
}
print "$o\n";
}
sub set_file {
my $f = shift @_;
if ("" eq $f) {
print STDERR
"ERROR: file flag was not clearly initialized; i.e. -f=index.html\n\n";
exit;
}
$file = $f;
print "-Initializing success output file to: $file\n";
}
sub set_show {
$display = 1;
print "-Will show source of URL in case of success.\n";
}
sub set_pwl {
my $p = shift @_;
if ("" eq $p) {
print STDERR
"ERROR: plength flag was not clearly initialized; i.e. -p=2\n\n";
exit;
}
$pwl = $p;
print "-Initializing password length to: $pwl\n";
}
sub set_maxpwl {
my $p = shift @_;
if ("" eq $p) {
print STDERR
"ERROR: maxplen flag was not clearly initialized; i.e. -m=$maxpwl\n\n";
exit;
}
if ($p > $maxpwl) {
print STDERR
"ERROR: maxplen setting is greater than the number of shuffled sets.\n" .
" Please run `$0 -s=$p`, and paste the generated block over the old one.".
"\n";
exit;
}
$maxpwl = $p;
print "-Initializing the maximum password length to: $maxpwl\n";
}
sub set_i {
my $i = shift @_;
if ("" eq $i) {
print STDERR
"ERROR: indices flag was not clearly initialized; i.e. -i=1,2,3,4,5,6,7,8\n\n";
exit;
}
@i = split /,/, $i;
for(my $j=scalar @i;$j<$maxpwl;$j++) {
$i[$j]=0;
};
print "-Initializing indices to: " . join(', ', @i) . "\n";
}
sub set_str {
my $s = shift @_;
if ("" eq $s) {
print STDERR
"ERROR: resume flag was not clearly initialized; i.e. \"-r=pqR4!a\"\n\n";
exit;
}
$pwl = length $s;
for(my $j=0;$j<length $s;$j++){
my $chr = substr $s, $j, 1;
for(my $k=0;$k<scalar @{$perms[$j]};$k++) {
if ($perms[$j][$k] eq $chr) {
$i[$j] = $k;
break;
}
}
}
print "-Initializing password length to: $pwl\n";
print "-Initializing indices to: " . join(', ', @i) . "\n";
}
sub increment_perms {
#For Password length 1 to $maxpwl.
for (;$pwl <= $maxpwl;$pwl++) {
while($i[0]<scalar @{$perms[0]}){
#Use the indices to form a trial string as a password.
my $trial = "";
for (my $j=0;$j<$pwl;$j++) {
$trial .= $perms[$j][${i[$j]}];
}
#See if the password matches the patterns and is acceptable to be tried
my $tryokay = 1;
foreach $match (@only) {
if ($trial !~ m/$match/) {
$tryokay = 0;
break;
}
}
if ($tryokay) {
# if so announce trying it, and commence trying it.
printf("TRYING -r=%-8s -p=%02d -i=", $trial, $pwl);
for(my $k=0;$k<$pwl;$k++) {
printf("%02d", $i[$k]);
if($k<$pwl-1) { print ','; }
}
try_password($trial);
}
#Increment the indices up to password length i.e. 00 01..09 10..99 stop
my $digit=$pwl;
do {
if ($digit != $pwl && $i[$digit] >= scalar @{$perms[$digit]})
{$i[$digit]=0;}
$digit--;
$i[$digit]++;
} until ( $digit==0 || $i[$digit]<scalar @{$perms[$digit]} );
}
#now that this password length is done, start again with a longer password.
for(my $j=0;$j<scalar @i;$j++) {
$i[$j]=0;
}
}
print "\n\n --- DONE BUT FAILED!\n";
}
sub try_password {
my $t = shift;
# ESCAPE string for sh shell " quoting.
my $t_esc = $t;
$t_esc =~ s/\\/\\\\/g;
$t_esc =~ s/\"/\\\"/g;
$t_esc =~ s/\`/\\\`/g;
$t_esc =~ s/\$/\\\$/g;
#NOTE THAT 2>&1 is sh's way of piping stderr to stdout, thus catching any
#error output in the $try variable as well.
my $try = `lynx -source \"-auth=${login}:${t_esc}\" \"${url}\" 2>&1`;
#lynx prints "Alert!: Access without authorization denied" on stderr
# if authorization failed,
#lynx prints "lynx: Can't access startfile ${url}" on stderr
# if the url was unreachable.
#if (($try =~ m/lynx: Can't access startfile ${url}/)){
# print "\tWHOOPS!\n\n --- WHOOPS! lynx: Can't access startfile ${url}\n";
# print " --- is your network connected and the URL correct?\n\n";
# exit;
#}
if ($try !~ m/Alert!: Access without authorization denied/ &&
$try !~ m/lynx: Can't access startfile/ ) {
print "\tSUCCESS!\n";
if ($file ne "") {
unless ( open FH, ">$file" ) {
print STDERR "ERROR: Couldn't open '$file' for writing output.\n";
} else {
print FH $try;
close FH;
}
}
if ($display) {
print "==================================================LYNX OUTPUT:\n";
print $try;
print "==================================================END LYNX OUTPUT.\n";
}
print "\nCorrect pass-phrase is: \"${t}\"\n\n";
exit;
}
print "\tFAILED ${t}\n";
}
sub shuffle_chrs {
my @list = ();
my @init = ();
my $s = shift @_;
if ("" eq $s) {
print STDERR
"WHOOPS: shuffle flag was not clearly initialized; Using \"-s=8\"\n\n";
$s = "8";
}
#pre convert string to int... not necessary, but speeds up for loop.
$s = int($s);
srand;
print STDERR
"Printing $s shuffled sets for inclusion into this program.\n\n";
print "
# THE FOLLOWING BLOCK is generated by the shuffle_chrs sub array.
# if you are working on one password for a while you won't want to regenerate
# this block so that you can easily pick up where you left off
";
for(my $i=0;$i<$s;$i++){
my @chrs_=@chrs;
$chrs_[0]='?';
my $slash = 0;
for(my $j=0;$j<scalar @chrs_;$j++){
my $x = int rand scalar @chrs_;
my $y = int rand scalar @chrs_;
if ($x==$slash) {$slash=$y;}
else {if ($y==$slash) {$slash=$x;}}
my $temp = $chrs_[$x];
$chrs_[$x]=$chrs_[$y];
$chrs_[$y]=$temp;
}
print "\@chrs$i = qw/";
for(my $j=0;$j<scalar @chrs_;$j++){
print "${chrs_[$j]} ";
if($j%30==29 && $j+1 < scalar @chrs_) {
print "\n ";
}
}
print "/;\n";
print "\$chrs".$i."[${slash}] = '/';\n";
# for printing out a list of all the chrsX and their initial values.
$list[$i] = '\@chrs'. $i;
$init[$i] = '0';
}
print "\nmy \@perms=(" . join(",",@list) . ");\n";
print "my \@i=(" . join(",",@init) . ");\n";
print "my \$maxpwl=$s;\n";
print "#THE END OF THE BLOCK that was generated by shuffle_chrs\n\n";
print STDERR
"\nEXITING; Remaining arguments not processed.\n";
exit;
}
sub help {
print "
$0 [--flag=setting] [-f=setting] :
--help or -h: Display help.
--shuffle or -s: Display a set of shuffled character for pasting into this
program. Set the number of sets. Default is 8.
--login or -l: Set the login to test passwords against. Default: -l=admin
--url or -u: Set the url to log in to. Default: -u=http://192.168.0.1/
--display or -d: Display the url's source if the password is successful.
--file or -f: Set the name of the file for storing a successful http get.
--plength or -p: Set the password length to start at.
--maxplen or -m: Set the maximum password length to try.
--onlytry or -o: Set a pattern that must be matched for a password to be
tried. This may be used multiple times.
I.E. In order to require one numeral one letter and one
meta-character in no required order try:
'-o=[0-9]' '-o=[A-Za-z]' '-o=[\\!@#\$%^&*()~`_\\-+=<,>.?/:;\"'\"'{}|\\[\\\\\\]].*\"
The following flags are only to be used if you want to resume
the progress of a previous trial.
Only either -r or -i (with -p) need be used.
--resume or -r: Set the string to resume the trials at.
Please quote and escape characters as necessary.
--indices or -i: Set 8 indices to resume at. i.e. -i=2,23,34,0,0,0,0,5
\n";
exit;
}
sub process_flags {
foreach $arg (@ARGV) {
#Separate the argument into <FLAG>=<SETTING>
$flag=$arg;
$set =$arg;
if ($arg =~ m/=/) {
$flag =~ s/=.*$//;
$set =~ s/^.*?=//;
} else {
$set = "";
}
if (exists $flags{$flag}) {
($flags{$flag})->($set);
} else {
print STDERR "ERROR: $arg is not recognized.\n";
help;
}
}
increment_perms;
}
process_flags;