#!/s/std/bin/perl -w

use lib '/p/gems/public/perl';
use CGI qw/:standard :html3 :netscape/;
use POSIX 'strftime';
use Apache::Htgroup

# Configuration, etc.
$mydbfile = "/afs/cs.wisc.edu/u/g/i/gibson/public/access/registration.txt";
$mylogfile = "/afs/cs.wisc.edu/u/g/i/gibson/public/access/log.txt";
$mylockfile = "/afs/cs.wisc.edu/u/g/i/gibson/public/access/lock_file";
$groupfile = "/afs/cs.wisc.edu/u/g/i/gibson/public/access/.htgroup";

@status = (
"Student",
"Faculty",
"Academic Staff",
"Research Staff",
"Techical Staff",
"Other",
);

@type = (
"University",
"Not-for-profit Company",
"For-profit Company",
"Other",
);

# omit Password and cPassword from fields below so that plaintext password isn't stored
@fields = (
"Last Name",
"First Name",
"Status",
"Affiliation",
"Type",
"E-mail",
);

@req_fields = (
"Last Name",
"First Name",
"Status",
"Affiliation",
"Type",
"E-mail",
"Password",
"cPassword"
);

sub err {
    my($msg) = @_;

    print "INTERNAL ERROR: $msg<br>\n";
    die $msg;
}

print header;
print <<__XYZZY;
<!--#include virtual="begin.html" -->
<body text="#000000" bgcolor="#FFFFFF">
__XYZZY

if (defined param('action')) {

$_ = param('action');
 
  CASE: {
      /^getform/i and do { print_myform(); last CASE; };
      /^register/i and do {  
			verify_myform() and
                        log_entry() and
                        add_to_mydb() and
			print_accept();
                        last CASE; };
      /^i accept/i and do { 
                        add_to_mydb() and
			print_accept();
                        last CASE; };
      /^i reject/i and do { 
                        print_reject();
			last CASE; };
      default 
                        print_myform(); 
	
  }
}
else {
	print_myform();
};

print end_html;


sub print_myform
{
    my ($req) = "<font color=red>(*)</font>";
    print start_form(-method=>'post', -action=>'https://pages.cs.wisc.edu/~gibson/register.cgi');

    print "<H2>Registration Form</H2>";

    print "Please fill out the following information for access to source code. This information is used <i>only</i> to prevent academic misconduct. I (Dan Gibson) freely give permission to use/modify this source, provided you <i>will not</i> use this source code to fulfill the requirements of a class without written consent of the instructor.";  
    print br, br, "If any instructor feels my code may have been used for academic misconduct, I will gladly assist an investigation by providing pertinent access records.", br; 
  
    print br, strong('Please fill in the form below to register for restricted source access.'), 
      p,
      strong('Press the "register" button below when complete.');
      
      print br,"<i>Note: The password is for accessing the download page. Your e-mail address will serve as the username</i><br>"; 
      print p,
      "<table><tr><td>",
      "$req Last Name: ", "</td><td>",
      textfield( -size=>'15', -maxlength=>'20', -name=>"Last Name", 'lname'),
      "</td></tr>\n<tr><td>",
      "$req First Name: ","</td><td>",
      textfield( -size=>'15', -maxlength=>'20', -name=>"First Name", 'fname'),
      "</td></tr>\n<tr><td>",
      "$req Status: ","</td><td>",
      popup_menu(-name=>"Status",
			-default=>"Student",
               		-value=>\@status),
      "</td></tr>\n<tr><td>",
      "$req Affiliation: ","</td><td>",
      textfield( -size=>'40', -maxlength=>'60', -name=>"Affiliation", 'company'),
      "</td></tr>\n<tr><td>",
      "$req Affiliation Type: ","</td><td>",
      popup_menu(-name=>"Type",
			-default=>"University",
               		-value=>\@type),
      "</td></tr>\n<tr><td>";
      print "$req E-mail: ","</td><td>",
      textfield( -size=>'50', -maxlength=>'100', -name=>"E-mail", 'E-mail'),
      "</td></tr><tr><td>\n",
      "$req Password: ","</td><td>",
      password_field( -size=>'16', -maxlength=>'30', -name=>"Password", 'Password'),
      "</td></tr><tr><td>\n",
      "$req Confirm Password: ","</td><td>",
      password_field( -size=>'16', -maxlength=>'30', -name=>"cPassword", 'cPassword'),
      "</td></tr>",
      "</table>",
      p, "$req required entry\n",
      p,hr,p,


    submit(-name=>'action', -value=>'Register'),
    reset,
    end_form,
    hr;
}

sub verify_myform {
    my($form_ok) = 1;

    foreach (@req_fields)
    {
        if (param($_) eq '') {
	    print "Field '$_' is required, please use 'back' button and revise",
	    p;
	    $form_ok = 0;
	}
    }

    if (param('Password') ne param('cPassword')) {
	print h3("Error: passwords didn't match");
        return undef;
    }

    return $form_ok;
}

sub print_formdata
{
    my(@rows);

    foreach (@fields) {
	push(@rows,TR(th({-align=>LEFT},$_),td(param($_))));
	print hidden(-name=>$_);
    }

    print table(@rows);
}

sub make_passwd() {
    return(random_hash(8,12));
}

sub random_hash {
   my ($ash,$ml) = ('',((defined$_[0]&&$_[0]>0)?$_[0]:4));
   my $Ml=(defined$_[1]&&$_[1]>=$ml)?$_[1]:$ml+5;
   $ash .= ('.','/',0..9,'A'..'Z','a'..'z')[rand 64]
                   foreach(1..($ml+int(rand $Ml-$ml)));
   $ash;
}

sub send_password {
   my ($login,$password) = @_;
   my $msg = "";

   $msg = "/usr/ucb/Mail -s 'www.cs.wisc.edu/~gibson/restricted Password' -c warts $login << EOF\n";
   $msg .= "Here is your login information:\n";
   $msg .= "\tlogin: $login\n";
   $msg .= "\tpassword: $password\n";
   $msg .= "http://www.cs.wisc.edu/~gibson/restricted/\n";
   $msg .= "EOF\n";
   system($msg);

}

sub LOCK_SH {1}
sub LOCK_EX {2}
sub LOCK_UN {8}

sub print_accept {
	unless (open(FH,">>$mylockfile")) {
		print strong('Internal error: unable to open lock file'),p;
		return undef;
        }

	unless (flock(FH,LOCK_EX)) {
		print strong('Error: unable to acquire lockfile, try again later'),p;
		close(FH);
		return undef;
        }

	print "Thank you for registering. ",p;
	print "You may now access the download area at <a href=\"http://www.cs.wisc.edu/~gibson/restricted/ \"> http://www.cs.wisc.edu/~gibson/restricted/ </a>", p;

        my $password = param('Password');
        my $username = param('E-mail');

        print "Your username is the e-mail address you entered: ", $username;

 
        system("/s/std/bin/htpasswd -b /afs/cs.wisc.edu/u/g/i/gibson/public/access/.htpasswd $username $password");


        $htgroup = Apache::Htgroup->load($groupfile);
        $htgroup->adduser( $username, "ok-users");
        $htgroup->save;

	flock(FH, LOCK_UN);
	close(FH);

##	send_password(param('E-mail'), $password);
}

sub print_reject {
    print "You must complete registration before access will be granted.";
}

sub print_license {

    print start_form(-method=>'post', 
	   -action=>'https://www.cs.wisc.edu/~gibson/register.cgi');

    print strong("Please read the terms carefully."), p;
    print "By registering for access, you agree to use this source code in good faith, and in total compliance with academic misconduct policies any institutions you may be affiliated with.";

    print
	p,
    	submit(-name=>'action', -value=>'I Accept'),
	strong(" the terms and assert that the information submitted below is correct."),
	p,
    	submit(-name=>'action', -value=>'I Reject'),
	strong(" the terms."), p;

    print p, hr, h3("Submitted information\n"), p;
    print_formdata();
    print
	end_form,
	hr;

}


sub add_to_mydb 
{
	unless (open(FH,">>$mydbfile"))
	{
		print strong('Internal error: unable to open database file'),p;
		return undef;
	}
	unless (flock(FH,LOCK_EX)) {
		print strong('Error: unable to lock database file, try again later'),p;
		close(FH);
		return undef;
	}

	my $date = strftime('%D',localtime);
	my @row;
	push(@row,$date);
	push(@row,'	');
	foreach (@fields)
	{
		push (@row,param($_));
		push (@row,'	');
	}
	push (@row,param('action'));
	print FH @row;
	print FH "\n";

	flock(FH, LOCK_UN);
	close(FH);

	return 1;
}


sub log_entry
{
	unless (open(FH,">>$mylogfile"))
	{
		print strong('Internal error: unable to open log file'),p;
		return undef;
	}
	unless (flock(FH,LOCK_EX)) {
		print strong('Error: unable to lock log file, try again later'),p;
		close(FH);
		return undef;
	}

	my $date = strftime('%D',localtime);
	my @row;
	push(@row,$date);
	push(@row,'	');
	foreach (@fields)
	{
		push (@row,param($_));
		push (@row,'	');
	}
	print FH @row;
	print FH "\n";

	flock(FH, LOCK_UN);
	close(FH);

	return 1;
}