moth

mktokens

 1#!/usr/bin/perl
 2### GAH PERL NOOOOOOO
 3use strict;
 4use warnings;
 5
 6use Getopt::Std;
 7use vars qw( $VERSION @VOWELS @CONSONANTS );
 8
 9$VERSION = '1.0';
10
11# Digest::BubbleBabble from Benjamin Trott, cpan@stupidfool.org
12@VOWELS     = split //, q{aeuioy};
13@CONSONANTS = split //, q{bcdfghklmnprstvzx};
14
15sub bubblebabble {
16    my ($input) = @_;
17	my @dgst = map { ord } split //, $input;
18    my $dlen = length $input;
19
20    my $seed = 1;
21    my $rounds = int($dlen / 2) + 1;
22    my $retval = 'x';
23    for my $i (0..$rounds-1) {
24        if ($i+1 < $rounds || $dlen % 2) {
25            my $idx0 = ((($dgst[2 * $i] >> 6) & 3) + $seed) % 6;
26            my $idx1 =   ($dgst[2 * $i] >> 2) & 15;
27            my $idx2 =  (($dgst[2 * $i] &  3) + $seed / 6) % 6;
28            $retval .= $VOWELS[$idx0] . $CONSONANTS[$idx1] . $VOWELS[$idx2];
29            if ($i+1 < $rounds) {
30                my $idx3 = ($dgst[2 * $i + 1] >> 4) & 15;
31                my $idx4 =  $dgst[2 * $i + 1] & 15;
32                $retval .= $CONSONANTS[$idx3] . q/-/ . $CONSONANTS[$idx4];
33                $seed = ($seed * 5 + $dgst[2 * $i] * 7 +
34                                     $dgst[2 * $i + 1]) % 36;
35            }
36        } else {
37            my $idx0 = $seed % 6;
38            my $idx1 = 16;
39            my $idx2 = $seed / 6;
40            $retval .= $VOWELS[$idx0] . $CONSONANTS[$idx1] . $VOWELS[$idx2];
41        }
42    }
43    $retval .= 'x';
44    return $retval;
45}
46# --- END
47
48sub readch {
49	my ($chars, $fh) = @_;
50	my $retval = '';
51	sysread $fh, $retval, $chars;
52	return $retval;
53}
54
55sub usage {
56	my ($msg) = @_;
57	print <<'EOB';
58Usage: mktokens [options] count
59    -c    category name
60    -s    size of token hash [default: 8]
61EOB
62	die "\n[x] $msg\n" if $msg;
63	exit 0;
64}
65
66my $count = 1;
67my $size  = 8;
68my $cat   = '';
69
70my %options=();
71getopts('c:s:h', \%options);
72usage('not enough arguments!') unless scalar @ARGV > 0;
73usage() if $options{h};
74
75$cat   = "$options{c}:1:" if $options{c} and $options{c} =~ m/\A ([[:alnum:]_-]+) \Z/msix;
76$size  = $options{s}      if $options{s} and $options{s} =~ m/\A (\d+)            \Z/msix;
77$count = $ARGV[0]         if $ARGV[0]    and $ARGV[0]    =~ m/\A (\d+)            \Z/msix;
78
79open my $fh, '<', '/dev/urandom';
80print {*STDERR} "[+] Generating $count token", ($count > 1 ? 's' : ''), " [$size bytes of entropy]", $cat ? " with prefix '$cat'" : '', $/;
81print $cat, bubblebabble(readch($size, $fh)), $/ for (1 .. $count);
82close $fh;