#!/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 tracking
	# 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 border=1>\n";
    foreach $f (@filelist) {
	if( $f eq '..back' ) { 
	    $up_level =  $GLOBAL{'UP_LEVEL'}; 
            #$formated_content = "<img src=\"/images/back.gif\"> <a href=".$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><TR>\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 object does not exist on this server. The link you followed is either outdated, 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 requested object was not uploaded to the server. <br> Reason : $reason. The server may have decided not let you write to the directory specified. 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 name
    #$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