#!/usr/local/bin/perl

BEGIN {
#  $HOME = '/usr/local/lib/perl5/site_perl/MJD/';
  $HOME = '/home/mjd/public_html/cm/';
  $ERR = '/tmp/getpw.err';

  # This program was run because some file was protected.  We're going
  # to put a cookie password into the browser that is sent whenever
  # the browser attempts to access that file or a similar file again.
  # There are a couple of sources for the information about what area
  # we want the password to apply to.  One is the `Source'
  # command-line argument; another is the REDIRECT_URL environment
  # variable.  If neither is present, we'll say that the password
  # applies to everything under $DEFAULT_PROTECTED_AREA.

  $DEFAULT_PROTECTED_AREA = '/';

  # After the user fills out the password information, the program
  # will send them to another page.  If there's a `Next_URL' argument,
  # that is where they go.  Otherwise, if there was a `Source',
  # argument, they go there.  Otherwise, the program tries to get the
  # REDIRECT_URL variable from the server to find out where they came
  # from and send them back; if that doesn't work, it sends them to a
  # default URL, which you can set below:
  
  $DEFAULT_NEXT_URL = '/';

  # The program will put a cookie into the user's browser that has
  # their username and password.  The cookie can expire automatically
  # after a certain amount of time, or it can expire automatically
  # when the user shuts down their browser.  Set `EXPIRE_TIME' to the
  # number of days you want the cookie to last, or use 
  #    $EXPIRE_TIME = undef
  # to make cookies that disappear when the browser is shut down.
  # I changed this so that if the value of save_cookie is not set to Y
  # in the form the value of expirt time is set to undef.
  
 $EXPIRE_TIME = 900;             # 900 days
 #$EXPIRE_TIME = undef;		# Remainder of session only


 # $form_page = "/home/mark/apache/cgi-bin/login.tmpl";
   $form_page = "/home/mjd/public_html/cm/login.tmpl";

 # URL
 $VALIDATOR = "/~mjd/cm/nph-validcookie.cgi";

}

$ERR and open(STDERR, "> $ERR")
  or die "Couldn't write error log file `$ERR': $!; aborting";

use lib $HOME;
use CGI::MJDReadParse;
use CGI::MJDReply;
use CGI::MJDError;
use Text::Template;
require 'CGI/Tools.pl';

# Get command-line arguments into %ARGV.
%ARGV = ParseThis($ENV{QUERY_STRING});

($me = $0) =~ s:.*/::;
$Q::POST_URL = &exec_url($me);

# This is to tell us where to go back to after reading username and password.
# See configuration variable DEFAULT_NEXT_URL above for explanation.
$Q::NEXT_URL = 
    $ARGV{Next_URL} || 
    $ARGV{Source} || 
    $ENV{REDIRECT_URL} || 
    $DEFAULT_NEXT_URL;

# See configuration variable DEFAULT_PROTECTED_AREA above for explanation.
$Q::PROTECTED_URL =  
    $ARGV{Source} || 
    $ENV{REDIRECT_URL} || 
    $ENV{HTTP_REFERER} || 
    $DEFAULT_PROTECTED_AREA;

# trim off http://host/ if present.
$Q::PROTECTED_URL =~ s(^http://[^/]*/)(/);

	      

if ($ERR) {
  print STDERR "Environment:\n";
  foreach $var (sort keys %ENV) {
    print STDERR "  ENV: \$$var => $ENV{$var}\n";
  }
}

if ($ENV{REQUEST_METHOD} eq GET) {
  respond($form_page);
}

## We're in post mode, so we should read the form.
%in = ReadParse();

# These variables get set from the form this time.  The form entries
# are carrying over the information about where to go back to that we
# deduced from the server environment variables when we got here.
$Q::NEXT_URL = $NEXT_URL = $in{NEXT_URL};
$Q::PROTECTED_URL = $PROTECTED_URL = $in{PROTECTED_URL};

if ($ERR) {
  print STDERR "Form:\n";
  foreach $var (sort keys %in) {
    print STDERR "  in: \$$var => $in{$var}\n";
  }
}


if ($in{Username} eq '' && $in{Password} eq '') {
  respond($form_page);
} elsif ($in{Username} eq '') {
  $Q::MESSAGE = 'Sorry, you have to supply a username.';
  respond($form_page);
} elsif ($in{Password} eq '') {
  $Q::MESSAGE = 'Sorry, you have to supply a password.';
  respond($form_page);
} 

# I am uuencodeing the cookie values, so that the user will not 
# reconize there username and pw if they have the warn feature 
# turned on.

#my $user = pack "u15",$in{'Username'};
# my $pass = pack "u10",$in{'Password'};
my $user = $in{'Username'};
my $pass = $in{'Password'};
# chomp ($user, $pass);

# I am giving the user an option to not set a persistant
# Cookie, rather it disappears when they quit the browser

unless ($in{'save_cookie'} eq "Y"){
	$EXPIRE_TIME = undef;
}



# That guy who wrote the auth_cookie_msql module did it wrong.
# Instead of having two cookie crumbs like this
#    USER=username
#    PASSWORD=password
# he uses one crumb like this:
#    username=password
my $cookie = "$user=$pass";

if (defined($EXPIRE_TIME))  {
  my ($sec, $min, $hour, 
      $mday, $mon, $year, $wday, 
      $yday, $isdst) = 
     gmtime(time + $EXPIRE_TIME * 24 * 60 * 60); # $EXPIRE_TIME is in days.
  my @wday = qw(Sun Mon Tues Wednes Thurs Fri Satur);
  my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  $date = sprintf "$wday[$wday]day, %02d-$mon[$mon]-%02d %02d:%02d:%02d GMT",
	$mday, $year % 100, # Fuck you, Netscape
	$hour, $min, $sec;
  $ERR and print STDERR "Computed date: $date\n";
  $expire = "; expires=$date";
}

$validcookie_url = 
    &exec_url($VALIDATOR,
	      Cookie => $cookie,
	      Next_URL => $NEXT_URL,
	      Back_URL => &exec_url($me, %ARGV),
	      );

$reply = new_Redirect CGI::MJDReply $validcookie_url;
&error($CGI::MJDReply::ERROR) unless $reply;

$cookie_data = "$cookie; path=$DEFAULT_PROTECTED_AREA $expire";
$ERR and print STDERR "Cookie data: $cookie_data\n";

$reply->add_header('Set-Cookie' => $cookie_data);
print $reply->to_text();



exit 0;



sub respond {
  my $template_file = shift;
  my $package = shift || Q;
  my $response = new CGI::MJDReply;
  my $template = new Text::Template type => FILE, source => $template_file
      or &error("Couldn't construct template from file `$template_file': $Text::Template::ERROR.  Aborting.");
  my $text = $template->fill_in('package' => $package);
  unless (defined $text) {
    &error("Couldn't fill in template from file `$template_file': $Text::Template::ERROR.  Aborting.");
  }
  $response->body($text);
  $response->print();
  exit 0;
}