#!/usr/bin/perl # Template : <..> # Function Name : init # Description : initialize parameters needed by this program # Inputs : none # Outputs : none # Return value : 1 if ok, 0 if error. # Calls : # Notes : # Created on Mon Jul 22 14:21:09 PDT 1996 by Steve Hsueh sub init { $thisurl = $ENV{'SERVER_URL'}.$ENV{'SCRIPT_NAME'}; $upload_dir = '/usr/home/shpank/public_html/incoming/'; # location for uploaded files $authorurl = 'webmaster@cavalcade-whimsey.com'; # for the mail-to tag $ACCESS_DENIED = 'access denied'; 1; } # end of init # Function Name : print_header # Description : print http header Content-Type # Inputs : none # Outputs : write message to stdout # Return value : 1 if ok, 0 if error. # Calls : print # Notes : none # Created on Mon Jul 22 12:13:36 PDT 1996 by Steve Hsueh sub print_header { print "Content-Type: text/html\n\n"; 1; } # end of print_header # Template : <..> # Function Name : urldecode # Description : decode url-encoded contents # Inputs : $input # Outputs : %GLOBAL # Return value : 1 if ok, 0 if error. # Calls : # Notes : # Creadted on Sun Aug 25 11:30:34 PDT 1996 by Steve Hsueh 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($1))/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 # Template : <..> # Function Name : read_net_input # Description : read input from web # Inputs : none # Outputs : %GLOBAL # Return value : 1 if ok, 0 if error. # Calls : sysread(), print(), foreach() # Notes : # if GET, read input from environment variable. if POST, read input from # stdin. Parse the content if it is ??, save the content and boundary if it is # multipart/form-data. # Created on Mon Jul 22 12:18:15 PDT 1996 by Steve Hsueh 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, bug fixed in v00.02 $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 # Template : <..> # Function Name : read_file # Description : read content of a file into buffer # Inputs : file name # Outputs : file content # Return value : $content if ok, 0 if error. # Calls : open, read, close # Notes : none # Created on Mon Jul 22 12:29:04 PDT 1996 by Steve Hsueh sub read_file { local($fname) = @_; local($content); open(FILE, "<$fname") || return ''; while() { $content .= $_; } close(FILE); $content; } # end of read_file # Template : <..> # Function Name : read_dir # Description : read the content of a directory # Inputs : $target_dir # Outputs : $dir_content # Return value : $dir_content if ok, 0 if error. # Calls : opendir(), closedir(), readdir() # Notes : $dir_content contain all files in the dir except # for ./, ../, and hidden files. All files are \n seperated. # Creadted on Sat Aug 24 13:25:00 PDT 1996 by Steve Hsueh sub read_dir { local($target_dir) = @_ ; local($filename, $dir_content, $open_failed); return 0 if( !$target_dir ); opendir(DIR, $target_dir) || do { $open_failed = $!; }; $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"; } if( !$open_failed ) { while($filename = readdir(DIR)) { if( $filename =~ /^\.|^\#|~$/ ) { next; } # skip hidden files $dir_content .= "$target_dir$filename\n"; } closedir(DIR); } else { $dir_content .= "$ACCESS_DENIED\n"; } $dir_content; } # end of read_dir # Template : <..> # Function Name : format_html_output # Description : format the output to be html # Inputs : $dir_content # Outputs : formated dir content # Return value : $formated_content if ok, 0 if error. # Calls : # Notes : this is specifically for file download # Creadted on Sat Aug 24 14:14:18 PDT 1996 by Steve Hsueh sub format_html_output { local($content) = @_; local(@filelist, $formated_content, $up_level); return 0 if (!$content); @filelist = sort(split(/\n/, $content)); $formated_content = "