web/cgi-bin/docs.cgi

#!/usr/bin/perl -w

use strict;
use CGI;

$| = 1;

# Settings
my ($menu) = "../nwww/menu.inc" ;
my ($header) = "../nwww/header.inc";
my ($footer) = "../nwww/footer.inc";
my ($style) = "../nwww/style.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*$/);

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 <<"END";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">

<html>

<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 "</div>";

&print_html($footer);

print "</div>";

&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 "</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.7
Committed:	Sun Mar 21 23:59:32 2004 UTC (20 years, 1 month ago) by tdb
Branch:	MAIN
Changes since 1.6:	+53 -56 lines
Log Message:	Commit new website. The old site is tagged, so this won't change the live site... but it does move HEAD on to the new site. Too many changes to list really. General points are: - Moved to a XHTML CSS compliant site. - Reorganised the site into a more multi-project based look. - Removed a lot of cruft. Still to do: - Fix all the zillions of bugs stopping the whole site from validating :-) - Tidy up the HTML in terms of layout and indentation. Thanks to AJ for his help this weekend in doing this.
#	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.7	my ($menu) = "../nwww/menu.inc" ;
10			my ($header) = "../nwww/header.inc";
11			my ($footer) = "../nwww/footer.inc";
12			my ($style) = "../nwww/style.inc";
13	tdb	1.1
14			my ($query) = new CGI;
15	pjm2	1.4
16			# Note filenames may only have one dot in them, in the ".txt".
17			# This prevents malicious users using "../" to view files.
18			my ($doc) = ($query->param('doc') =~ /^\s([^\.]?\.txt)\s*$/);
19	tdb	1.1
20	tdb	1.2	print "Content-type: text/html\n\n";
21	pjm2	1.4
22			unless (defined $doc) {
23			print "The link to this page was broken - it must specify a .txt file.";
24			exit;
25			}
26
27			# Prevent hackers from supplying a malformed document string.
28			# I.e. only allow normal characters, slashes and dots.
29			unless ($doc =~ /^[a-zA-Z_\-0-9\.\/]+$/) {
30	tdb	1.7	print "Malformed request.";
31	pjm2	1.4	exit;
32			}
33	tdb	1.6	$doc = "../htdocs/documentation/".$doc;
34	tdb	1.1
35	tdb	1.7	my($docname) = $doc =~ /\/([^\/]+)$/;
36
37	tdb	1.1	print <<"END";
38	tdb	1.7	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
39			"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
40	tdb	1.1
41			<html>
42
43			<head>
44	tdb	1.7	<title>i-scream plain text documentation viewer</title>
45			END
46
47			&print_html($style);
48
49			print <<"END";
50	tdb	1.1	</head>
51
52	tdb	1.7	<body>
53	tdb	1.1
54	tdb	1.7	<div id="container">
55
56			<div id="main">
57	tdb	1.1	END
58
59	tdb	1.7	&print_html($header);
60	tdb	1.1
61			print <<"END";
62	tdb	1.7	<div id="contents">
63			<h1 class="top">i-scream documentation viewer</h1>
64	tdb	1.1
65	tdb	1.7	<h2>$docname</h2>
66	tdb	1.1	END
67
68			&print_file($doc);
69	tdb	1.7	print "</div>";
70
71			&print_html($footer);
72
73			print "</div>";
74
75			&print_html($menu);
76	tdb	1.1
77			print <<"END";
78	tdb	1.7	</div>
79	tdb	1.1
80			</body>
81			</html>
82			END
83
84			exit 0;
85
86	tdb	1.2	# Print a file, whilst escaping HTML: -
87	tdb	1.1	sub print_file ($) {
88	tdb	1.7	my ($urls) = '(' . join ('\|', qw{
89			http
90			telnet
91			gopher
92			file
93			wais
94			ftp
95			} )
96			. ')';
97
98			my ($ltrs) = '\w';
99			my ($gunk) = '/#~:.?+=&%@!\-';
100			my ($punc) = '.:?\-';
101			my ($any) = "${ltrs}${gunk}${punc}";
102			my ($filename) = @_;
103			if(open(FILE, $filename)) {
104	tdb	1.2	print "<pre>\n";
105			# Use $_ implicitly throughout.
106			while (<FILE>) {
107			# Must do the next line first!
108			s/&/&/g;
109			s/</</g;
110			s/>/>/g;
111			s/"/"/g;
112	tdb	1.3	s/\b($urls:[$any]+?)(?=[$punc]*[^$any]\|$)/<a href="$1">$1<\/a>/igox;
113	tdb	1.2	print;
114	tdb	1.1	}
115	tdb	1.2	print "</pre>";
116	tdb	1.1	}
117	tdb	1.7	else {
118			print "Failed to open $docname.";
119			}
120			}
121	tdb	1.1
122	tdb	1.2	# Print a file without escaping HTML: -
123			sub print_html ($) {
124	tdb	1.7	my ($filename) = @_;
125			print `cat $filename 2>&1`;
126	tdb	1.2	}