#!/usr/bin/perl

##############################################################
#
# verify.pl
# password assignment script
#
# written by Duc M. Do (ducdo@mis.net) to automate the process
# of adding a user to a password-protection scheme using
# .htaccess with ODBM.
#
##############################################################
#
# COPYRIGHT NOTICE:
#
# Copyright ©1998 Duc M. Do. All rights reserved.
#
# This script file is being distributed as freeware. It may
# be used and modified by anyone, so long as this copyright
# notice and the header above remain intact. By using this
# script file, you agree to indemnify the author, Duc M. Do,
# from any liability.
#
# Selling the code for this script file without prior written
# consent is expressly forbidden. Please obtain permission
# before redistributing this script file over the Internet
# or by any other medium. In all cases, the copyright notice
# and header must remain intact.
#
##############################################################
#
# The protection scheme is fairly basic:
#
# - Force the user to log in before giving him access to the
#   'add' script (using ODBM .htaccess and .htpasswd)
# - If the user has not registered before, ask for his name
#   and e-mail address. Check his name against the list of
#   authorized users (in $allowed).
# - If it's not in there, he is rejected. (He needs to contact
#   the webmaster to be added to the list.)
# - If his name is on the authorized list, he is assigned a
#   new password, which is sent to his e-mail address, subtly
#   checking to make sure that he is who he claims to be. Add
#   his name, email address and password to the list of
#   registered users in ODBM .htpasswd.
#
# If everything is okay, let him go on to access the
# protected directory.
#
# For more information about ODBM .htaccess protection scheme,
# see:
#
#   http://www.mit.edu:8001/perl/DB_File.html
#
##############################################################
#
# Revision History:
#
#  3/14/98  v0.01  Original concept and script
#  4/21/98  v0.02  clean up and add the DBM htpasswd scheme
#  4/25/98  v0.90  final working script
#  4/30/98  v1.00  first version for public use
#
##############################################################

# define variables

# $thiscgi contains the name of this script file.
$thiscgi = "verify.cgi";

# $cgiurl contains the full URL for this script file up to, but not
# including, the trailing slash of the directory where this script
# resides.
$cgiurl = "http://www.foo.com/username/cgi-bin";

# $cgidir contains the full path name of the directory where this
# script resides. Do not include the trailing slash.
$cgidir = "/home/users/username/cgi-bin";

# $allowed points to a simple text file that contains the names of
# authorized users. Leave this variable undefined ($allowed = "";)
# if you don't need to limit access to a certain group of people.
# In other words, if you allow access to everybody.
$allowed = "/home/users/username/cgi-bin/allowusers.txt";

# the next two variables define the template header and footer for
# the script-generated HTML files.
$HeaderFile = "/home/users/username/files/header.txt";
$FooterFile = "/home/users/username/files/footer.txt";

# $prot_action is the text used to describe the password-protected
# resource.
$prot_action = "Special Secret Script";

# $prot_dir and $prot_cgi together specify the full path name of
# the script or resource which the .htaccess authorization scheme
# protects
$prot_dir = "/home/users/username/cgi-bin/protdir";
$prot_cgi = "scriptname.cgi";

# the next two variables define parameters for sending e-mail to
# the users (for sending them the script-generated passwords).
$mailprog = '/usr/lib/sendmail';
$admin = "youremail\@address.com";

# If you want to be copied on the password e-mails, assign 1 to
# $admin_cc; otherwise, make it 0 and you won't be bothered.
$admin_cc = 1;


##############################################################
# Nothing needs to be modified below this point
##############################################################

# use cgi-lib.pl
require ("cgi-lib.pl");

print "Content-type: text/html\n\n";

# parse the form data
&ParseForm;

# Create the form for them to use the first time the script executes
if (!$FORM{'action'}) {
	&Header;
	&RegForm;
	&Footer;
}
elsif ($FORM{'action'} eq "register") {
	if (!$FORM{'name'}) {
		&Missing("You forgot to enter your name (firstname lastname)!");
	}
	if (!$FORM{'email'}) {
		&Missing("You must enter an e-mail address!");
	}
	if (!&check_email($FORM{'email'})) {
		&Missing("You must enter a VALID e-mail address!");
	}
	if ($allowed) { &CheckAuth; }
	if ($authorized || !$allowed) {
		&GenPass;		# generate a password ...
		&SendPass;		# and send it to him/her
		&AddUser;		# and add him to the list
		&Header;
		print "<h1>Thank You, $FORM{'name'}!</h1>\n";
		print "<hr size=2>\n\n";
		print "Thank you for registering for \“$prot_action\” ";
		print "capability. Your username and password have been ";
		print "sent to <i>$FORM{'email'}</i>.\n\n";
		print "<p>Please check your e-mail for your new password. ";
		print "You can <a href=\"$prot_dir/$prot_cgi\">click here</a> ";
		print "when you’re ready to log in using your new password.\n";
		&Footer;
	}
}
exit;

##############################################################
# subroutine to read the filled-in log-in form
##############################################################
sub ParseForm{
	if ($ENV{'REQUEST_METHOD'} eq 'POST') {
		# Get the input
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
 
		# Split the name-value pairs
		@pairs = split(/&/, $buffer);
      
		#determine name and variable for each pair
		foreach $pair (@pairs) {
			($name, $value) = split(/=/, $pair);
			$value =~ tr/+/ /;
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
			$value =~ s/<!--(.|\n)*-->//g; 	#removes any SSI
			$value =~ s/[;><&\*`\|]//g; 	#removes dangerous characters
			$value =~ s/^\s+//;		#remove any leading spaces
			$value =~ s/\s+$//;		#remove any trailing spaces
			$FORM{$name} = $value;
		}
	}
}

##############################################################
# subroutine to generate the registration form
##############################################################
sub RegForm {
	print <<"(END HTML)";
	<p>
	<hr size=2>
	<p>
	<h1>User Registration for \“$prot_action\”</h1>
	<p>
	<p>
	<form method="POST" action="$cgiurl/$thiscgi">
	<input type=hidden name="action" value="register">
	<table border=0 cellspacing=1 cellpadding=1>
	<tr valign=top>
	   <td align=right>
	   Name:
	   <td align=left>
	   <input type=text name="name" size=30>
	<tr valign=top>
	   <td align=right>
	   E-mail address:
	   <td align=left>
	   <input type=text name="email" size=30>
	<tr valign=top>
	   <td>
	   <td align=left>
	   <input type=submit value=" Register ">
	   <input type=reset  value=" Clear ">
	</table>
	</form>

(END HTML)
}

##############################################################
# generic error message 
##############################################################
sub Missing {
	local($MsgText) = $_[0];
	&Header;
	print "<H2>ERROR - $MsgText</H2>\n";
	print "<hr size=2>\n";
	print "<p>An error occurred while processing your request. ";
	print "Please use the BACK button to return to the form, ";
	print "make sure all the fields are filled in and try again.\n";
	&Footer;
	exit;
}

##############################################################
# generic routine to verify valid email address format
##############################################################
sub check_email {
	$email = $_[0];
	if ($email =~ /(@.*@)|(\.\.)|(@\.)|(^\.)/ ||
        $email !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) 	{
		return 0;
	}
	else {
		return 1;
	}
}

##############################################################
# subroutine to generate a 6-character password
##############################################################
sub GenPass {
	# the characters to use for generating password,
	# we don't want to use o/0 and l/1 to avoid confusion
	@chars=("a".."k","m","n","p".."z",2..9);
	$password = "";
	for ($i=1;$i<=6;$i++) { $password .= $chars[rand(@chars)]; }
	$salt = substr($FORM{'email'},0,2);
	$enc_password = crypt($password,$salt);

	# we also create a user name for him from the first part
	# of his e-mail address
	($username,$domain) = split (/\@/,$FORM{'email'})
}

##############################################################
# subroutine to send the user the newly-generated password
##############################################################
sub SendPass {
	$email = $FORM{'email'};
	open (MAIL, "| $mailprog -t") || &FileError("$mailprog");
	print MAIL "To: $email\n";
	print MAIL "From: $admin\n";
	if ($admin_cc) { print MAIL "Cc: $admin\n"; }
	print MAIL "Subject: Your Registration\n\n";
	print MAIL "Thank you, $FORM{'name'}, for registering for ";
	print MAIL "the \“$prot_action\” capability. Following is ";
	print MAIL "your access information. Please save it for ";
	print MAIL "future reference!\n\n";
	print MAIL "-----------------------------\n";
	print MAIL "      Username: $username\n";
	print MAIL "      Password: $password\n";
	print MAIL "-----------------------------\n\n";
	print MAIL "You can now use this username and password ";
	print MAIL "to access the protected resource. ";
	print MAIL "($cgiurl/add/)\n\n";
	print MAIL "Please contact the webmaster ($admin) if you have ";
	print MAIL "any question.\n\n";
	print MAIL "Regards,\n";
	close (MAIL);
}

##############################################################
# subroutine to add the user and his password to the .htpasswd file
##############################################################
sub AddUser {
	use ODBM_File;
	require ODBM_File;
	$O_RDWR = 02;
	$O_CREAT = 0100;
	$O_RDONLY = 00;

	tie(%HTPASSWD, ODBM_File, "$prot_dir/.htpasswd", $O_RDWR|$O_CREAT, 0644);
	$HTPASSWD{$username} = $enc_password;
	untie %HTPASSWD;                    
}

##############################################################
# subroutine to check a new user against list of authorized users
##############################################################
sub CheckAuth {
	$authorized = 0;
	open (AUTHLIST,"$allowed") || &FileError("$allowed");
	@authusers = <AUTHLIST>;
	close (AUTHLIST);
	foreach $name (@authusers) {
		chomp $name;
		if (lc($FORM{'name'}) eq lc($name)) {
			$authorized = 1;
			last;
		}
	}
	if (!$authorized) {
		&Header;
		print "<h1>Unauthorized!</h1>\n";
		print "<hr size=2>\n\n";
		print "<p>Your name is not on the list of authorized ";
		print "users for \“$prot_action.\” Please contact the ";
		print "<a href=\"mailto:$admin\">webmaster</a> to be ";
		print "added to the list of authorized users.\n\n";
		print "<p>Thank you!\n\n";
		&Footer;
	}
}

##############################################################
# subroutine to create the header for the HTML files
##############################################################
sub Header {
	if ($HeaderFile) {
		open (HEADER,"$HeaderFile");
		@header = <HEADER>;
		close (HEADER);
		foreach $line (@header) { print "$line"; }
	}
}

##############################################################
# subroutine to create the footer for the HTML files
##############################################################
sub Footer {
	if ($FooterFile) {
		open (FOOTER,"$FooterFile");
		@footer = <FOOTER>;
		close (FOOTER);
		foreach $line (@footer) { print "$line"; }
	}
}

##############################################################
# file operation error
##############################################################
sub FileError {
	$file_name = $_[0];
	&Header;
	print "<h1>File Operation Error!</h1>\n";
	print "<hr size=2>\n";
	print "<p>There is an error accessing $file_name.\n\n";
 	print "<p>Please contact the ";
	print "<a href=\"mailto:$admin\">webmaster</a> for assistance.\n\n";
	print "<p>Thank you!\n\n";
	&Footer;
	exit(0);
}