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