#!/usr/bin/perl -wT
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use Fcntl qw(:flock :seek);
use strict;

my $passfile = 'secure/.htpasswd';
print header;
print start_html("Registration Results");

my $username = param('username');
my $password = param('password');

# First, do some data validation.

# be sure the username is alphanumeric - no spaces or funny characters
# also, require it to be at least 3 chars long
if ($username !~ /^\w{3,}$/) {
    &dienice("Please use an alphanumeric username at least 3 letters long, with no spaces.");   
}

# be sure the password isn't blank or shorter than 6 chars
if (length($password) < 6) {
    &dienice("Please enter a password at least 6 characters
long.");
}

# now encrypt the password
my $encpass = &encrypt($password);

# open the password file for read-write
open(PASSF,"+<$passfile") or &dienice("Can't open password file.");
flock(PASSF, LOCK_EX);          # lock the file (exclusively)
seek(PASSF, 0, SEEK_SET);       # rewind to beginning
my @passf = <PASSF>;            # read entire file

# the structure of the htpasswd file is:
# username:passwd
# username:passwd
# ...etc., with each user's record on a separate line.
# here we're going to loop through and make sure the new username
# doesn't already exist in the htpasswd file.
foreach my $i (@passf) {
    chomp($i);
    my ($user,$pass) = split(/:/,$i);
    if ($user eq $username) {
       &dienice("The username `$username' is already in use. Please choose another.");
   }
}

# everything seems clear now, so append the info to the password file.
seek(PASSF, 0, SEEK_END);       # go to EOF
print PASSF "$username:$encpass\n";
close(PASSF);

print qq(<p>
You're now registered!  Your username is <b>$username</b>, and your 
password is <b>$password</b>.  Login <a href="secure/">here</a>.</p>\n);

print end_html;

sub encrypt {
    my($plain) = @_;
    my @salt = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
    return crypt($plain, $salt[int(rand(@salt))] . $salt[int(rand(@salt))] );
}

sub dienice {
    my($msg) = @_;
    print "<h2>Error</h2>\n";
    print $msg;
    exit;
}