#!/usr/bin/perl -wT

=pod

=head1 NAME

passwdif - test a user's password and change it if it matches.

$Ringlet: perl/sys/passwdif/passwdif.pl,v 1.1 2004/06/02 09:38:23 roam Exp $

=head1 DESCRIPTION

The I<passwdif> utility may be used in non-interactive setups to allow users
to change their passwords.  When executed, it reads three lines from its
standard input: a username, the old password, and the new password.  If the
old password is valid for the specified user account, I<passwdif> uses the
method defined by the C<$passwd_method> variable (see the I<CONFIGURATION>
section below) to set the account's password to the one specified on the
third input line.

Before using I<passwdif>, make sure you have edited it to set the
configuration options, especially C<$passwd_method>.  In the future,
I<passwdif> will read its own configuration file, but for the present,
editing the source is the only way to change its settings.

=cut

use strict;

=head1 CONFIGURATION

=head2 --- START OF THE USER-CONFIGURABLE SECTION ---

=over 4

=item $passwd_method

Specify the method to use to change the user's password; one of:

=over 4

=item I<chpass>

Use the I<-p encryptedpass> option of I<chpass(8)> (BSD).

=item I<chpasswd>

Use I<chpasswd(8)> (Linux).

=item I<pw>

Use the I<-h fdnum> option of I<pw(8)> and send the password in plaintext
(BSD).

=item I<pw_enc>

Use the I<-H fdnum> option of I<pw(8)> and send the encrypted password (BSD).

=item I<usermod>

Use the I<-p encryptedpass> option of I<usermod(8)> (Linux).

=back

=cut

my $passwd_method = 'chpass';

=pod

=item $passwd_salt

Specify the password encryption method; one of I<des> or I<md5>.

=cut

my $passwd_salt = 'md5';

=pod

=item $check_child_status

If true, I<passwdif> attempts to wait for the child processes spawned and
returns an error if their exit status is non-zero.  You may need to turn
this off on some systems where C<wait()> in the C<reaper()> signal handler
returns -1, even though the signal handbler has obviously been invoked for
a received I<SIGCHLD> signal... go figure.

=cut

my $check_child_status = 1;

=pod

=back

=head2 --- END OF THE USER-CONFIGURABLE SECTION ---

=head1 INTERNAL VARIABLES

=over 4

=item %passwd_method_cmd

An associative array defining the program to use according to the setting of
C<$passwd_method> (see I<CONFIGURATION> above).  Each element is an array
reference.  If its first item is not the undefined value, I<passwdif> will
expand it and provide it (as a single line) on the standard input of the
command.  The second and subsequent items define the command to be executed
to change a user account's password.

The following substitutions are valid for both the input, the command, and
the arguments:

=over 4

=item * @USERNAME@

The username of the account which password should be changed.

=item * @PASS@

The plain-text password.

=item * @ENCPASS@

The password encrypted as specified by C<$passwd_salt> (see I<CONFIGURATION>
above) and C<%passwd_salt_fmt>.

=back

=cut

my %passwd_method_cmd = (
	'chpass'	=> [ undef, '/usr/bin/chpass', '-p', '@ENCPASS@',
			     '@USERNAME@' ],
	'chpasswd'	=> [ '@USERNAME@:@PASS@', '/usr/sbin/chpasswd' ],
	'pw'		=> [ '@PASS@', '/usr/sbin/pw', 'usermod',
			     '-n', '@USERNAME@', '-h', '0' ],
	'pw_enc'	=> [ '@ENCPASS@', '/usr/sbin/pw', 'usermod',
			     '-n', '@USERNAME@', '-H', '0' ],
	'usermod'	=> [ undef, '/usr/sbin/usermod', '-p', '@ENCPASS@',
			     '@USERNAME@' ],
);

=pod

=item %passwd_salt_fmt

The format for the randomly-generated salt used for encrypting the new
password for the account.  A I<@number@> sequence denotes the specified
number of random alphanumeric characters to use.

=cut

my %passwd_salt_fmt = (
	'des'		=> '@2@',
	'md5'		=> '$1$@8@$',
);

=pod

=item $child_waited

The process ID of the child reaped by the C<reaper()> I<SIGCHLD> handler if
C<%check_child_status> is true (see I<CONFIGURATION> above).

=item $child_status

The exit status of the C<$child_waited> child process.

=cut

my ($child_waited, $child_status);

=pod

=back

=head1 FUNCTIONS

=over 4

=item MAIN

The main routine - reads in the username, old and new passwords, then invokes
C<check_passwd()> and C<set_passwd()> as necessary.

=cut

MAIN:
{
	my ($uname, $oldpass, $newpass);

	if (!defined($uname = <>) || !defined($oldpass = <>) ||
	    !defined($newpass = <>)) {
		die("Not enough input parameters.\n");
	};
	chomp($uname);
	chomp($oldpass);
	chomp($newpass);
	if ($uname =~ /^([\w\d._-]+)$/) {
		$uname = $1;
	} else {
		die("Invalid format for the username\n");
	}
	# We'll accept anything for the password (yeah, yeah, I know...)
	if ($oldpass =~ /^(.*)$/) {
		$oldpass = $1;
	}
	if ($newpass =~ /^(.*)$/) {
		$newpass = $1;
	}
	if (!&check_passwd($uname, $oldpass)) {
		die("Incorrect password specified.\n");
	}
	if (!&set_passwd($uname, $newpass)) {
		die("Could not set the new password.\n");
	}
	exit(0);
}

=pod

=item check_passwd($username, $password)

Check if the password is valid for the specified user account.

=cut

sub check_passwd($ $)
{
	my ($username, $password) = @_;
	my ($enc, @data);

	@data = getpwnam($username);
	if ($#data == -1) {
		die("Could not look up the account data for '$username'\n");
	}
	print "RDBG got password '$data[1]'.\n";
	$enc = crypt($password, $data[1]);
	print "RDBG enc is ".crypt($password, $data[1])."\n";
	return $enc eq $data[1];
}

=pod

=item set_passwd($username, $password)

Change the password of the specified user account.

=cut

sub set_passwd($ $)
{
	my ($username, $password) = @_;
	my ($salt, $enc, $i, $pid, $k, $status);
	my (@tmp, @cmd, %data);

	if (!defined($passwd_method)) {
		die("Password change method not specified!\n");
	}
	if (!defined($passwd_method_cmd{$passwd_method})) {
		die("Unsupported password change method!\n");
	}
	$salt = &generate_salt();
	$enc = crypt($password, $salt);
	print "RDBG generated encrypted password '$enc'\n";
	%data = ( 'USERNAME', $username, 'PASS', $password, 'ENCPASS', $enc);
	@tmp = @{$passwd_method_cmd{$passwd_method}};
	foreach $i (@tmp[1..$#tmp]) {
		foreach $k (keys %data) {
			$i =~ s/\@$k\@/$data{$k}/g;
		}
		push @cmd, $i;
	}
	print "RDBG password change command: ".join(' ', @cmd)."\n";
	if (defined($tmp[0])) {
		foreach $k (keys %data) {
			$tmp[0] =~ s/\@$k\@/$data{$k}/g;
		}
		print "RDBG need to supply input: ".$tmp[0]."\n" if (defined($tmp[0]));
	}
	$child_waited = -2;
	$SIG{'CHLD'} = \&reaper;
	if (!defined($pid = open(PW, '|-'))) {
		die("fork: $!\n");
	} elsif ($pid == 0) {
		$ENV{'PATH'} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin';
		delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
		exec(@cmd) or die("exec: $!\n");
	}
	print PW $tmp[0]."\n" if (defined($tmp[0]));
	close PW;
	while ($child_waited == -2) {
		print "RDBG waiting for child_waited...\n";
		sleep(1);
	}
	if ($child_waited == -1) {
		die("Could not get the status of child process $pid: $!\n");
	} elsif ($child_waited != $pid) {
		die("Could not wait for child: got $child_waited, expected $pid\n");
	}
	print "RDBG got status $child_status from pid $child_waited\n";
	return $child_status == 0;
}

=pod

=item generate_salt()

Generate a salt after the pattern specified by C<$passwd_salt> and
C<%passwd_salt_fmt> variables.

=cut

sub generate_salt()
{
	my ($salt, $pat, $i);

	if (!defined($passwd_salt) ||
	    !defined($pat = $passwd_salt_fmt{$passwd_salt})) {
		die("Password salt generation method not specified!\n");
	}
	print "RDBG using salt pattern '$pat'\n";
	$salt = '';
	while ($pat =~ /^(.*?)\@(\d+)\@(.*)/) {
		my ($prev, $num, $rest) = ($1, $2, $3);
		$salt .= $prev;
		for ($i = 0; $i < $num; $i++) {
			$salt .= chr(64 + int(rand(63)));
		}
		$pat = $rest;
	}
	$salt .= $pat;
	print "RDBG using salt '$salt'\n";
	return $salt;
}

=pod

=item reaper()

A I<SIGCHLD> reaper.

=cut

sub reaper()
{
	$child_waited = wait();
	$child_status = $?;
}

=pod

=back

=head1 BUGS

=over 4

=item *

The I<SIGCHLD> reaper fails on some versions of Linux: C<wait()> returns -1
with C<$!> set to "No child processes".

=item *

Configuration file parsing is needed - editing I<passwdif> itself to change
the configuration settings is, well, suboptimal ;)

=back

=head1 AUTHORS

The I<passwdif> utility was written by Peter Pentchev <roam@ringlet.net>.

=cut