OSSP CVS Repository

ossp - Check-in [174]
Not logged in
[Honeypot]  [Browse]  [Home]  [Login]  [Reports
[Search]  [Ticket]  [Timeline
  [Patchset]  [Tagging/Branching

Check-in Number: 174
Date: 2000-Oct-30 15:44:02 (local)
2000-Oct-30 14:44:02 (UTC)
User:rse
Branch:
Comment: *** empty log message ***
Tickets:
Inspections:
Files:
ossp-pkg/eperl/ChangeLog      1.13 -> 1.14     4 inserted, 1 deleted
ossp-pkg/eperl/mod/Apache/ePerl.pm      added-> 1.3

ossp-pkg/eperl/ChangeLog 1.13 -> 1.14

--- ChangeLog    2000/07/03 09:34:23     1.13
+++ ChangeLog    2000/10/31 14:44:02     1.14
@@ -19,7 +19,10 @@
      / __/ _ ___) |
   __|_____(_)____/___________________________________________________________
                
-  Changes between 2.2.14 and 2.3.0 (12-Jun-1996 to 03-Jul-2000)
+  Changes between 2.2.14 and 2.3.0 (12-Jun-1996 to xx-Nov-2000)
+
+   *) Year 2000 patch for ePerl.pm
+      [Denis Barbier <barbier@imacs.polytechnique.fr>, 31-Oct-2000]
 
    *) Ported to Perl 5.6.0
       [Ralf S. Engelschall, 03-Jul-2000]


ossp-pkg/eperl/mod/Apache/ePerl.pm -> 1.3

*** /dev/null    Thu Mar 28 09:55:00 2024
--- -    Thu Mar 28 09:58:28 2024
***************
*** 0 ****
--- 1,517 ----
+ ##        ____           _ 
+ ##    ___|  _ \ ___ _ __| |
+ ##   / _ \ |_) / _ \ '__| |
+ ##  |  __/  __/  __/ |  | |
+ ##   \___|_|   \___|_|  |_|
+ ## 
+ ##  ePerl -- Embedded Perl 5 Language
+ ##
+ ##  ePerl interprets an ASCII file bristled with Perl 5 program statements
+ ##  by evaluating the Perl 5 code while passing through the plain ASCII
+ ##  data. It can operate both as a standard Unix filter for general file
+ ##  generation tasks and as a powerful Webserver scripting language for
+ ##  dynamic HTML page programming. 
+ ##
+ ##  ======================================================================
+ ##
+ ##  Copyright (c) 1996,1997 Ralf S. Engelschall, All rights reserved.
+ ##
+ ##  This program is free software; it may be redistributed and/or modified
+ ##  only under the terms of either the Artistic License or the GNU General
+ ##  Public License, which may be found in the ePerl source distribution.
+ ##  Look at the files ARTISTIC and COPYING or run ``eperl -l'' to receive
+ ##  a built-in copy of both license files.
+ ##
+ ##  This program is distributed in the hope that it will be useful, but
+ ##  WITHOUT ANY WARRANTY; without even the implied warranty of
+ ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
+ ##  Artistic License or the GNU General Public License for more details.
+ ##
+ ##  ======================================================================
+ ##
+ ##  ePerl.pm -- Fast emulated Embedded Perl (ePerl) facility
+ ##
+ 
+ package Apache::ePerl;
+ 
+ 
+ #   requirements and runtime behaviour
+ require 5.00325;
+ use strict;
+ use vars qw($VERSION);
+ use vars qw($nDone $nOk $nFail $Cache $Config);
+ 
+ #   imports
+ use Carp;
+ use Apache ();
+ use Apache::Debug;
+ use Apache::Constants qw(:common OPT_EXECCGI);
+ use FileHandle ();
+ use File::Basename qw(dirname);
+ use Parse::ePerl;
+ 
+ #   private version number
+ $VERSION = do { my @v=("2.3.0"=~/\d+/g); sprintf "%d."."%02d"x$#v,@v }; 
+ 
+ #   globals
+ $nDone  = 0;
+ $nOk    = 0;
+ $nFail  = 0;
+ $Cache  = {};
+ 
+ #   configuration
+ $Config = {
+     'BeginDelimiter'  => '<?',
+     'EndDelimiter'    => '!>',
+     'CaseDelimiters'  => 0,
+     'ConvertEntities' => 1
+ };
+ 
+ #
+ #   send HTML error page
+ #
+ sub send_errorpage {
+     my ($r, $e, $stderr) = @_;
+ 
+     $r->content_type('text/html');
+     $r->send_http_header;
+     $r->print(
+         "<html>\n" .
+         "<head>\n" .
+         "<title>Apache::ePerl: Error</title>\n" .
+         "</head>\n" .
+         "<body bgcolor=\"#d0d0d0\">\n" .
+         "<blockquote>\n" .
+         "<h1>Apache::ePerl</h1>\n" .
+         "<b>Version $VERSION</b>\n" .
+         "<p>\n" .
+         "<table bgcolor=\"#d0d0f0\" cellspacing=0 cellpadding=10 border=0>\n" .
+         "<tr>\n" .
+         "<td bgcolor=\"#b0b0d0\">\n" .
+         "<font face=\"Arial, Helvetica\"><b>ERROR:</b></font>\n" .
+         "</td>\n" .
+         "</tr>\n" .
+         "<tr>\n" .
+         "<td>\n" .
+         "<h2><font color=\"#3333cc\">$e</font></h2>\n" .
+         "</td>\n" .
+         "</tr>\n" .
+         "</table>\n" .
+         "<p>\n" .
+         "<table bgcolor=\"#e0e0e0\" cellspacing=0 cellpadding=10 border=0>\n" .
+         "<tr>\n" . 
+         "<td bgcolor=\"#c0c0c0\">\n" .
+         "<font face=\"Arial, Helvetica\"><b>Contents of STDERR channel:</b></font>\n" .
+         "</td>\n" .
+         "</tr>\n" .
+         "<tr>\n" . 
+         "<td>\n" .
+         "<pre>$stderr</pre>\n" .
+         "</td>\n" . 
+         "</tr>\n" .
+         "</table>\n" .
+         "</blockquote>\n" .
+         "</body>\n" .
+         "</html>\n"
+     );
+     $r->log_reason("Apache::ePerl: $e", $r->filename);
+ }
+ 
+ #   
+ #   helping functions to create time strings
+ #
+ sub ctime {
+     my ($time) = @_;
+     my @dow = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' );
+     my @moy = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
+                 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
+     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
+         localtime($time);
+     my ($str) = sprintf("%s %s %2d %02d:%02d:%02d %s%s",
+                         $dow[$wday], $moy[$mon], $mday, $hour, $min, $sec, $year+1900,
+                         $isdst ?  " DST" : "");
+     return $str;
+ }
+ sub isotime {
+     my ($time) = @_;
+     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
+         localtime($time);
+     my ($str) = sprintf("%02d-%02d-%04d %02d:%02d",
+                         $mday, $mon+1, $year+1900, $hour, $min);
+     return $str;
+ }
+ 
+ #
+ #   the mod_perl handler
+ #
+ sub handler {
+     my ($r) = @_;
+     my ($filename, $data, $error, $fh);
+     my (%env, $rc, $mtime, $owner, $size, $header, $key, $value, $path, $dir, $file, @S);
+ 
+     #   statistic
+     $nDone++;
+ 
+     #   create an request object for Apache::Registory-based
+     #   scripts like newer CGI.pm versions
+     Apache->request($r);
+     
+     #   import filename from Apache API
+     $filename = $r->filename;
+ 
+     #   check for invalid filename
+     if (-d $filename) {
+         $r->log_reason("Apache::ePerl: Attempt to invoke directory as ePerl script", $filename);
+         return FORBIDDEN;
+     }
+     if (not (-f _ and -s _)) {
+         $r->log_reason("Apache::ePerl: File not exists, not readable or empty", $filename);
+         return NOT_FOUND;
+     }
+ 
+     #   check if we are allowed to use ePerl
+     if (not ($r->allow_options & OPT_EXECCGI)) {
+         $r->log_reason("Apache::ePerl: Option ExecCGI is off in this directory", $filename);
+         return FORBIDDEN;
+     }
+ 
+     #   determine script file information
+     @S = stat(_);
+     $size  = $S[7];
+     $mtime = $S[9];
+     $owner = (getpwuid($S[4]))[0] || 'UNKNOWN';
+ 
+     #   check cache for existing P-code
+     if (not (    $Cache->{$filename} 
+              and $Cache->{$filename}->{CODE}
+              and $Cache->{$filename}->{SIZE}  == $size
+              and $Cache->{$filename}->{MTIME} == $mtime
+              and $Cache->{$filename}->{OWNER} eq $owner)) {
+         #   read script
+         local ($/) = undef;
+         $fh = new FileHandle $filename;
+         $data = <$fh>;
+         $fh->close;
+ 
+         #   run the preprocessor over the script
+         if (not Parse::ePerl::Preprocess({
+             Script => $data,
+             Cwd    => dirname($filename),
+             Result => \$data
+         })) {
+             &send_errorpage($r, 'Error on preprocessing script', '');
+             $nFail++;
+             return OK;
+         }
+ 
+         #   translate the script from bristled 
+         #   ePerl format to plain Perl format
+         if (not Parse::ePerl::Translate({
+             Script          => $data,
+             BeginDelimiter  => $Config->{'BeginDelimiter'},
+             EndDelimiter    => $Config->{'EndDelimiter'},
+             CaseDelimiters  => $Config->{'CaseDelimiters'},
+             ConvertEntities => $Config->{'ConvertEntities'},
+             Result          => \$data
+         })) {
+             &send_errorpage($r, 'Error on translating script from bristled to plain format', '');
+             $nFail++;
+             return OK;
+         }
+ 
+         #   precompile the source into P-code
+         $error = '';
+         if (not Parse::ePerl::Precompile({
+             Script => $data,
+             Name   => $filename, 
+             Cwd    => dirname($filename),
+             Result => \$data,
+             Error  => \$error
+         })) {
+             &send_errorpage($r, 'Error on precompiling script from plain format to P-code', $error);
+             $nFail++;
+             return OK;
+         }
+ 
+         #   set the new results
+         $Cache->{$filename} = {};
+         $Cache->{$filename}->{CODE}  = $data;
+         $Cache->{$filename}->{SIZE}  = $size;
+         $Cache->{$filename}->{MTIME} = $mtime;
+         $Cache->{$filename}->{OWNER} = $owner;
+     }
+   
+     #   retrieve precompiled script from cache
+     $data = $Cache->{$filename}->{CODE};
+ 
+     #   create runtime environment
+     %env = $r->cgi_env;
+ 
+     $env{'VERSION_LANGUAGE'}    = "Perl/$]";
+     $env{'VERSION_INTERPRETER'} = "ePerl/$VERSION";
+ 
+     $path  = 'http://';
+     $path .= $r->server->server_hostname;
+     $path .= sprintf(':%d', $r->server->port) if ($r->server->port != 80);
+     $path .= $r->uri;
+     ($dir, $file) = ($path =~ m|^(.*/)([^/]*)$|);
+     $env{'SCRIPT_SRC_URL'}      = $path;
+     $env{'SCRIPT_SRC_URL_DIR'}  = $dir;
+     $env{'SCRIPT_SRC_URL_FILE'} = $file;
+ 
+     $path = $filename;
+     ($dir, $file) = ($path =~ m|^(.*/)([^/]*)$|);
+     $env{'SCRIPT_SRC_PATH'}      = $path;
+     $env{'SCRIPT_SRC_PATH_DIR'}  = $dir;
+     $env{'SCRIPT_SRC_PATH_FILE'} = $file;
+ 
+     $env{'SCRIPT_SRC_MODIFIED'}         = sprintf("%d", $mtime);
+     $env{'SCRIPT_SRC_MODIFIED_CTIME'}   = &ctime($mtime);
+     $env{'SCRIPT_SRC_MODIFIED_ISOTIME'} = &isotime($mtime);
+ 
+     $env{'SCRIPT_SRC_SIZE'}  = sprintf("%d", $size);
+     $env{'SCRIPT_SRC_OWNER'} = $owner;
+ 
+     #   evaluate script
+     if (not Parse::ePerl::Evaluate({
+         Script  => $data,
+         Name    => $filename, 
+         Cwd     => dirname($filename),
+         ENV     => \%env,
+         Result  => \$data,
+         Error   => \$error
+     })) {
+         &send_errorpage($r, 'Error on evaluating script from P-code', $error);
+         $nFail++;
+         return OK;
+     }
+ 
+     #   generate headers
+     if ($data =~ m|^([A-Za-z0-9-]+:\s.+?\n\n)(.*)$|s) {
+         ($header, $data) = ($1, $2);
+ 
+         $r->content_type('text/html');
+         $r->cgi_header_out('Content-Length', sprintf("%d", length($data)));
+         
+         while ($header =~ m|^([A-Za-z0-9-]+):\s+(.+?)\n(.*)$|s) {
+             ($key, $value, $header) = ($1, $2, $3);
+             if ($key =~ m|^Content-Type$|i) {
+                 $r->content_type($value);
+             }
+             else {
+                 $r->cgi_header_out($key, $value);
+             }
+         }
+     }
+     else {
+         $r->content_type('text/html');
+         $r->cgi_header_out('Content-Length', sprintf("%d", length($data)));
+     }
+ 
+     #   send resulting page
+     $r->send_http_header;
+     $r->print($data) if (not $r->header_only);
+ 
+     #   statistic
+     $nOk++;
+ 
+     #   make Apache API happy ;_)
+     return OK;
+ }
+ 
+ 
+ #
+ #   optional Apache::Status information
+ #
+ Apache::Status->menu_item(
+     'ePerl' => 'Apache::ePerl status',
+     sub {
+         my ($r, $q) = @_;
+         my (@s, $cs, $cn, $e);
+         push(@s, "<b>Status Information about Apache::ePerl</b><br>");
+         push(@s, "Versions: Apache::ePerl <b>$VERSION</b>, Parse::ePerl <b>$Parse::ePerl::VERSION</b>");
+         push(@s, "<p>\n");
+         push(@s, "<table cellspacing=0 cellpadding=4 border=1>\n");
+         push(@s, "<tr>\n");
+         push(@s, "<td align=center bgcolor=\"#ccccff\" colspan=2><b>Runtime Statistic</b></td>");
+         push(@s, "</tr>\n");
+         push(@s, "<tr>\n");
+         push(@s, "<td align=right>Interpreted Documents:</td> <td><b>$nDone</b> (<b>$nOk</b> ok, <b>$nFail</b> failed)</td>");
+         push(@s, "</tr>\n");
+         $cs = 0;
+         $cn = 0;
+         foreach $e (keys(%{$Cache})) {
+             $cn += 1;
+             $cs += $Cache->{$e}->{SIZE};
+         }
+         push(@s, "<tr>\n");
+         push(@s, "<td align=right>Cached Documents:</td> <td><b>$cn</b> (<b>$cs</b> bytes)</td>\n");
+         push(@s, "</tr>\n");
+         push(@s, "</table>\n");
+         return \@s;
+     }
+ ) if Apache->module('Apache::Status');
+ 
+ 
+ #   sometimes Perl wants it...
+ sub DESTROY { };
+ 
+ 
+ 1;
+ ##EOF##
+ __END__
+ 
+ =head1 NAME
+ 
+ Apache::ePerl - Fast emulated Embedded Perl (ePerl) facility
+ 
+ =head1 SYNOPSIS
+ 
+    #   Apache's httpd.conf file
+    #   mandatory: activation of Apache::ePerl
+    PerlModule Apache::ePerl
+    <Directory /root/of/webmaster/area>
+        <Files *.iphtml>
+            Options     +ExecCGI
+            SetHandler  perl-script
+            PerlHandler Apache::ePerl
+        </Files>
+    </Directory>
+    #   optional: configuration of Apache::ePerl
+    <Perl>
+    $Apache::ePerl::Config->{'BeginDelimiter'}  = '<?';
+    $Apache::ePerl::Config->{'EndDelimiter'}    = '!>';
+    $Apache::ePerl::Config->{'CaseDelimiters'}  = 0;
+    $Apache::ePerl::Config->{'ConvertEntities'} = 1;
+    </Perl>
+    #   optional: activation of Apache::Status for Apache::ePerl
+    <Location /perl-status>
+        Options     +ExecCGI
+        SetHandler  perl-script
+        PerlHandler Apache::Status
+    </Location>
+ 
+ =head1 DESCRIPTION
+ 
+ This packages provides a handler function for Apache/mod_perl which can be
+ used to emulate the stand-alone Server-Side-Scripting-Language I<ePerl> (see
+ eperl(3) for more details) in a very fast way. This is not a real 100%
+ replacement for F<nph-eperl> because of reduced functionality under some
+ special cases, principal runtime restrictions and speedup decisions. For
+ instance this variant does not (and cannot) provide the SetUID feature of
+ ePerl nor does it check for allowed filename extensions (speedup!), etc.
+ Instead it uses further features like object caching which ePerl does not use. 
+ 
+ But the accepted bristled source file format is exactly the same as with the
+ regular ePerl facility, because Apache::ePerl uses the Parse::ePerl package
+ which provides the original ePerl parser and translator. So, any valid ePerl
+ which works under F<nph-eperl> can also be used under Apache::ePerl.
+ 
+ The intent is to use this special variant of ePerl for scripts which are
+ directly under control of the webmaster. In this situation no real security
+ problems exists for him, because all risk is at his own hands. For the average
+ user you should B<not> use Apache::ePerl. Instead additionally install the
+ regular stand-alone ePerl facility (F<nph-eperl>) for those users.
+ 
+ So, the advantage of Apache::ePerl against the regular F<nph-eperl> is better
+ performance and nothing else. Actually scripts executed under Apache::ePerl
+ are at least twice as fast as under F<nph-eperl>. The reason its not that
+ ePerl itself is faster. The reason is the runtime in-core environment of
+ Apache/mod_perl which does not have any forking overhead.
+ 
+ =head2 Installation and Configuration
+ 
+ First you have to install Apache::ePerl so that Apache/mod_perl can find it.
+ This is usually done via configuring the ePerl distribution via the same Perl
+ interpreter as was used when building Apache/mod_perl.
+ 
+ Second, you have to add the following config snippet to Apache's F<httpd.conf>
+ file:
+ 
+    PerlModule Apache::ePerl
+    <Directory /root/of/webmaster/area>
+        <Files *.iphtml>
+            Options     +ExecCGI
+            SetHandler  perl-script
+            PerlHandler Apache::ePerl
+        </Files>
+    </Directory>
+ 
+ This forces all files under the directory /root/of/webmaster/area/ with
+ extension .iphtml to be processed by the Apache::ePerl::handler function which
+ emulates the runtime behavior of the stand-alone "eperl" program (when run as
+ a SSSL) up to 90%.  
+ 
+ If you're not paranoid about security (for instance driving a stand-alone
+ webserver without user accounts) you can also just use
+ 
+    PerlModule Apache::ePerl
+    <Files *.iphtml>
+        SetHandler  perl-script
+        PerlHandler Apache::ePerl
+    </Files>
+ 
+ which enables .iphtml files everywhere.
+ 
+ Third, when you want to change the defaults of the ePerl parser, you also can
+ add something like this to the end of the snippet above.
+ 
+    <Perl>
+    $Apache::ePerl::Config->{'BeginDelimiter'}  = '<?';
+    $Apache::ePerl::Config->{'EndDelimiter'}    = '!>';
+    $Apache::ePerl::Config->{'CaseDelimiters'}  = 0;
+    $Apache::ePerl::Config->{'ConvertEntities'} = 1;
+    </Perl>
+ 
+ Fourth, you can additionally enable the mod_perl runtime status which then
+ automatically enables an Apache::ePerl status handler:
+ 
+    <Location /perl-status>
+        Options     +ExecCGI
+        SetHandler  perl-script
+        PerlHandler Apache::Status
+    </Location>
+ 
+ This enables the URL C</perl-status> in general and the URL
+ C</perl-status?ePerl> in special. Use it to see how much scripts where run and
+ how much are still cached.
+ 
+ =head1 AUTHOR
+ 
+  Ralf S. Engelschall
+  rse@engelschall.com
+  www.engelschall.com
+ 
+ =head1 HISTORY
+ 
+ Apache::ePerl was first implemented by Mark Imbriaco E<lt>mark@itribe.netE<gt>
+ in December 1996 as a plain Perl module after he has seen the original ePerl
+ from Ralf S. Engelschall. It implemented the ePerl idea, but was not
+ compatible to the original ePerl. In May 1997 Hanno Mueller
+ E<lt>hmueller@kabel.deE<gt> has taken over the maintainance from Mark I. and
+ enhanced Apache::ePerl by adding caching for P-Code, adding the missing
+ C<chdir> stuff, etc. 
+ 
+ Nearly at the same time Ralf S. Engelschall was unhappy of the old
+ Apache::ePerl from Mark I. and already started to write this version (the one
+ you are current reading its POD). He has rewritten the complete module from
+ scratch, but incorporated the P-Code caching idea and the Apache::Status usage
+ from Hanno M.'s version. The big difference between this one and Mark I.'s or
+ Hanno M.'s versions are that this version makes use of the new Parse::ePerl
+ module which itself incorporates the original ePerl parser.  So this version
+ is more compliant to the original ePerl facility.
+ 
+ =head1 SEE ALSO
+ 
+ Parse::ePerl(3)
+ 
+ Web-References:
+ 
+   Perl:     perl(1),     http://www.perl.com/
+   ePerl:    eperl(1),    http://www.engelschall.com/sw/eperl/
+   mod_perl: mod_perl(1), http://perl.apache.org/
+   Apache:   httpd(7),    http://www.apache.org/
+ 
+ =cut
+ 
+ ##EOF##

CVSTrac 2.0.1