diff options
author | Tatsuya Kinoshita <tats@vega.ocn.ne.jp> | 2011-05-04 07:18:09 +0000 |
---|---|---|
committer | Tatsuya Kinoshita <tats@vega.ocn.ne.jp> | 2011-05-04 07:18:09 +0000 |
commit | 5f8e0f8ef9a422691dd72e8a953a42a41478fcb4 (patch) | |
tree | 4b2df4796a534793648b3c4fc532fc36bd0cd525 /scripts/w3mman/hlink.cgi | |
parent | Releasing debian version 0.3-2.4 (diff) | |
download | w3m-5f8e0f8ef9a422691dd72e8a953a42a41478fcb4.tar.gz w3m-5f8e0f8ef9a422691dd72e8a953a42a41478fcb4.zip |
Releasing debian version 0.5.1-1debian/0.5.1-1
Diffstat (limited to 'scripts/w3mman/hlink.cgi')
-rw-r--r-- | scripts/w3mman/hlink.cgi | 97 |
1 files changed, 97 insertions, 0 deletions
diff --git a/scripts/w3mman/hlink.cgi b/scripts/w3mman/hlink.cgi new file mode 100644 index 0000000..a92ac1d --- /dev/null +++ b/scripts/w3mman/hlink.cgi @@ -0,0 +1,97 @@ +#!/usr/local/bin/perl + +$SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0; +$CGI = "file://$SCRIPT_NAME?"; + +if ($ENV{'QUERY_STRING'}) { + $file = $ENV{'QUERY_STRING'}; +} else { + $file = $ARGV[0]; +} +$file = &cleanup($file); + +if (-d $file) { + print <<EOF; +Location: file:$file +EOF + exit; +} +if (! open(FILE, "< $file")) { + $file = &html_quote($file); + $_ = "$file: " . &html_quote($!); + print <<EOF; +Content-Type: text/html + +<head><title>$file</title></head> +<b>$_</b> +EOF + exit 1; +} + +$file = &html_quote($file); +($dir = $file) =~ s@[^/]*$@@; + +print <<EOF; +Content-Type: text/html + +<head><title>$file</title></head> +<pre> +EOF +while (<FILE>) { + $_ = &html_quote($_); + + s/^(\#\s*include\s+)(\".*\"|\<\;.*\>\;)/$1 . &header_ref($2)/ge; + + print; +} +close(FILE); +print "</pre>\n"; + +sub header_ref { + local($_) = @_; + local($d); + + if (s/^\"//) { + s/\"$//; + return ""<a href=\"$CGI$dir$_\">$_</a>""; + } + s/^\<\;//; + s/\>\;$//; + + for $d ( + "/usr/include", + "/usr/local/include", + "/usr/X11R6/include", + "/usr/X11/include", + "/usr/X/include", + "/usr/include/X11" + ) { + -f "$d/$_" && return "<<a href=\"$CGI$d/$_\">$_</a>>"; + } + return $_; +} + + +sub html_quote { + local($_) = @_; + local(%QUOTE) = ( + '<', '<', + '>', '>', + '&', '&', + '"', '"', + ); + s/[<>&"]/$QUOTE{$&}/g; + return $_; +} + +sub cleanup { + local($_) = @_; + + s@//+@/@g; + s@/\./@/@g; + while(m@/\.\./@) { + s@^/(\.\./)+@/@; + s@/[^/]+/\.\./@/@; + } + return $_; +} |