#!/usr/bin/perl # # DONT USE THIS SCRIPT ON A PUBLIC WEBSERVER # IT IS FULL OF SECURITY HOLES # # use at your own risk # First, get the CGI variables into a list of strings %cgivars= &getcgivars ; # save content in file $file = "/tmp/$cgivars{name}"; if (length $file le 0) { HTMLdie("no filename error"); } $buf = $cgivars{content}; $buf =~ s/%([0-9A-Fa-f]{2})/pack ("C", hex($1))/ge ; # double decode $len = length $buf; open FILE, ">$file" || HTMLdie("cannot open $file"); binmode FILE; # print FILE $buf; while ($len) { $written = (syswrite FILE, $buf, $len, $offs) || \ HTMLdie("file $file write error"); $len -= $written; $offs += $written; } close FILE || HTMLdie("cannot close $file"); # Print the CGI response header, required for all HTML output # Note the extra \n, to send the blank line print "Content-type: text/html\n\n" ; # Finally, print out the complete HTML response page print < postfile

postfile

file $file successfully written.

EOF exit ; #----------------- start of &getcgivars() module ---------------------- # Read all CGI vars into an associative array. # If multiple input fields have the same name, they are concatenated into # one array element and delimited with the \0 character (which fails if # the input has any \0 characters, very unlikely but conceivably possible). # Currently only supports Content-Type of application/x-www-form-urlencoded. sub getcgivars { local($in, %in) ; local($name, $value) ; # First, read entire string of CGI vars into $in if ( ($ENV{'REQUEST_METHOD'} eq 'GET') || ($ENV{'REQUEST_METHOD'} eq 'HEAD') ) { $in= $ENV{'QUERY_STRING'} ; } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { if ($ENV{'CONTENT_TYPE'}=~ m#^application/x-www-form-urlencoded$#i) { length($ENV{'CONTENT_LENGTH'}) || &HTMLdie("No Content-Length sent with the POST request.") ; read(STDIN, $in, $ENV{'CONTENT_LENGTH'}) ; } else { &HTMLdie("Unsupported Content-Type: $ENV{'CONTENT_TYPE'}") ; } } else { &HTMLdie("Script was called with unsupported REQUEST_METHOD.") ; } # Resolve and unencode name/value pairs into %in foreach (split(/[&;]/, $in)) { s/\+/ /g ; ($name, $value)= split('=', $_, 2) ; $name=~ s/%([0-9A-Fa-f]{2})/pack ("C", hex($1))/ge ; $value=~ s/%([0-9A-Fa-f]{2})/pack ("C", hex($1))/ge ; $in{$name}.= "\0" if defined($in{$name}) ; # concatenate multiple vars $in{$name}.= $value ; } return %in ; } # Die, outputting HTML error page # If no $title, use a default title sub HTMLdie { local($msg,$title)= @_ ; $title= "CGI Error" if $title eq '' ; print < $title

$title

$msg

EOF exit ; }