#!/usr/bin/perl -wT
use strict;
use CGI;
use MD5;

# uncomment this for debugging only
#BEGIN {
#    $|++;
#    use CGI::Carp 'fatalsToBrowser';
#    print "Content-type: text/html\n\n";
#}

# security stuff
$CGI::DISABLE_UPLOADS = 0;  # enable uploads
$CGI::POST_MAX = 1024;      # limit the maximum upload size to 1MB
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
$ENV{'PATH'}   = 'usr/bin';

my $q = new CGI;
my $sess_life  = 300;                # sessions to expire 300 sec after login
my $dbmfile    = 'c:/dbmfile';       # location/name of session database file
my $homepage   = 'http://localhost/';
my $cgi_script = $homepage.'cgi-bin/session.cgi';
my $filepath   = 'c:/';              # protected dir outside web root
my $passfile   = 'c:/password.txt';  # needs to be the same a useradd script
my $salt       = 'aa';               # needs to be the same a useradd script

my $session_id = $q->param('id') || '';

if ( my @session_data = retrieve($session_id) ) {
    send_file(@session_data);
} elsif ( $q->param('login') ) {
    my $user = $q->param('username') || '';
    my $pass = $q->param('password') || '';
    die_error( 'Please enter a username and password!' ) unless $user and $pass;
    if ( check_valid_user($user,$pass) ) {
        # found a valid user so store session id
        my $session_id = MD5->hexhash(MD5->hexhash(time.{}.rand().$$));                
        store($session_id);
        display_files($session_id);
    } else {
        die_error( 'Invalid Login, please try again!' );
    }
} else {
    display_login_page(); # default to login page
} 

exit;

########################### subs ###########################

sub send_file {
    my $time_stamp = shift;
    die_error('Login expired, please login again') if time() > $time_stamp + $sess_life;
    my $filename = $q->param('file') || '';
    # untaint filename allowing alphanumerics _ . -
    ($filename) = $filename =~ m/^([\w.-]+)\z/;
    my @available_files = get_file_list($filepath);
    die_error("Invalid Filename $filename") unless grep{$filename eq $_}@available_files;
    my $filesize = -s $filepath.$filename;
    die_error("File '$filename' does not exist!") unless -e _;
    print "Content-disposition: attachment; filename=$filename\n";
    print "Content-Length: $filesize\n";
    print "Content-Type: application/octet-stream\n\n";
    my $buffer;
    open FILE, $filepath.$filename or die_error("Oops, can't open $filename $!");
    binmode FILE;
    binmode STDOUT;
    print $buffer while (read(FILE, $buffer, 4096));
    close FILE;
    # renew session life by doing another store() - overwrites old data
    store($session_id)
} 

sub get_file_list {
    my $dir = shift;
    opendir DIR, $dir or die_error("Can't read file dir!");
    my @files = grep { ! -d $dir.$_ and ! -l $dir.$_ } readdir DIR;
    closedir DIR;
  return @files;
}

sub check_valid_user {
    my ($user, $pass) = @_;
    $pass = crypt( $pass, $salt );  
    open PASS, $passfile or die_error("Can't validate password from file!");
    while( my $line = <PASS>) {
        chomp $line;
        if ( $line eq "$user:$pass" ) {
            close PASS;
          return 1; # found valid user
        }
    }
    # did not find valid username:password in file so exit with a false value
    close PASS;
  return 0; 
}

sub display_files {
    my $session_id = shift;
    my @files = get_file_list($filepath);
    my $links = qq'<p><a href="$homepage">Home Page</a>\n<p>';
    for my $filename (@files) {
       my $safename = $q->escape($filename);
       $links .= qq'<br><a href="$cgi_script?id=$session_id&file=$safename">$filename</a>\n';
    }
    my $body = "<h3>Click on the file you want to download</h3>\n" . $links;
    print page_template( 'Available Files', $body )
}

# returns list of data associated with a session_id
# returns false if $session_id does not exist
sub retrieve {
    my $session_id = shift;
  return () unless $session_id;
    my %sessions;
    dbmopen ( %sessions, $dbmfile, 0666 ) or die_error("Can't open db $!\n");
    my $data = exists $sessions{$session_id} ? $sessions{$session_id} : '';
    dbmclose %sessions;
  return split "\0", $data;
}

# store session id as key and time stamp (and concatenated data) as value
# no data is being store in this implementation
sub store {
    my ($session_id, @data) = @_;
    my %sessions;
    dbmopen ( %sessions, $dbmfile, 0666) or die_error("Can't open db $!\n");
    $sessions{$session_id} = join "\0", ( time(), @data );
    dbmclose %sessions;
}

sub display_login_page {
    my $body = qq'
    <h3>Login Page</h3>
    <form method="POST" action="$cgi_script">
        <input type="hidden" name="login" value="login">
        <p>Username <input type="text" name="username">
        <p>Password <input type="password" name="password">
        <p><input type="submit" name="submit" value="Login">
    </form>';
    print page_template( 'Login Page', $body );
}

sub die_error {
    my $error = shift;
    my $msg   = qq'
    <h3>Sorry!</h3>
    <p>$error<p>Click <a href="$cgi_script">here</a> to try again';
    print page_template( 'Sorry', $msg );  # print response to user
    # CGI.pm query_string method returns param value data for examination
    my $query_string = $q->query_string;
  die "$error\n$query_string\n" ;  # die so we log error in logs
} 

# use really basic page templating (plan for the future!)
sub page_template {
    my ($title, $body) = @_;
    # use CGI.pm's header method to send an expires now (no refresh header)
    my $header = $q->header( -type          => 'text/html',
                             -expires       => '-1d',
                             -Pragma        => 'no-cache',
                             -Cache-control => 'no-cache'
                           );
    my $html = <<HTML;
$header
<html>
<head>
  <title>$title</title>
</head>
<body>$body</body>
</html>
HTML

  return $html
}

__END__
# this is the useradd.pl script to write the password file
# to configure this:
# specify your password file (full path)
# select a $salt of 2 chars  for crypt()
# specify a minimum username/password length
# save as say 'useradd' in a dir in your path
# useage:
#   C:\> perl useradd

#!/usr/bin/perl -w
use strict;
my $passfile = 'c:/password.txt';
my $salt     = 'aa';
my $length   = 5;   # minimum length for username and password
print "Username: ";
chomp(my $user = <>);
print "Password: ";
chomp(my $pass = <>);
die "Invalid username or password, must be 5+ chars\n"
    if length $user < $length or length $pass < $length;
open PASS, ">>$passfile" or die "Can't open $passfile $!\n";
print PASS "$user:" . crypt ( $pass, $salt ) . "\n";
close PASS;
print "Entry for '$user' added to $passfile\n";