w3m

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/w3m.git/
Log | Files | Refs | README

hlink.cgi (1508B)

      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 }