1 61b3aef3 2023-08-29 op #!/usr/bin/env perl
3 61b3aef3 2023-08-29 op # Copyright (c) 2022, 2023 Omar Polo <op@omarpolo.com>
4 61b3aef3 2023-08-29 op # Copyright (c) 2023 Alexander Arkhipov <aa@alearx.org>
6 ee89c9f1 2022-12-03 op # Permission to use, copy, modify, and distribute this software for any
7 ee89c9f1 2022-12-03 op # purpose with or without fee is hereby granted, provided that the above
8 ee89c9f1 2022-12-03 op # copyright notice and this permission notice appear in all copies.
10 ee89c9f1 2022-12-03 op # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11 ee89c9f1 2022-12-03 op # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12 ee89c9f1 2022-12-03 op # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13 ee89c9f1 2022-12-03 op # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14 ee89c9f1 2022-12-03 op # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15 ee89c9f1 2022-12-03 op # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16 ee89c9f1 2022-12-03 op # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
22 61b3aef3 2023-08-29 op use open ":std", ":encoding(UTF-8)";
24 61b3aef3 2023-08-29 op use Getopt::Long qw(:config bundling require_order);
25 61b3aef3 2023-08-29 op use File::Basename;
27 61b3aef3 2023-08-29 op my $urandom; # opened later
29 61b3aef3 2023-08-29 op my $chars = "\x20-\x7E";
31 61b3aef3 2023-08-29 op my $length = 32;
33 61b3aef3 2023-08-29 op my $me = basename $0;
35 8fa71bde 2023-08-30 op say STDERR "usage: $me [-an] [-w wordlist] [len]";
39 61b3aef3 2023-08-29 op # not really arc4random but closer...
40 61b3aef3 2023-08-29 op sub arc4random {
41 61b3aef3 2023-08-29 op my $r = read($urandom, my $buf, 4)
42 61b3aef3 2023-08-29 op or die "$me: failed to read /dev/urandom: $!\n";
43 61b3aef3 2023-08-29 op die "$me: short read\n" if $r != 4;
44 61b3aef3 2023-08-29 op return unpack('L', $buf);
47 61b3aef3 2023-08-29 op # Calculate a uniformly distributed random number less than $upper_bound
48 61b3aef3 2023-08-29 op # avoiding "modulo bias".
50 61b3aef3 2023-08-29 op # Uniformity is achieved by generating new random numbers until the one
51 61b3aef3 2023-08-29 op # returned is outside the range [0, 2**32 % $upper_bound). This
52 61b3aef3 2023-08-29 op # guarantees the selected random number will be inside
53 61b3aef3 2023-08-29 op # [2**32 % $upper_bound, 2**32) which maps back to [0, $upper_bound)
54 61b3aef3 2023-08-29 op # after reduction modulo $upper_bound.
55 61b3aef3 2023-08-29 op sub randline {
56 61b3aef3 2023-08-29 op my $upper_bound = shift;
58 61b3aef3 2023-08-29 op return 0 if $upper_bound < 2;
60 61b3aef3 2023-08-29 op my $min = 2**32 % $upper_bound;
62 61b3aef3 2023-08-29 op # This could theoretically loop forever but each retry has
63 61b3aef3 2023-08-29 op # p > 0.5 (worst case, usually far better) of selecting a
64 61b3aef3 2023-08-29 op # number inside the range we need, so it should rarely need
68 61b3aef3 2023-08-29 op $r = arc4random;
69 61b3aef3 2023-08-29 op last if $r >= $min;
71 61b3aef3 2023-08-29 op return $r % $upper_bound;
75 61b3aef3 2023-08-29 op "a" => sub { $chars = "0-9a-zA-Z" },
76 61b3aef3 2023-08-29 op "n" => sub { $chars = "0-9" },
77 61b3aef3 2023-08-29 op "w=s" => \$wordlist,
80 61b3aef3 2023-08-29 op $length = 6 if defined $wordlist;
81 61b3aef3 2023-08-29 op $length = shift if @ARGV;
82 61b3aef3 2023-08-29 op die "$me: invalid length: $length\n" unless $length =~ /^\d+$/;
84 61b3aef3 2023-08-29 op open($urandom, "<:raw", "/dev/urandom")
85 61b3aef3 2023-08-29 op or die "$me: can't open /dev/urandom: $!\n";
87 61b3aef3 2023-08-29 op if (not defined $wordlist) {
88 61b3aef3 2023-08-29 op my $pass = "";
89 61b3aef3 2023-08-29 op my $l = $length;
90 61b3aef3 2023-08-29 op while ($l >= 0) {
91 61b3aef3 2023-08-29 op read($urandom, my $t, 128)
92 61b3aef3 2023-08-29 op or die "$me: failed to read /dev/urandom: $!\n";
93 61b3aef3 2023-08-29 op $t =~ s/[^$chars]//g;
94 61b3aef3 2023-08-29 op $l -= length($t);
97 61b3aef3 2023-08-29 op say substr($pass, 0, $length);
101 61b3aef3 2023-08-29 op open(my $fh, "<", $wordlist) or die "$me: can't open $wordlist: $!\n";
103 61b3aef3 2023-08-29 op my @lines = (0);
104 61b3aef3 2023-08-29 op push @lines, tell $fh while <$fh>;
106 61b3aef3 2023-08-29 op while ($length--) {
107 61b3aef3 2023-08-29 op seek $fh, $lines[randline scalar(@lines)], 0
108 61b3aef3 2023-08-29 op or die "$me: seek: $!\n";
109 61b3aef3 2023-08-29 op my $line = <$fh>;
110 61b3aef3 2023-08-29 op chomp($line);
112 61b3aef3 2023-08-29 op print " " if $length;
