forked from openwall/john
-
Notifications
You must be signed in to change notification settings - Fork 0
/
leet.pl
executable file
·95 lines (85 loc) · 2.57 KB
/
leet.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
#! /usr/bin/env perl -l
# John rules generator for combination of 1337-speak substitutions.
# Proof of concept
# Copyright © 2014 Aleksey Cherepanov <[email protected]>
# Redistribution and use in source and binary forms, with or without
# modification, are permitted.
use strict;
use warnings;
use Data::Dumper;
# TODO: Do we need to replace letter with itself? I guess, no.
my %replacements = qw/s [S5$] e [E3]/;
# Each letter could be replaced in $max_count places
my $max_count = 2;
# Try positions up to $max_pos position
my $max_pos = 5;
my @letters = keys %replacements;
my @letters_counts = (0) x @letters;
sub generate_positions {
my $c = shift;
return [] if $c == 0;
my $mp = shift;
my @r;
for my $p ($c .. $mp) {
my @t = generate_positions($c - 1, $p - 1);
push @$_, $p for @t;
push @r, @t;
}
@r
}
# warn Dumper [generate_positions 2, 4];
# TODO: We don't replace all. Do that separately.
sub combine {
my $a = shift;
my $b = shift;
# warn Dumper $a, $b;
my @r;
# return @$a unless @$b;
for my $i (@$a) {
for my $j (@$b) {
push @r, [@$i, $j];
}
}
@r
}
while (1) {
# Print variants for given counts
my @rules = [];
# warn Dumper [@letters_counts];
for (0 .. $#letters) {
my $letter = $letters[$_];
my $replacement = $replacements{$letter};
my $count = $letters_counts[$_];
my @letter_rules;
if ($count > 0) {
my @positions = generate_positions($count, $max_pos);
# warn Dumper [$count, $max_pos, @positions];
for (@positions) {
# We use positions in back order so first replacement
# does not change numbers of others.
# TODO: We may exploit change and simplify rules:
# %2s op[S5$] %1s op[S5$] -> %1s op[S5$] %1s op[S5$]
push @letter_rules, join " ", map {
"%$_$letter op$replacement"
} reverse @$_;
}
@rules = combine [@rules], [@letter_rules];
}
}
# warn Dumper [@rules];
for (@rules) {
if ($#$_ == -1) {
print ":"
} else {
print join " ", @$_;
}
}
# Increase counts like: 0,0,0 -> 0,0,1 -> 0,0,2 -> 0,1,0
$letters_counts[$#letters_counts]++;
my $i = $#letters_counts;
for (; $i > 0 && $letters_counts[$i] > $max_count; $i--) {
$letters_counts[$i] = 0;
$letters_counts[$i - 1]++;
}
last if $i == 0 && $letters_counts[$i] > $max_count;
}