download.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use POSIX qw(strftime);
   7 use URI::Escape;
   8 use File::Copy qw( copy );
   9 use File::Basename;
  10 use Digest::SHA qw(sha256_hex sha1);
  11 use MIME::Base64;
  12 use File::Spec;
  13 use CGI;
  14 use HTML::Entities;
  15 use IO::Handle;
  16
  17 my $log;
  18 my $transaction="unknown";
  19
  20 my $logfile = "/var/log/download.log";
  21 my $datadir = "/var/www/server.example.com/public_html/download/";
  22 my $secretfile="/etc/apache2/download.secret";
  23 my $secret;
  24 my $sentheader = 0;
  25 my $maxdrift = 60;
  26
  27 sub lprintf
  28 {
  29     if (defined($log))
  30     {
  31         my $now = strftime "%a, %d %b %Y %T %z", localtime;
  32         print $log "$now: [$$][$transaction]: ";
  33         printf $log @_;
  34     }
  35 }
  36
  37 sub closelog
  38 {
  39     close $log if defined($log);
  40     $log = undef;
  41 }
  42
  43 sub openlog
  44 {
  45     closelog;
  46     open ($log, '>>', $logfile) || die ("Cannot open logfile $logfile: $!");
  47     $log->autoflush;
  48 }
  49
  50 sub qdie
  51 {
  52     my $err = shift @_;
  53     lprintf "ERROR: $err\n";
  54     if (!$sentheader)
  55     {
  56         my $error = encode_entities( $err );
  57         print "Status: 404 Not Found\n";
  58         print "Content-type: text/html\n\n";
  59         print "<html><head><title>404 Not Found</title></head><body><h1>Not Found</h1><p>$error</p><hr><address>Download Server</address>";
  60         print "</body></html>\n";
  61     }
  62     closelog;
  63     die $err;
  64 }
  65
  66 sub caughtsignal
  67 {
  68     my $signame = shift;
  69     qdie ("Received SIG$signame");
  70 }
  71
  72 sub sendfile {
  73     my $file = shift @_;
  74     my $name = basename($file);
  75
  76     open my $fh, '<:raw', $file
  77         or qdie "Cannot open '$file': $!";
  78
  79     $sentheader = 1;
  80     print CGI::header(
  81         -type => 'application/octet-stream',
  82         -attachment => $name,
  83         );
  84
  85     binmode STDOUT, ':raw';
  86
  87     unless (copy $fh => \*STDOUT, 8192)
  88     {
  89         qdie "Cannot write to STDOUT";
  90     }
  91
  92     close $fh
  93         or qdie "Cannot close '$file': $!";
  94
  95     return;
  96 }
  97
  98 sub gethash
  99 {
 100     return sha256_hex(shift @_);
 101 }
 102
 103 sub decodeparams
 104 {
 105     my $query = CGI::url(-absolute=>1);
 106     my $clienttime = CGI::url_param('time');
 107     my $clientid = CGI::url_param('id');
 108     my $clienthash = CGI::url_param('hash');
 109     my $clientfile = CGI::url_param('file');
 110     $clientfile = "default" unless(defined($clientfile));
 111     qdie ("Bad parameters") unless (defined($clienttime) && defined($clientid) && defined($clienthash) && ($clienttime=~/^[0-9]+$/));
 112     my $drift = time()-$clienttime;
 113     qdie ("Client time has drifted - we have ".time()) if (($drift < -$maxdrift) || ($drift > $maxdrift));
 114     qdie ("Bad ID") unless ($clientid=~/^[-+._\@a-zA-Z0-9]+$/);
 115     qdie ("Bad filename") unless ($clientfile=~/^[-+._a-zA-Z0-9]+$/);
 116     qdie ("Bad filename") if ($clientfile=~/^\./);
 117
 118     my $hash = gethash($clienttime.":".$clientid.":".$clientfile.":".$secret);
 119     qdie ("Bad hash") unless ($hash eq $clienthash);
 120     my $fn = $datadir.$clientfile;
 121     $fn = File::Spec->rel2abs( readlink($fn) ) if (-l $fn);
 122     qdie ("File not found") unless ( -f $fn);
 123     $clientfile = basename ($fn);
 124     $transaction=$hash." ".$clientfile." ".$clientid;
 125     return $fn;
 126 }
 127
 128 open (my $sfh, "<", $secretfile) || qdie("Can't open secret file $secretfile: $!");
 129 chomp($secret=join("",<$sfh>));
 130 close ($sfh);
 131
 132 if (!defined($ENV{DOCUMENT_ROOT}) && !defined($ENV{SERVER_NAME}))
 133 {
 134     die ("Bad parameters") unless ($#ARGV == 1);
 135     my $t = time();
 136     printf "id=%s&file=%s&time=%s&hash=%s",uri_escape($ARGV[0]),uri_escape($ARGV[1]),$t,gethash($t.":".$ARGV[0].":".$ARGV[1].":".$secret)."\n";
 137     exit(0);
 138 }
 139 else
 140 {
 141     openlog;
 142     my $file = decodeparams;
 143     lprintf("STARTING\n");
 144     $SIG{INT} = \&caughtsignal;
 145     $SIG{QUIT} = \&caughtsignal;
 146     $SIG{PIPE} = \&caughtsignal;
 147     $SIG{HUP} = \&caughtsignal;
 148     $SIG{KILL} = \&caughtsignal;
 149     $SIG{TERM} = \&caughtsignal;
 150     sendfile($file);
 151     lprintf("SUCCESS\n");
 152     closelog;
 153
 154     exit(0);
 155 }