#! /usr/bin/perl -w

# Change a DCC end-user's password

# Copyright (c) 2003 by Rhyolite Software
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND RHYOLITE SOFTWARE DISCLAIMS ALL
# WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL RHYOLITE SOFTWARE
# BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES
# OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
#	Rhyolite Software DCC 1.2.16-1.3 $Revision$
#	Generated automatically from chgpasswd.in by configure.

# This file must protected with an equivalent to httpd.conf lines
#   in the README file.

use strict 'subs';
use 5.004;
use Fcntl qw(:DEFAULT :flock);


sub emsg {
    my($msg) = html_str_encode(@_);

    return "<P class=warn>$msg";
}



# get DCC parameters
local($DCC_HOMEDIR, $DCCM_USERDIRS, $user);
do('/var/www/dcc-bin/common') || die("could not get DCC configuration: $!\n");

$WEBUSERS="$DCC_HOMEDIR/$DCCM_USERDIRS/webusers";
$WEBUSERS_LOCK="$WEBUSERS.lock";

$PREQ="The password must be 4 or more characters.";

get_query();

$passwd1 = $query{passwd1} ? $query{passwd1} : "";
$passwd2 = $query{passwd2} ? $query{passwd2} : "";

$form_start = "form.passwd1";
if (!$query{passwd1}) {
    $result_msg = html_str_encode($PREQ);

} elsif (length($passwd1) < 4) {
    $result_msg = emsg($PREQ);

} elsif ($passwd1 =~ /'/) {
    $result_msg = emsg("Quotes are not allowed in passwords.");

} elsif (!$query{passwd2} || $passwd1 ne $passwd2) {
    $result_msg = emsg("The two copies of the password do not match.");
    $form_start = "form.passwd2";

} else {
    $result_msg = "";
    # use a separate lock file in case htpasswd actually does some locking
    #	of its own
    if (!sysopen(LOCKFH, "$WEBUSERS_LOCK", O_WRONLY | O_CREAT)) {
	$result_msg = emsg("open($WEBUSERS_LOCK): $!");
    } elsif (!flock(LOCKFH, LOCK_EX | LOCK_NB)) {
	$result_msg = emsg("$WEBUSERS_LOCK busy: $!\nTry again");
	close(LOCKFH);
    } else {
	open(CMD, "htpasswd -b $WEBUSERS '$user' '$passwd1' 2>&1 |");
	if (!read(CMD, $result_msg, 1000)) {
	    $result_msg = emsg("read(htpasswd): $!");
	    close(CMD);
	} else {
	    close(LOCKFH);
	    if (!close(CMD)) {
		$result_msg = ($! ? "$result_msg\nclose(htpasswd): $!"
			       : "$result_msg\nhtpasswd exit status $?");
		$result_msg = emsg($result_msg);
	    } else {
		close(LOCKFH);
		punt("password changed", $passwd1);
	    }
	}
	close(LOCKFH);
    }
}

$result_msg =~ s/^\s+//;
$result_msg =~ s/\s+$//;
$result_msg =~ s/\n/<BR>\n/g;

html_head("Change DCC Password for $user", $form_start);

print <<EOF;
<H3>Change DCC Password for <EM>$user</EM></H3>
<P>
<FORM action="$ENV{SCRIPT_NAME}" name=form method=POST>
    <TABLE border=0 cellspacing=0 cellpadding=0>
    <TR><TD><LABEL for=passwd1>Password</LABEL>
	<TD><INPUT tabindex=1 id=passwd1 type=password name=passwd1 maxlength=12
	    value="$passwd1">
	<TD><LABEL for=passwd2>Repeat</LABEL>
	<TD><INPUT tabindex=2 id=passwd2 type=password name=passwd2 maxlength=12
	    value="$passwd2">
    <TR><TD><INPUT tabindex=3 type=submit value="Submit">
    </TABLE>
</FORM>
<P>
$result_msg
<P>
If the password is acceptable,
it will be changed and you will be asked to log in.
<P>
EOF

common_buttons();

print <<EOF;
</BODY>
</HTML>
EOF
