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.
#	Content
1	#!/usr/bin/perl -w
2
3	use strict;
4	use CGI;
5
6	$\| = 1;
7
8	# Settings
9	my ($menu) = "../nwww/menu.inc" ;
10	my ($header) = "../nwww/header.inc";
11	my ($footer) = "../nwww/footer.inc";
12	my ($style) = "../nwww/style.inc";
13
14	my ($query) = new CGI;
15
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
20	print "Content-type: text/html\n\n";
21
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	print "Malformed request.";
31	exit;
32	}
33	$doc = "../htdocs/documentation/".$doc;
34
35	my($docname) = $doc =~ /\/([^\/]+)$/;
36
37	print <<"END";
38	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
39	"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
40
41	<html>
42
43	<head>
44	<title>i-scream plain text documentation viewer</title>
45	END
46
47	&print_html($style);
48
49	print <<"END";
50	</head>
51
52	<body>
53
54	<div id="container">
55
56	<div id="main">
57	END
58
59	&print_html($header);
60
61	print <<"END";
62	<div id="contents">
63	<h1 class="top">i-scream documentation viewer</h1>
64
65	<h2>$docname</h2>
66	END
67
68	&print_file($doc);
69	print "</div>";
70
71	&print_html($footer);
72
73	print "</div>";
74
75	&print_html($menu);
76
77	print <<"END";
78	</div>
79
80	</body>
81	</html>
82	END
83
84	exit 0;
85
86	# Print a file, whilst escaping HTML: -
87	sub print_file ($) {
88	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	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	s/\b($urls:[$any]+?)(?=[$punc]*[^$any]\|$)/<a href="$1">$1<\/a>/igox;
113	print;
114	}
115	print "</pre>";
116	}
117	else {
118	print "Failed to open $docname.";
119	}
120	}
121
122	# Print a file without escaping HTML: -
123	sub print_html ($) {
124	my ($filename) = @_;
125	print `cat $filename 2>&1`;
126	}