web/cgi-bin/docs.cgi

#!/usr/bin/perl -w

use strict;
use CGI;

$| = 1;

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

# 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-static.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/cms/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 the contents of a file containing html
sub print_html ($) {
    my ($filename) = @_;
    open(FILE, $filename);
    while(<FILE>) {
        print;
    }
    close FILE;
}
Revision:	1.13
Committed:	Thu Mar 25 22:51:20 2004 UTC (20 years, 8 months ago) by tdb
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.12:	+1 -1 lines
Log Message:	Docs are now under cms tree.
#	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.12	my ($incdir) = "../htdocs";
10	tdb	1.8
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	tdb	1.11	my ($menu) = "$incdir/menu-static.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.13	$doc = "../htdocs/cms/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.9	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	tdb	1.9	my ($ltrs) = '\w';
113			my ($gunk) = '/#~:.?+=&%@!\-';
114			my ($punc) = '.:?\-';
115			my ($any) = "${ltrs}${gunk}${punc}";
116			my ($filename) = @_;
117			if(open(FILE, $filename)) {
118			print " <pre>\n";
119			# 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			s/\b($urls:[$any]+?)(?=[$punc]*[^$any]\|$)/<a href="$1">$1<\/a>/igox;
127			print;
128			}
129			print "\n</pre>";
130			}
131			else {
132			print "Failed to open $docname.";
133	tdb	1.1	}
134	tdb	1.7	}
135	tdb	1.1
136	tdb	1.9	# Print the contents of a file containing html
137	tdb	1.2	sub print_html ($) {
138	tdb	1.9	my ($filename) = @_;
139			open(FILE, $filename);
140			while(<FILE>) {
141			print;
142			}
143			close FILE;
144	tdb	1.2	}