home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / bos225b2.zip / perlssi < prev    next >
Text File  |  1999-05-17  |  15KB  |  416 lines
  1. #! /usr/bin/perl
  2. #
  3. #   Name:       perlssi
  4. #   Title:      Implementation of SSI as a Perl filter
  5. #   Package:    Xitami web server
  6. #
  7. #   Written:    96/11/02  Xitami team <xitami@imatix.com>
  8. #   Revised:    99/05/17  Xitami team <xitami@imatix.com>
  9. #
  10. #   Copyright:  Copyright (c) 1991-99 iMatix
  11. #   License:    This is free software; you can redistribute it and/or modify
  12. #               it under the terms of the License Agreement as provided
  13. #               in the file LICENSE.TXT.  This software is distributed in
  14. #               the hope that it will be useful, but without any warranty.
  15. #
  16. #   This program is based on the FakeSSI program, documented at:
  17. #   <URL:http://sw.cse.bris.ac.uk/WebTools/fakessi.html>
  18. #
  19. #   Server side include documentation at NCSA:
  20. #   <URL:http://hoohoo.ncsa.uiuc.edu/docs/tutorials/includes.html>
  21. #
  22. #   In defaults.cfg:
  23. #   [Filter]
  24. #       shtml=perlssi               #   Parse files with .shtml extension
  25. #
  26. #   This script is a quick and dirty SSI solution, not meant to be used for
  27. #   heavy work, but at least something until we build SSI into Xitami the
  28. #   proper way.  It's also a useful demo of a filter program.
  29. #
  30. #   The exec cmd= tag is only recognised if you set the environment variable
  31. #   "SSI_INSECURE=yes", in your autoexec.bat or system environment (for NT).
  32. #
  33. require 5;
  34.  
  35. $BINDIR  = $ENV {CGI_ROOT};         #   Location of CGI programs
  36. $BINURL  = $ENV {CGI_URL};          #   CGI URL prefix
  37. $DOCROOT = $ENV {DOCUMENT_ROOT};    #   Location of web pages
  38. $DOCPATH = $ENV {PATH_TRANSLATED};  #   Document root, cut before '/'
  39. $DOCPATH = $1 if $DOCPATH =~ /(.*)\//;
  40.  
  41. $errno = 0;
  42.  
  43. # Set the default error message you want, the size format, time format and
  44. # timezone here.
  45. $errmsg   = '<P>[perlssi: "#%s" produced errors]';
  46. $sizefmt  = 'bytes';
  47. # Default time format: eg Mon, 05-Jan-98 15:25:05 NZST
  48. $timefmt  = "%A, %d-%b-%y %H:%M:%S %Z";
  49. $timezone = $ENV {'TZ'};
  50. $timezone = "" if (!defined($timezone));           # Empty if not set
  51. @timezones = split(/-?\d+/, $timezone);            # Get Timezones
  52. if (defined($timezones[0]) && (!defined($timezones[1])))
  53. { $timezones[1] = $timezones[0]; }
  54.  
  55. @DAYS_OF_WEEK = ('Sunday', 'Monday', 'Tuesday', 'Wednesday',
  56.                  'Thursday', 'Friday', 'Saturday');
  57.  
  58. @MONTH_NAME   = ('January', 'February', 'March', 'April', 'May', 'June',
  59.                  'July', 'August', 'September', 'October', 'November',
  60.                  'December');
  61.  
  62. # OK, now to work!!!
  63. print ("Content-type: text/html\n\n");
  64.  
  65. # Convert the target file name from WWW form into explicit form
  66.  
  67. $sent = $ENV {SCRIPT_NAME};
  68. $ENV {'HTTP_REFERER'} = $sent
  69.     unless $ENV {'HTTP_REFERER'};
  70.  
  71. $infile = $sent;
  72. &MakePathname;
  73. $target = $outfile;
  74.  
  75. # Read in target WWW page, and make into one long line.
  76. $bigline = join ('', <STDIN>);
  77.  
  78. # Go thru the line until we reach the end, looking for SSI's.
  79. $len = length ($bigline);
  80. while ($len > 0) {
  81.     if ($bigline =~ /<!--\s*#\s*/) {
  82.         print ($`);
  83.         if ($' =~ /-->/) {
  84.             $ssi = $`;
  85.             $bigline = $';
  86.             &HandleSSI;
  87.             $len = length ($bigline);
  88.         }
  89.     }
  90.     else {
  91.         $len = 0;
  92.         print ($bigline);
  93.     }
  94. }
  95.  
  96. 0;   #   Return code 0 -> everything okay
  97.  
  98.  
  99. #----------------------------------------------------------------------
  100.  
  101. sub HandleSSI {
  102.     if ($ssi =~ /^config/i) {
  103.         @var1 = split ('="', $ssi);
  104.         @var2 = split ('"', $var1 [1]);
  105.         $var  = $var2 [0];
  106.         if ($ssi =~ /errmsg/i) {
  107.             $errmsg = $var;
  108.         }
  109.         elsif ($ssi =~ /sizefmt/i) {
  110.             $sizefmt = $var;
  111.         }
  112.         elsif ($ssi =~ /timefmt/i) {
  113.             $timefmt = $var;
  114.         }
  115.         else {
  116.             print "<P>Unrecognised #config variable";
  117.             &GiveErrMsg;
  118.         }
  119.     }
  120.     elsif ($ssi =~ /^echo\s+var="([^"]+)"/i) {
  121.         $var = $1;
  122.         if ($var eq "DOCUMENT_NAME") {
  123.             @output = split ('/', substr ($target, rindex ($target, '/')));
  124.             print ($output [1]);
  125.         }
  126.         elsif ($var eq "DOCUMENT_URI") {
  127.             print $sent;
  128.         }
  129.         elsif ($var eq "DATE_GMT") {
  130.             &strftime (time (), 0);
  131.         }
  132.         elsif ($var eq "DATE_LOCAL") {
  133.             &strftime (time (), 1);
  134.         }
  135.         elsif ($var eq "LAST_MODIFIED") {
  136.             &strftime ( (stat ($target))[9], 1);
  137.         }
  138.         elsif ($ENV {$var}) {
  139.             print $ENV {$var};
  140.         }
  141.         else {
  142.             print "<P>Unrecognised #echo variable: $var";
  143.             &GiveErrMsg;
  144.         }
  145.     }
  146.     elsif ($ssi =~ /^exec/i) {
  147.         if ($ENV {SSI_INSECURE} !~ /yes/i) {
  148.             print <<".";
  149. <P>#exec command not permitted for security reasons.  On the server,
  150. set the environment variable SSI_INSECURE to 'yes'.  For Win95 add
  151. 'SET SSI_INSECURE=yes' to the AUTOEXEC.BAT file.  For WinNT, in the
  152. System Control Panel, under 'Environment', add 'SSI_INSECURE=yes'.
  153. Reboot after making your changes.
  154. .
  155.             &GiveErrMsg;
  156.         }
  157.         elsif ($ssi =~ /cgi="([^"?]+)(\??([^"]*))"/i) {
  158.             $infile = $1;
  159.             $args   = $3;
  160.             &MakePathname;
  161.             $var = $outfile;
  162.             if ($errno == 0) {
  163.                 #   We can now execute the CGI script in $var
  164.                 $ENV {"QUERY_STRING"} = $3;
  165.  
  166.                 #   First, handle MS-DOS systems
  167.                 if (defined ($ENV {"COMSPEC"})) {
  168.                     $var =~ s/\//\\/g;
  169.                     #   Try normal executable programs first
  170.                     if ($var =~ /\.exe$|\.com$|\.bat$/i) {
  171.                         $_ = `$var $args`;
  172.                     }
  173.                     else {
  174.                         #   Check file header to see if it's a script
  175.                         #   We're looking for '#! xxxx' or '/*! xxxx'
  176.                         open (FOO, $var);
  177.                         $_ = <FOO>;
  178.                         chop;
  179.                         close (FOO);
  180.  
  181.                         if (/^\#\!\s*(.+)|^\/\*\!\s*([^*]+)\*\//) {
  182.                              $_ = `$1 $var $args`;
  183.                         }
  184.                         else {
  185.                             print "<P>Cannot execute $var";
  186.                             &GiveErrMsg;
  187.                         }
  188.                     }
  189.                 }
  190.                 #   Handle other systems (OS/2 may need to be handled as DOS)
  191.                 else {
  192.                     $_ = `$var $args`;
  193.                 }
  194.  
  195.                 #   If output has HTTP header fields, skip to blank line
  196.                 if (/^[A-Z-]+: /i) {
  197.                     /\n\n/;
  198.                     print $';
  199.                 }
  200.                 else {
  201.                     print $_;
  202.                 }
  203.             }
  204.         }
  205.         elsif ($ssi =~ /cmd="([^"]+)"/i) {
  206.             print `$1`;
  207.         }
  208.         else {
  209.             print "<P>#exec command not understood";
  210.             &GiveErrMsg;
  211.         }
  212.     }
  213.     elsif ($ssi =~ /^include/i) {
  214.         &WhichFile;
  215.         if ($errno == 0) {
  216.             open (FOO, $filename);
  217.             $bigline = join ('', <FOO>).$bigline;
  218.             close (FOO);
  219.         }
  220.         else {
  221.             print "<P>#include file not found: $filename";
  222.             &GiveErrMsg;
  223.         }
  224.     }
  225.     elsif ($ssi =~ /^flastmod/i) {
  226.         &WhichFile;
  227.         if ($errno == 0) {
  228.             &strftime ((stat ($filename))[9], 1);
  229.         }
  230.         else {
  231.             print "<P>#flastmod file not found: $filename";
  232.             &GiveErrMsg;
  233.         }
  234.     }
  235.     elsif ($ssi =~ /^fsize/i) {
  236.         &WhichFile;
  237.         if ($errno == 0) {
  238.             $size = -s $filename;
  239.             if ($sizefmt =~ /abbrev/i) {
  240.                 print (int ( ($size / 1024) + 1), "Kbytes");
  241.             }
  242.             else {
  243.                 print ("$size bytes");
  244.             }
  245.         }
  246.         else {
  247.             print "<P>#fsize file not found: $filename";
  248.             &GiveErrMsg;
  249.         }
  250.     }
  251.     else {
  252.         print "<P>Unrecognised SSI command";
  253.         &GiveErrMsg;
  254.     }
  255. }
  256.  
  257. sub MakePathname {
  258.     $errno = 1;
  259.     $info = $infile;
  260.     if ($info =~ /^$BINURL\//) {
  261.         @split1 = split (/$BINURL\//, $info);
  262.         $info = join ('/', $BINDIR, $split1 [1]);
  263.     }
  264.     else {
  265.         $info = $DOCROOT.$info;
  266.     }
  267.     $outfile = $info;
  268.     if (!-e $outfile) {
  269.         print "<P>File not found: $outfile";
  270.         &GiveErrMsg;
  271.     }
  272.     else {
  273.         $errno = 0;
  274.     }
  275. }
  276.  
  277. sub GiveErrMsg {
  278.     printf ($errmsg, $ssi);
  279. }
  280.  
  281. sub WhichFile {
  282.     $errno = 1;
  283.     if ($ssi =~ /virtual="\/?([^"]+)"/i) {
  284.         $filename = "$DOCROOT/$1";
  285.     }
  286.     elsif ($ssi =~ /file="([^"]+)"/i) {
  287.         #  If the SSI is a "#include file=", then prepend the filename
  288.         #  with the invoking document's absolute path - DH 98/06/20
  289.         $filename = "$DOCPATH/$1";
  290.     }
  291.     if (-e $filename) {
  292.         $errno = 0;
  293.     }
  294. }
  295.  
  296. # Usage:
  297. #   strftime ( seconds-since-epoch, local-flag )
  298. #
  299. # Where local-flag is 0 for GMT
  300. #   and               1 for local time
  301. #
  302. # Defaults to: current time, and local time format
  303. #
  304. # Display the time specified as either a GMT time string, or a local time
  305. # string in the format specified by the global variable $timefmt, using
  306. # the time zone in $timezone.
  307.  
  308. sub strftime {
  309.     local ($nowtime, $timetype) = @_;
  310.     $nowtime = time() if (! defined($nowtime));
  311.     $timetype = 1     if (! defined($timetype));
  312.     defined($timefmt) || ($timefmt = "%A, %d-%b-%y %H:%M:%S %Z");
  313.  
  314.     if ($timetype == 0) {
  315.         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
  316.            = gmtime ($nowtime);
  317.     }
  318.     else {
  319.         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
  320.            = localtime ($nowtime);
  321.     }
  322.  
  323.     # Setup day and month names, and year, for later use.
  324.     $lday = $DAYS_OF_WEEK[$wday];
  325.     $lmon = $MONTH_NAME[$mon];
  326.     $year += 1900;                    # Add in offset to get 4 digit year
  327.  
  328.     defined($lday) || ($lday = "");
  329.     defined($lmon) || ($lmon = "");
  330.  
  331.     local ($i) = (0, "");
  332.     for ($i = 0; $i < length($timefmt); $i++)
  333.     {
  334.       if (substr($timefmt, $i, 1) eq "%")
  335.       { # A magic value in the format string, expand the item
  336.         $i++;                         # Skip the percent
  337.         local ($pad) = "02";          # Pad with "0" by default
  338.         if (substr($timefmt, $i, 1) eq "-") {$i++; $pad = ""}  # No padding
  339.         if (substr($timefmt, $i, 1) eq "_") {$i++; $pad = "2"} # Pad with spaces
  340.  
  341.         local ($ch) = substr($timefmt, $i, 1);   # Format character
  342.  
  343.         # Poor man's switch:
  344.         # The recognised symbols are the ones recognised by GNU date.
  345.  
  346.         # Ideally these would be defined into a table of subroutines to
  347.         # call, but I'll have to check if Perl 4 can handle references to
  348.         # subroutines.
  349.  
  350.         # symbols
  351.         $ch eq "%" && do { print "%";                               next; };
  352.         $ch eq "n" && do { print "\n";                              next; };
  353.         $ch eq "t" && do { print "\t";                              next; };
  354.  
  355.         # Time format fields
  356.         $ch eq "H" && do { printf("%${pad}d", $hour);               next; };
  357.         $ch eq "I" && do { printf("%${pad}d", ($hour % 12) +1);     next; };
  358.         $ch eq "k" && do { printf("%2d",       $hour);              next; };
  359.         $ch eq "l" && do { printf("%2d",       ($hour % 12) +1);    next; };
  360.         $ch eq "M" && do { printf("%${pad}d", $min);                next; };
  361.         $ch eq "p" && do { print ($hour < 12 ? "AM" : "PM");        next; };
  362.         $ch eq "r" && do { printf("%${pad}d:%${pad}d:%${pad}d %s",
  363.                                   (($hour % 12) + 1), $min, $sec,
  364.                                   ($hour < 12 ? "AM" : "PM"));      next; };
  365.         $ch eq "s" && do { print $nowtime;                          next; };
  366.         $ch eq "S" && do { printf("%${pad}d", $sec);                next; };
  367.         $ch eq "T" && do { printf("%${pad}d:%${pad}d:%${pad}d",
  368.                                   $hour, $min, $sec);               next; };
  369.         # This one is supposed to be the locale's time format, but
  370.         # we'll just have to have military time for now.
  371.         $ch eq "X" && do { printf("%${pad}d:%${pad}d:%${pad}d",
  372.                                   $hour, $min, $sec);               next; };
  373.         $ch eq "Z" && do { print ($timetype? ($timezones[$isdst ? 1 : 0])
  374.                                   : "GMT");                         next; };
  375.  
  376.         # Date format fields
  377.         $ch eq "a" && do { print substr($lday, 0, 3);               next; };
  378.         $ch eq "A" && do { print $lday;                             next; };
  379.         $ch eq "b" && do { print substr($lmon, 0, 3);               next; };
  380.         $ch eq "B" && do { print $lmon;                             next; };
  381.         # This one works only with perl 5; we'd have to emulate it in
  382.         # perl 4.  Prints out the time like ctime().
  383.         $ch eq "c" && do { print scalar localtime($nowtime);        next; };
  384.         $ch eq "d" && do { printf("%${pad}d", $mday);               next; };
  385.         $ch eq "D" && do { printf("%${pad}d/%${pad}d/%${pad}d",
  386.                                   $mday, ($mon + 1), ($year % 100));next; };
  387.         $ch eq "h" && do { print substr($lmon, 0, 3);               next; };
  388.         $ch eq "j" && do { local ($pd) = $pad;  $pd =~ s/2/3/;
  389.                            printf("%${pd}d", $yday);                next; };
  390.         $ch eq "m" && do { printf("%${pad}d", ($mon + 1));          next; };
  391.         # This should be week number of year with Sunday as first day of
  392.         # the week, but we cheat and just go mod 7, for now.
  393.         $ch eq "U" && do { printf("%${pad}d", int($lday / 7));      next; };
  394.         $ch eq "w" && do { print $wday;                             next; };
  395.         # This should be week number of year with Monday as first day of
  396.         # the week, but we cheat and just go mod 7, for now.
  397.         $ch eq "W" && do { printf("%${pad}d", int($lday / 7));      next; };
  398.         # This is supposed to be the locale's time format, but we cheat
  399.         # and just print mm/dd/yy for now.
  400.         $ch eq "x" && do { printf("%${pad}d/%${pad}d/%${pad}d",
  401.                                   ($mon + 1), $mday, ($year % 100));next; };
  402.         $ch eq "y" && do { printf("%${pad}d", ($year % 100));       next; };
  403.         $ch eq "Y" && do { local ($pd) = $pad;  $pd =~ s/2/4/;
  404.                            printf("%${pd}d", $year);                next; };
  405.  
  406.         # If we fall through this far, then it wasn't matched so we'll
  407.         # print it out literally.
  408.         print "%" . ($pad ne "02" ? ($pad eq "2" ? "_" : "-") : "") . $ch;
  409.       } # Twas a magic code
  410.       else
  411.       { # Not a magic code, print literally
  412.         print substr($timefmt, $i, 1);
  413.       }
  414.     }
  415. }
  416.