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