#!/usr/bin/perl -T
#
# dropbox v2
# Copyright (C) 2004, 2005 Doke Scott, doke at udel dot edu
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# $Header: /usr/local/home/doke/work/dropbox/RCS/dropbox.cgi,v 1.7 2005/01/03 22:58:09 doke Exp $


my $title = "SullivanCC Drop Box";

my $insiders_formal = "Sullivan Computer Consulting";
my $insiders_short = "SCC";
my $insiders_domain = "sullivan.cc";

my $dropbox_dir = "/usr/local/dropbox";
my $log = "$dropbox_dir/dropbox.log";
my $retention = 3;   # days to keep dropbox files

my $auth_expiration = 900;   # seconds 
my $auth_require_ssl = 0;   # require ssl connection for login
my $auth_secret = "5fbfacc1119600d0c799173909af49bc";  # Change this!
# secret came from: dd if=/dev/random bs=1024 count=1 | md5sum

my $ldap_host_1 = "127.0.0.1";  # server to try first
my $ldap_host_2 = "127.0.0.1";  # try this one if can't connect to first
my $ldap_base = "cn=users,dc=sullivan,dc=cc";
my $ldap_require_tls = 1;   # require ssl connection to ldap server

my $verbose = 0;

#my $trace = '';

$ENV{PATH} = "/usr/bin;/usr/sbin";

############################

use strict;
use CGI qw/:standard -nosticky/;
use Digest::MD5  qw(md5_base64);
use Net::LDAP;

my $username = undef;
my $from_email = undef;
my $auth_authed = 0;
my $logging_out = 0;
my( $using_ssl, $q, $state );


#############################

my $http_host = $ENV{HTTP_HOST};    # this includes :port
my $http_user_agent = $ENV{HTTP_USER_AGENT};
my $script_name = $ENV{SCRIPT_NAME};
my $request_uri = $ENV{REQUEST_URI};
my $remote_addr = $ENV{REMOTE_ADDR};
my $server_name = $ENV{SERVER_NAME};  # server hostname

$using_ssl = ( length $ENV{ SSL_SESSION_ID } >= 64 ) ? 1 : 0;

if ( ! open( lH, ">>", $log ) ) {
    print "Content-type: text/plain\n\n";
    print "error: unable to open log: $!\n";
    exit 1;
    }
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst )
    = localtime( time );
my $nowstr = sprintf "%04d.%02d.%02d_%02d:%02d:%02d", 
    $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
&log( "dropbox starting $nowstr $remote_addr $request_uri" );

$q = new CGI;



# page flow 3: drop and pickup are context sensitive
# top main menu
#     drop off inbound form
#         dropped inbound
#     pickup outbound form
#         pickup outbound info
#             pickup outbound download
#     logged in menu
#         drop off in/out form
#             dropped in/out
#         pickup list
#         pickup in/out form
#             pickup in/out info
#                 pickup in/out download
#         logout

&auth_check();   

$state = $q->param( 'state' );

if ( $state eq 'pickup_download' ) {
    &pickup_download();   
    }
elsif ( $state eq 'logout' && $auth_authed ) {
    &auth_logout();
    }

&fancy_header();

if ( $state eq 'drop' ) {
    &drop();
    }
elsif ( $state eq 'drop2' ) {
    &drop2();
    }
elsif ( $state eq 'pickup' ) {
    &pickup();   
    }
elsif ( $state eq 'pickup_list' && $auth_authed ) {
    &pickup_list();
    }
elsif ( $state eq 'pickup_info' ) {
    &pickup_info();   
    }
elsif ( $state eq 'member_menu' || $auth_authed ) {
    &member_menu();
    }
else {
    &top_menu();
    }

&http_footer();
exit 0;


###################################


sub fancy_header { 
    my( $cookie, $cookie_val );

    if ( $auth_authed ) { 
	$cookie_val = &auth_generate_cookie( $username );
	#$trace .= " cookie_val $cookie_val";
	$cookie = $q->cookie( -name => 'dropbox_session',
	    -value => $cookie_val,
	    -expires => '+15m',
	    -secure => 1 );
	#$trace .= " cookie $cookie";
	}
    elsif ( $logging_out ) { 
	$cookie_val = "logged_out";
	$cookie = $q->cookie( -name => 'dropbox_session',
	    -value => "logged_out",
	    -expires => 'now',
	    -secure => 1 );
	}
    else { 
	undef $cookie;
	}

    print $q->header( 
	    -expires => 'now',
	    -cookie => $cookie,
	    );
#	$q->start_html(
#	    -title => $title,
#	    -BGCOLOR => '#ffffff',
#	    -leftmargin => '0',
#	    -topmargin => '0',
#	    -marginwidth => '0',
#	    -marginheight => '0',
#	    -cookie => $cookie,
#           -style=>{'src'=>'/styles/style.css'},
#	    );

	print qq{<html>
<head>
<title>$title</title>
</head>
<body>
};


    if ( $auth_authed ) { 
	print qq{
Welcome $username.
You may 
<a href="https://$http_host$script_name?state=drop">drop</a>,
<a href="https://$http_host$script_name?state=pickup">pickup</a>,
<a href="https://$http_host$script_name?state=pickup_list">list files</a>,
<a href="https://$http_host$script_name?state=logout">logout</a>.
<hr>
<p>
};
	}



    if ( $verbose ) { 
	my( $name );
	my( @names ) = $q->param;
	print "names:<br>\n";
	foreach $name ( @names ) {
	    print "$name ", $q->param( $name ), "<br>\n";
	    }
	#print "<p>trace '$trace'\n";
	print "<p>\n";
	}

    }





sub http_footer { 
    print "<p><hr><p>Sullivan Computer Consulting Ltd.\n",
	$q->end_html, 
	"\n";
    }




sub top_menu {
    if ( $auth_authed ) { 
	&member_menu();
	return;
	}

    print qq{
<p>
If you are a $insiders_formal user, you may 
<ul>
<li><a href="https://$http_host$script_name?state=member_menu">login</a>
    to access restricted features.
</ul>
<p>
Other people may either:
<ul>
<li><a href="https://$http_host$script_name?state=drop">drop off</a> 
    (upload) a file for a $insiders_formal user, or 
<li><a href="https://$http_host$script_name?state=pickup">pick up</a> 
    (download) a file left for them by a $insiders_short user.
</ul>
};
    }



sub member_menu {
    if ( ! $auth_authed ) { 
	&auth_login();   # doesn't return;
	}

    print qq{ 
<p>
You may:
<ul>
<li><a href="https://$http_host$script_name?state=drop">drop off</a> 
    (upload) a file for anyone ($insiders_short or other),
<li><a href="https://$http_host$script_name?state=pickup_list">see a list</a>
    of files left for you, or 
<li><a href="https://$http_host$script_name?state=pickup">pickup</a>
    (download) a file left for you.
<li><a href="https://$http_host$script_name?state=logout">logout</a> 
    of dropbox.
</ul>
};
    }





sub drop {
    my( $from_name, $from_org, $from_mail );

    if ( $auth_authed ) { 
	print qq{
<p>
This web page will allow you to drop off (upload) a file for anyone (either
$insiders_short or others).  They will receive an automated email with the
information you enter below and instructions for downloading the file.

<p>
};
	}
    else { 

	print qq{
<p>
This web page will allow you to upload a file for a $insiders_formal user.  They
will receive an automated email with the information you enter below and
instructions for downloading the file.  Your IP address will be logged and
sent to the recipient.

<p>
};
	}


    # CGI.pm's form creation stuff puts in a lot of extra kruft
    # and it tries to hang onto values

    print $q->start_multipart_form();

    print qq{<input type=hidden name=state value=drop2>\n};
    print qq{<table>\n};


    if ( $auth_authed ) { 
	$from_name = $username;
	$from_org = $insiders_formal;
	$from_mail = "$username\@$insiders_domain";
	}
    else { 
	$from_name = '';
	$from_org = '';
	$from_mail = '';
	}

    print qq{ 
<tr><td>From:</td><td></td><td></td></tr>
<tr><td></td><td>Your Name:</td><td><input type=text name=from_name size=30 value="$from_name"> <i>(required)</i></td></tr>
<tr><td></td><td>Your Organization:</td><td><input type=text name=from_org size=30 value="$from_org"></td></tr>
<tr><td></td><td>Your eMail: </td><td><input type=text name=from_email size=30 value="$from_mail"> <i>(required)</i></td></tr>

};




    print qq{
<tr><td>To:</td><td></td><td></td></tr>
<tr><td></td><td>Their Name: </td><td><input type=text name=to_name size=30></td></tr>
};

    if ( $auth_authed ) { 
	print qq{
<tr><td></td><td>Their eMail: </td><td><input type=text name=to_email
    size=30 value=""> <i>(required)</i></td></tr>
};
	}

    else { 
	print qq{
<tr><td></td><td>Their $insiders_short eMail: </td><td><input type=text 
    name=to_email size=30 value="\@zoology.ubc.ca"> 
    <i>(required, and must be in the form username\@$insiders_domain)</i></td>
    </tr>
};
	}


    print qq{
<tr><td>File:</td><td></td><td></td></tr>
<tr><td></td><td>File pathname<br>on your system:
    </td><td><input id="file_name" name="file_name" size="50" type="file"> <i>(required)</i></td></tr>
<tr><td></td><td>Brief description: </td><td><input type=text name=file_desc size=30></td></tr>
<tr><td></td><td><input type=submit name=upload value=upload></td><td></td></tr>
</table>

</form>

<p>
<hr>
<p>
};

    if ( $auth_authed ) { 
	print qq{
<a href="https://$http_host$script_name?state=member_menu">$insiders_short 
    menu</a>
};
	}
    else { 
	print qq{
<a href="https://$http_host$script_name?state=top_menu">top menu</a>
};

	}
    }








sub drop2 {
    my( $from_name, $from_org, $from_email, $to_name, $to_email,
	$file_name, $file_desc, $to_username, $file_length, $nonce,
	$sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst,
	$id, $lock_link, $control_file, $data_file, $pickup_url,
	$subject, $body, $len, $ufH, $buf, $key, $upload_info,
	$file_content_type, $to_domain, $n, $drop_date, $file_basename, 
	$passcode );

    $from_name = $q->param( 'from_name' );
    $from_org = $q->param( 'from_org' );
    $from_email = $q->param( 'from_email' );
    $to_name = $q->param( 'to_name' );
    $to_email = lc $q->param( 'to_email' );
    $file_name = $q->param( 'file_name' );
    $file_desc = $q->param( 'file_desc' );

    &log( "drop from $from_name $from_org $from_email,"
	. " to $to_name $to_email, file $file_name" );

    if ( ! $from_name || ! $from_email || ! $to_email || ! $file_name ) {
        &log_print( "Error: Required parameter missing.  Please click back"
	    . " and fill in the missing data." );
	return;
	}

    if ( $to_email !~ m/^([a-z][a-z0-9\._-]*)\@(\w[\w\d\.-]*)$/ ) {
        &log( "invalid to_email '$to_email'" );
	sleep 1;   # keep them from guessing too fast
	print( "error: to_email must be of the form 'username\@domainname'."
	    . "  The username must start with a letter, and contain"
	    . " only letters, numbers, periods, underscores, and hyphens." );
	return;
	}
    $to_username = $1;   # de-taint
    $to_domain = $2;   # de-taint
    $to_email = "$1\@$2";   # de-taint

    if ( $to_domain eq $insiders_domain  ) { 
	# dropping for an insider
	#if ( ! &verify_username( $to_username ) ) {
	    # it will log it's own error messages
	    #print "Warning: unknown user '$to_username'";
	    #return;
	    #}
	}
    elsif ( ! $auth_authed ) { 
	print "You must be an authenticated $insiders_formal user to drop a 
	    file for an outsider.";
	return;
	}

    $passcode = sprintf "%x", 1 + int rand 0x7ffffffe;
	# don't want it to be zero

    if ( ! $file_name ) {
        &log_print( "error: no file name" );
	return;
	}

    $ufH = $q->upload( 'file_name' );
    if ( ! $ufH ) {
        &log_print( "error: no file uploaded" );
	return;
	}

    $upload_info = $q->uploadInfo( $file_name );
    if ( $verbose ) { 
	print "<p>upload info:<br>\n";
	foreach $key ( keys %$upload_info ) {
	    print "'$key' '", $upload_info->{ $key }, "'<br>\n";
	    }
	print "<p>\n";
	}

    # find an unused id number
    $n = 0;
    while ( 1 ) {
	$id = sprintf "%x", 1 + int rand 0x7ffffffe;
	    # don't want it to be zero
	$lock_link = "$dropbox_dir/$id.lock";
	if ( ! -e $lock_link )  {
	    $control_file = "$dropbox_dir/$id.control";
	    if ( ! -e $control_file ) {
		if ( symlink( $$, $lock_link ) ) {
		    last if ( readlink( $lock_link ) eq $$ );
		    }
		}
	    }
	if ( ++$n >= 1000 ) {
	    &log_print( "Error: Unable to obtain dropbox lock." );
	    return;
	    }
	};

    if ( ! open( cfH, '>', $control_file ) ) {
	&log_print( "Error: Unable to create control file: $!" );
	unlink $lock_link;
	return;
	}
    chmod 0600, $control_file;

    # copy the file
    $data_file = "$dropbox_dir/$id.data";
    if ( ! open( dfH, '>', $data_file) ) {
	&log_print( "Error: Unable to create data file: $!" );
	close cfH;
	unlink $control_file;
	unlink $lock_link;
	return;
	}
    chmod 0600, $data_file;
    $file_length = 0;
    while ( ( $len = read( $ufH, $buf, 1048576 ) ) > 0 ) {
	print dfH $buf;
	$file_length += $len;
	}
    if ( ! close dfH ) {
	&log_print( "Error: Unable to write data file: $!" );
	close cfH;
	unlink $data_file;
	unlink $control_file;
	unlink $lock_link;
	return;
	}

    ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst )
	= localtime( time );
    $drop_date = sprintf "%04d.%02d.%02d %02d:%02d:%02d", 
	$year + 1900, $mon + 1, $mday, $hour, $min, $sec;

    $file_content_type = $upload_info->{ 'Content-Type' };
    $file_content_type = "application/octet-stream" if ( ! $file_content_type );

    $file_basename = $file_name;
    $file_basename =~ s!.*\\([^\\])!$1!;   # stupid windows filenames
    #$file_basename =~ s!.*/([^/])!$1!;    # unix browsers only send basename?


    # write control file info
    print cfH "id $id\n";
    print cfH "drop_date $drop_date\n";
    if ( $auth_authed ) { 
	print cfH "drop_authed $auth_authed\n";
	print cfH "drop_authed_by $username\n";
	}
    print cfH "passcode $passcode\n";
    print cfH "from_name $from_name\n";
    print cfH "from_org $from_org\n";
    print cfH "from_email $from_email\n";
    print cfH "from_ip $remote_addr\n";
    print cfH "to_name $to_name\n";
    print cfH "to_email $to_email\n";
    print cfH "data_file $data_file\n";
    print cfH "file_name $file_name\n";
    print cfH "file_basename $file_basename\n";
    print cfH "file_length $file_length\n";
    print cfH "file_content_type $file_content_type\n";
    print cfH "file_desc $file_desc\n";
    if ( ! close cfH ) {
	unlink $data_file;
	unlink $control_file;
	unlink $lock_link;
	&log_print( "Error: Unable to write control file: $!" );
	return;
	}

    unlink $lock_link;
    &log( "successfully saved file $id, $file_basename, $file_length bytes" );

    # let them know it worked
    $pickup_url = "https://$http_host$script_name?state=pickup_info&id=$id";

    print qq{<p>File successfully uploaded and saved.<br>
It will be held for $retention days (unless we run low on disk space).<br>
<p>
File name is '$file_basename'.<br>
File content type is '$file_content_type'.<br>
File length is $file_length bytes.<br>
File description is '$file_desc'.<br>
<p>
Pickup claim id is <a href="$pickup_url">$id</a>.
<p>
Pickup passcode is $passcode.
<p>
};

#Pickup url is <a href="$pickup_url">$pickup_url</a>

    # send the email notice to recipient
    $subject = "dropbox $from_name $from_email $file_basename";
    $subject =~ tr/'//;
    $subject =~ m/(.*)/;
    $subject = $1;

    $body = qq{    $from_name $from_email has dropped off a file for you
named $file_basename.

    You may pick up this file within 3 days at:

$pickup_url

    You will need the claim passcode '$passcode' 
    to retrieve the file.  

Additional info:
    claim id: $id
    claim passcode: $passcode
    drop date $drop_date
    from name: $from_name
    from org: $from_org
    from email: $from_email
    from ip: $remote_addr
    to name: $to_name
    to email: $to_email
    file basename: $file_basename
    file length: $file_length
    file content_type: $file_content_type
    file desc: $file_desc

};

    &email( $to_email, $from_email, $subject, $body );

    }






sub email_mailx {
    my( $email_addr, $from_email, $subject, $body ) = @_;
    my( $cmd, $rc );

    # this stuff is so specific to mailx, and so interrelated, 
    # that it doesn't make sense to make config variables for it at the top.
    $ENV{postmark} = "$insiders_short Drop Box";
    $subject =~ tr/'/ /;
    $cmd = "| /usr/bin/mail -s '$subject' $email_addr";

    if ( ! open( mH, $cmd ) ) {
        &log_print( "error sending email, unable to start mail: $!" );
        return;
        }

    print mH $body, "\n";
    close mH;
    $rc = $? >> 8;
    if ( $rc ) {
        &log_print( "error sending email, mail returned $rc: $!" );
	return;
        }

    &log_print( "eMail successfully sent to $email_addr" );

    }



sub email {
    my( $email_addr, $from_email, $subject, $body ) = @_;
    my( $cmd, $rc, $server_username, $from );

    $cmd = "| /usr/sbin/sendmail -t ";

    if ( ! open( mH, $cmd ) ) {
        &log_print( "error sending email, unable to start mail: $!" );
        return;
        }

    $server_username = getpwuid( $> );
    $from = qq{"$insiders_short Drop Box" <$server_username\@$server_name>};

    print mH "To: $email_addr\n";
    print mH qq{From: $from_email\n};
    print mH "Subject: $subject\n";
    print mH "\n", $body, "\n";
    print mH ".\n";
    close mH;
    $rc = $? >> 8;
    if ( $rc ) {
        &log_print( "error sending email, sendmail returned $rc: $!" );
	return;
        }

    &log_print( "eMail successfully sent to $email_addr" );

    }





sub pickup {
    my( $id );

    $id = lc $q->param( 'id' );

    print qq{
<p>
Please enter the claim id and claim passcode.  
};

    if ( $auth_authed ) { 
	print qq{
<p>
Since you are logged in, you may 
not need the passcode, it depends on how the sender dropped off the file.  
If they gave you a passcode, enter it, otherwise you can leave it 
blank.
};
	}
    print qq{
<p>
<form method=POST>
<input type=hidden name=state value=pickup_info>
<table>
<tr><td>Claim id:</td><td><input type=text name=id size=12 value="$id"></td></tr>
<tr><td>Claim passcode:</td><td><input type=text name=passcode size=12 
    value=""></td></tr>
<tr><td></td><td><input type=submit name=pickup value="pickup"></td></tr>
</table>
</form>
};

    }





sub pickup_list {
    my( %data, $file, $key, $val, %control_params, $nids, $id, $pickup_url );
    my( $to_email );

    if ( ! opendir( dH, $dropbox_dir ) ) {
	&log_print( "Error: Unable to diropen dropbox dir: $!" );
	return;
	}
    $to_email = "$username\@$insiders_domain";
    undef %data;
    while ( $file = readdir( dH ) ) {
	next unless ( $file =~ m/^([\da-f][\da-f_]+)\.control$/i );
	$id = $1;

	if ( ! open( fH, '<', "$dropbox_dir/$file" ) ) {
	    &log_print( "Error: Unable to open control file $file: $!" );
	    return;
	    }
	while ( <fH> ) {
	    chomp;
	    ( $key, $val ) = split( /\s+/, $_, 2 );
	    $control_params{ $key } = $val;
	    }
	close fH;

	$verbose && print "$id '$control_params{ to_email }' <br>\n";
	next if ( $control_params{ to_email } ne $to_email );

	$data{ $id }{ from_name } = $control_params{ from_name };
	$data{ $id }{ from_email } = $control_params{ from_email };
	$data{ $id }{ file_basename } = $control_params{ file_basename };
	$data{ $id }{ file_length } = $control_params{ file_length };
	$data{ $id }{ file_desc } = $control_params{ file_desc };

	}
    closedir dH;

    $nids = scalar keys %data;
    print "There are $nids claim ids for your username\n";

    return if ( $nids < 1 );

    print qq{
<table border=1>
<tr>
    <th>pickup id</th>
    <th>from name</th>
    <th>from email</th>
    <th>file name</th>
    <th>file length</th>
    <th>file description</th>
</tr>
};

    foreach $id ( sort keys %data ) {
	$pickup_url = "https://$http_host$script_name?state=pickup_info&id=$id";
	print qq{
<tr>
    <td><a href="$pickup_url">$id</a></td>
    <td>$data{$id}{from_name}</td>
    <td>$data{$id}{from_email}</td>
    <td>$data{$id}{file_basename}</td>
    <td>$data{$id}{file_length}</td>
    <td>$data{$id}{file_desc}</td>
</tr>
};
	}
    print "</table>\n";
    }





sub pickup_info {
    my( $control_file, %control_params, $key, $val, $id, $allowed, 
	$to_email, $to_username, $to_domain, $passcode );

    $id = lc $q->param( 'id' );
    &log( "pickup_info $username requesting info on $id" );

    $control_file = "$dropbox_dir/$id.control";
    if ( ! -f $control_file ) {
	&log( "$id no control file" );
	sleep 1;
	print "unable to find a dropbox file with claim id $id.";
	return;
	}

    if ( ! open( fH, '<', $control_file ) ) {
	&log_print( "Error: Unable to open control file for id $id: $!" );
	return;
	}
    undef %control_params;
    while ( <fH> ) {
	chomp;
	( $key, $val ) = split( /\s+/, $_, 2 );
	$control_params{ $key } = $val;
	}
    close fH;

    #print "id $id\n";
    #print "passcode ", lc $q->param( 'passcode' ), "\n";
    #print "control passcode ", $control_params{ passcode }, "\n";
    #print "drop_authed ", $control_params{ drop_authed }, "\n";
    #print "auth_authed $auth_authed\n";

    if ( ! $control_params{ 'drop_authed' } && ! $auth_authed ) { 
	&log( "unauthed drop, need to be logged in to pickup" );
	print "File was dropped by an an unauthenticated user,",
	    " so you must be logged in to pick it up.";
	&auth_login();
	return;
	}

    $passcode = lc $q->param( 'passcode' );
    $to_email = "$username\@$insiders_domain";

    if ( $passcode ne $control_params{ passcode } 
	    && $to_email ne $control_params{ to_email } ) {  
	&log( "access denied" );
	sleep 1;

	if ( $auth_authed ) {  
	    print "The requested file was not dropped for you,",
		" and you did not provide the correct claim passcode.\n";
	    }

	else { 
	    print "You are not logged in, and did not provide the",
		" correct claim passcode for claim id $id.\n";
	    }

	&pickup();
	return;
	}

    print qq{
<p>control info for $id
<p>
<dl>
    <dd>from_name: $control_params{ from_name }
    <dd>from_org: $control_params{ from_org }
    <dd>from_email: $control_params{ from_email }
    <dd>from_ip: $control_params{ from_ip }
    <dd>to_name: $control_params{ to_name }
    <dd>to_email: $control_params{ to_email }
    <dd>file_basename: $control_params{ file_basename }
    <dd>file_content_type: $control_params{ file_content_type }
    <dd>file_length: $control_params{ file_length }
    <dd>file_desc: $control_params{ file_desc }
</dl>
};

    print "<p>Warning: file has not been virus scanned!\n";

    print qq{
<p>
<form method=POST>
<input type=hidden name=state value=pickup_download>
<input type=hidden name=id value="$id">
<input type=hidden name=passcode value="$passcode">
<input type=submit name=download value=download>
</form>

<p>
};

    }




sub pickup_download {
    my( $id, $control_file, %control_params, $data_file, $key, $val, $buf,
	$file_content_type, $to_email, $passcode,
	$file_basename );

    $id = lc $q->param( 'id' );
    &log( "download $username requesting $id" );

    $control_file = "$dropbox_dir/$id.control";
    if ( ! -f $control_file ) {
	&log( "$id no control file" );
	sleep 1;
	&http_error( "404 Not Found" );
	exit 0;
	}

    if ( ! open( fH, '<', $control_file ) ) {
	&log( "$id can't open control file: $!" );
	&http_error( "403 Forbidden" );
	exit 0;
	}
    undef %control_params;
    while ( <fH> ) {
	chomp;
	( $key, $val ) = split( /\s+/, $_, 2 );
	$control_params{ $key } = $val;
	}
    close fH;

    if ( ! $control_params{ 'drop_authed' } && ! $auth_authed ) { 
	&log( "unauthed drop, need to be logged in to pickup" );
	sleep 1;
	&http_error( "403 Forbidden" );
	exit 0;
	}

    $passcode = lc $q->param( 'passcode' );
    $to_email = "$username\@$insiders_domain";
    if ( $passcode ne $control_params{ passcode } 
	    && $to_email ne $control_params{ to_email } ) {  
	&log( "access denied" );
	sleep 1;
	&http_error( "403 Forbidden" );
	exit 0;
	}

    $data_file = $control_params{ data_file };

    if ( ! open( fH, '<', $data_file ) ) {
	&log( "$id can't open data file '$data_file': $!" );
	&http_error( "404 Not Found" );
	exit 0;
	}

    $file_basename = $control_params{ file_basename };
    $file_content_type = $control_params{ file_content_type };
    #print qq{Content-Type: $file_content_type; name="$file_basename"\n},
	##qq{Content-Disposition: inline; filename="$file_basename"\n},
	#qq{Content-Disposition: filename="$file_basename"\n},
	#qq{\n};

    print $q->header(
	-expires => 'now',
	-type => $file_content_type,
	-attachment => $file_basename,
	);

    while ( read( fH, $buf, 1048576 ) > 0 ) {
	print $buf;
	}
    close fH;

    &log( "download $username downloaded $id" );

    exit 0;

    }




sub http_error {
    my( $error ) = @_;

    print $q->header( 
	    -status => $error, 
	    -expires => 'now'
	    ),
	$q->start_html(
	    -title => $error 
	    ),
	qq{<h1>$error</h1>\n},
	qq{</body></html>\n};
    exit 0;
    }









# check authentication 
# return 1 for ok,
# exits if tring to authenticate, but not ok
# 0 for unauthorized and not tring to auth
sub auth_check { 
    my( $cookie_val, $password, $id );

    $auth_authed = 0;
    if ( ! $q->cookie( 'dropbox_session' ) && ! $q->param('username') ) { 
	# they're not tring to authenticate
	&log( "un-authenticated anonymous user" );
	$username = "anonymous";
	$auth_authed = 0;
	return 0;
	}

    # they are tring to authenticate, so if they fail, give the login form 

    if ( ! $using_ssl && $auth_require_ssl ) {
	&log( "auth requires ssl" );
	&fancy_header();
	print( "You must use a secure connection."
	    . "  Verify the url you're using begins with 'https'."  );
	exit 0;
	}

    $cookie_val = $q->cookie( 'dropbox_session' );
    #$trace .= " cookie $cookie_val";
    if ( $cookie_val && ( $username = &auth_verify_cookie( $cookie_val ) ) )  { 
	$cookie_val = &auth_generate_cookie( $username );
	$auth_authed = 1;
	&log( "authenticated by cookie as user $username" );
	return 1;
	}

    $username = $q->param('username');
    #$trace .= " username $username";
    $password = $q->param('password');
    #$trace .= " password $password";
    $id = lc $q->param( 'id' );
    #$trace .= " id $id";

    if ( ! $username || ! $password ) {
	&auth_login();
	}

    if ( ! &verify_username_password( $username, $password ) ) {
	# it will log it's own error messages
	&fancy_header();
	print "access denied for username '$username'";
	&http_footer();
	exit 0;
	}

    &log( "authenticated by login as user $username" );

    $auth_authed = 1;
    return 1;
    }



sub auth_login { 
    my( $username, $id );
    $username = $q->param('username');
    $state = $q->param( 'state' );
    $id = lc $q->param( 'id' );

    #&fancy_header();
    print qq{
<form method=POST>
<input type=hidden name=state value="$state">
<input type=hidden name=id value="$id">
<table>
<tr><td>SullivanCC ID:</td><td><input type=text name=username size=8 value="$username"></td></tr>
<tr><td>Password:</td><td><input type=password name=password size=8 value=""></td></tr>
<tr><td></td><td><input type=submit name=login value=login></td></tr>
</table>
</form>
};
    &http_footer();
    exit 0;
    }





sub auth_logout { 
    $logging_out = 1;
    $auth_authed = 0;

    &fancy_header();

    print qq{You are logged out.
<p>
For better security, you should also exit this browser, or at least close
this browser window.

};

    &http_footer();
    exit 0;
    }





# check authentication cookie
# return 1 for ok, 0 for unauthorized
sub auth_check_old { 
    my( $cookie_val, $password, $id );

    $auth_authed = 0;   # global

    if ( ! $using_ssl && $auth_require_ssl ) {
	&log( "auth requires ssl" );
	return 0;
	}

    $cookie_val = $q->cookie( 'dropbox_session' );
    #$trace .= " cookie $cookie_val";
    if ( $cookie_val && ( $username = &auth_verify_cookie( $cookie_val ) ) )  { 
	# make a new one
	$cookie_val = &auth_generate_cookie( $username );
	$auth_authed = 1;   
	return 1;
	}

    $username = $q->param('username');
    #$trace .= " username $username";
    $password = $q->param('password');
    #$trace .= " password $password";
    $id = lc $q->param( 'id' );
    #$trace .= " id $id";

    if ( ! $username || ! $password ) {
	&log( "no username or no password" );
	return 0;
	}

    if ( ! &verify_username_password( $username, $password ) ) {
	# it will log it's own error messages
	exit 0;
	}

    &log( "authenticated as user $username" );

    $auth_authed = 1;
    return 1;
    }



# only returns if they're authorized.
# exits if not authorized
sub auth_login_old { 
    my( $cookie_val, $password, $id );

    if ( ! $using_ssl && $auth_require_ssl ) {
	&log( "auth requires ssl" );
	&fancy_header();
	print( "You must use a secure connection."
	    . "  Verify the url you're using begins with 'https'."  );
	exit 0;
	}

    $cookie_val = $q->cookie( 'dropbox_session' );
    #$trace .= " cookie $cookie_val";
    if ( $cookie_val && ( $username = &auth_verify_cookie( $cookie_val ) ) )  { 
	$cookie_val = &auth_generate_cookie( $username );
	$auth_authed = 1;
	return 1;
	}


    $username = $q->param('username');
    #$trace .= " username $username";
    $password = $q->param('password');
    #$trace .= " password $password";
    $id = lc $q->param( 'id' );
    #$trace .= " id $id";

    if ( ! $username || ! $password ) {
	&fancy_header();
	print qq{
<form method=POST>
<input type=hidden name=pickup value=1>
<input type=hidden name=id value="$id">
Username: <input type=text name=username size=8 value="$username"><br>
Password: <input type=password name=password size=8 value=""><br>
<input type=submit name=login value=login>
</form>
};
	&http_footer();
	exit 0;
	}

    if ( ! &verify_username_password( $username, $password ) ) {
	# it will log it's own error messages
	&fancy_header();
	print "access denied for username '$username'";
	&http_footer();
	exit 0;
	}

    &log( "authenticated as user $username" );

    $auth_authed = 1;
    return 1;
    }









sub auth_is_authed { 
    return $auth_authed;
    }



sub auth_unauth { 
    $auth_authed = 0;
    }






# takes username
# returns cookie string
sub auth_generate_cookie { 
    my( $username ) = @_;
    my( $ip, $time, $nonce, $str, $digest, $cookie_val );

    $ip = $remote_addr;
    $time = time();
    $nonce = int rand 0x7fffffff;
    $str = "$username $ip $time $nonce $http_user_agent $auth_secret";
    $digest = md5_base64( $str );
    $cookie_val = "$username,$ip,$time,$nonce,$digest";
    return $cookie_val;
    }


# takes cookie string
# returns username if valid
sub auth_verify_cookie { 
    my( $cookie ) = @_;
    my( $ip, $time, $nonce, $str, $digest, $digest2, $username );

    #$trace .= ' verify';
    return undef if ( $cookie !~ m/^(\w[\w\d]*), (\d+\.\d+\.\d+.\d+), (\d+), 
	(\d+), (\S+)$/x );
    ( $username, $ip, $time, $nonce, $digest ) 
	= ( $1, $2, $3, $4, $5 );

    #$trace .= ' ip';
    return undef if ( $ip ne $remote_addr );
    #$trace .= ' time';
    return undef if ( $time < time() - $auth_expiration );

    #$trace .= ' digest';
    $str = "$username $ip $time $nonce $http_user_agent $auth_secret";
    $digest2 = md5_base64( $str );
    return undef if ( $digest2 ne $digest );

    #$trace .= ' good_cookie';
    return $username;
    }






# check it's the right password for that username
# return 0 on error, 1 on ok
sub verify_username_password {
    my( $username, $password ) = @_;
    my( $ldap, $mesg, $search, $dn );

    if ( $username !~ m/^([a-z][a-z0-9]*)$/ ) {
        #&log( "invalid username '$username'" );
	sleep 1;
	return 0;
	}
    $username = $1;    # de-taint

    $ldap = Net::LDAP->new ( $ldap_host_1 );
    if ( ! $ldap ) { 
	$ldap = Net::LDAP->new ( $ldap_host_2 );
	if ( ! $ldap ) { 
	    &log( "can't create ldap object $@" );
	    return 0;
	    }
	}
#
#    $mesg = $ldap->start_tls( sslversion => 'sslv2/3' );
#    if ( $mesg->is_error() ) { 
#	&log( "can't start tls to ldap " . $mesg->error() );
#	return 0 if ( $ldap_require_tls );
#	}
#
    $mesg = $ldap->bind ( version => 3 );
    if ( ! $mesg || $mesg->is_error ) { 
	&log( "can't anonymous bind to ldap " . $mesg->error() );
	return 0;
	}

    $search = $ldap->search ( 
	base => $ldap_base,
	scope   => "sub",
	filter  => "(uid=$username)",
	attrs   => [ "uid" ],
	);

    if ( ! $search || $search->count != 1 )  { 
	&log( "unknown username '$username'" );
	sleep 1;
	return 0;
	}

    #&log( "valid username '$username'" );

    $dn = $search->entry( 0 )->dn;
    $mesg = $ldap->bind ( 
	$dn,
	password => $password,
	version => 3 );
    if ( ! $mesg || $mesg->is_error() ) { 
	&log( "can't authenticated-bind to ldap " . $mesg->error() );
	sleep 1;
	return 0;
	}

    #&log( "'$username' valid authentication" );
    return 1;
    }









# check if username exists
# return 0 on error, 1 on ok
sub verify_username {
    my( $username ) = @_;
    my( $ldap, $mesg, $search );

    if ( $username !~ m/^([a-z][a-z0-9]*)$/ ) {
        #&log( "invalid username '$username'" );
	sleep 1;
	return 0;
	}
    $username = $1;    # de-taint

    $ldap = Net::LDAP->new ( $ldap_host_1 );
    if ( ! $ldap ) { 
	$ldap = Net::LDAP->new ( $ldap_host_2 );
	if ( ! $ldap ) { 
	    &log( "can't create ldap object $@" );
	    return 0;
	    }
	}

    $mesg = $ldap->bind ( version => 3 );
    if ( ! $mesg || $mesg->is_error ) { 
	&log( "can't anonymous bind to ldap $@" );
	return 0;
	}

    $search = $ldap->search ( 
	base => $ldap_base,
	scope   => "sub",
	filter  => "(uid=$username)",
	attrs   => [ "mail" ],
	);

    if ( ! $search || $search->count != 1 )  { 
	&log( "unknown username '$username'" );
	sleep 1;
	return 0;
	}

    #&log( "valid username '$username'" );
    return 1;
    }





sub log {
    my( $msg ) = @_;
    print lH "$$ $msg\n";
    }

sub log_print {
    my( $msg ) = @_;
    print lH "$$ $msg\n";
    print "$msg\n";
    }