#!/usr/bin/env perl
# mkpass --- prompt for cleartext password and echo crypted result
# Author: Noah Friedman <friedman@splode.com>
# Created: 1993-09-26
# Public domain

# $Id: mkpass,v 1.10 2010/08/25 19:36:01 friedman Exp $

# Commentary:
# Code:

use strict;
use Getopt::Long;
use POSIX;

$^W = 1;  # enable warnings

my $progname;
($progname = $0) =~ s|.*/||;

my $salt;
my $cost;
my $method;
my $interactivep;

my %crypt_salt
  = ( des    => { prefix => '',
                  len    => 2,
                },

      md5    => { prefix => '$1$',
                  len    => 8,
                },

      # glibc 2.7 and later
      sha256 => { prefix => '$5$',
                  len    => sub { 16 }, # default, but exact not required
                },

      # glibc 2.7 and later
      sha512 => { prefix => '$6$',
                  len    => sub { 16 }, # default, but exact not required
                },

      # NetBSD, FreeBSD, Solaris 9 and later
      bsdbf  => { prefix => '$2a$',
                  len    => 16,
                  cost   => \&bsdbf_cost,
                  encode => \&base64_encode,
                },

      # Solaris.  See /etc/security/crypt.conf
      # The salt can be arbitrarily long for this implementation, but the
      # function fails on larger salts as the number of rounds increases.
      sunmd5 => { prefix => '$md5$',
                  len    => sub { 16 },  # default, but exact not required
                  cost   => sub { sprintf ("rounds=%d\$", $_[0] || 904) },
                  encode => sub { $_[0] . '$dummy' },
                },
    );

my $opt_methods = join ("|", sort keys %crypt_salt);

sub usage
{
  print STDERR "Usage: $progname {options} {cleartext}

Options are:
-D, --debug                  Enable debugging.
-h, --help                   You're looking at it.
-i, --interactive            Prompt for input and confirmation even if
                             standard input is not a terminal.

-s, --salt     SALT          Use SALT to encode cleartext.
                             Default is to generate a random sequence.
                             SALT should be a 2-letter sequence for DES
                             style encryption, an 8-letter sequence
                             optionally prefixed by \`\$1\$' for MD5 style,
                             Or a 16-letter sequence for SHA256/SHA512.

-c, --cost     COST          \"Cost\" (e.g. number of rounds) for some algorithms.
                             This is only used for some algorithms,
                             e.g. \`bsdbf' or \`sunmd5'.

-m, --method   [$opt_methods]
                             Choose an encryption algorithm.
                             Default depends on supplied SALT, or \`des'
                             if no salt is supplied.
--[$opt_methods]	Use corresponding method.

If cleartext is not specified on the command line, it will be prompted for
interactively.  Specifying the cleartext on the command line is less secure
since someone may be able to see it with the \`ps' command.
You can also feed the cleartext password as input using a pipe.\n";
  exit (1);
}

sub diag
{
  print STDERR join (": ", $progname, @_), "\n";
}

sub parse_options
{
  $interactivep = -t STDIN;

  Getopt::Long::config ('bundling', 'autoabbrev');
  GetOptions ("s|salt=s",      \$salt,
              "c|cost=i",      \$cost,
              "m|method=s",    \$method,
              (map { $_, sub { $method = $_[0] }, } keys %crypt_salt),
              "i|interactive", \$interactivep,
              "h|help",        \&usage);

  $method = (defined $salt
             ? (length ($salt) < 3
                ? 'des'
                : 'md5')
             : 'des')
    unless defined $method;

  unless (exists $crypt_salt{$method})
    {
      diag ($method, "Unknown encryption method.");
      exit (1);
    }
}

sub input_noecho
{
  my ($prompt) = @_;
  my $tty;
  my $c_lflag;
  my %trap_sigs = ( HUP  =>  1,
                    INT  =>  2,
                    QUIT =>  3,
                    TERM => 15);
  my %sig_orig;
  my $fd = fileno (STDIN);

  # If stdin is a tty, disable echo while reading password.
  if (-t STDIN)
    {
      $tty = POSIX::Termios->new;
      $tty->getattr ($fd);
      $c_lflag = $tty->getlflag;

      # Set up handlers to restore tty on typical signals
      my $restore = sub {
        $tty->setlflag ($c_lflag);
        $tty->setattr ($fd);
        my $signum = $trap_sigs{$_[0]};
        print STDERR "\n";
        diag ("Exiting on signal $signum (SIG$_[0])");
        # 7th bit set indicates lower 6 bits represent a
        # signal number (0x80 == 2**7)
        exit (0x80 | $signum);
      };
      map { $sig_orig{$_} = $SIG{$_} || 'DEFAULT';
            $SIG{$_} = $restore
          } keys %trap_sigs;

      $tty->setlflag ($c_lflag & ~&POSIX::ECHO);
      $tty->setattr ($fd);
    }

  # Temporarily disable buffering on stderr, which is where prompt is printed.
  my $fh_orig = select (STDERR);
  my $stderr_bufp = $|;
  $| = 1;
  $prompt = "Password:" unless defined $prompt;
  print $prompt;
  my $input = <STDIN>;
  chomp $input if defined $input;
  $| = $stderr_bufp;
  select ($fh_orig);

  # Restore echo afterward, if it was originally on;
  # and restore signal handlers
  print STDERR "\n" if $interactivep;
  if ($tty)
    {
      $tty->setlflag ($c_lflag);
      $tty->setattr ($fd);
      map { $SIG{$_} = $sig_orig{$_} } keys %trap_sigs;
    }

  return $input;
}

sub gensalt
{
  my $saltlen = shift;
  $saltlen = &$saltlen if (ref $saltlen eq 'CODE');

  my $sc = './0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  my $sclen = length ($sc);

  join ("", map { substr ($sc, (1 + int (rand () * 100000)) % $sclen, 1) }
                (1 .. $saltlen));
}

sub base64_encode
{
  local $_ = pack ("u", $_[0]);
  s/^.//mg;              # remove first char of each line
  s/\n//g;               # remove newlines
  tr|` -_|AA-Za-z0-9+/|; # `# help emacs
  my $padding = (3 - length($_[0]) % 3) % 3;   # pad end
  s/.{$padding}$/'=' x $padding/e if $padding;
  return $_;
}

sub bsdbf_cost
{
  my $c = $_[0] || 8;

  if ($c < 4 || $c > 63)
    {
      diag ($c, "Cost out of range [04, 63]");
      exit (1);
    }

  sprintf ("%02d\$", $c);
}

sub crypt_with_method
{
  my ($method, $pass, $salt) = @_;

  my $prefix  = $crypt_salt{$method}->{prefix};
  my $saltlen = $crypt_salt{$method}->{len};
  my $encfn   = $crypt_salt{$method}->{encode};
  my $costfn  = $crypt_salt{$method}->{cost};

  if ($costfn)
    {
      if (ref $costfn eq 'CODE')
        {
          $prefix .= &$costfn ($cost);
        }
      else
        {
          $prefix .= $costfn;
        }
    }

  if (! defined $salt) { $salt = gensalt ($saltlen)  }
  else                 { $salt =~ s/^\$.*?\$//       }

  if (!ref $saltlen && length ($salt) != $saltlen)
    {
      diag ("salt \"$salt\" is not $saltlen characters as required for \"$method\" hash.");
      exit (1);
    }

  $salt = &$encfn ($salt) if defined $encfn;
  $salt = $prefix . $salt;

  my $result = crypt ($pass, $salt);
  if (! defined $result
      || (length $result == 13
          && substr ($result, 0, length $prefix) ne $prefix))
    {
      diag ("error", "$method hashes not supported, or some overflow occured.");
      exit (1);
    }
  return $result;
}

sub main
{
  parse_options;

  my $pass;
  if (defined $ARGV[0])
    {
      $pass = shift @ARGV;
    }
  elsif ($interactivep)
    {
      while (1)
        {
          $pass     = input_noecho ("Password:");
          my $pass2 = input_noecho ("Confirm password:");
          exit (1) unless defined $pass2;
          last if $pass eq $pass2;
          diag ("Input mismatch; please try again.\n");
        }
    }
  else
    {
      $pass = <STDIN>;
      exit (1) unless defined $pass;
      chomp $pass;
    }

  print crypt_with_method ($method, $pass, $salt), "\n";
}

main (@ARGV);

# mkpass ends here