This script is a much a demo of basic sessioning concepts as anything. This script has three 'modes':

1. Displays the login page if either no params are passed OR an invalid id param is passed
2. Accepts and validates a login. When a valid login is received you assign an encoded session id to the user. You will then pass this session id back to the browser embedded in the download links. These links call your cgi script with the filename of the desired file and the session id.
3. Finally we have a mode that checks for a valid session id and file request. If both the id and requested file are valid you send the file.

The directory in which you place the secure files should be outsied the root of you webserver and NOT WORLD READABLE.

Here is a skeleton of how this works.....

Update

Could not resist finishing it off as it seems this functionality is lacking. This script will now protect one dir for you. There is a second command line script at the end that is required to generate the encrypted username:password file.

#!/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 afte
+r login
my $dbmfile    = 'c:/dbmfile';       # location/name of session databa
+se 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_s
+tamp + $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 $fil
+ename $!");
    binmode FILE;
    binmode STDOUT;
    print $buffer while (read(FILE, $buffer, 4096));
    close FILE;
    # renew session life by doing another store() - overwrites old dat
+a
    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 fi
+le!");
    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 fals
+e 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=$safe
+name">$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 va
+lue
# 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 examinat
+ion
    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 he
+ader)
    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";
[download]

Note the session cache will continue to expand indefinately. Each session have a timestamp associated with it. You can see the access to this time in send_file() where we check if the session has expired. This ensures that even if the Display Files gets cached (some browsers ignore no-cache/expires directives) the access provided by the session id will be useless. You would need to write a cron job to periodically open the dbm file, check the timestamps and undef all the keys that have expired sessions.

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print