web/cgi-bin/docs.cgi

#!/usr/bin/perl -w

use strict;
use CGI;

$| = 1;

# Settings
my ($incdir) = "../nwww";

# Include files
my ($doctype) = "$incdir/doctype.inc";
my ($style) = "$incdir/style.inc";
my ($header) = "$incdir/header.inc";
my ($footer) = "$incdir/footer.inc";
my ($menu) = "$incdir/menu.inc" ;

my ($query) = new CGI;

# Note filenames may only have one dot in them, in the ".txt".
# This prevents malicious users using "../" to view files.
my ($doc) = ($query->param('doc') =~ /^\s*([^\.]*?\.txt)\s*$/);

# This should be application/xhtml+xml
print "Content-type: text/html\n\n";

unless (defined $doc) {
    print "The link to this page was broken - it must specify a .txt file.";
    exit;
}

# Prevent hackers from supplying a malformed document string.
# I.e. only allow normal characters, slashes and dots.
unless ($doc =~ /^[a-zA-Z_\-0-9\.\/]+$/) {
    print "Malformed request.";
    exit;
}
$doc = "../htdocs/documentation/".$doc;

my($docname) = $doc =~ /\/([^\/]+)$/;

&print_html($doctype);

print <<"END";

  <head>
    <title>
      i-scream plain text documentation viewer
    </title>
END

&print_html($style);

print <<"END";

  </head>
  <body>
    <div id="container">
      <div id="main">
END

&print_html($header);

print <<"END";

        <div id="contents">
          <h1 class="top">
            i-scream documentation viewer
          </h1>
          <h2>
            $docname
          </h2>
END

&print_file($doc);

print <<"END";

        </div>
END

&print_html($footer);

print <<"END";

      </div>
END

&print_html($menu);

print <<"END";

    </div>
  </body>
</html>
END

exit 0;

# Print a file, whilst escaping HTML: -
sub print_file ($) {
my ($urls) = '(' . join ('|', qw{
               http
               telnet
               gopher
               file
               wais
               ftp
               } )
           . ')';

my ($ltrs) = '\w';
my ($gunk) = '/#~:.?+=&%@!\-';
my ($punc) = '.:?\-';
my ($any) = "${ltrs}${gunk}${punc}";
my ($filename) = @_;
if(open(FILE, $filename)) {
    print "          <pre>\n";
    # Use $_ implicitly throughout.
    while (<FILE>) {
        # Must do the next line first!
        s/&/&amp;/g;
        s/</&lt;/g;
        s/>/&gt;/g;
        s/"/&quot;/g;
        s/\b($urls:[$any]+?)(?=[$punc]*[^$any]|$)/<a href="$1">$1<\/a>/igox;
        print;
    }
    print "\n</pre>";
}
else {
    print "Failed to open $docname.";
}
}

# Print a file without escaping HTML: -
sub print_html ($) {
my ($filename) = @_;
print `cat $filename 2>&1`;
}
Revision:	1.8
Committed:	Wed Mar 24 13:11:42 2004 UTC (20 years, 8 months ago) by tdb
Branch:	MAIN
Changes since 1.7:	+39 -25 lines
Log Message:	Make docs.cgi XHTML 1.1 compliant (and tidied up the layout). Problem with this doc is it doesn't have a .xhtml extension, so will always have to be served as text/html - until I come up with a solution.
#	User	Rev	Content
1	tdb	1.1	#!/usr/bin/perl -w
2
3			use strict;
4			use CGI;
5
6			$\| = 1;
7
8			# Settings
9	tdb	1.8	my ($incdir) = "../nwww";
10
11			# Include files
12			my ($doctype) = "$incdir/doctype.inc";
13			my ($style) = "$incdir/style.inc";
14			my ($header) = "$incdir/header.inc";
15			my ($footer) = "$incdir/footer.inc";
16			my ($menu) = "$incdir/menu.inc" ;
17	tdb	1.1
18			my ($query) = new CGI;
19	pjm2	1.4
20			# Note filenames may only have one dot in them, in the ".txt".
21			# This prevents malicious users using "../" to view files.
22			my ($doc) = ($query->param('doc') =~ /^\s([^\.]?\.txt)\s*$/);
23	tdb	1.1
24	tdb	1.8	# This should be application/xhtml+xml
25	tdb	1.2	print "Content-type: text/html\n\n";
26	pjm2	1.4
27			unless (defined $doc) {
28			print "The link to this page was broken - it must specify a .txt file.";
29			exit;
30			}
31
32			# Prevent hackers from supplying a malformed document string.
33			# I.e. only allow normal characters, slashes and dots.
34			unless ($doc =~ /^[a-zA-Z_\-0-9\.\/]+$/) {
35	tdb	1.7	print "Malformed request.";
36	pjm2	1.4	exit;
37			}
38	tdb	1.6	$doc = "../htdocs/documentation/".$doc;
39	tdb	1.1
40	tdb	1.7	my($docname) = $doc =~ /\/([^\/]+)$/;
41
42	tdb	1.8	&print_html($doctype);
43
44	tdb	1.1	print <<"END";
45
46	tdb	1.8	<head>
47			<title>
48			i-scream plain text documentation viewer
49			</title>
50	tdb	1.7	END
51
52			&print_html($style);
53
54			print <<"END";
55	tdb	1.1
56	tdb	1.8	</head>
57			<body>
58			<div id="container">
59			<div id="main">
60	tdb	1.1	END
61
62	tdb	1.7	&print_html($header);
63	tdb	1.1
64			print <<"END";
65
66	tdb	1.8	<div id="contents">
67			<h1 class="top">
68			i-scream documentation viewer
69			</h1>
70			<h2>
71			$docname
72			</h2>
73	tdb	1.1	END
74
75			&print_file($doc);
76	tdb	1.8
77			print <<"END";
78
79			</div>
80			END
81	tdb	1.7
82			&print_html($footer);
83
84	tdb	1.8	print <<"END";
85
86			</div>
87			END
88	tdb	1.7
89			&print_html($menu);
90	tdb	1.1
91			print <<"END";
92
93	tdb	1.8	</div>
94			</body>
95	tdb	1.1	</html>
96			END
97
98			exit 0;
99
100	tdb	1.2	# Print a file, whilst escaping HTML: -
101	tdb	1.1	sub print_file ($) {
102	tdb	1.7	my ($urls) = '(' . join ('\|', qw{
103			http
104			telnet
105			gopher
106			file
107			wais
108			ftp
109			} )
110			. ')';
111
112			my ($ltrs) = '\w';
113			my ($gunk) = '/#~:.?+=&%@!\-';
114			my ($punc) = '.:?\-';
115			my ($any) = "${ltrs}${gunk}${punc}";
116			my ($filename) = @_;
117			if(open(FILE, $filename)) {
118	tdb	1.8	print " <pre>\n";
119	tdb	1.2	# Use $_ implicitly throughout.
120			while (<FILE>) {
121			# Must do the next line first!
122			s/&/&/g;
123			s/</</g;
124			s/>/>/g;
125			s/"/"/g;
126	tdb	1.3	s/\b($urls:[$any]+?)(?=[$punc]*[^$any]\|$)/<a href="$1">$1<\/a>/igox;
127	tdb	1.2	print;
128	tdb	1.1	}
129	tdb	1.8	print "\n</pre>";
130	tdb	1.1	}
131	tdb	1.7	else {
132			print "Failed to open $docname.";
133			}
134			}
135	tdb	1.1
136	tdb	1.2	# Print a file without escaping HTML: -
137			sub print_html ($) {
138	tdb	1.7	my ($filename) = @_;
139			print `cat $filename 2>&1`;
140	tdb	1.2	}