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) {
222 &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 }