cgi-bin/docs.cgi

   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/&/&amp;/g;
 109         s/</&lt;/g;
 110         s/>/&gt;/g;
 111         s/"/&quot;/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 }