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