#!/usr/bin/perl



    $thisurl = $ENV{'SERVER_URL'}.$ENV{'SCRIPT_NAME'};  
    $upload_dir = ''; # location for uploaded files
    $authorurl = 'kmeltz@cris.com'; 

main(); 

sub main {
    #init(); 
    read_net_input();  

#  print_header();
#  while( ($n, $v) = each(%ENV)) { print "$n = $v <br>"; } print "<br>
+"; 
#  while( ($n, $v) = each(%GLOBAL)) { print "$n = $v <br>"; } print "<
+br>"; 
    
    if( $GLOBAL{'UPLOAD'} ) { handle_upload(); }
    elsif( !$ENV{'PATH_INFO'} || $ENV{'PATH_INFO'} eq '/' ) { show_dir
+_content(); }
    else { start_download( $ENV{'PATH_INFO'} ); }

    1; # for fun
} # end of main 

#sub init {

#    $thisurl  = $ENV{'SERVER_URL'}.$ENV{'SCRIPT_NAME'};  
#    $upload_dir  = ''; # location for uploaded files
#    $authorurl   = 'kmeltz@cris.com'; 

#    1; 
#} # end of init

sub print_header {
    print "Content-Type: text/html\n\n";   
    1;
} # end of print_header 

sub urldecode {
    local($in) = @_; 
    local($i, @input_list); 

    @input_list = split(/&/,$in);

    foreach $i (@input_list) {
        $i =~ s/\+/ /g;      # Convert plus's to spaces

        # Convert %XX from hex numbers to alphanumeric
        $i =~ s/%(..)/pack("c",hex($2))/ge;

        # Split into key and value.
        $loc = index($i,"=");
        $key = substr($i,0,$loc);
        $val = substr($i,$loc+1);
        $GLOBAL{$key} = $val;
    }

    1;
} # end of urldecode 

sub read_net_input {
    local ($i, $loc, $key, $val, $input);
    local($f,$header, $header_body, $len, $buf); 

    if ($ENV{'REQUEST_METHOD'} eq "GET")
    { $input = $ENV{'QUERY_STRING'}; }
    elsif ($ENV{'REQUEST_METHOD'} eq "POST")
    {  
        # Need to read TILL we got all bytes
    $len = 0;
    $input = ''; 
    while( $len != $ENV{'CONTENT_LENGTH'} ) {
        $buf = ''; 
        $len += sysread(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
        $input .= $buf; 
    }
    }

    # conform to RFC1867 for upload specific 
    if( $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/
+ ) {
    $boundary = '--'.$1;  # please refer to RFC1867 
    @list = split(/$boundary/, $input); 

    $header_body = $list[1]; 
    $header_body =~ /\r\n\r\n|\n\n/; # separate header and body 
    $header = $`;        # front part
    $body   = $';        # rear part
     $body =~ s/\r\n$//;  # the last \r\n was put in by Netscape
    $GLOBAL{'FILE_CONTENT'} = $body;  

    # open(FD,">input.txt"); print FD $input; close(FD);  # for tracki
+ng
    # parse header
    $header =~ /filename=\"(.+)\"/; 
    $GLOBAL{'FILE_NAME'} = $1; 
    $GLOBAL{'FILE_NAME'} =~ s/\"//g; # remove "s
        $GLOBAL{'FILE_NAME'} =~ s/\s//g; # make sure no space(include 
+\n, \r..) in the file name 

    # parse trailer
    for( $i=2; $list[$i]; $i++) { 
        $list[$i] =~ s/^.+name=$//; 
        $list[$i] =~ /\"(\w+)\"/; 
        $GLOBAL{$1} = $'; 
    }

    return 1; 
    }

    urldecode($input); 

    1;
} # end of read_net_input 

sub read_file {
    local($fname) = @_;
    local($content);

    open(FILE, "<$fname") || return '';

    while(<FILE>)
    {
        $content .= $_;
    }
    close(FILE);

    $content; 
} # end of read_file 

sub read_dir {
    local($target_dir) = @_ ; 
    local($filename, $dir_content); 

    return 0 if( !$target_dir ); 
    opendir(DIR, $target_dir) || return 0; 

    $target_dir =~ s/^\.\///;        # remove ./ 
    $target_dir =~ /(.+)\/(.+)\/$/;  # find out upper level 
    $GLOBAL{'UP_LEVEL'} = $1;        # save upper level as a global

    if( $target_dir ) {
    $dir_content = "..back\n\n\n";
    }

    while($filename = readdir(DIR)) {
    if( $filename =~ /^\.|^\#|~$/ ) { next; } # skip hidden files
    $dir_content .= "$target_dir$filename\n"; 
    }
    closedir(DIR);

    $dir_content;
} # end of read_dir 

sub format_html_output {
# Was first done listing files to download using an
# unordered list (<UL>). But, I like it much better
# using a table. 
    local($content) = @_; 
    local(@filelist, $formated_content, $up_level); 

    return 0 if (!$content); 
    @filelist = split(/\n/, $content); 
    $foo = 0;
    #$formated_content = "<UL>\n";
    $formated_content = "<CENTER><TABLE cellspacing=5 cellpadding=5 bo
+rder=1>\n";
    foreach $f (@filelist) {
    if( $f eq '..back' ) { 
        $up_level =  $GLOBAL{'UP_LEVEL'}; 
            #$formated_content = "<img src=\"/images/back.gif\"> <a hr
+ef=".$thisurl.'/'.$up_level.">$f</a><br>\n<UL>\n";
            #$formated_content = "<a href=".$thisurl.'/'.$up_level.">$
+f</a><br>\n<UL>\n";
            $formated_content = "<a href=".$thisurl.'/'.$up_level.">$f
+</a><br>\n<P><CENTER><TABLE cellspacing=5 cellpadding=5 border=1>\n";
            next;
    }

    if( !$f ) {
        next;
        }
    if( -d $f ) {
        $f = "$f/";
        }
        $foo++;
        if ($foo eq 5) {
        $formated_content .= '<TD><a href='.$thisurl.'/'.$f.">$f</a><T
+R>\n";
        $foo = 0;
        }
        else {
        $formated_content .= '<TD><a href='.$thisurl.'/'.$f.">$f</a>\n
+";
        }
        #$formated_content .= '<li><a href='.$thisurl.'/'.$f.">$f</a><
+br>\n";
    }
    #$formated_content .= "</UL>\n";
    $formated_content .= "</TABLE></CENTER>\n";
    $formated_content; 

} # end of format_html_output 

sub show_dir_content {
    local($dir) = @_; 
    local($files, $f_files); 

    $dir = './' if (!$dir); # default to cgi dir
    $files = read_dir($dir); 
    $f_files = format_html_output($files); 
    
    print_header(); 
    print "
<HTML>
<HEAD><TITLE>File UpLoad</TITLE></HEAD>
<BODY BGCOLOR=\#FFFFFF >
<CENTER><H2>File to Upload</H2></CENTER> 
<FORM METHOD=\"POST\"  ENCTYPE=multipart/form-data>
<CENTER>
<TABLE ALIGN=CENTER><TR>
<TD WIDTH=80% ALIGN=CENTER>File Name: <INPUT TYPE=\"file\" NAME=\"file
+\" SIZE=35kb></TD>
</TR></TABLE></CENTER>
<CENTER><TABLE>
<TR><TD WIDTH=10%><INPUT TYPE=submit NAME=UPLOAD VALUE=Upload></TD>
<TD WIDTH=10%><INPUT TYPE=HIDDEN NAME=UPLOAD_DIR VALUE=images>($dir)</
+TD>
<TR>
</TABLE></CENTER>
<INPUT TYPE=HIDDEN NAME=CURRENT_DIR VALUE=\"$dir\">
</FORM>

<HR>
<FONT SIZE=-1>
<I>
<P>\ \;</P>
Comments, questions or problems? mail to <a HREF=\"mailto:$authorurl\"
+>$authorurl</a><br>

</I>
</FONT>
</BODY>
</HTML>
"; 


    exit;  

} # end of show_dir_content 

sub show_file_not_found {

    print_header(); 
    print "<TITLE>Not Found</TITLE><H1>Not Found</H1> The requested ob
+ject does not exist on this server. The link you followed is either o
+utdated, inaccurate, or the server has been instructed not to let you
+ have it. Connection closed by foreign host.\n"
; 
    
    exit;  
    
} # show_file_not_found
 
sub start_download {
    local($target_file) = @_; 
    local($file_name); 


    $target_file =~ s/^\/|^\\|\s//; 

    if( -d $target_file ) { show_dir_content("./$target_file"); }

    # check if file exists , though this is not likely to happen
    if ( ! -e "./$target_file")  { show_file_not_found(); }
    
    # get file name
    $file_name = $target_file; 
    $file_name =~ s/.+\/([^\/]+)$/$1/; # for PC system
    $file_name =~ s/.+\\([^\\]+)$/$1/; # for Unix system

    # start download
    print "Content-Type: application/x-unknown\n"; 
    print "Content-Disposition: attachment; fillename=$file_name\n\n";
+ 
    
    print read_file($target_file); 


1;
} # end of start_download 
 
sub show_upload_failed {

    local($reason) = @_; 

    print_header(); 
    print "<TITLE>Upload Failed</TITLE><H1>Upload Failed</H1> The requ
+ested object was not uploaded to the server. <br> Reason : $reason. T
+he server may have decided not let you write to the directory specifi
+ed. Please contact the web master for this prob
lem. Connection closed by foreign host.\n"; 
    
    exit;  

} # end of show_upload_failed 
 
sub show_upload_success {
    local($uploaded_file) = @_; 
    local(@status_list) ; 

    # @status_list = stat($uploaded_file); 
    $file_stats = `ls -la $uploaded_file`; 
    @status_list = split(/\s+/,  $file_stats); # bug fix in v00.01 

    print_header(); 
    #foreach $s ( @status_list ) { print "==$s== <br>\n"; }
     print "
<HTML>
<HEAD><TITLE>File UpLoaded</TITLE></HEAD>
<BODY BGCOLOR=\#FFFFFF >
<H2>File Transfer Successful</H2> 
<PRE>
Remote File Name : <FONT COLOR=\#FF0000> $GLOBAL{'FILE_NAME'} </FONT>
File Name : $filename  
Location  : $upload_dir 
File Size : $status_list[4] 
Local Time: $status_list[5] $status_list[6] $status_list[7] 
<a href=\"$ENV{'SERVER_URL'}\"> Back </a>
</PRE>
</BODY>
</HTML>
"; 

    exit; 

} # end of show_upload_success 
 
sub handle_upload {

    if( !$GLOBAL{'FILE_NAME'} ) { show_file_not_found(); } 

    # grep the file name , there is always a / in front of the file na
+me
    #$GLOBAL{'FILE_NAME'} =~ /.+\\([^\\]+)$|([^\/]+)$/; 
    $filename   = $GLOBAL{'FILE_NAME'}; 
    $filename =~ s/.+\\([^\\]+)$|.+\/([^\/]+)$/\1/;     

    if( $GLOBAL{'UPLOAD_DIR'} =~ /CURRENT/ ) { # change upload dir to 
+current 
    $GLOBAL{'CURRENT_DIR'} =~ s/\s//g; 
    $upload_dir = $GLOBAL{'CURRENT_DIR'}; 
    }

    $write_file = $upload_dir.$filename; 

    open(ULFD,">$write_file")  || show_upload_failed("$write_file  $!"
+); 
    print ULFD $GLOBAL{'FILE_CONTENT'}; 
    close(ULFD); 

    show_upload_success($write_file); 

    1;
} # end of handle_upload 
 
# end of script
[download]