diff options
Diffstat (limited to '')
| -rw-r--r-- | scripts/dirlist.cgi | 532 | ||||
| -rwxr-xr-x | scripts/dirlist.cgi.in (renamed from scripts/dirlist.in) | 0 | ||||
| -rw-r--r-- | scripts/multipart/multipart.cgi | 272 | ||||
| -rw-r--r-- | scripts/w3mman/w3mman | 41 | ||||
| -rw-r--r-- | scripts/w3mman/w3mman2html.cgi | 252 |
5 files changed, 0 insertions, 1097 deletions
diff --git a/scripts/dirlist.cgi b/scripts/dirlist.cgi deleted file mode 100644 index 2e723b4..0000000 --- a/scripts/dirlist.cgi +++ /dev/null @@ -1,532 +0,0 @@ -#!/usr/bin/perl -# -# Directory list CGI by Hironori Sakamoto (hsaka@mth.biglobe.ne.jp) -# - -if ( $^O =~ /^(ms)?(dos|win(32|nt)?)/i ) { - $WIN32 = 1; - $CYGPATH = 1; -} -elsif ( $^O =~ /cygwin|os2/i ) { - $WIN32 = 1; - $CYGPATH = 0; -} -else { - $WIN32 = 0; - $CYGPATH = 0; -} -$RC_DIR = '~/.w3m/'; - -$RC_DIR =~ s@^~/@$ENV{'HOME'}/@; -if ($CYGPATH) { - $RC_DIR = &cygwin_pathconv("$RC_DIR"); -} -$CONFIG = "$RC_DIR/dirlist"; -$CGI = $ENV{'SCRIPT_NAME'} || $0; -$CGI = "file://" . &file_encode("$CGI"); - -$AFMT = '<a href="%s"><nobr>%s</nobr></a>'; -$NOW = time(); - -@OPT = &init_option($CONFIG); - -$query = $ENV{'QUERY_STRING'}; -$cmd = ''; -$cgi = 0; -if ($query eq '') { - $_ = `pwd`; - chop; - s/\r$//; - $dir = $_; - $cgi = 0; -} elsif ($query =~ /^(opt\d+|dir|cmd)=/) { - foreach(split(/\&/, $query)) { - if (s/^dir=//) { - $dir = &form_decode($_); - } elsif (s/^opt(\d+)=//) { - $OPT[$1] = $_; - } elsif (s/^cmd=//) { - $cmd = $_; - } - } - $cgi = 1; -} else { - $dir = $query; - if (($dir !~ m@^/@) && - ($WIN32 && $dir !~ /^[a-z]:/i)) { - $_ = `pwd`; - chop; - s/\r$//; - $dir = "$_/$dir"; - } - $cgi = -1; -} -if ($dir !~ m@/$@) { - $dir .= '/'; -} -if ($dir =~ m@^/@ && $CYGPATH) { - $dir = &cygwin_pathconv("$dir"); -} -$ROOT = ''; -if ($WIN32) { - if (($dir =~ s@^//[^/]+@@) || ($dir =~ s@^[a-z]:@@i)) { - $ROOT = $&; - } - if ($CYGPATH) { - $ROOT = &cygwin_pathconv("$ROOT"); - } -} -if ($cgi) { - $dir = &cleanup($dir); -} - -$TYPE = $OPT[$OPT_TYPE]; -$FORMAT = $OPT[$OPT_FORMAT]; -$SORT = $OPT[$OPT_SORT]; -if ($cmd) { - &update_option($CONFIG); -} - -$qdir = "$ROOT" . &html_quote("$dir"); -$edir = "$ROOT" . &file_encode("$dir"); -if (! opendir(DIR, "$ROOT$dir")) { - print <<EOF; -Content-Type: text/html - -<html> -<head> -<title>Directory list of $qdir</title> -</head> -<body> -<b>$qdir</b>: $! ! -</body> -</html> -EOF - exit 1; -} - -# ($cgi > 0) && print <<EOF; -# w3m-control: DELETE_PREVBUF -# EOF -print <<EOF; -Content-Type: text/html - -<html> -<head> -<title>Directory list of $qdir</title> -</head> -<body> -<h1>Directory list of $qdir</h1> -EOF -&print_form($edir, @OPT); -print <<EOF; -<hr> -EOF -$dir =~ s@/$@@; -@sdirs = split('/', $dir); -$_ = $sdirs[0]; -if ($_ eq '') { - $_ = '/'; -} -if ($TYPE eq $TYPE_TREE) { - print <<EOF; -<table hborder width="640"> -<tr valign=top><td width="160"> -<pre> -EOF - $q = "$ROOT". &html_quote("$_"); - $e = "$ROOT" . &file_encode("$_"); - if ($dir =~ m@^$@) { - $n = "\" name=\"current"; - } else { - $n = ''; - } - printf("$AFMT\n", "$e$n", "<b>$q</b>"); - $N = 0; - $SKIPLINE = ""; - - &left_dir('', @sdirs); - - print <<EOF; -</pre> -</td><td width="400"> -<pre>$SKIPLINE -EOF -} else { - print <<EOF; -<pre> -EOF -} - -&right_dir($dir); - -if ($TYPE eq $TYPE_TREE) { - print <<EOF; -</pre> -</td></tr> -</table> -</body> -</html> -EOF -} else { - print <<EOF; -</pre> -</body> -</html> -EOF -} - -sub left_dir { - local($pre, $dir, @sdirs) = @_; - local($ok) = (@sdirs == 0); - local(@cdirs) = (); - local($_, $dir0, $d, $qdir, $q, $edir, $e); - - $dir0 = "$dir/"; - $dir = "$dir0"; - opendir(DIR, "$ROOT$dir") || return; - - foreach(sort readdir(DIR)) { - -d "$ROOT$dir$_" || next; - /^\.$/ && next; - /^\.\.$/ && next; - push(@cdirs, $_); - } - closedir(DIR); - - $qdir = "$ROOT" . &html_quote($dir); - $edir = "$ROOT" . &file_encode($dir); - while(@cdirs) { - $_ = shift @cdirs; - $q = &html_quote($_); - $e = &file_encode($_); - $N++; - if (!$ok && $_ eq $sdirs[0]) { - $d = $dir0 . shift @sdirs; - if (!@sdirs) { - $n = "\" name=\"current"; - $SKIPLINE = "\n" x $N; - } else { - $n = ''; - } - printf("${pre}o-$AFMT\n", "$edir$e$n", "<b>$q</b>"); - &left_dir(@cdirs ? "$pre| " : "$pre ", $d, @sdirs); - $ok = 1; - } else { - printf("${pre}+-$AFMT\n", "$edir$e", $q); - } - } -} - -sub right_dir { - local($dir) = @_; - local(@list); - local($_, $qdir, $q, $edir, $e, $f, $max, @d, $type, $u, $g); - local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, - $atime,$mtime,$ctime,$blksize,$blocks); - local(%sizes, %ctimes, %prints); - - $dir = "$dir/"; - opendir(DIR, "$ROOT$dir") || return; - - $qdir = "$ROOT" . &html_quote($dir); - $edir = "$ROOT" . &file_encode($dir); - if ($TYPE eq $TYPE_TREE) { - print "<b>$qdir</b>\n"; - } - @list = (); - $max = 0; - foreach(readdir(DIR)) { - /^\.$/ && next; -# if ($TYPE eq $TYPE_TREE) { -# /^\.\.$/ && next; -# } - $f = "$ROOT$dir$_"; - (($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, - $atime,$mtime,$ctime,$blksize,$blocks) = lstat($f)) || next; - push(@list, $_); - $sizes{$_} = $size; - $ctimes{$_} = $ctime; - - if ($FORMAT eq $FORMAT_COLUMN) { - if (length($_) > $max) { - $max = length($_); - } - next; - } - $type = &utype($mode); - if ($FORMAT eq $FORMAT_SHORT) { - $prints{$_} = sprintf("%-6s ", "[$type]"); - next; - } - if ($type =~ /^[CB]/) { - $size = sprintf("%3u, %3u", ($rdev >> 8) & 0xff, $rdev & 0xffff00ff); - } - if ($FORMAT eq $FORMAT_LONG) { - $u = $USER{$uid} || ($USER{$uid} = getpwuid($uid) || $uid); - $g = $GROUP{$gid} || ($GROUP{$gid} = getgrgid($gid) || $gid); - $prints{$_} = sprintf( "%s %-8s %-8s %8s %s ", - &umode($mode), $u, $g, $size, &utime($ctime)); -# } elsif ($FORMAT eq $FORMAT_STANDARD) { - } else { - $prints{$_} = sprintf("%-6s %8s %s ", "[$type]", $size, &utime($ctime)); - } - } - closedir(DIR); - if ($SORT eq $SORT_SIZE) { - @list = sort { $sizes{$b} <=> $sizes{$a} || $a <=> $b } @list; - } elsif ($SORT eq $SORT_TIME) { - @list = sort { $ctimes{$b} <=> $ctimes{$a} || $a <=> $b } @list; - } else { - @list = sort @list; - } - if ($FORMAT eq $FORMAT_COLUMN) { - local($COLS, $l, $nr, $n); - if ($TYPE eq $TYPE_TREE) { - $COLS = 60; - } else { - $COLS = 80; - } - $l = int($COLS / ($max + 2)) || 1; - $nr = int($#list / $l + 1); - $n = 0; - print "<table>\n<tr valign=top>"; - foreach(@list) { - $f = "$ROOT$dir$_"; - $q = &html_quote($_); - $e = &file_encode($_); - if ($n % $nr == 0) { - print "<td>"; - } - if (-d $f) { - printf($AFMT, "$edir$e", "$q/"); - } else { - printf($AFMT, "$edir$e", $q); - } - $n++; - if ($n % $nr == 0) { - print "</td>\n"; - } else { - print "<br>\n"; - } - } - print "</tr></table>\n"; - return; - } - foreach(@list) { - $f = "$ROOT$dir$_"; - $q = &html_quote($_); - $e = &file_encode($_); - print $prints{$_}; - if (-d $f) { - printf($AFMT, "$edir$e", "$q/"); - } else { - printf($AFMT, "$edir$e", $q); - } - if (-l $f) { - print " -> ", &html_quote(readlink($f)); - } - print "\n"; - } -} - -sub init_option { - local($config) = @_; - $OPT_TYPE = 0; - $OPT_FORMAT = 1; - $OPT_SORT = 2; - $TYPE_TREE = 't'; - $TYPE_STANDARD = 'd'; - $FORMAT_SHORT = 's'; - $FORMAT_STANDARD = 'd'; - $FORMAT_LONG = 'l'; - $FORMAT_COLUMN = 'c'; - $SORT_NAME = 'n'; - $SORT_SIZE = 's'; - $SORT_TIME = 't'; - local(@opt) = ($TYPE_TREE, $FORMAT_STANDARD, $SORT_NAME); - local($_); - - open(CONFIG, "< $config") || return @opt; - while(<CONFIG>) { - chop; - s/^\s+//; - tr/A-Z/a-z/; - if (/^type\s+(\S)/i) { - $opt[$OPT_TYPE] = $1; - } elsif (/^format\s+(\S)/i) { - $opt[$OPT_FORMAT] = $1 - } elsif (/^sort\s+(\S)/i) { - $opt[$OPT_SORT] = $1; - } - } - close(CONFIG); - return @opt; -} - -sub update_option { - local($config) = @_; - - open(CONFIG, "> $config") || return; - print CONFIG <<EOF; -type $TYPE -format $FORMAT -sort $SORT -EOF - close(CONFIG); -} - -sub print_form { - local($d, @OPT) = @_; - local(@disc) = ('Type', 'Format', 'Sort'); - local(@val) = ( - "('t', 'd')", - "('s', 'd', 'c')", - "('n', 's', 't')", - ); - local(@opt) = ( - "('Tree', 'Standard')", - "('Short', 'Standard', 'Column')", - "('By Name', 'By Size', 'By Time')" - ); - local($_, @vs, @os, $v, $o); - - print <<EOF; -<form action=\"$CGI\"> -<center> -<table> -<tr valign=top> -EOF - foreach(0 .. 2) { - print "<td align> $disc[$_]</td>\n"; - } - print "</tr><tr>\n"; - foreach(0 .. 2) { - print "<td><select name=opt$_>\n"; - eval "\@vs = $val[$_]"; - eval "\@os = $opt[$_]"; - foreach $v (@vs) { - $o = shift(@os); - if ($v eq $OPT[$_]) { - print "<option value=$v selected>$o\n"; - } else { - print "<option value=$v>$o\n"; - } - } - print "</select></td>\n"; - } - print <<EOF; -<td><input type=submit name=cmd value="Update"></td> -</tr> -</table> -</center> -<input type=hidden name=dir value="$d"> -</form> -EOF -} - -sub html_quote { - local($_) = @_; - local(%QUOTE) = ( - '<', '<', - '>', '>', - '&', '&', - '"', '"', - ); - s/[<>&"]/$QUOTE{$&}/g; - return $_; -} -sub file_encode { - local($_) = @_; - s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg; - return $_; -} - -sub form_decode { - local($_) = @_; - s/\+/ /g; - s/%([\da-f][\da-f])/pack('C', hex($1))/egi; - return $_; -} - -sub cleanup { - local($_) = @_; - - s@//+@/@g; - s@/\./@/@g; - while(m@/\.\./@) { - s@^/(\.\./)+@/@; - s@/[^/]+/\.\./@/@; - } - return $_; -} - -sub utype { - local($_) = @_; - local(%T) = ( - 0010000, 'PIPE', - 0020000, 'CHR', - 0040000, 'DIR', - 0060000, 'BLK', - 0100000, 'FILE', - 0120000, 'LINK', - 0140000, 'SOCK', - ); - return $T{($_ & 0170000)} || 'FILE'; -} - -sub umode { - local($_) = @_; - local(%T) = ( - 0010000, 'p', - 0020000, 'c', - 0040000, 'd', - 0060000, 'b', - 0100000, '-', - 0120000, 'l', - 0140000, 's', - ); - - return ($T{($_ & 0170000)} || '-') - . (($_ & 00400) ? 'r' : '-') - . (($_ & 00200) ? 'w' : '-') - . (($_ & 04000) ? 's' : - (($_ & 00100) ? 'x' : '-')) - . (($_ & 00040) ? 'r' : '-') - . (($_ & 00020) ? 'w' : '-') - . (($_ & 02000) ? 's' : - (($_ & 00010) ? 'x' : '-')) - . (($_ & 00004) ? 'r' : '-') - . (($_ & 00002) ? 'w' : '-') - . (($_ & 01000) ? 't' : - (($_ & 00001) ? 'x' : '-')); -} - -sub utime { - local($_) = @_; - local(@MON) = ( - 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', - 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' - ); - local($sec,$min,$hour,$mday,$mon, - $year,$wday,$yday,$isdst) = localtime($_); - - if ($_ > $NOW - 182*24*60*60 && $_ < $NOW + 183*24*60*60) { - return sprintf("%3s %2d %.2d:%.2d", $MON[$mon], $mday, $hour, $min); - } else { - return sprintf("%3s %2d %5d", $MON[$mon], $mday, 1900+$year); - } -} - -sub cygwin_pathconv { - local($_) = @_; - local(*CYGPATH); - - open(CYGPATH, '-|') or exec('cygpath', '-w', $_); - $_ = <CYGPATH>; - close(CYGPATH); - s/\r?\n$//; - s!\\!/!g; - s!/$!!; - return $_; -} diff --git a/scripts/dirlist.in b/scripts/dirlist.cgi.in index c756273..c756273 100755 --- a/scripts/dirlist.in +++ b/scripts/dirlist.cgi.in diff --git a/scripts/multipart/multipart.cgi b/scripts/multipart/multipart.cgi deleted file mode 100644 index e7c71e5..0000000 --- a/scripts/multipart/multipart.cgi +++ /dev/null @@ -1,272 +0,0 @@ -#!/usr/local/bin/perl - -if ($use_NKF = eval "use NKF;") { - $CONV = "-e"; - $MIME_DECODE = "-m -e"; -} else { -# $CONV = "w3m -dump -e"; - $CONV = "/usr/local/bin/nkf -e"; - $MIME_DECODE = "/usr/local/bin/nkf -m -e"; -} -$MIME_TYPE = "$ENV{'HOME'}/.mime.types"; - -if (defined($ENV{'QUERY_STRING'})) { - for (split('&', $ENV{'QUERY_STRING'})) { - s/^([^=]*)=//; - $v{$1} = $_; - } - $file = &form_decode($v{'file'}); - $boundary = &form_decode($v{'boundary'}); -} else { - $file = $ARGV[0]; - if (@ARGV >= 2) { - $boundary = $ARGV[1]; - } - $CGI = "file:///\$LIB/multipart.cgi?file=" . &html_quote($file); -} - -open(F, $file); -$end = 0; -$mbody = ''; -if (defined($boundary)) { - while(<F>) { - s/\r?\n$//; - ($_ eq "--$boundary") && last; - ($_ eq "--$boundary--") && ($end = 1, last); - $mbody .= "$_\n"; - } -} else { - while(<F>) { - s/\r?\n$//; - if (s/^\-\-//) { - $boundary = $_; - last; - } - $mbody .= "$_\n"; - } -} -$CGI .= "&boundary=" . &html_quote($boundary); - -if (defined($v{'count'})) { - $count = 0; - while($count < $v{'count'}) { - while(<F>) { - s/\r?\n$//; - ($_ eq "--$boundary") && last; - } - eof(F) && exit; - $count++; - } - - %header = (); - $hbody = ''; - while(<F>) { - /^\s*$/ && last; - $x = $_; - s/\r?\n$//; - if (/=\?/) { - $_ = &decode($_, $MIME_DECODE); - } - if (s/^(\S+)\s*:\s*//) { - $hbody .= "$&$_\n"; - $p = $1; - $p =~ tr/A-Z/a-z/; - $header{$p} = $_; - } elsif (s/^\s+//) { - chop $hbody; - $hbody .= "$_\n"; - $header{$p} .= $_; - } - } - $type = $header{"content-type"}; - $dispos = $header{"content-disposition"}; - if ($type =~ /application\/octet-stream/) { - if ($type =~ /type\=gzip/) { - print "Content-Encoding: x-gzip\n"; - } - if ($type =~ /name=\"?([^\"]+)\"?/ || - $dispos =~ /filename=\"?([^\"]+)\"?/) { - $type = &guess_type($1); - if ($type) { - print "Content-Type: $type; name=\"$1\"\n"; - } else { - print "Content-Type: text/plain; name=\"$1\"\n"; - } - } - } - print $hbody; - print "\n"; - while(<F>) { - $x = $_; - s/\r?\n$//; - ($_ eq "--$boundary") && last; - if ($_ eq "--$boundary--") { - last; - } - print $x; - } - close(F); - exit; -} - -if ($mbody =~ /\S/) { - $_ = $mbody; - s/\&/\&/g; - s/\</\</g; - s/\>/\>/g; - print "<pre>\n"; - print $_; - print "</pre>\n"; -} - -$count = 0; -while(! $end) { - %header = (); - $hbody = ''; - while(<F>) { - /^\s*$/ && last; - s/\r?\n$//; - if (/=\?/) { - $_ = &decode($_, $MIME_DECODE); - } - if (s/^(\S+)\s*:\s*//) { - $hbody .= "$&$_\n"; - $p = $1; - $p =~ tr/A-Z/a-z/; - $header{$p} = $_; - } elsif (s/^\s+//) { - chop $hbody; - $hbody .= "$_\n"; - $header{$p} .= $_; - } - } - $type = $header{"content-type"}; - $dispos = $header{"content-disposition"}; - if ((! $type || $type =~ /^text\/plain/i) && - (! $dispos || $dispos =~ /^inline/i)) { - $plain = 1; - } else { - $plain = 0; - } - $body = ''; - while(<F>) { - s/\r?\n$//; - ($_ eq "--$boundary") && last; - if ($_ eq "--$boundary--") { - $end = 1; - last; - } - if ($plain) { - $body .= "$_\n"; - } - } - $| = 1; - print "<hr>\n"; - { - $_ = $hbody; - s/\&/\&/g; - s/\</\</g; - s/\>/\>/g; - print "<pre>\n"; - print $_; - if ($type =~ /name=\"?([^\"]+)\"?/ || - $dispos =~ /filename=\"?([^\"]+)\"?/) { - $name = $1; - } else { - $name = "[Content]"; - } - print "\n<a href=\"$CGI&count=$count\">", &html_quote($name), "</a>"; - print "\n\n</pre>\n"; - } - if ($plain) { - $body = &decode($body, $CONV); - $_ = $body; - s/\&/\&/g; - s/\</\</g; - s/\>/\>/g; - print "<pre>\n"; - print $_; - print "</pre>\n"; - } - eof(F) && last; - $count++; -} -close(F); - -sub decode { -if ($use_NKF) { - local($body, $opt) = @_; - return nkf($opt, $body); -} - local($body, @cmd) = @_; - local($_); - - $| = 1; - pipe(R, W2); - pipe(R2, W); - if (! fork()) { - close(F); - close(R); - close(W); - open(STDIN, "<&R2"); - open(STDOUT, ">&W2"); - exec @cmd; - die; - } - close(R2); - close(W2); - print W $body; - close(W); - $body = ''; - while(<R>) { - $body .= $_; - } - close(R); - return $body; -} - -sub html_quote { - local($_) = @_; - local(%QUOTE) = ( - '<', '<', - '>', '>', - '&', '&', - '"', '"', - ); - s/[<>&"]/$QUOTE{$&}/g; - return $_; -} - -sub form_decode { - local($_) = @_; - s/\+/ /g; - s/%([\da-f][\da-f])/pack('c', hex($1))/egi; - return $_; -} - -sub guess_type { - local($_) = @_; - - /\.(\w+)$/ || next; - $_ = $1; - tr/A-Z/a-z/; - %mime_type = &load_mime_type($MIME_TYPE); - $mime_type{$_}; -} - -sub load_mime_type { - local($file) = @_; - local(%m, $a, @b, $_); - - open(M, $file) || return (); - while(<M>) { - /^#/ && next; - chop; - (($a, @b) = split(" ")) >= 2 || next; - for(@b) { - $m{$_} = $a; - } - } - close(M); - return %m; -} diff --git a/scripts/w3mman/w3mman b/scripts/w3mman/w3mman deleted file mode 100644 index 44aba2f..0000000 --- a/scripts/w3mman/w3mman +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/local/bin/perl - -@W3M = split(' ', 'w3m'); -$ENV{'MAN'} = 'man'; -$SCRIPT = 'file:///$LIB/w3mman2html.cgi'; - -sub usage { - ($_ = $0) =~ s@.*/@@; - print STDERR "$_ [-M <path>] [[<section>] <command>]\n"; - print STDERR "$_ [-M <path>] [-k <keyword>]\n"; - exit 1; -} - -$query = ""; -while (@ARGV) { - $_ = shift @ARGV; - if (/^-M$/) { - @ARGV || &usage(); - $ENV{'MANPATH'} = shift @ARGV; - } elsif (/^-k$/) { - @ARGV || &usage(); - $query = "?keyword=" . &form_encode(shift @ARGV); - } elsif (/^-/) { - &usage(); - } elsif (/^\d/ || $_ eq 'n') { - @ARGV || &usage(); - $query = "?quit=ok&man=" . &form_encode(shift @ARGV); - $query .= "§ion=" . &form_encode($_); - } else { - $query = "?quit=ok&man=" . &form_encode($_); - } -} - -exec @W3M, "$SCRIPT$query"; - -sub form_encode { - local($_) = @_; - s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg; - return $_; -} - diff --git a/scripts/w3mman/w3mman2html.cgi b/scripts/w3mman/w3mman2html.cgi deleted file mode 100644 index 0f75502..0000000 --- a/scripts/w3mman/w3mman2html.cgi +++ /dev/null @@ -1,252 +0,0 @@ -#!/usr/local/bin/perl - -$MAN = $ENV{'MAN'} || 'man'; -$QUERY = $ENV{'QUERY_STRING'} || $ARGV[0]; -$SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0; -$CGI = "file://$SCRIPT_NAME"; -$CGI2 = "file:"; -# $CGI2 = "file:///\$LIB/hlink.cgi?"; -$SQUEEZE = 1; - -if ($QUERY =~ /\=/) { - for (split('&', $QUERY)) { - ($v, $q) = split('=', $_, 2); - $query{$v} = &form_decode($q); - } -} else { - $QUERY =~ s/^man=//; - $query{"man"} = &form_decode($QUERY); -} - -if (! $query{"man"}) { - if ($query{"keyword"}) { - $keyword = $query{"keyword"}; - $k = &html_quote($keyword); - print <<EOF; -Content-Type: text/html - -<html> -<head><title>man -k $k</title></head> -<body> -<h2>man -k <b>$k</b></h2> -<ul> -EOF - $keyword =~ s:([^\w./]):\\$1:g; - open(F, "$MAN -k $keyword 2> /dev/null |"); - @line = (); - while(<F>) { - chop; - $_ = &html_quote($_); - s/(\s+-.*)$//; - $title = $1; - s@(\w[\w.\-]*(\s*\,\s*\w[\w.\-]*)*)\s*(\([\dn]\w*\))@&keyword_ref($1, $3)@ge; - print "<li>$_$title\n"; - } - close(F); - print <<EOF; -</ul> -</body> -</html> -EOF - exit; - } - print <<EOF; -Content-Type: text/html - -<html> -<head><title>man</title></head> -<body> -<form action="$CGI"> -<table> -<tr><td>Manual:<td><input name=man> -<tr><td>Section:<td><input name=section> -<tr><td>Keyword:<td><input name=keyword> -<tr><td><td><input type=submit> <input type=reset> -</table> -</form> -</body> -</html> -EOF - exit; -} - -$man = $query{"man"}; -if ($man =~ s/\((\w+)\)$//) { - $section = $1; - $man_section = "$man($1)"; -} elsif ($query{"section"}) { - $section = $query{"section"}; - $man_section = "$man($section)"; -} else { - $section = ""; - $man_section = "$man"; -} - -$section =~ s:([^\w./]):\\$1:g; -$man =~ s:([^\w./]):\\$1:g; -open(F, "$MAN $section $man 2> /dev/null |"); -$ok = 0; -undef $header; -$blank = -1; -while(<F>) { - if (! defined($header)) { - /^\s*$/ && next; - $header = $_; - $space = $header; - chop $space; - $space =~ s/\S.*//; - } elsif ($_ eq $header) { # delete header - $blank = -1; - next; - } elsif (!/\010/ && /^$space[\w\200-\377].*\s\S/o) { # delete footer - $blank = -1; - next; - } - if ($SQUEEZE) { - if (/^\s*$/) { - $blank || $blank++; - next; - } elsif ($blank) { - $blank > 0 && print "\n"; - $blank = 0; - } - } - - s/\&/\&/g; - s/\</\</g; - s/\>/\>/g; - - s@([\200-\377].)(\010{1,2}\1)+@<b>$1</b>@g; - s@(\&\w+;|.)(\010\1)+@<b>$1</b>@g; - s@__\010{1,2}((\<b\>)?[\200-\377].(\</b\>)?)@<u>$1</u>@g; - s@_\010((\<b\>)?(\&\w+\;|.)(\</b\>)?)@<u>$1</u>@g; - s@((\<b\>)?[\200-\377].(\</b\>)?)\010{1,2}__@<u>$1</u>@g; - s@((\<b\>)?(\&\w+\;|.)(\</b\>)?)\010_@<u>$1</u>@g; - s@.\010(.)@$1@g; - - s@\</b\>\</u\>\<b\>_\</b\>\<u\>\<b\>@_@g; - s@\</u\>\<b\>_\</b\>\<u\>@_@g; - s@\</u\>\<u\>@@g; - s@\</b\>\<b\>@@g; - - if (! $ok) { - /^No/ && last; - print <<EOF; -Content-Type: text/html - -<html> -<head><title>man $man_section</title></head> -<body> -<pre> -EOF - print; - $ok = 1; - next; - } - - s@(http|ftp)://[\w.\-/~]+[\w/]@<a href="$&">$&</a>@g; - s@(\W)(mailto:)?(\w[\w.\-]*\@\w[\w.\-]*\.[\w.\-]*\w)@$1<a href="mailto:$3">$2$3</a>@g; - s@(\W)(\~?/[\w.][/\w.\-]*)@$1 . &file_ref($2)@ge; - s@(include(<\/?[bu]\>|\s)*\<)([/\w.\-]+)@$1 . &include_ref($3)@ge; - s@(\w[\w.\-]*)((\</[bu]\>)*)(\([\dm]\w*\))@<a href="$CGI?$1$4">$1</a>$2$4@g; - print; -} -close(F); -if (! $ok) { - if ($query{'quit'}) { - print STDERR "No manual entry for $man_section.\n"; - print <<EOF; -w3m-control: EXIT -EOF - exit 1; - } - print <<EOF; -Content-Type: text/html - -<html> -<head><title>man $man_section</title></head> -<body> -<pre> -EOF - print "No manual entry for <B>$man_section</B>.\n"; -} -print <<EOF; -</pre> -</body> -</html> -EOF - -sub is_command { - local($_) = @_; - local($p); - - (! -d && -x) || return 0; - if (! defined(%PATH)) { - for $p (split(":", $ENV{'PATH'})) { - $p =~ s@/+$@@; - $PATH{$p} = 1; - } - } - s@/[^/]*$@@; - return defined($PATH{$_}); -} - -sub file_ref { - local($_) = @_; - - if (&is_command($_)) { - ($man = $_) =~ s@.*/@@; - return "<a href=\"$CGI?$man\">$_</a>"; - } - if (/^\~/ || -f || -d) { - return "<a href=\"$CGI2$_\">$_</a>"; - } - return $_; -} - -sub include_ref { - local($_) = @_; - local($d); - - for $d ( - "/usr/include", - "/usr/local/include", - "/usr/X11R6/include", - "/usr/X11/include", - "/usr/X/include", - "/usr/include/X11" - ) { - -f "$d/$_" && return "<a href=\"$CGI2$d/$_\">$_</a>"; - } - return $_; -} - -sub keyword_ref { - local($_, $s) = @_; - local(@a) = (); - - for (split(/\s*,\s*/)) { - push(@a, "<a href=\"$CGI?$_$s\">$_</a>"); - } - return join(", ", @a) . $s; -} - -sub html_quote { - local($_) = @_; - local(%QUOTE) = ( - '<', '<', - '>', '>', - '&', '&', - '"', '"', - ); - s/[<>&"]/$QUOTE{$&}/g; - return $_; -} - -sub form_decode { - local($_) = @_; - s/\+/ /g; - s/%([\da-f][\da-f])/pack('c', hex($1))/egi; - return $_; -} - |