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