#!/usr/bin/perl
# fs2web - make your filesystem accessible from the web
# (C) 2002-2004 by Amir Malik. All Rights Reserved.
# web: http://www.unoc.net/a/fs2web/
# email: a@unoc.net

# Copyright (c) 2002-2004 Amir Malik. <http://www.unoc.net/a/>

# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:

# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

# If you are using Apache, here is a sample configuration to make / point
# directly to the fs2web script so that all paths can be handled by it.

# <VirtualHost webfs.us.unoc.net>
#   Alias /images/ /home/webfs/www/images/
#   ScriptAliasMatch ^/(.*) /home/webfs/cgi-bin/fs2web/$1
#   ServerName webfs.us.unoc.net
# </VirtualHost>

#################### CONFIGURATION start ###############

# url to this script; no slash / at the end
$url = "http://webfs.us.unoc.net";

# stream the multimedia file (eg. RealServer), leave blank if none
$streamurl = "http://streaming-webfs.us.unoc.net:8000";

# allow downloads, 0 if no, but dir browsing is still possible
$download = 0;

# redirect to $baseurl if set to 1 to d/l file, 0 to just pipe it out
$redirect = 0;

# allow deletion of files (ANY file; BE CAREFUL HERE!!!)
$deletion = 0;

# allow uploads to ANY directory (BE CAREFUL HERE!!!)
$upload = 0;

# enable dynamic playlist generation (M3U format)
$dynamicm3u = 1;

# if $redirect is 1, then where are the files located locally
$basedir = "/storage/webfs";

# url of the path containing the downloadable files (required if redirect=1)
$baseurl = "http://yoursite/ftp";

# url to the images
$imageurl = "/images";

# file types we have images for
@filetypes = ("avi", "bmp", "gif", "html", "jpg", "mov", "mpeg", "swf", "txt", "zip");

# streamable file types
%streamtypes = qw(
avi     1
mpg     1
mpeg    1
mp3     1
m3u     0
pls     1
mp2     1
mov     1
rm      1
swf     1
ogg     1
);

# extensions that will always be allowed to download inline
%allowdown = qw(
txt     1
nfo     1
jpg     1
jpeg    1
gif     1
png     1
);

#################### CONFIGURATION end #################

# CGI.pm is EXTREMELY slow! comment out the following block to speed things up
# you could actually have 2 script; one main one and another for uploads...
if($upload && $ENV{'REQUEST_METHOD'} eq 'POST') {
  use CGI qw/:standard/;
  $CGI::DISABLE_UPLOADS = 0;
  $CGI::POST_MAX        = 1048576 * 100; # max 100 MB uploads
}

$VERSION = '1.1';

if($^O !~ /win32/i) {
  $SIG{'ALRM'} = sub { exit(0) };
  alarm(600); # max 10 min on Linux/UNIX systems, then exit script
}

$ENV{'HTTP_REFERER'} = $url if(!$ENV{'HTTP_REFERER'});

$ENV{'PATH_INFO'} =~ s/(\\\/|\/\\|\\\\|\/\/)//g;
$ENV{'PATH_INFO'} =~ s/\/$//;
$ENV{'PATH_INFO'} =~ s/^\///;
$vir_path = $ENV{'PATH_INFO'};
$vir_path =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$vir_path = '' if(length($vir_path) > 512);

my @in = split(/[&;]/,$ENV{'QUERY_STRING'});
foreach $i (0 .. $#in) {
  $in[$i] =~ s/\+/ /g;
  ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  # Convert %XX from hex numbers to alphanumeric
  $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
  $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
  # Associate key and value
  $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  $in{$key} .= $val;
}

if($vir_path =~ /\.\./) {
  print "Content-type: text/html\r\n\r\n";
  print <<_EOF;
<html>


<head><title>fs2web - Error</title>
<style type="text/css">
BODY {
 font-family: arial;
}
</style>
</head>
<body bgcolor="white">
<h2>Error</h2>
The requested resource <b>/$vir_path</b> does not exist.
</body>
</html>
<b>You are not allowed to access a higher level directory with <i>..</i></b>
<br>Return to <a href="$ENV{HTTP_REFERER}">$ENV{HTTP_REFERER}</a>.
_EOF
  exit(0);
} else {
  $path = "$basedir/$vir_path";
}

# 2004.05.22 - dynamic m3u playlist generation
if( $in{'pls'} eq 'm3u' ) {
  print "Content-Type: audio/x-mpegurl\r\nContent-Disposition: attachment; filename=fs2web-playlist.m3u\r\nCache-Control: none\r\n\r\n";
  opendir(DIR, $path);
  my @files = readdir(DIR);
  closedir(DIR);

  foreach my $file (@files) {
    my $ext = lc(substr($file, rindex($file, "\.")+1));
    if($ext ne 'm3u' && $streamtypes{$ext} == 1) {
      $file =~ s/ /\%20/g;
      $file =~ s/\#/%23/g;
      # 2004.08.11 - support space in directory names
      # 2004.09.03 - support # in file names
      $vir_path =~ s/ /\%20/g;
      $vir_path =~ s/\#/%23/g;
      print "$streamurl/$vir_path/$file\n";
    }
  }
  exit(0);
}


if(-d $path) {
  $action = 'browse';
} elsif(-e $path) {
  $action = 'get';
} else {
  print "Content-type: text/html\r\nStatus: 404 Not Found\r\n\r\n";
  print <<_EOF;
<html>
<head><title>404 Not Found</title>
<style type="text/css">
BODY {
 font-family: arial;
}
</style>
</head>
<body bgcolor="white">
<h2>404 Not Found</h2>
The requested resource <b>/$vir_path</b> does not exist.
<br>Return to <a href="$ENV{HTTP_REFERER}">$ENV{HTTP_REFERER}</a>.
</body>
</html>
_EOF
  exit(0);
}

$thisdir = ($vir_path eq "") ? "" : "$vir_path/";
($action eq "browse") ? &browse : &get;

sub browse {
  print "Content-type: text/html\r\n\r\n";
  #$thisdir =~ s/ /\%20/g;
  $uri = $vir_path;

  print <<_EOF;
<html>
<head><title>fs2web - Index of /$uri</title>
<style type="text/css">
BODY {
 font-family: arial;
 scrollbar-face-color: #DBDCE7; scrollbar-shadow-color: #689cd0; scrollbar-highlight-color: #F1F2F4; scrollbar-3dlight-color: #000000; scrollbar-darkshadow-color:#000000; scrollbar-track-color: #689cd0; scrollbar-arrow-color: #689cd0;
}
</style>
<script language="Javascript">
function d (file) {
  if(confirm('Are you sure you want to delete: ' + file, '')) {
    location.href = '?d=' + file;
  }
}
</script>
</head>
<body bgcolor="white" vlink="blue">
<h2>Index of /$uri</h2>
_EOF

  if($deletion && $in{d}) {
    $in{d} =~ s/(\\|\/|\.\.)//g;
    my $file = "$basedir/$vir_path/$in{d}";
    if(unlink($file)) {
      print "<p>The file, <b>$in{d}</b> was successfully deleted.<p>";
    } else {
      print "<p>The file, <b>$in{d}</b> could not be deleted!<p>";
    }
  }

  if($upload && $ENV{'REQUEST_METHOD'} eq 'POST') {
    my $file = param('fileupload');
    if($file) {
      $file =~ m/^.*(\\|\/)(.*)/;
      my $name = $2;
      $name =~ s/(\\|\/|\.\.)//g;
      my $msg;
      if(open(X,">$basedir/$vir_path/$name")) {
        binmode(X);
        while(<$file>) {
          print X;
        }
        close(X);
        $msg = 'was successfully saved.';
      } else {
        $msg = 'could not be saved!';
      }
      print <<_EOF;
<p>The file, <b>$name</b>, $msg<p>
_EOF
    }
  }

  opendir(BASE, $path);
  @names = readdir(BASE);
  closedir(BASE);

  foreach $name (@names) {	
    $isdir = opendir(DIR, "$basedir/$thisdir$name");
    if ($isdir == 1) {
      push(@dirs, $name) unless ($name =~ /^\./);
    } else {
      push(@files, $name) unless ($name =~ /^\./);
    }
    closedir(DIR);

    # some of the following code is based on CGIHK's ftpex
    # see http://www.cgihk.com/ for more info
    (undef, undef, undef, undef, undef, undef, undef,
    $size, undef, $modified, undef, undef, undef) = stat("$basedir/$thisdir$name");
    ($min, $hr, $day, $mon, $yr) = (localtime($modified))[1,2,3,4,5];
    $min = "0$min" unless $min >= 10;
    $hr  = "0$hr"  unless $hr  >= 10;
    $day = "0$day" unless $day >= 10;
    $mon = "0$mon" unless $mon >= 10;
    $yr += 1900;
    $mon++; # they are from 0 to 11 (man localtime)

    $filesize{$name} = int((1023 + $size) / 1024) . " kb";
    if($filesize{$name} > 1024) {
      $filesize{$name} = int((1023 + $filesize{$name}) / 1024) . " Mb";
    }
    # 2004.05.13 - changed to conform to ISO 8601 date format
    #$last_mod{$name} = "$day-$mon-$yr $hr:$min";
    $last_mod{$name} = "$yr-$mon-$day $hr:$min";
  }

  # 2004.08.11 - moved here to support directory names with spaces
  $thisdir =~ s/ /\%20/g;

print <<_EOF;
<table border=0 cellspacing=1 width="80%">
 <tr>
  <td width="50%"><b>Name</b></td>
  <td width="15%"><b>Options</b></td>
  <td width="25%"><b>Last Modified</b></td>
  <td align=right width="10%"><b>Size</b></td>
 </tr>
 <tr>
  <td colspan=3>
   <b>
_EOF

  if($vir_path ne "") {
    $temp = $vir_path =~ tr#/#/#;
    if ($temp > 0) {
      $pardir = "$url/browse/".substr($vir_path, 0, rindex($vir_path, "/"));
    } else {
      $pardir = "";
    }
    print "   <img src=\"$imageurl/up.gif\" align=\"absbottom\"><a href=\"../\">Parent Directory</a>\n";
  }

  print <<_EOF;
   </b>
  </td>
 </tr>
_EOF

  foreach $dir (sort @dirs) {
    $dir_url = $dir;
    $dir_url =~ s/ /\%20/g;
    print <<_EOF;
 <tr>
  <td>
   <b><img src="$imageurl/dir.gif" align="absbottom"><a href="$url/$thisdir$dir_url/">$dir</a></b>
  </td>
  <td>&nbsp;</td>
  <td><b>$last_mod{$dir}</b></td>
  <td align=right><b>$filesize{$dir}</b></td>
 </tr>
_EOF
  }

  foreach $file (sort @files) {
    # 2004.05.22 - hide dot-files
    next if(substr($file, 1) eq '.');
    $ext = substr($file, rindex($file, "\.")+1);
    $type = "file";
    foreach $filetype (@filetypes) {
      if (lc($ext) eq $filetype) {$type = $filetype;}
    }
    $file_url = $file;
    $file_url =~ s/ /\%20/g;
    print <<_EOF;
 <tr>
  <td>
   <b>
_EOF
    my $filetitle = $file;
    $filetitle = substr($file, 0, 31) . '...' if(length($file) > 29);
    my $delete = "<td>&nbsp;</td>";
    if($deletion) {
      $delete = "<td><b><a href=\"javascript:d('$file')\">delete</a></b></td>";
    }
    if($streamurl && $ext =~ /(m3u|pls|mp3|mpg|mpeg|avi|mov|rm|swf)/i) {
      print <<_EOF;
   <img src="$imageurl/$type.gif" align="absbottom"><a href="$url/$thisdir$file_url">$filetitle</a> (<a href="$streamurl/$thisdir$file_url">stream it!</a>)</b>
_EOF
    } else {
      print <<_EOF;
   <img src="$imageurl/$type.gif" align="absbottom"><a href="$url/$thisdir$file_url">$filetitle</a></b>
_EOF
    }
    print <<_EOF;
  </td>
  $delete
  <td><b>$last_mod{$file}</b></td>
  <td align=right><b>$filesize{$file}</b></td>
 </tr>
_EOF
  }

  print "</table>\n";

  # 2004.05.22 - playlist link
  printf <<_EOF if($dynamicm3u);
<br>Generate a <a href="?pls=m3u">playlist</a>.<br>
_EOF

  print <<_EOF if($upload);
<br>
<form method="post" action="$url/$vir_path/" enctype="multipart/form-data">
Upload a file to this directory:
<input type="file" name="fileupload">
<input type="submit" value="Upload">
</form>
_EOF

  print <<_EOF;
<br><hr><address>Powered by <a href="http://www.unoc.net/a/fs2web/">fs2web</a> $VERSION</address>
</body>
</html>
_EOF
}

sub get {
  $download = 1 if("/$vir_path" eq '/robots.txt');
  my $inline = 0;
  my $inlinetype = 'text/plain';
  my $inline_ext = substr($vir_path, rindex($vir_path, "\.")+1);
  if($allowdown{$inline_ext} == 1) {
    $download = 1;
    $inline = 1;
    if($inline_ext =~ /(gif|jpg|jpeg|png)/i) {
      $inlinetype = "image/$1";
    }
  }

  if(!$download) {
    print "Content-Type: text/html\r\n\r\n";
    print <<_EOF;
<html>
<head><title>fs2web - Error</title>
<style type="text/css">
BODY {
 font-family: arial;
}
</style>
</head>
<body bgcolor="white">
<h2>Error</h2>
Sorry, but the administrator has disabled file downloads!
Possible reason(s):
<ul>
<li><b>Requested content not local:</b> This server merely contains a listing of content. The actual
content resides on a dedicated file server.
</ul>
<br>Return to <a href="$ENV{HTTP_REFERER}">$ENV{HTTP_REFERER}</a>.
</body>
</html>
_EOF
    exit(0);
  }
  if($redirect) {
    print "Content-Type: application/octet-stream\r\n";
    print "Location: $baseurl/$vir_path\r\n";
    print "URI: $baseurl/$vir_path\r\n\r\n";
  } else {
    if($inline) {
      print "Content-Disposition: inline\r\nContent-Type: $inlinetype\r\n";
    } else {
      print "Content-Type: application/octet-stream\r\n";
    }

    # TODO: handle HTTP's Range parameter so that one can resume a download
    #my $rset = int($ENV{'HTTP_RANGE'});

    open(FILE,"$basedir/$vir_path");
    binmode(FILE);

    $size = -s "$basedir/$vir_path";
    print "Content-Length: $size\r\n\r\n";

    #if($rset && $rset < $size) {
    #  seek(FILE,$rset,0);
    #  $size = $size - $rset;
    #}

    while(!eof(FILE)) {
      read(FILE, $x, 16384);
      print $x;
    }
    close(FILE);
  }
}