scripts/w3mman/hlink.cgi

   1 #!/usr/local/bin/perl
   2
   3 $SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0;
   4 $CGI = "file://$SCRIPT_NAME?";
   5
   6 if ($ENV{'QUERY_STRING'}) {
   7   $file = $ENV{'QUERY_STRING'};
   8 } else {
   9   $file = $ARGV[0];
  10 }
  11 $file = &cleanup($file);
  12
  13 if (-d $file) {
  14   print <<EOF;
  15 Location: file:$file
  16 EOF
  17   exit;
  18 }
  19 if (! open(FILE, "< $file")) {
  20   $file = &html_quote($file);
  21   $_ = "$file: " . &html_quote($!);
  22   print <<EOF;
  23 Content-Type: text/html
  24
  25 <head><title>$file</title></head>
  26 <b>$_</b>
  27 EOF
  28   exit 1;
  29 }
  30
  31 $file = &html_quote($file);
  32 ($dir = $file) =~ s@[^/]*$@@;
  33
  34 print <<EOF;
  35 Content-Type: text/html
  36
  37 <head><title>$file</title></head>
  38 <pre>
  39 EOF
  40 while (<FILE>) {
  41   $_ = &html_quote($_);
  42
  43   s/^(\#\s*include\s+)(\&quot;.*\&quot;|\&lt\;.*\&gt\;)/$1 . &header_ref($2)/ge;
  44
  45   print;
  46 }
  47 close(FILE);
  48 print "</pre>\n";
  49
  50 sub header_ref {
  51   local($_) = @_;
  52   local($d);
  53
  54   if (s/^\&quot;//) {
  55     s/\&quot;$//;
  56     return "&quot;<a href=\"$CGI$dir$_\">$_</a>&quot;";
  57   }
  58   s/^\&lt\;//;
  59   s/\&gt\;$//;
  60
  61   for $d (
  62         "/usr/include",
  63         "/usr/local/include",
  64         "/usr/X11R6/include",
  65         "/usr/X11/include",
  66         "/usr/X/include",
  67         "/usr/include/X11"
  68   ) {
  69     -f "$d/$_" && return "&lt;<a href=\"$CGI$d/$_\">$_</a>&gt;";
  70   }
  71   return $_;
  72 }
  73
  74
  75 sub html_quote {
  76   local($_) = @_;
  77   local(%QUOTE) = (
  78     '<', '&lt;',
  79     '>', '&gt;',
  80     '&', '&amp;',
  81     '"', '&quot;',
  82   );
  83   s/[<>&"]/$QUOTE{$&}/g;
  84   return $_;
  85 }
  86
  87 sub cleanup {
  88   local($_) = @_;
  89
  90   s@//+@/@g;
  91   s@/\./@/@g;
  92   while(m@/\.\./@) {
  93     s@^/(\.\./)+@/@;
  94     s@/[^/]+/\.\./@/@;
  95   }
  96   return $_;
  97 }