#!/usr/bin/perl -w
use strict;

=pod

The code below is a conceptual demonstration of how to handle file downloads
in a CGI program, when your program is responsible for streaming the download.
This isn't working code.  It is for demonstration purposes only.  A lot of it
has been removed for easy reading and  that renders it non-functional.  For
example, this code never shows you where it gets it's configuration variable
"$config" from, so just pretend.

   -Tommy Butler, Fri Jan 23 10:45:50 CST 2004

=cut

BEGIN { ++$| } # auto-flush STDOUT from the very beginning

use CGI qw/ header /;
use File::Util qw/ SL /; # "SL" is correct dir seperator char for your platform
use vars qw/ $mime /;

my($cgi)  = CGI->new();
my($fu)   = File::Util->new();

# get requested file name from path info passed to this CGI program
# (ie- www.mysite.com/cgi-bin/this-program.cgi/filename)
my($file) = $ENV{'PATH_INFO'} || '';

# whack trailing dir seperator, if any
$file =~ s/(?:\/|\\|\:)$//o;

# taint-check "$file"
&file404 if (!$fu->valid_filename($file));

# get real file name by appending requested file to the private directory
# where the download files are actually kept
$file = $config->{'DIR'}{'archives'} . SL . $file;

# check if the file exists and is not a directory
&file404 if !-e $file || -d $file;

# get file suffix; we will attempt to determine file type based on its suffix
my($sufx) = $file; $sufx =~ s/^.*\.(.*)/$1/;

# vivify text hash table of MIME types and definitions
$mime = { eval 'qw(' . $mime . ')' }->{ $sufx };

# send HTTP headers for the request, including MIME type information,
# expiratory directives, suggested download file names for binary files,
# and appropriate content length information about the file before transit

# is the file binary?
if (not (-B $file)) {

   # look at file suffix to help determine its MIME type, or fall back
   # to a generic plain-text MIME type header
   print header
      (
         '-status'   => '200 OK',
         '-type'     => $mime || 'text/plain',
         '-expires'  => '+7d',
         '-Content_length' => -s $file,
      ), $fu->load_file($file)
}
else {

   # look at file suffix to help determine its MIME type, or fall back
   # to a generic binary MIME type header
   my($suf) = $file; $suf =~ s/^.*\.(.*)/$1/;

   binmode(STDOUT); # call binmode on STDOUT for binary file streams

   print header
      (
         '-status'   => '200 OK',
         '-type'     => $mime || 'application/octet-stream',
         '-expires'  => '+7d',
         '-attachment' => $fu->strip_path($file),
         '-Content_length' => -s $file,
      ), $fu->load_file($file)
}

# the original code does not embed HTML in it, as does this code below...
sub file404 { print header('-status' => '404 NOT FOUND'), <<__404__ and exit }
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>404 Not Found</title>
</head><body>
<h1>Not Found</h1>
The requested file could not be located for download.<p>
</body></html>
__404__

# Auto-vivified hash of MIME types and definitions for use with remote file
# downloads when requested file is a different MIME type than plain text or
# html.  This isn't an authoritave list, but it does the job.
INIT { $mime = <<'__MIME_TYPES__' }
ai     application/postscript            aif    audio/aiff
aifc   audio/aiff                        aiff   audio/aiff
aim    application/x-aim                 aip    text/x-audiosoft-intra
art    image/x-jg                        as     text/plain
asc    text/plain                        asf    video/x-ms-asf
asx    video/x-ms-asf                    au     audio/basic
avi    video/avi                         bmp    image/bmp
cat    application/vnd.ms-pki.seccat     cdf    application/x-cdf
cer    application/pkix-cert             cil    application/vnd.ms-artgalry
cpio   application/x-cpio                cpt    application/mac-compactpro
crl    application/pkix-crl              crt    application/pkix-cert
csh    application/x-csh                 css    text/css
cur    image/cursor                      dcr    application/x-director
der    application/pkix-cert             dib    image/bmp
dic    text/plain                        dir    application/x-director
dll    application/x-msdownload          doc    application/msword
dot    application/msword                dvi    application/x-dvi
dxr    application/x-director            eps    application/postscript
etx    text/x-setext                     exc    text/plain
exe    application/x-msdownload          ez     application/andrew-inset
fdf    application/vnd.fdf               fif    application/fractals
gif    image/gif                         gtar   application/x-gtar
gz     application/x-gzip                hdf    application/x-hdf
hqx    application/mac-binhex40          hta    application/hta
htc    text/x-component                  htm    text/html
html   text/html                         htt    text/webviewhtml
ice    x-conference/x-cooltalk           ico    image/x-icon
ief    image/ief                         iges   model/iges
iii    application/x-iphone              ins    application/x-internet-signup
isp    application/x-internet-signup     ivf    video/x-ivf
jbr    image/jbr                         jfif   image/pjpeg
jgd    image/jgd                         jpe    image/jpeg
jpeg   image/jpeg                        jpg    image/jpg
js     application/x-javascript          jsl    image/jsl
latex  application/x-latex               log    text/plain
lsf    video/x-la-asf                    lsx    video/x-la-asf
m1v    video/mpeg                        m3u    audio/mpegurl
man    application/x-troff-man           mdb    application/msaccess
mdef   text/perl                         me     application/x-troff-me
mht    message/rfc822                    mhtml  message/rfc822
mid    audio/mid                         midi   audio/mid
mif    application/vnd.mif               mmz    application/x-mmjb-mmz
mov    video/quicktime                   mp1    audio/mpeg
mp2    audio/mpeg                        mp2v   video/mpeg
mp3    audio/mpeg                        mpa    audio/mpeg
mpe    video/mpeg                        mpeg   video/mpeg
mpg    video/mpeg                        mpga   audio/mpeg
mpv2   video/mpeg                        ms     application/x-troff-ms
mxu    video/vnd.mpegurl                 nws    message/rfc822
oda    application/oda                   old    text/plain
p10    application/pkcs10                p12    application/x-pkcs12
p7b    application/x-pkcs7-certificates  p7c    application/pkcs7-mime
p7m    application/pkcs7-mime            p7r    application/x-pkcs7-certreqresp
p7s    application/pkcs7-signature       pal    image/pal
pbm    image/x-portable-bitmap           pdb    chemical/x-pdb
pdf    application/pdf                   pfr    image/pfr
pfx    application/x-pkcs12              pgm    image/x-portable-graymap
pgn    application/x-chess-pgn           ph     text/perl
pko    application/vnd.ms-pki.pko        pl     text/plain
pls    audio/scpls                       pm     text/plain
png    image/png                         pnm    image/x-portable-anymap
pod    text/pod                          pot    application/vnd.ms-powerpoint
ppa    application/vnd.ms-powerpoint     ppt    application/vnd.ms-powerpoint
ppm    image/x-portable-pixmap           pps    application/vnd.ms-powerpoint
ppt    application/vnd.ms-powerpoint     prf    application/pics-rules
ps     application/postscript            psd    image/tiff
pwz    application/vnd.ms-powerpoint     qt     video/quicktime
qtl    application/x-quicktimeplayer     ra     audio/x-pn-realaudio
ram    audio/x-pn-realaudio              ras    image/x-cmu-raster
raw    image/tiff                        rgb    image/x-rgb
rm     audio/x-pn-realaudio              rmi    audio/mid
rmm    audio/x-pn-realaudio
rtf    application/msword                rtx    text/richtext
sct    text/scriptlet                    ses    text/plain
sgm    text/sgml                         sh     application/x-sh
shar   application/x-shar                silo   model/mesh
sit    application/x-stuffit             skm    application/x-koan
sld    image/sld                         smi    application/smil
snd    audio/basic                       spc    application/x-pkcs7-certificates
spl    application/futuresplash          sql    text/sql
src    application/x-wais-source         sst    application/vnd.ms-pki.certstore
stl    application/vnd.ms-pki.stl        sub    text/perl
svg    image/svg-xml                     svgz   image/svg-xml
swf    application/x-shockwave-flash     tar    application/x-tar
tcl    application/x-tcl                 tex    image/tex
texi   application/x-texinfo             tgz    application/x-compressed
tif    image/tiff                        tiff   image/tiff
tr     application/x-troff               tsv    text/tab-separated-values
tub    image/tub                         txt    text/plain
ustar  application/x-ustar               vcd    application/x-cdlink
vcf    text/x-vcard                      vrml   model/vrml
wav    audio/wav                         ax    audio/x-ms-wax
wbmp   image/vnd.wap.wbmp                wbxml  application/vnd.wap.wbxml
wiz    application/msword                wm     video/x-ms-wm
wma    audio/x-ms-wma                    wme    text/xml
wml    text/vnd.wap.wml                  wmlc   application/vnd.wap.wmlc
wmls   text/vnd.wap.wmlscript            wmlsc  application/vnd.wap.wmlscriptc
wmv    video/x-ms-wmv                    wsc    text/scriptlet
wvx    video/x-ms-wvx                    xbm    image/x-xbitmap
xfdf   application/vnd.adobe.xfdf        xls    application/vnd.ms-excel
xml    text/xml                          xpl    audio/mpegurl
xpm    image/x-xpixmap                   xsl    text/xml
xwd    image/x-xwindowdump               xyz    chemical/x-xyz
z      application/x-compress            zip    application/x-zip-compressed
bz2    application/x-compressed
__MIME_TYPES__