Mailing List Archive

HotPerl
Tom Christianson asked me to pass this along to all of you. So here goes....

This is a working version of what I call HotPerl. The code is not clean,
It kind of evolved. There are some areas that need improving: Illegal
code checks, and hiding some key variables from the user. It is written
for Perl 4, not Perl 5. HotPerl runs in the Server, not the client like
Hot-Java. Should it be called HotPerlS or HotSPerl or HSPerl?

I am looking for comments, improvements, people interested in migrating
this to Perl5 ... If we can get the code to be somewhat protected from
the user, I would like to release it to all perl / HTML users.

What I did was to extend HTML adding a <perl> tag. Unknown tags are
supposed to be ignored by HTML viewers, so you can look at the stuff
directly, but if you pass it through HotPerl first, the code is executed,
and the results placed in the code. This is easy to do with the FORM tags
in HTML.

The following form placed in an HTML file calls HotPerl and tells it to
read an HTML file called HPtest.HTML. The hidden variable HPHTML is the
one that specifies which form Hot-Metal will read. Both POST and GET can
be used. I use post here.

<FORM ACTION="http://charlotte.mayo.edu/cgi-bin/ccs/HotPerlS.pl" METHOD="POST">
<TEXTAREA NAME=PerlCode ROWS=5 COLS=60>
Enter a Directory (for ls):
<INPUT NAME="dir" VALUE="/char1/web/prod/httpd" SIZE=40>
<INPUT TYPE="hidden" NAME = "HPHTML"
VALUE="/char1/web/prod/httpd/htdocs/ccs/HPtest.html">
<INPUT TYPE="submit" VALUE="Directory">
<INPUT TYPE="reset" VALUE="RESET">
</FORM>

-------------------------------------------------------

The form looks like regular HTML with the <perl> statements added. The
variable $HARGV{} contains the input items sent from the form statement.
A subroutine &checkarg can be used to check args passed in for `` and other
things that might break the program (this has not been tested yet).

<HEAD><TITLE>HotPerl Demo</TITLE>
</HEAD>
<BODY>
<H1>This is a simple HotPerl Demo</H1>
<perl>
$s = &checkarg($HARGV{"dir"}); # check for bad characters
</perl>
The Directory <B><perl $s></B> contains:
<P><OL>
<perl>
print "<LI>, join("<LI>", `ls $s`);
</perl>
<OL>
</BODY>

-----------------------------------------------------

Here is my First draft of HotPerl:

#!/usr/local/bin/perl
# HotPerl 0.1 9/6/95 schaller.william@mayo.edu
&hotperlarg;
if (open(HPOUT, $HARGV{"HPHTML"})) {
$HPdata=join("",<HPOUT>);
close(HPOUT);
} else {
$HPerror = "Could not open file $HARGV{HPHTML}";
$HPdata = join("",<DATA>);
}
open(LOG,">>/char1/web/prod/httpd/cgi-bin//ccs/HotPerl.log");
print LOG "$ENV{REMOTE_HOST} $HARGV{HPHTML}\n";
close(LOG);

&hotperlrun($HPdata);

# The following Check routines can be used to make sure there are no
# nasty bits of stuff in the data fields.
# checkexe - Make sure there are no unsafe perl executable items
# checkquote - Make sure quotes are escaped, and remove backticks!.

sub checkexe{
$_ = $_[0];
if (/exec/ || /system/ || /\`/ || /link/ || /mkdir/ || /unlink/
|| /rmdir/ || /chmod/ || /chown/ || /ioctl/ || /open/
|| /socket/ || /fcntl/ || /dbmopen/ || /eval/ || /qx/
|| /umask/ || /wait/ || /waitpid/ || /kill/ || /require/) {
$_ = 'print "Unsafe Perl Command found!"';
}
$_;
}
sub checkquote {
$_=$_[0];
s/\`//g;
s/\\\\"//g;
s/[^\\]"/\\"/g;
$_;
}
sub checkarg {
$_=$_[0];
s/\`//g;
s/\\\\;//g;
s/[^\\];/\\;/g;
$_;
}

sub hotperlarg {
local($HPs, @HPinp, $HPa, $HPb, $HPd, $HPstr);

($HPs=$ENV{"REQUEST_METHOD"}) =~ tr/a-z/A-Z/;
if ($HPs eq "POST") {
($HPs = <STDIN>) =~ s/[\r\n]//g;
print "Content-type: text/html\n\n";
} else {
$HPs = $ENV{"QUERY_STRING"};
print "<!DOCTYPE HTML>\n\n";
}
$HPs =~ s/%0[DA]//g;
@HPinp = split(/\&/,$HPs);
foreach (@HPinp) {
($HPa,$HPb) = split(/=/,$_);
$HPb =~ s/\+/ /g;
$HPb =~ s/%([0-9A-F]{2})/sprintf("%c",hex($1))/ge;
$HARGV{$HPa}=$HPb;
}
}

sub hotperlrun {
# local($HPs, @HPinp, $HPa, $HPb, $HPd, $HPstr);
$HPstr=$_[0];
$HPstr =~ s@(</?)perl@$1perl@gi;
@HPd=split(/<perl/,$HPstr);
print shift(@HPd);
while ($HPs=shift(@HPd)) {
if ($HPs=~/^>/) {
($HPa, $HPb) = split(/<\/perl>/,$HPs,2);
$HPa=substr($HPa,1);
eval($HPa); print $HPb;
} else {
($HPa,$HPb) = split(/>/,$HPs,2);
print eval($HPa), $HPb;
}
}
}

__END__
<HEAD> <TITLE>HotPerlS Error</TITLE> </HEAD>
<BODY>
<H1> HotPerlS Error</H1>
HotPerlS could not continue processing because it found this error:<P>
<PERL $HPerror>
</BODY>

------------------------------------------------------------------

This is the disclaimer: This code comes with NO guarantees. It may not
work. It may even cause bad things to happen on your system. There is a
limited amount of protection built in, but improper use (possibly even
proper use) can cause unpredictable results. Mayo Clinic is not
responsible for use of this information.