adding perl-script

1 files changed, 141 insertions, 0 deletions

diff --git a/makepass.pl b/makepass.pl
new file mode 100755
index 0000000..defe5fc
--- /dev/null
+++ b/makepass.pl
@@ -0,0 +1,141 @@
+#!/usr/bin/env perl
+#
+# Author  : Dennis Eriksen <d@ennis.no>
+# File    : makepass.pl
+# Created : 2023-07-27
+#
+
+use strict;
+use warnings;
+use v5.10.0;
+use feature qw(signatures);
+
+use constant {
+    NORM_NUM => 10,    # number of normal passwords
+    SPEC_NUM => 6,     # number of special passwords
+    PASS_NUM => 6,     # number of passphrases
+
+    MAX_LENGTH => 255, # max length of passwords
+    RANGE_MAX  => 42,  # max length when using random length
+    RANGE_MIN  => 8,   # min length when using random length
+    PASS_WORDS => 8,   # number of words in passphrases
+
+    LOWER => 'abcdefghijklmnopqrstuvwxyz',
+    UPPER => 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',
+    DIGIT => '0123456789',
+    OTHER => '!$%&#/()=?+-_,.;:<>[]{}|\@*',
+};
+
+my @lower = split //, LOWER;
+my @upper = split //, UPPER;
+my @digit = split //, DIGIT;
+my @other = split //, OTHER;
+my @alpha = ( @lower, @upper );
+my @alnum = ( @alpha, @digit );
+my @every = ( @alnum, @other );
+
+my $length = $ARGV[0] // $ENV{'MAKEPASS_DEFAULT_LENGTH'} // 0;
+my @normal =
+  $ENV{'MAKEPASS_NORMAL'}
+  ? split //, $ENV{'MAKEPASS_NORMAL'}
+  : ( @alnum, '-', '_' );
+my @special =
+  $ENV{'MAKEPASS_SPECIAL'}
+  ? split //, $ENV{'MAKEPASS_SPECIAL'}
+  : (@every);
+my $wordlist = $ENV{'MAKEPASS_WORDLIST'} || '/usr/share/dict/words';
+
+#
+# Some errorhandling
+#
+die "Length has to be a whole number between 0 and "
+  . MAX_LENGTH
+  . ". 0 means random length, and is the default."
+  if ( $length !~ /^[[:digit:]]+$/ || $length < 0 || $length > MAX_LENGTH );
+
+die "The file \"$wordlist\" does not exist" if ( !-f $wordlist );
+
+#
+# Seed rand with data from /dev/random
+#
+# This is probably not necessary, but I do this in makepass.zsh and I want the
+# scripts to match
+open( my $random, '<:raw', '/dev/random' ) or die $!;
+read( $random, my $bytes, 8 ) and close($random);
+
+# See https://perldoc.perl.org/functions/pack
+srand( unpack( "L", $bytes ) );
+
+#
+# Get screen width so we can print in pretty columns
+#
+# TODO: Native perl. Possible solutions:
+# - Term::ReadKey
+#     - not a builtin module. Needs installing everywhere.
+# - builtin module ioctl and posix-call `TIOCGWINSZ`.
+#     - does not work on all systemd. I.e. OpenBSD.
+my $width = `tput cols` || 80;
+chomp($width);    # remove \n at end of line
+
+#
+# Function to create random string
+#
+sub randstring (@chars) {
+    @chars = @normal if !@chars;
+    my $len = $length || int( rand( RANGE_MAX - RANGE_MIN ) + RANGE_MIN );
+    my $str;
+
+    for my $i ( 1 .. $len ) {
+        $str .=
+          ( $i == 1 || $i == $len )
+          ? $alnum[ rand @alnum ]
+          : $chars[ rand @chars ];
+    }
+
+    return $str;
+}
+
+#
+# Print in random strings in columns
+#
+sub print_columns ( $title, $num, @chars ) {
+    say "$title:";
+
+    my @strings = map { randstring(@chars) } 1 .. $num;
+
+    # Calculate the number of columns that can fit on the screen.
+    my $length =
+      ( $length || RANGE_MAX ) + 2;    # Add two for spacing between columns
+    my $columns = int( $width / $length ) || 1;    # Minimum 1 col
+
+    for my $i ( 1 .. $num ) {
+        printf "%-${length}s%s",
+          $strings[ $i - 1 ],
+          ( $i % $columns == 0 ) ? "\n" : "";
+        print "\n" if ( $i == $num && $i % $columns > 0 );
+    }
+    print "\n";
+}
+
+#
+# Print passwords
+#
+print_columns( "Normal passwords",                  NORM_NUM, @normal );
+print_columns( "Passwords with special characters", SPEC_NUM, @special );
+
+#
+# Print Passphrases
+#
+say "Passphrases:";
+open( FILE, "<", $wordlist ) or die("Can't open file");
+chomp( my @wordlist = <FILE> ) and close(FILE);
+
+#
+# Return passphrases
+#
+sub passphrase ($arrh) {  # Use array-handle to avoid copying large array around
+    my @indexes = map { rand( @{$arrh} ) } 1 .. PASS_NUM;
+    join( '-', @{$arrh}[@indexes] );
+}
+
+say passphrase( \@wordlist ) foreach ( 1 .. PASS_NUM );