Page 1 of 2 12 LastLast
Results 1 to 10 of 14

Thread: Dictionary permutator

  1. #1
    Moderator KMDave's Avatar
    Join Date
    Jan 2010
    Posts
    2,281

    Default Dictionary permutator

    Hi,

    I thought that this script might help to extend your dictionaries.

    Most of the times the dictionary files only contain plaintext words like admin but are lacking permutations like 4dm1n or admin! or ?admin or alike.

    For that reason I wrote this little perl script to create a new dict from an existing one with some possible permutations.

    As of now the following functions are supported (with the switch parameter)

    • -n : will append the numbers from 0 to 9999 to each word
    • -L : will "leetify" the words (right now just in total, it is planned for the next release to support more than one character as the substitution and to get all possible results. Like test would be test, t3st,te5t and t35t.)
    • -s : will prepend and append the given special characters to the words. Note that you have to use the \ to escape certain characters.
    • -a : will apply the "leetification" and then prepend and append the special characters given to all created words (plaintext and all "leet" variations). The number option was left out intentionally since it would result in enormous sized files.


    Keep in mind that the more options you are using, the bigger the resulting file will be.
    But great if you have some space left and want to have more possible options in your dictionary files.

    The link
    Tiocfaidh ár lá

  2. #2
    Senior Member
    Join Date
    Feb 2008
    Posts
    681

    Default

    Very nice

    Thanks for sharing.
    [FONT=Courier New][SIZE=2][FONT=Courier New]hehe...
    [/FONT][/SIZE][/FONT]

  3. #3
    Junior Member Schtekarn's Avatar
    Join Date
    Feb 2008
    Posts
    29

    Default

    I've been looking for a script like this, sounds very nice.

    The link on the other hand seems broken

    Could you repost the code here, or maybe on some other site?

  4. #4
    Member
    Join Date
    Aug 2006
    Posts
    100

    Default

    yea, the link redirects me to something completely different.

  5. #5
    Moderator KMDave's Avatar
    Join Date
    Jan 2010
    Posts
    2,281

    Default

    I will post the code again. Might be tomorrow till I will upload it though.
    Tiocfaidh ár lá

  6. #6
    Moderator KMDave's Avatar
    Join Date
    Jan 2010
    Posts
    2,281

    Default

    Ok, decided to put the sourcecode directly in here, so just copy & paste it and enjoy

    Might start to work on it again pretty soon, since it is not completly working, as i wish.

    #!/usr/bin/perl
    #A script by KMDave to extend dictionary files from existing ones.
    #The purpose is to create different permutations of regular passwords like l33tifing the words or adding special characters
    #Version 0.1
    #Thanks to the guys at OffSec and RemoteExploit
    #Special thanks go to Muts, Xploitz,didN0t,ryujin and shamanvirtuel

    use Getopt::Std;

    #Define which characters to use to replace certain characters in leet mode:
    #Only one character substitution possible atm, more are planned for the next release

    $rep_a = "4";
    $rep_e = "3";
    $rep_o = "0";
    $rep_s = "5";
    $rep_i = "1";


    getopts("a:Ls:n") or die &usage();

    #Check which options are given if none, then print the usage

    if (@ARGV != 2)
    {
    &usage;
    }


    $infilename = @ARGV[0];
    $outfilename = @ARGV[1];

    $wordcount = 0;
    $proccessed = 0;

    @words = ();
    if ($opt_a)
    {
    $specialchars = $opt_a;
    }
    elsif ($opt_s)
    {
    $specialchars = $opt_s;
    }

    print "Processing...\n";

    open IF,"<",$infilename or die "Cannot read $infilename. Please check the location and permissions\n";
    open OF,">",$outfilename or die "Cannot write to $outfilename. Please check the location and permissions\n";

    #Get the number of words in the file (not the best way to do it but it works, even with a good speed for large files)

    while (<IF>)
    {
    $wordcount +=1;
    }

    open IF,"<",$infilename or die "Cannot read $infilename. Please check the location and permissions\n";

    while (<IF>)
    {
    $_ =~ s/\s+$//;

    my $result = '';
    if ($opt_L)
    {
    $result .= &leet($_);
    }
    if ($opt_s)
    {
    $result .= &special($_,$specialchars);
    }
    if ($opt_n)
    {
    $result .=&numbers($_);
    }
    if ($opt_a)
    {
    $result .= &leet($_);
    $tmp = &special($result,$specialchars);
    $result .= $tmp;
    }
    print OF $_."\n";
    print OF "$result";

    $processed +=1;

    print "Processed $processed of $wordcount words\n";
    }

    print "DONE\n";


    sub leet
    {
    my($string) = @_;
    my $sccount = 0;
    my $res = '';
    my $strlen = length($string);
    my $letter = '';
    my $word = '';

    $string =~ s/\s+$//;

    #Full replace at first :
    for (my $i = 0; $i < $strlen; $i++)
    {
    $letter = substr($string,$i,1);
    if (&checkreplace($letter) == 1)
    {
    $sccount += 1;
    if ($offset < 0)
    {
    $offset = $i;
    }
    }
    $word .= &leetreplace($letter);
    }

    $res .= $word."\n";
    $word = '';


    return $res;
    }

    sub special
    {
    my($string,$chars) = @_;
    my $res;

    $string =~ s/\s+$//;

    $charcount = length($chars);
    for ($i = 0; $i < $charcount; $i++)
    {
    $char1 = substr($chars,$i,1);
    for ($j = 0; $j < $charcount; $j++)
    {
    $char2 = substr($chars,$j,1);
    $res .= $char1.$string.$char2."\n";
    }
    $res .= $char1.$string."\n";
    $res .= $string.$char1."\n";
    }
    return $res;
    }

    sub numbers
    {
    my ($string) = @_;
    my $res;

    $string =~s/\s+$//;
    for (my $i = 0; $i <= 9999; $i++)
    {
    $res .= $string.$i."\n";
    }
    return $res;
    }

    sub leetreplace
    {
    my ($char) = @_;

    if (lc($char) eq "i")
    {
    return $rep_i;
    }
    if (lc($char) eq "e")
    {
    return $rep_e;
    }
    if (lc($char) eq "a")
    {
    return $rep_a;
    }
    if (lc($char) eq "s")
    {
    return $rep_s;
    }
    if (lc($char) eq "o")
    {
    return $rep_o;
    }
    else
    {
    return $char;
    }

    }

    sub checkreplace
    {
    my ($char) = @_;

    if (lc($char) eq "i" || lc($char) eq "e" || lc($char) eq "a" || lc($char) eq "s" || lc($char) eq "o")
    {
    return 1;
    }
    else
    {
    return 0;
    }
    }

    sub usage
    {
    print "\n";
    print "Usage: ./dictperm.pl [options] <input dictionary> <output dictionary>\n\n";
    print "Options :\n\n";
    print "-a : Use all but number permutation options(see below, remember to give a list of special characters)\n";
    print "-L : 'L33tify' in different flavours (i.e. test results in : t3st, te5t and t35t)\n";
    print "-s : Add a list of special characters to put before the password and at the end \n";
    print " (i.e. -s \\?! results in test ?test? ?test! !test! !test?\n";
    print "-n : Append the numbers from 0 to 9999 to the password (not included in the -a option since it will bloat a passwordfile too much.\n";
    print " Has to be used exclusively\n\n";

    }
    Tiocfaidh ár lá

  7. #7
    Just burned his ISO
    Join Date
    Jan 2010
    Posts
    12

    Default Thanks

    Thanks for the script

  8. #8
    Moderator KMDave's Avatar
    Join Date
    Jan 2010
    Posts
    2,281

    Default

    No problem

    Still trying to figure out the right algorithm for the correct amount of permutations. I drew a blank on it and hadn't had time due to my work. But I will look into this again pretty soon.
    Tiocfaidh ár lá

  9. #9
    Just burned his ISO
    Join Date
    Jul 2008
    Posts
    15

    Default

    i'm bussy width a same script maby you can do something width this code
    (there are still a lot of bugs so don't blame me if something goes wrong)

    Code:
    use Switch;
    
    if ($ARGV[0] ne "" && $ARGV[1] ne "" && $ARGV[1] ne "")	
    {
    	#Variabelen
    	$name = $ARGV[0];
    	$output = $ARGV[1];
    	$options = $ARGV[2];
    	#Einde vars*	
    	open(INFO, ">>$output");											#open file
    	print INFO "$name\n";												#schrijf eerst de company naam neer.
    	
    	my @row = split(',', $options);										#split de opties
    	foreach my $opt (@row)
    	{
    		switch($opt)
    		{
    			case "N" {doNumeriek()}
    			case "L" {doLeet()}
    			case "B" {doBreezer()}
    			case "LN" {doLeetNumeriek()}
    			else	{ print "optie $opt is ongeldig \n" }				#ongeldige param afhandeling
    		}
    	}
    	
    	close(INFO);														#sluit file
    }
    else
    {
    	#standaard melding
    	print "\n###########################################################################\n#\n";
    	print "# Syntax: cgc.pl [companyname] [fileoutput] [csvOptions]\n#\n";
    	print "# Options: \n";
    	print "# L (make 1337 combinations)\n";
    	print "# N (zet alle combinaties van 0 t'm 999 voor en achter het bestand)\n";
    	print "# B (make breezha combination)\n#\n";
    	print "# LN (maakt voor alle 1337 combinaties ook een numerieke waarde)\n";
    	print "# example cgc.pl company company_dic.txt N,B,L\n";
    	print "#\n###########################################################################\n";
    	#einde melding
    }
    
    sub doNumeriek
    {
    	#genereer alle mogelijkheden van een company wachtwoord met xxx getal er voor of erachter.
    	for($i = 0; $i<1000; $i++)
    	{
    		$add = "";
    		if($i < 10)
    		{
    			$add = "00" . $i;
    			$sadd = "0" . $i;
    			$snname = $sadd . $name;
    			$saname = $name . $sadd;
    			print INFO "$snname\n";
    			print INFO "$saname\n";
    		}
    		if($i < 100 && $i >= 10 )
    		{
    			$add = "0" . $i;
    		}
    		if($i >= 100)
    		{
    			$add = $i;
    		}
    		$pname =  $add . $name;
    		$aname = $name . $add;
    		
    		if($i < 100)
    		{
    			$pnzname = $i . $name;
    			$anzname = $name . $i;
    			print INFO "$pnzname\n";
    			print INFO "$anzname\n";
    		}
    		print INFO "$aname\n";
    		print INFO "$pname\n";
    		
    
    	}
    }
    
    sub doLeet
    {
    	#vervang tabel: a=4 e=3 h=# i = 1 l=1 o=0 s=5 t=7 
    	@search =      ("a","e","h","i","l","o","s","t");
    	@replaceWidth =("4","3","#","1","1","0","5","7");
    	$counter = 7;
    	
    	#losse replaces
    	for($i = 0; $i<=$counter; $i++)
    	{
    		$string = $name;
    		$string =~ s/$search[$i]/$replaceWidth[$i]/; 
    		if($string ne $name)
    		{
    			print INFO "$string \n";
    		}
    	}
    	#replace all
    	$counter = 7;     #reset vars
    	$string = $name;  #reset vars
    	#losse replaces
    	for($i = 0; $i<=$counter; $i++)
    	{
    		$string =~ s/$search[$i]/$replaceWidth[$i]/; 
    	}
    	print INFO $string;
    
    }
    
    sub doBreezer
    {
    	#print INFO "BrEeZhA";
    }
    
    sub doLeetNumeriek
    {
    	#vervang tabel: a=4 e=3 h=# i = 1 l=1 o=0 s=5 t=7 
    	@search =      ("a","e","h","i","l","o","s","t");
    	@replaceWidth =("4","3","#","1","1","0","5","7");
    	$counter = 7;
    	$temp = $name;
    	#losse replaces
    	for($x = 0; $x<=$counter; $x++)
    	{
    		$string = $temp;
    		$string =~ s/$search[$x]/$replaceWidth[$x]/; 
    		if($string ne $temp)
    		{
    			print INFO "$string \n";
    			$name = $string;
    			doNumeriek();
    		}
    	}
    	#replace all
    	$counter = 7;     #reset vars
    	$string = $name;  #reset vars
    	#losse replaces
    	for($x = 0; $x<=$counter; $x++)
    	{
    		$string =~ s/$search[$x]/$replaceWidth[$x]/; 
    	}
    	print INFO $string;
    	$name = $string;
    	doNumeriek();
    }
    Two things are infinite: the universe and human stupidity;

  10. #10
    Just burned his ISO
    Join Date
    Jul 2008
    Posts
    15

    Default

    I made a new version, it wil also take care of upper and lowercase characters.
    one word wil grow by 2^x * (replaceable_vars) * 2448.
    Here's the code,

    Code:
    #!/usr/bin/perl
    # version 0.3
    # auteur: shad0w_crash 
    
    use Switch;
    
    #main
    
    if ($ARGV[0] ne "" && $ARGV[1] ne "" && $ARGV[2] ne "")	
    {
    	#Variabelen
    	$name = $ARGV[0];
    	$output = $ARGV[1];
    	$options = $ARGV[2];
    	$Alles = "f";
    	$totaalTeMakenCombos = 0;
    	#Einde vars*	
    
    	open(INFO, ">>$output");											#open file
    	
    	
    	if(substr($name, -4) eq ".txt")
    	{
    		open(IN, "$name");
    		while ($line = <IN>) 
    		{
    		  $name =  substr($line,0,2);
    		  doOpties();
    		}
    		close(IN);
    	}
    	else
    	{										#split de opties
    		doOpties();
    	}
    	
    	close(INFO);														#sluit file
    }
    else
    {
    	usage();
    }
    #end main
    
    sub doOpties
    {
    	my @row = split(',', $options);
    		foreach my $opt (@row)
    		{
    			switch($opt)
    			{
    				case "N" {doNumeriek()}
    				case "L" {doLeet()}
    				case "B" {doBreezer()}
    				case "LN" {doLeetNumeriek()}
    				case "A" {doAll()}
    				else	{ print "optie $opt is ongeldig \n" }				#ongeldige param afhandeling
    			}
    		}
    }
    sub doNumeriek
    {
    	#genereer alle mogelijkheden van een company wachtwoord met xxx getal er voor of erachter.
    	for($i = 0; $i<1000; $i++)
    	{
    		$add = "";
    		if($i < 10)
    		{
    			$add = "00" . $i;
    			$sadd = "0" . $i;
    			$snname = $sadd . $name;
    			$saname = $name . $sadd;
    			print INFO "$snname\n";
    			print INFO "$saname\n";
    		}
    		if($i < 100 && $i >= 10 )
    		{
    			$add = "0" . $i;
    		}
    		if($i >= 100)
    		{
    			$add = $i;
    		}
    		$pname =  $add . $name;
    		$aname = $name . $add;
    		
    		if($i < 100)
    		{
    			$pnzname = $i . $name;
    			$anzname = $name . $i;
    			print INFO "$pnzname\n";
    			print INFO "$anzname\n";
    		}
    		print INFO "$aname\n";
    		print INFO "$pname\n";
    	}
    }
    
    sub usage
    {
    	#standaard melding
    	print "\n################################################################################\n#\n";
    	print "# Syntax: cgc.pl [companyname || filenaam.txt] [output.txt] [csvOptions]\n#\n";
    	print "# Options: \n";
    	print "# L (make 1337 combinations)\n";
    	print "# N (put 0-999 to back and front (a a001 a01 a1 up to a999 )\n";
    	print "# B (make BrEeZhA combination)\n";
    	print "# LN (make 1337 and 0-999)\n#\n";
    	print "# A (make all possible combinaties)\n#\n";
    	print "# example cgc.pl company company_dic.txt N,B,L\n#\n";
    	print "# Auteur: shad0w_crash\n#\n";
    	print "# Warning: !F(x) = 2^X * replaceable vars * 2448 !";
    	print "#\n################################################################################\n";
    	#einde melding
    }
    
    sub doLeet
    {
    	#vervang tabel: a=4 e=3 h=# i = 1 l=1 o=0 s=5 t=7 
    	@search =      ("a","e","h","i","l","o","s","t");
    	@replaceWidth =("4","3","#","1","1","0","5","7");
    	$counter = 7;
    	
    	#losse replaces
    	for($i = 0; $i<=$counter; $i++)
    	{
    		$string = $name;
    		$string =~ s/$search[$i]/$replaceWidth[$i]/; 
    		if($string ne $name)
    		{
    			print INFO "$string \n";
    		}
    	}
    	#replace all
    	$counter = 7;     #reset vars
    	$string = $name;  #reset vars
    	#losse replaces
    	for($i = 0; $i<=$counter; $i++)
    	{
    		$string =~ s/$search[$i]/$replaceWidth[$i]/; 
    	}
    	print INFO $string;
    
    }
    
    sub doBreezer()
    {
    	$tname = lc($name);
    	$possibilitys = ((2 ** length($tname)) -1);
    	#loop door alle mogelijkheden.
    	for($xy = 0; $xy<=$possibilitys; $xy++)
    	{
    		$newCombo = "";
    		#maak binair
    		$binpos = sprintf("%b",$xy);
    		#zorg voor de juiste lengte
    		while(length($binpos) != length($tname))
    		{
    			$binpos = "0" . $binpos;
    		}
    
    		for($yyx = 0; $yyx<length($tname); $yyx++)
    		{			
    			$teken = substr($name,$yyx,1);
    			$num = substr($binpos,$yyx,1);
    			if($num eq "0")
    			{
    				$newCombo = $newCombo . $teken;
    			}
    			else
    			{
    				$newCombo = $newCombo . uc($teken);
    			}
    		}
    		print INFO "$newCombo\n";
    		if($Alles eq "t")
    		{
    			$name = $newCombo;
    			doLeetNumeriek();
    			#calculate possibility's
    			$percentageAlGedaan = (($xy / $possibilitys) * 100);
    			$percentageAlGedaan = substr($percentageAlGedaan,0,5);
    			print "$percentageAlGedaan % van $totaalTeMakenCombos\n";
    		}
    	}
    	
    }
    
    
    sub doLeetNumeriek
    {
    	#vervang tabel: a=4 e=3 h=# i = 1 l=1 o=0 s=5 t=7 
    	@search =      ("a","e","h","i","l","o","s","t");
    	@replaceWidth =("4","3","#","1","1","0","5","7");
    	$counter = 7;
    	$temp = $name;
    	#losse replaces
    	for($x = 0; $x<=$counter; $x++)
    	{
    		$string = $temp;
    		$string =~ s/$search[$x]/$replaceWidth[$x]/; 
    		if($string ne $temp)
    		{
    			print INFO "$string \n";
    			$name = $string;
    			doNumeriek();
    		}
    	}
    	#replace all
    	$counter = 7;     #reset vars
    	$string = $name;  #reset vars
    	#losse replaces
    	for($x = 0; $x<=$counter; $x++)
    	{
    		$string =~ s/$search[$x]/$replaceWidth[$x]/; 
    	}
    	print INFO $string;
    	$name = $string;
    	doNumeriek();
    }
    
    sub doAll
    {
    	$Alles = "t";
    
    	
    	$rt = 1;
    	#bereken totaal aantal opties.
    	for($z = 0; $z<length($name); $z++)
    	{
    		$teken = substr($name,$zz,1);
    		if($teken eq "a" || $teken eq "e" || $teken eq "h" || $teken eq "i" || $teken eq "l" || $teken eq "o" || $teken eq "s" || $teken eq "t")
    		{
    			$rt = $rt + 1;
    		}
    	}
    			
    	$totaalTeMakenCombos = ((((2 ** length($name)) -1) * $rt) * 2448);
    	print "Generating: $totaalTeMakenCombos combinaties\n";
    	doBreezer();
    }
    Two things are infinite: the universe and human stupidity;

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •