path: root/makepass.pl

#!/usr/bin/env perl
#
# Author  : Dennis Eriksen <d@ennis.no>
# File    : makepass.pl
# Created : 2023-07-27
# License : BSD-3-Clause
#
# Copyright (c) 2018-2022 Dennis Eriksen • d@ennis.no

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;
    push( @strings, randstring(@chars) ) foreach ( 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;
    push( @indexes, rand( @{$arrh} ) ) foreach ( 1 .. PASS_NUM );
    join( '-', @{$arrh}[@indexes] );
}

say passphrase( \@wordlist ) foreach ( 1 .. PASS_NUM );