#!/usr/bin/env perl

# Identify most common multi-character tokens in a wordlist or password list.
# Output two programs:
# 1. sed script to perform tokenization and output a fake pot file
# 2. external mode for John the Ripper to perform the reverse translation
# Intended usage is for training John the Ripper's incremental mode on a
# tokenized list (perhaps same as input to this script) and then running
# incremental mode along with the external mode generated by this script.
#
# Usage example:
#
# grep -v '^#!comment:' password.lst | ./tokenize.pl > john-local.conf
# sed -n 's/^# //p' john-local.conf > tokenize.sh
# grep -v '^#!comment:' password.lst | sh tokenize.sh > fake.pot
# ./john --pot=fake.pot --make-charset=custom.chr
# ./john --incremental=custom --external=untokenize --stdout --max-candidates=10
# ./john --incremental=custom --external=untokenize hashfile
#
# Copyright (c) 2024 Solar Designer
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted.
#
# There's ABSOLUTELY NO WARRANTY, express or implied.

use strict;
use warnings;

my $minlen = 2;
my $maxlen = 4;
my $maxtok = 158;

my %subcnt;
while (<>) {
	chomp;
	for (my $len = $minlen; $len <= $maxlen; $len++) {
		my $maxpos = length($_) - $len;
		for (my $pos = 0; $pos <= $maxpos; $pos++) {
			my $sub = substr($_, $pos, $len);
			# Disallow chars we currently can't encode for sed
			next if ($sub =~ '[\'/.*\\\]');
			$subcnt{$sub} += $len;
		}
	}
}

my @subtop = sort {$subcnt{$b} <=> $subcnt{$a}} keys %subcnt;

my @tokens;
foreach my $sub (@subtop) {
	$tokens[$#tokens + 1] = $sub;
	last if $#tokens >= $maxtok - 1;
}

my @subst;
for (my $c = 1; $c < 0x100; $c++) {
	$c++ if ($c == 0x0a || $c == 0x0d);
	$c = 0x7f if ($c == 0x20);
	$subst[$#subst + 1] = $c;
}

die("Error: No tokens found\n") if ($#tokens < 0);
die("Error: Too many tokens\n") if ($#tokens > $#subst);

my $sed = '/[^ -~]/d';
for (my $len = $maxlen; $len >= $minlen; $len--) {
	for (my $i = 0; $i <= $#tokens; $i++) {
		next if ($len != length($tokens[$i]));
		$sed .= '; ' . sprintf("s/$tokens[$i]/\\x%x/g", $subst[$i]);
	}
}

print qq`# sed '$sed; s/^/:/'

[List.External:Untokenize]
int mod[0x100];

void init()
{
	int i;

	i = -1;
	while (++i < 0x100)
		mod[i] = i;

`;

for (my $i = 0; $i <= $#tokens; $i++) {
	my $sub = $tokens[$i], my $c = $subst[$i], my $v = 0;
	for (my $pos = length($sub) - 1; $pos >= 0; $pos--) {
		$v = ($v << 8) | ord(substr($sub, $pos, 1));
	}
	printf("\tmod[%d] = 0x%x; // \"%s\" %d\n", $c, $v, $sub, $subcnt{$sub});
}

print q`}

void filter()
{
	int i, j, k, m, save[0x80];

	i = j = k = 0;
	while (save[i] = word[i])
		i++;

	while (m = mod[save[j++]]) {
		word[k++] = m;
		while (m >>= 8)
			word[k++] = m;
	}
	word[k] = 0;
}
`;
