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