#!/usr/bin/perl # # $Id: bsdi-man.pl,v 1.1 2026/03/31 02:15:16 kristaps Exp $ # # bsdi-man -- HTML hypertext BSDI man page interface # based on bsdi-man.pl,v 2.10 1993/10/02 06:13:23 sanders Exp # by polk@BSDI.COM 1/10/95 # BSDI Id: bsdi-man,v 1.2 1995/01/11 02:30:01 polk Exp # Dual CGI/Plexus mode and new interface by sanders@bsdi.com 9/22/1995 # # TODO:: Add support for multiple architectures (i386, sparc) # TODO:: Add support for OS version # TODO:: Config option for man path package bsdi_man; # Config Options # map sections to their man command argument(s) %sections = ( "", "", "1", "-s 1", "1L", "-s 1", "1X", "-s 1", "2", "-s 2", "3", "-s 3", "3C", "-s 3", "3N", "-s 3", "3R", "-s 3", "3X", "-s 3", "3X11", "-M X11 -s 3", "3X1F", "-s 3", "3X1X", "-s 3", "3XT", "-s 3", "3XX", "-s 3", "3XXL", "-s 3", "3Xt", "-s 3", "4", "-s 4", "5", "-s 5", "5F", "-s 5", "5F", "-s 5", "6", "-s 6", "7", "-s 7", "8", "-s 8", "8C", "-s 8", "l", "-s local", "n", "-s new", "o", "-s old", "bsdi", "-M bsdi", "mh", "-M mh", "sendmail", "-M sendmail", "X11", "-M X11", ); @sections = keys %sections; shift @sections; # all but the "" entry $sections = join("|", @sections); # sections regexp $protocol = "1.0"; # version of the form protocol # this can easily overridden by setting $bsdi_man'webmaster $webmaster = $webmaster || $main'plexus{'admin'}; # CGI Interface -- runs at load time &main'do_bsdi_man(&env('SCRIPT_NAME'), &env('PATH_INFO'), &env('QUERY_STRING')) unless defined($main'plexus_configured); # Plexus Native Interface sub main'do_bsdi_man { local($BASE, $path, $form) = @_; local($_, %form, $query, $proto, $name, $section, $apropos); $BASE = "/" . $BASE; # we serve up our own bitmap if needed return &bitmap if ($path =~ /bsdi-man.xbm$/); # indexpage if no query data return &indexpage unless defined($form); # check to see if it's an old- or new-style query if ($form =~ m/^proto=[\d\.]*&/) { # New-style query, process the form data # We are expecting: proto=$protocol, query, section, apropos, title &decode_form($form, *form, 0); $proto = $form{'proto'}; # new-style proto die "Invalid Query Protocol Version\n" unless $proto eq $protocol; $name = $query = $form{'query'}; $section = $form{'section'}; $section = "" if $section eq "ALL"; $apropos = $form{'apropos'}; $alttitle = $form{'title'}; if (!$apropos && $query =~ m/^(.*)\(([^\)]*)\)/) { $name = $1; $section = $2; } } else { # Old-style query, look for `foo', `foo()', `foo(sect)' patterns. undef $proto; # old-style $query = join(" ", &splitquery($form)); ($name, $section) = $query =~ m/^([\w\s\+\,\.\_\-]+)\\*\(([\w\,]*)\\*\)/; $apropos = !(defined($name) && defined($section)); } $apropos ? &apropos($query) : &man($name, $section); } # --------------------- support routines ------------------------ sub debug { &http_header("text/plain"); print @_,"\n----------\n\n\n"; } sub http_header { local($content_type) = @_; if (defined($main'plexus_configured)) { &main'MIME_header('ok', $content_type); } else { print "Content-type: $content_type\n\n"; } } sub env { defined($main'ENV{$_[0]}) ? $main'ENV{$_[0]} : undef; } sub apropos { local($query) = @_; local($_, $title, $head, *APROPOS); local($names, $section, $msg, $key); local($prefix); $prefix = "Apropos "; if ($alttitle) { $prefix = ""; $title = &encode_title($alttitle); $head = &encode_data($alttitle); } else { $title = &encode_title($query); $head = &encode_data($query); } &http_header("text/html"); print "\n"; print "\n"; print "BSDI Hypertext Man Pages: Apropos $title\n"; print "\n"; print "\n"; print "

$prefix$head

\n"; print "

\n"; print "Index Page and Help\n"; &formquery; print "

\n"; print "
\n"; &proc(*APROPOS, "/usr/bin/apropos", "--", $query) || die "$0: open of /usr/bin/apropos failed: $!\n"; while () { if (m/nothing appropriate/) { print "Sorry, no data found...\n"; last; } # matches whatis.db lines: name[, name ...] (sect) - msg $names = $section = $msg = $key = undef; ($names, $section, $msg) = m/^([^()]+)\(([^)]*)\)\s+-\s+(.*)/; ($key) = m/^([^,\s]*)/; # match first element only print "
", &encode_data("$names($section)"), "\n
", &encode_data($msg), "\n"; } close(APROPOS); print "
\n\n\n"; } sub man { local($name, $section) = @_; local($_, $title, $head, *MAN); local($html_name, $html_section, $prefix); local(@manargs); $prefix = "MAN "; if ($alttitle) { $prefix = ""; $title = &encode_title($alttitle); $head = &encode_data($alttitle); } elsif ($section) { $title = &encode_title("${name}($section)"); $head = &encode_data("${name}($section)"); } else { $title = &encode_title("${name}"); $head = &encode_data("${name}"); } &http_header("text/html"); print "\n"; print "\n"; print "BSDI Hypertext Man Pages: $title \n"; print "\n"; print "\n"; print "

$prefix$head

\n"; print "

\n"; print "Index Page and Help\n"; &formquery; print "

\n"; print "This data is part of a licensed program from BERKELEY SOFTWARE\n"; print "DESIGN, INC. Portions are copyrighted by BSDI, The Regents of\n"; print "the University of California, Massachusetts Institute of\n"; print "Technology, Free Software Foundation, and others.\n"; print "
\n"; print "

\n"; print "
\n";

    $html_name = &encode_data($name);
    $html_section = &encode_data($section);

    if (!defined($sections{$section})) {
	print "Sorry, section ``$html_section'' is not valid\n";
	return;
    }

    @manargs = split(/ /, $sections{$section});

    &proc(*MAN, "/usr/bin/man", @manargs, "--", $name) ||
	die ("$0: open of man command failed: $!\n");
    if (eof(MAN)) {
	print "Sorry, no data found for $html_name($html_section)...\n";
	return;
    }
    while() {
	$_ = &encode_data($_);
	if(m,()?\#include()?\s+()?\&#lt\;(.*\.h)\&#gt\;()?,) {
	    $match = $4; ($regexp = $match) =~ s/\./\\\./;
	    s,$regexp,\$match\,;
        }
	/^\s/ && 			# skip headers
	    s,((<[IB]>)?[\w\_\.\-]+\s*()?\s*\(($sections)\)),&mlnk($1),oige;
	print;
    }
    close(MAN);
    print "
\n"; print "\n"; print "\n"; } sub mlnk { local($matched) = @_; local($link, $section); ($link = $matched) =~ s/[\s]+//g; $link =~ s/<\/?[IB]>//g; ($link, $section) = ($link =~ m/^([^\(]*)\((.*)\)/); $link = &encode_url($link); $section = &encode_url($section); return "$matched"; } sub proc { local(*FH, $prog, @args) = @_; local($pid) = open(FH, "-|"); return undef unless defined($pid); if ($pid == 0) { exec $prog, @args; die "exec $prog failed\n"; } 1; } # $indent is a bit of optional data processing I put in for # formatting the data nicely when you are emailing it. # This is derived from code by Denis Howe # and Thomas A Fine sub decode_form { local($form, *data, $indent, $key, $_) = @_; foreach $_ (split(/&/, $form)) { ($key, $_) = split(/=/, $_, 2); $_ =~ s/\+/ /g; # + -> space $key =~ s/\+/ /g; # + -> space $_ =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig; # undo % escapes $key =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig; # undo % escapes $_ =~ s/[\r\n]+/\n\t/g if defined($indent); # indent data after \n $data{$key} = $_; } } # # Splits up a query request, returns an array of items. # usage: @items = &main'splitquery($query); # sub splitquery { local($query) = @_; grep((s/%([\da-f]{1,2})/pack(C,hex($1))/eig, 1), split(/\+/, $query)); } # encode unknown data for use in a URL sub encode_url { local($_) = @_; # rfc1738 says that ";"|"/"|"?"|":"|"@"|"&"|"=" may be reserved. # And % is the escape character so we escape it along with # single-quote('), double-quote("), grave accent(`), less than(<), # greater than(>), and non-US-ASCII characters (binary data), # and white space. Whew. s/([\000-\032\;\/\?\:\@\&\=\%\'\"\`\<\>\177-\377])/sprintf('%%%02x',ord($1))/eg; $_; } # encode unknown data for use in ...</TITILE> sub encode_title { # like encode_url but less strict (I couldn't find docs on this) local($_) = @_; s/([\000-\031\%\&\<\>\177-\377])/sprintf('%%%02x',ord($1))/eg; $_; } # encode unknown data for use inside markup attributes <MARKUP ATTR="..."> sub encode_attribute { # rfc1738 says to use entity references here local($_) = @_; s/([\000-\031\"\'\`\%\&\<\>\177-\377])/sprintf('\&#%03d;',ord($1))/eg; $_; } # encode unknown text data for using as HTML, # treats ^H as overstrike ala nroff. sub encode_data { local($_) = @_; local($str); # Escape binary data except for ^H which we process below # \375 gets turned into the & for the entity reference s/([^\010\012\015\032-\176])/sprintf('\375#%03d;',ord($1))/eg; # Process ^H sequences, we use \376 and \377 (already escaped # above) to stand in for < and > until those characters can # be properly escaped below. s,((_\010.)+),($str = $1) =~ s/.\010//g; "\376I\377$str\376/I\377";,ge; s,((.\010.)+),($str = $1) =~ s/.\010//g; "\376B\377$str\376/B\377";,ge; s,\376[IB]\377_\376/[IB]\377,,g; s/.[\b]//g; # just do an erase for anything else # Escape &, < and > s/\&/\&\;/g; s/\</\<\;/g; s/\>/\>\;/g; # Now convert our magic chars into our tag markers s/\375/\&/g; s/\376/</g; s/\377/>/g; $_; } sub indexpage { &http_header("text/html"); print <<ETX; <HTML> <HEAD> <TITLE>BSDI Hypertext Man Pages: Index Page

BSDI Man Pages

Man Page Lookup searches for man pages name and section as given in the selection menu and the query dialog. Apropos Keyword Search searches the database for the string given in the query dialog. There are also several hypertext links provided as short-cuts to various queries: Section Indexes is apropos listings of all man pages by section. Explanations of Man Sections contains pointers to the intro pages for various man sections. Or you can select a catagory from Quick Reference Categories and see man pages relevant to the selected topic.

ETX &formquery; print <Section Indexes: 1 ¤ 2 ¤ 3 ¤ 3X11 ¤ 4 ¤ 5 ¤ 6 ¤ 7 ¤ 8
Explanations of Man Sections: intro(1) ¤ intro(2) ¤ intro(3) ¤ intro(4) ¤ intro(7) ¤ intro(8)
Quick Reference Categories: Networking ¤ NFS ¤ Mail ¤ Languages ¤ SCO Emulation ¤ DOS
ETX print < Please direct questions about this server to <${webmaster}>

ETX print "\n\n"; 0; } sub formquery { local($astring, $bstring); if (!$apropos) { $astring = " CHECKED"; } else { $bstring = " CHECKED"; } print <

Type of Search:
Man Page Lookup
Apropos Keyword Search (all sections)
Man Page or Keyword Search:
ETX 0; } sub bitmap { &http_header("image/x-xbitmap"); print <