home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / xsos222c.zip / perlssi < prev    next >
Text File  |  1998-02-07  |  13KB  |  373 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/02/07  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".
  32. #
  33.  
  34. $BINDIR  = $ENV {CGI_ROOT};         #   Location of CGI programs
  35. $BINURL  = $ENV {CGI_URL};          #   CGI URL prefix
  36. $DOCROOT = $ENV {DOCUMENT_ROOT};    #   Location of web pages
  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. warn "Timezone[0] = $timezones[0];  Timezone[1] = $timezones[1]\n";
  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. $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 you reach the end looking for SSI's.
  76. $len = length ($bigline);
  77. while ($len > 0) {
  78.     if ($bigline =~ /<!--\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/i) {
  118.         @var1 = split ('var="', $ssi);
  119.         @var2 = split ('"', $var1 [1]);
  120.         $var = $var2 [0];
  121.         if ($var =~ /DOCUMENT_NAME/) {
  122.             @output = split ('/', substr ($target, rindex ($target, '/')));
  123.             print ($output [1]);
  124.         }
  125.         elsif ($var =~ /DOCUMENT_URI/) {
  126.             @output = split ($DOCROOT, $target);
  127.             print ($output [1]);
  128.         }
  129.         elsif ($var =~ /DATE_GMT/) {
  130.             &strftime (time (), 0);
  131.         }
  132.         elsif ($var =~ /DATE_LOCAL/) {
  133.             &strftime (time (), 1);
  134.         }
  135.         elsif ($var =~ /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 ($ssi =~ /cgi=/i) {
  148.             @var1 = split ('cgi="', $ssi);
  149.             @var2 = split ('"', $var1 [1]);
  150.             $var = $var2 [0];
  151.             $infile = $var;
  152.             &MakePathname;
  153.             $var = $outfile;
  154.             if ($errno == 0) {
  155.                 #   On MS-DOS systems, replace / by \
  156.                 if (defined ($ENV {"COMSPEC"})) {
  157.                     $var =~ s/\//\\/g;
  158.                     print `$var`;
  159.                 }
  160.             }
  161.         }
  162.         elsif ($ssi =~ /cmd=/i) {
  163.             @var1 = split ('cmd="', $ssi);
  164.             @var2 = split ('"', $var1 [1]);
  165.             $var = $var2 [0];
  166.             print `$var`;
  167.         }
  168.         else {
  169.             print "<P>#exec command not understood";
  170.             &GiveErrMsg;
  171.         }
  172.     }
  173.     elsif ($ssi =~ /include/i) {
  174.         &WhichFile;
  175.         if ($errno == 0) {
  176.             open (FOO, $filename);
  177.             @lines = <FOO>;
  178.             foreach $line (@lines) {
  179.                 print ($line);
  180.             }
  181.         }
  182.         else {
  183.             print "<P>#include file not found: $filename";
  184.             &GiveErrMsg;
  185.         }
  186.     }
  187.     elsif ($ssi =~ /flastmod/i) {
  188.         &WhichFile;
  189.         if ($errno == 0) {
  190.             &strftime ((stat ($filename))[9], 1);
  191.         }
  192.         else {
  193.             print "<P>#flastmod file not found: $filename";
  194.             &GiveErrMsg;
  195.         }
  196.     }
  197.     elsif ($ssi =~ /fsize/i) {
  198.         &WhichFile;
  199.         if ($errno == 0) {
  200.             $size = -s $filename;
  201.             if ($sizefmt =~ /abbrev/i) {
  202.                 print (int ( ($size / 1024) + 1), "Kbytes");
  203.             }
  204.             else {
  205.                 print ("$size bytes");
  206.             }
  207.         }
  208.         else {
  209.             print "<P>#fsize file not found: $filename";
  210.             &GiveErrMsg;
  211.         }
  212.     }
  213. }
  214.  
  215. sub MakePathname {
  216.     $errno = 1;
  217.     $info = $infile;
  218.     if ($info =~ /^$BINURL\//) {
  219.         @split1 = split (/$BINURL\//, $info);
  220.         $info = join ('/', $BINDIR, $split1 [1]);
  221.     }
  222.     else {
  223.         $info = $DOCROOT.$info;
  224.     }
  225.     $outfile = $info;
  226.     if (!-e $outfile) {
  227.         print "<P>File not found: $outfile";
  228.         &GiveErrMsg;
  229.     }
  230.     else {
  231.         $errno = 0;
  232.     }
  233. }
  234.  
  235. sub GiveErrMsg {
  236.     printf ($errmsg, $ssi);
  237. }
  238.  
  239. sub WhichFile {
  240.     $errno = 1;
  241.     if ($ssi =~ /virtual="\/?([^"]+)"/i) {
  242.         $filename = "$DOCROOT/$1";
  243.     }
  244.     elsif ($ssi =~ /file="([^"]+)"/i) {
  245.         $filename = $1;
  246.     }
  247.     if (-e $filename) {
  248.         $errno = 0;
  249.     }
  250. }
  251.  
  252. # Usage:
  253. #   strftime ( seconds-since-epoch, local-flag )
  254. #
  255. # Where local-flag is 0 for GMT
  256. #   and               1 for local time
  257. #
  258. # Defaults to: current time, and local time format
  259. #
  260. # Display the time specified as either a GMT time string, or a local time
  261. # string in the format specified by the global variable $timefmt, using
  262. # the time zone in $timezone.
  263.  
  264. sub strftime {
  265.     local ($nowtime, $timetype) = @_;
  266.     $nowtime = time() if (! defined($nowtime));
  267.     $timetype = 1     if (! defined($timetype));
  268.     defined($timefmt) || ($timefmt = "%A, %d-%b-%y %H:%M:%S %Z");
  269.  
  270.     if ($timetype == 0) {
  271.         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
  272.            = gmtime ($nowtime);
  273.     }
  274.     else {
  275.         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
  276.            = localtime ($nowtime);
  277.     }
  278.  
  279.     # Setup day and month names, and year, for later use.
  280.     $lday = $DAYS_OF_WEEK[$wday];
  281.     $lmon = $MONTH_NAME[$mon];
  282.     $year += 1900;                    # Add in offset to get 4 digit year
  283.  
  284.     defined($lday) || ($lday = "");
  285.     defined($lmon) || ($lmon = "");
  286.  
  287.     local ($i) = (0, "");
  288.     for ($i = 0; $i < length($timefmt); $i++)
  289.     {
  290.       if (substr($timefmt, $i, 1) eq "%")
  291.       { # A magic value in the format string, expand the item
  292.         $i++;                         # Skip the percent
  293.         local ($pad) = "02";          # Pad with "0" by default
  294.         if (substr($timefmt, $i, 1) eq "-") {$i++; $pad = ""}  # No padding
  295.         if (substr($timefmt, $i, 1) eq "_") {$i++; $pad = "2"} # Pad with spaces
  296.  
  297.         local ($ch) = substr($timefmt, $i, 1);   # Format character
  298.  
  299.         # Poor man's switch:
  300.         # The recognised symbols are the ones recognised by GNU date.
  301.  
  302.         # Ideally these would be defined into a table of subroutines to
  303.         # call, but I'll have to check if Perl 4 can handle references to
  304.         # subroutines.
  305.  
  306.         # symbols
  307.         $ch eq "%" && do { print "%";                               next; };
  308.         $ch eq "n" && do { print "\n";                              next; };
  309.         $ch eq "t" && do { print "\t";                              next; };
  310.  
  311.         # Time format fields
  312.         $ch eq "H" && do { printf("%${pad}d", $hour);               next; };
  313.         $ch eq "I" && do { printf("%${pad}d", ($hour % 12) +1);     next; };
  314.         $ch eq "k" && do { printf("%2d",       $hour);              next; };
  315.         $ch eq "l" && do { printf("%2d",       ($hour % 12) +1);    next; };
  316.         $ch eq "M" && do { printf("%${pad}d", $min);                next; };
  317.         $ch eq "p" && do { print ($hour < 12 ? "AM" : "PM");        next; };
  318.         $ch eq "r" && do { printf("%${pad}d:%${pad}d:%${pad}d %s",
  319.                                   (($hour % 12) + 1), $min, $sec,
  320.                                   ($hour < 12 ? "AM" : "PM"));      next; };
  321.         $ch eq "s" && do { print $nowtime;                          next; };
  322.         $ch eq "S" && do { printf("%${pad}d", $sec);                next; };
  323.         $ch eq "T" && do { printf("%${pad}d:%${pad}d:%${pad}d",
  324.                                   $hour, $min, $sec);               next; };
  325.         # This one is supposed to be the locale's time format, but
  326.         # we'll just have to have military time for now.
  327.         $ch eq "X" && do { printf("%${pad}d:%${pad}d:%${pad}d",
  328.                                   $hour, $min, $sec);               next; };
  329.         $ch eq "Z" && do { print ($timetype
  330.                                   ? ($timezones[$isdst ? 1 : 0])
  331.                                   : "GMT");                         next; };
  332.  
  333.         # Date format fields
  334.         $ch eq "a" && do { print substr($lday, 0, 3);               next; };
  335.         $ch eq "A" && do { print $lday;                             next; };
  336.         $ch eq "b" && do { print substr($lmon, 0, 3);               next; };
  337.         $ch eq "B" && do { print $lmon;                             next; };
  338.         # This one works only with perl 5; we'd have to emulate it in
  339.         # perl 4.  Prints out the time like ctime().
  340.         $ch eq "c" && do { print scalar localtime($nowtime);        next; };
  341.         $ch eq "d" && do { printf("%${pad}d", $mday);               next; };
  342.         $ch eq "D" && do { printf("%${pad}d/%${pad}d/%${pad}d",
  343.                                   $mday, ($mon + 1), ($year % 100));next; };
  344.         $ch eq "h" && do { print substr($lmon, 0, 3);               next; };
  345.         $ch eq "j" && do { local ($pd) = $pad;  $pd =~ s/2/3/;
  346.                            printf("%${pd}d", $yday);                next; };
  347.         $ch eq "m" && do { printf("%${pad}d", ($mon + 1));          next; };
  348.         # This should be week number of year with Sunday as first day of
  349.         # the week, but we cheat and just go mod 7, for now.
  350.         $ch eq "U" && do { printf("%${pad}d", int($lday / 7));      next; };
  351.         $ch eq "w" && do { print $wday;                             next; };
  352.         # This should be week number of year with Monday as first day of
  353.         # the week, but we cheat and just go mod 7, for now.
  354.         $ch eq "W" && do { printf("%${pad}d", int($lday / 7));      next; };
  355.         # This is supposed to be the locale's time format, but we cheat
  356.         # and just print mm/dd/yy for now.
  357.         $ch eq "x" && do { printf("%${pad}d/%${pad}d/%${pad}d",
  358.                                   ($mon + 1), $mday, ($year % 100));next; };
  359.         $ch eq "y" && do { printf("%${pad}d", ($year % 100));       next; };
  360.         $ch eq "Y" && do { local ($pd) = $pad;  $pd =~ s/2/4/;
  361.                            printf("%${pd}d", $year);                next; };
  362.  
  363.         # If we fall through this far, then it wasn't matched so we'll
  364.         # print it out literally.
  365.         print "%" . ($pad ne "02" ? ($pad eq "2" ? "_" : "-") : "") . $ch;
  366.       } # Twas a magic code
  367.       else
  368.       { # Not a magic code, print literally
  369.         print substr($timefmt, $i, 1);
  370.       }
  371.     }
  372. }
  373.