#! /usr/bin/env perl

=comment

Copyright (c) 2013, Perforce Software, Inc.  All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1.  Redistributions of source code must retain the above copyright
    notice, this list of conditions and the following disclaimer.

2.  Redistributions in binary form must reproduce the above copyright
    notice, this list of conditions and the following disclaimer in the
    documentation and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL PERFORCE SOFTWARE, INC. BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.



User contributed content on the Perforce Public Depot is not supported  
by Perforce, although it may be supported by its author. This applies  
to all contributions even those submitted by Perforce employees.

=cut

=comment

Sample Perforce external authentication trigger.

This program is both the auth-set and auth-check executable.  It stores
passwords in an admin-specified named file as a serialized Perl data structure,
e.g. '$pass.pl'.  It protects against concurrent access with a lock file,
'$pass.pl.lock'.  It logs to '$pass.pl.log'.

The administrator must first set a user's password before they can login
or change it on their own.

Usage:

1. First create an empty password file: `touch pass.pl`

2. Give a user their password:

    echo -e 'newpass\nnewpass' | \
    ./auth_trigger.pl auth-set the_new_user /p4/passwords.pl

3. Update the server's trigger table.  The %quote% is uncessesary if you
   don't have spaces in your path.

    p4 triggers -o | /bin/grep -v ^#

    Triggers:
       as auth-set   auth "%quote%/p4/auth_trigger.pl%quote% auth-set   %user% \
                           %quote%/p4/passwords.pl%quote%"

       ac auth-check auth "%quote%/p4/auth_trigger.pl%quote% auth-check %user% \
                           %quote%/p4/passwords.pl%quote%"

Note:  only tested on GNU/Linux.

Potential future additions:  record failed login attempts, throttling.

todo:  Determine if things will get too slow for a large site with lots of
       old passwords.  We might want to use separate files per-user.

$Author: jason_gibson $

=cut

use strict;
use warnings FATAL => 'all';
use autodie;
use Fcntl ':flock';
use File::Spec;
use File::Temp;
use Carp 'longmess';
use Data::Dumper;

my ( $mode, $user, $data ) = @ARGV;
my ( $in1 , $in2         ) = map { chomp; $_ } <STDIN>;

# Make sure the end-user sees something when the trigger definition is wrong.
print "Trigger config error." and exit 1
  if grep { ! defined $_ } $mode, $user, $data;

my $rcs_re = qr /^\$\S+: (.*) \$$/;

# Identify ourselves via RCS keywords.  This file must be +k for it to work.

'$File: //guest/jason_gibson/misc/triggers/auth_trigger.pl $' =~ $rcs_re;
my $trigger_path = $1;

'$Change: 8462 $' =~ $rcs_re;
my $trigger_version = $1;

# Note that STDERR doesn't always get sent back to the user.

sub logr {
  open my $fh, ">>$data.log";
  flock   $fh, LOCK_EX;
  print   $fh  ( scalar localtime ) . " $trigger_path\@$trigger_version: @_\n";
  close   $fh;
}

sub logrf { logr  @_     ; exit 1 }
sub fail  { print $_[ 0 ]; logrf "failure message for '$user': @_" }

#$SIG{ __DIE__ } = sub { my $e = "@_\n" . longmess; print $e; logrf $e };

# A generic message to send back to the user.
my $emsg = "auth-set trigger failed.  See server-side trigger logfile.";

logrf "Invalide mode '$mode'" if $mode !~ /^auth-(check|set)$/;

logrf "Data file must be specified with an absolute path."
  unless File::Spec->file_name_is_absolute( $data );

# To make sure the trigger isn't accidentally pointed at an invalid location.

logr "Password file '$data' missing!  Must already exist."
    and fail $emsg
        unless -e $data;

# Use the data file's dir so we can stick our temp files in the same place.

my ( $svol, $sdir, $sfile ) = File::Spec->splitpath( $data );
chdir File::Spec->catpath( $svol, $sdir );

open my $LOCK, ">$data.lock";
flock   $LOCK, $mode eq 'auth-set' ? LOCK_EX : LOCK_SH;

# The data structure is the list of user names, the current password, when
# it was set and the list of previously-used passwords.
#
# $d{ users }{ password => { string }, date => epoch, prior => { passwords } }

open my $DATA, "+<$data";
my %d = -s $data ? %{ eval do { local $/; <$DATA> } } : ();
logrf "eval failed: $@" if $@;
close $DATA;

# Note that for 'p4 passwd', the auth-check trigger is called first.  This is
# why the admin has to manually create the password the first time.

if( $mode eq 'auth-check' ) {
  my $pass = $in1;

  fail "Password is invalid or is unset."
    unless exists $d{ $user } and $d{ $user }{ password } eq $pass;

  # The password matches, but is it too old?  (a month)
  fail "Password expired." if time - $d{ $user }{ date } > 60 * 60 * 24 * 30;

  logr "$user logged in.";

  exit; # Success.
}

# auth-set from now on.

my ( $old, $new ) = ( $in1, $in2 );

goto SAVE unless exists $d{ $user };

fail 'Password not updated.  Old and new must differ.' if $old eq $new;
fail 'May not reuse password.' if exists $d{ $user }{ prior }{ $new };

my $strength = 0;
$strength++ if $new =~ /[a-z]/;
$strength++ if $new =~ /[A-Z]/;
$strength++ if $new =~ /[\W+]/;
$strength++ if length $new > 8;

fail 'Password strength is comparable to a wet noodle.' if $strength < 4;

SAVE: # the updates.

$d{ $user }{ prior    }{ $new } = 1;
$d{ $user }{ date     } = time;
$d{ $user }{ password } = $new;

my $tmp = File::Temp->new( TEMPLATE => "$data.tmp-XXXXXX",
			     UNLINK => 1, SUFFIX => '.pl' );

# Make the above eval easier by avoiding the default "$VAR ="
$Data::Dumper::Terse = 1;

print  $tmp Dumper \ %d;
close  $tmp;
rename $tmp, $data; # Subject to rename()'s limitations, notably on Windows.