download.pl

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