#!/usr/bin/perl -T # manServer - Unix man page to HTML converter # Rolf Howarth, rolf@squarebox.co.uk # Version 1.07 16 July 2001 $version = "1.07"; $manServerUrl = "manServer $version"; use Socket; $ENV{'PATH'} = "/bin:/usr/bin"; initialise(); $request = shift @ARGV; # Usage: manServer [-dn] filename | manServer [-s port] $root = ""; $cgiMode = 0; $bodyTag = "BODY bgcolor=#F0F0F0 text=#000000 link=#0000ff vlink=#C000C0 alink=#ff0000"; if ($ENV{'GATEWAY_INTERFACE'} ne "") { *OUT = *STDOUT; open(LOG, ">>/tmp/manServer.log"); chmod(0666, '/tmp/manServer.log'); $root = $ENV{'SCRIPT_NAME'}; $url = $ENV{'PATH_INFO'}; if ($ENV{'REQUEST_METHOD'} eq "POST") { $args = ; chop $args; } else { $args = $ENV{'QUERY_STRING'}; } $url .= "?".$args if ($args); $cgiMode = 1; $date = &fmtTime(time); $remoteHost = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'}; $referer = $ENV{'HTTP_REFERER'}; $userAgent = $ENV{'HTTP_USER_AGENT'}; print LOG "$date\t$remoteHost\t$url\t$referer\t$userAgent\n"; processRequest($url); } elsif ($request eq "-s" || $request eq "") { *LOG = *STDERR; startServer(); } else { $cmdLineMode = 1; if ($request =~ m/^-d(\d)/) { $debug = $1; $request = shift @ARGV; } *OUT = *STDOUT; *LOG = *STDERR; $file = findPage($request); man2html($file); } exit(0); ##### Mini HTTP Server #### sub startServer { ($port) = @ARGV; $port = 8888 unless $port; $sockaddr = 'S n a4 x8'; ($name, $aliases, $proto) = getprotobyname('tcp'); ($name, $aliases, $port) = getservbyname($port, 'tcp') unless $port =~ /^\d+$/; while(1) { $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0"); select(NS); $| = 1; select(stdout); socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; if (bind(S, $this)) { last; } else { print STDERR "Failed to bind to port $port: $!\n"; ++$port; } } listen(S, 5) || die "connect: $!"; select(S); $| = 1; select(stdout); while(1) { print LOG "Waiting for connection on port $port\n"; ($addr = accept(NS,S)) || die $!; #print "accept ok\n"; ($af,$rport,$inetaddr) = unpack($sockaddr,$addr); @inetaddr = unpack('C4',$inetaddr); print LOG "Got connection from ", join(".",@inetaddr), "\n"; while () { if (m/^GET (\S+)/) { $url = $1; } last if (m/^\s*$/); } *OUT = *NS; processRequest($url); close NS ; } } sub processRequest { $url = $_[0]; print LOG "Request = $url, root = $root\n"; if ( ($url =~ m/^([^?]*)\?(.*)$/) || ($url =~ m/^([^&]*)&(.*)$/) ) { $request = $1; $args = $2; } else { $request = $url; $args = ""; } @params = split(/[=&]/, $args); for ($i=0; $i<=$#params; ++$i) { $params[$i] =~ tr/+/ /; $params[$i] =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C",hex($1))/eg; } %params = @params; $request = $params{'q'} if ($params{'q'}); $searchType = $params{'t'}; $debug = $params{'d'}; $processed = 0; $file = ""; if ($searchType) { print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode); print OUT "Content-type: text/html\n\n"; print OUT "

Searching not yet implemented

\n"; print LOG "Searching not implemented\n"; $processed = 1; } elsif ($request eq "/" || $request eq "") { print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode); print OUT "Content-type: text/html\n\n"; print LOG "Home page\n"; homePage(); $processed = 1; } elsif ($request =~ m,^/.*/$,) { print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode); print OUT "Content-type: text/html\n\n"; print LOG "List directory\n"; listDir($request); $processed = 1; } elsif (-f $request || -f "$request.gz" || -f "$request.bz2") { # Only allow fully specified files if they're in our manpath foreach $md (@manpath) { $dir = $md; if (substr($request,0,length($dir)) eq $dir) { print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode); print OUT "Content-type: text/html\n\n"; man2html($request); $processed = 1; last; } } } else { $file = findPage($request); if (@multipleMatches) { print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode); print OUT "Content-type: text/html\n\n"; print LOG "Multiple matches\n"; printMatches(); $processed = 1; } elsif ($file) { print OUT "HTTP/1.0 301 Redirected\n" unless ($cgiMode); $file .= "&d=$debug" if ($debug); print OUT "Location: $root$file\n\n"; print LOG "Redirect to $root$file\n"; $processed = 1; } } unless ($processed) { print OUT "HTTP/1.0 404 Not Found\n" unless ($cgiMode); print OUT "Content-type: text/html\n\n"; print OUT "\nNot Found\n<$bodyTag>\n"; print OUT "


Not Found

\nFailed to find man page /$request\n"; print OUT "


Main Index\n\n"; print STDERR "Failed to find /$request\n" unless ($cgiMode); } } sub homePage { print OUT "Manual Pages - Main Index <$bodyTag>


Manual Reference Pages - Main Index

\n"; $uname = `uname -s -r`; if (! $?) { $hostname = `hostname`; print OUT "$uname pages on $hostname

\n"; } # print OUT "\n"; print OUT "Command name:

\n"; loadManDirs(); foreach $dir (@mandirs) { ($section) = ($dir =~ m/man([0-9A-Za-z]+)$/); print OUT "$dir" ; print OUT "- $sectionName{$section}" if ($sectionName{$section}); print OUT "
\n"; } print OUT "


Generated by $manServerUrl from local unix man pages.\n\n"; } sub listDir { foreach $md (@manpath) { $dir = $md; if (substr($request,0,length($dir)) eq $dir) { $request =~ s,/$,,; ($section) = ($request =~ m/man([0-9A-Za-z]+)$/); $sectionName = $sectionName{$section}; $sectionName = "Manual Reference Pages" unless ($sectionName); print OUT "Contents of $request\n<$bodyTag>\n"; print OUT "


$sectionName - Index of $request

\n"; print OUT "
\n"; print OUT "Command name:

\n"; if (opendir(DIR, $request)) { @files = sort readdir DIR; foreach $f (@files) { next if ($f eq "." || $f eq ".." || $f !~ m/\./); $f =~ s/\.(gz|bz2)$//; # ($name) = ($f =~ m,/([^/]*)$,); print OUT "$f \n"; } closedir DIR; } print OUT "

Main Index\n\n"; print OUT "


Generated by $manServerUrl from local unix man pages.pre { line-height: 125%; } td.linenos .normal { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; } span.linenos { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; } td.linenos .special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; } span.linenos.special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; } .highlight .hll { background-color: #ffffcc } .highlight .c { color: #888888 } /* Comment */ .highlight .err { color: #a61717; background-color: #e3d2d2 } /* Error */ .highlight .k { color: #008800; font-weight: bold } /* Keyword */ .highlight .ch { color: #888888 } /* Comment.Hashbang */ .highlight .cm { color: #888888 } /* Comment.Multiline */ .highlight .cp { color: #cc0000; font-weight: bold } /* Comment.Preproc */ .highlight .cpf { color: #888888 } /* Comment.PreprocFile */ .highlight .c1 { color: #888888 } /* Comment.Single */ .highlight .cs { color: #cc0000; font-weight: bold; background-color: #fff0f0 } /* Comment.Special */ .highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */ .highlight .ge { font-style: italic } /* Generic.Emph */ .highlight .gr { color: #aa0000 } /* Generic.Error */ .highlight .gh { color: #333333 } /* Generic.Heading */ .highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */ .highlight .go { color: #888888 } /* Generic.Output */ .highlight .gp { color: #555555 } /* Generic.Prompt */ .highlight .gs { font-weight: bold } /* Generic.Strong */ .highlight .gu { color: #666666 } /* Generic.Subheading */ .highlight .gt { color: #aa0000 } /* Generic.Traceback */ .highlight .kc { color: #008800; font-weight: bold } /* Keyword.Constant */ .highlight .kd { color: #008800; font-weight: bold } /* Keyword.Declaration */ .highlight .kn { color: #008800; font-weight: bold } /* Keyword.Namespace */ .highlight .kp { color: #008800 } /* Keyword.Pseudo */ .highlight .kr { color: #008800; font-weight: bold } /* Keyword.Reserved */ .highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */ .highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */ .highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */ .highlight .na { color: #336699 } /* Name.Attribute */ .highlight .nb { color: #003388 } /* Name.Builtin */ .highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */ .highlight .no { color: #003366; font-weight: bold } /* Name.Constant */ .highlight .nd { color: #555555 } /* Name.Decorator */ .highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */ .highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */ .highlight .nl { color: #336699; font-style: italic } /* Name.Label */ .highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */ .highlight .py { color: #336699; font-weight: bold } /* Name.Property */ .highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */ .highlight .nv { color: #336699 } /* Name.Variable */ .highlight .ow { color: #008800 } /* Operator.Word */ .highlight .w { color: #bbbbbb } /* Text.Whitespace */ .highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */ .highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */ .highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */ .highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */ .highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */ .highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */ .highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */ .highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */ .highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */ .highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */ .highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */ .highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */ .highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */ .highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */ .highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */ .highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */ .highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */ .highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */ .highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */ .highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */ .highlight .vc { color: #336699 } /* Name.Variable.Class */ .highlight .vg { color: #dd7700 } /* Name.Variable.Global */ .highlight .vi { color: #3333bb } /* Name.Variable.Instance */ .highlight .vm { color: #336699 } /* Name.Variable.Magic */ .highlight .il { color: #0000DD; font-weight: bold } /* Literal.Number.Integer.Long */

fetchmail-SA-2005-01: security announcement

Topic:		remote code injection vulnerability in fetchmail

Author:		Matthias Andree
Version:	1.04
Announced:	2005-07-21
Type:		buffer overrun/stack corruption/code injection
Impact:		account or system compromise possible through malicious
		or compromised POP3 servers
Danger:		high: in sensitive configurations, a full system
		compromise is possible
		(for 6.2.5.1: denial of service for the whole fetchmail
		system is possible)
CVE Name:	CVE-2005-2335
URL:		http://fetchmail.berlios.de/fetchmail-SA-2005-01.txt
		http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=212762
		http://www.vuxml.org/freebsd/3497d7be-2fef-45f4-8162-9063751b573a.html
		http://www.vuxml.org/freebsd/3f4ac724-fa8b-11d9-afcf-0060084a00e5.html
		http://www.freebsd.org/cgi/query-pr.cgi?pr=83805
		http://www.heise.de/security/news/meldung/62070
Thanks:		Edward J. Shornock (located the bug in UIDL code)
		Miloslav Trmac (pointed out 6.2.5.1 was faulty)
		Ludwig Nussel (provided minimal correct fix)

Affects:	fetchmail version 6.2.5.1 (denial of service)
		fetchmail version 6.2.5 (code injection)
		fetchmail version 6.2.0 (code injection)
		(other versions have not been checked)

Not affected:	fetchmail 6.2.5.2
		fetchmail 6.2.5.4
		fetchmail 6.3.0

		Older versions may not have THIS bug, but had been found
		to contain other security-relevant bugs.

Corrected:	2005-07-22 01:37 UTC (SVN) - committed bugfix (r4157)
		2005-07-22                   fetchmail-patch-6.2.5.2 released
		2005-07-23                   fetchmail-6.2.5.2 tarball released
		2005-11-13                   fetchmail-6.2.5.4 tarball released
		2005-11-30                   fetchmail-6.3.0 tarball released

0. Release history

2005-07-20	1.00 - Initial announcement
2005-07-22	1.01 - Withdrew 6.2.5.1 and 6.2.6-pre5, the fix was buggy
		       and susceptible to denial of service through
		       single-byte read from 0 when either a Message-ID:
		       header was empty (in violation of RFC-822/2822)
		       or the UIDL response did not contain an UID (in
		       violation of RFC-1939).
		     - Add Credits.
		     - Add 6.2.5.1 failure details to sections 2 and 3
		     - Revise section 5 and B.
2005-07-26	1.02 - Revise section 0.
		     - Add FreeBSD VuXML URL for 6.2.5.1.
		     - Add heise security URL.
		     - Mention release of 6.2.5.2 tarball.
2005-10-27	1.03 - Update CVE Name after CVE naming change
2005-12-08	1.04 - Mention 6.2.5.4 and 6.3.0 releases "not affected"
		     - remove patch information

1. Background

fetchmail is a software package to retrieve mail from remote POP2, POP3,
IMAP, ETRN or ODMR servers and forward it to local SMTP, LMTP servers or
message delivery agents.

2. Problem description

The POP3 code in fetchmail-6.2.5 and older that deals with UIDs (from
the UIDL) reads the responses returned by the POP3 server into
fixed-size buffers allocated on the stack, without limiting the input
length to the buffer size. A compromised or malicious POP3 server can
thus overrun fetchmail's stack.  This affects POP3 and all of its
variants, for instance but not limited to APOP.

In fetchmail-6.2.5.1, the attempted fix prevented code injection via
POP3 UIDL, but introduced two possible NULL dereferences that can be
exploited to mount a denial of service attack.

3. Impact

In fetchmail-6.2.5 and older, very long UIDs can cause fetchmail to
crash, or potentially make it execute code placed on the stack. In some
configurations, fetchmail is run by the root user to download mail for
multiple accounts.

In fetchmail-6.2.5.1, a server that responds with UID lines containing
only the article number but no UID (in violation of RFC-1939), or a
message without Message-ID when no UIDL support is available, can crash
fetchmail.

4. Workaround

No reasonable workaround can be offered at this time.

5. Solution

Upgrade your fetchmail package to version 6.3.0 or newer.

<http://developer.berlios.de/project/showfiles.php?group_id=1824>

A. References

fetchmail home page: <http://fetchmail.berlios.de/>

B. Copyright, License and Warranty

(C) Copyright 2005 by Matthias Andree, <matthias.andree@gmx.de>.
Some rights reserved.

This work is licensed under the Creative Commons
Attribution-NonCommercial-NoDerivs German License. To view a copy of
this license, visit http://creativecommons.org/licenses/by-nc-nd/2.0/de/
or send a letter to Creative Commons; 559 Nathan Abbott Way;
Stanford, California 94305; USA.

THIS WORK IS PROVIDED FREE OF CHARGE AND WITHOUT ANY WARRANTIES.
Use the information herein at your own risk.

END OF fetchmail-SA-2005-01.txt
t("\n"); } # Look ahead skipping comments and other common non-text tags sub lookahead { $ll = _lookahead(); while ($ll =~ m/^\.(\\"|PD|IX|ns)/) { $ll = _lookahead(); } return $ll; } # Process $_, expaning any macros into HTML and calling outputLine(). # If necessary, this method can read more lines of input from (.ig & .de) # The following state variables are used: # ... sub processLine { $doneLine = 1; # By default, this counts as a line for trap purposes s,^\.if t ,,; s,^\.el ,,; # conditions assumed to evaluate false, so else must be true... if ($troffTable) { processTable(); } elsif ($eqnMode == 2) { plainOutput("\n"); processEqns($_); } elsif (m/^\./) { processMacro(); } else { processPlainText(); } if ($doneLine) { # Called after processing (most) input lines to decrement trapLine. This is needed # to implement the .it 1 trap after one line for .TP, where the first line is outdented if ($trapLine > 0) { --$trapLine; if ($trapLine == 0) { &$trapAction; } } } } # Process plain text lines sub processPlainText { if ($_ eq "") { lineBreak(); plainOutput("

\n"); return; } s,(\\f[23BI])([A-Z].*?)(\\f.),$1.($contents{"\U$2"}?"$2":$2).$3,ge; if ($currentSection eq "SEE ALSO" && ! $cmdLineMode) { # Some people don't use BR or IR for see also refs s,(^|\s)([-.A-Za-z_0-9]+)\s?\(([0-9lL][0-9a-zA-Z]*)\),\1$2($3),g; } outputLine("$_\n"); } # Process macros and built-in directives sub processMacro { outputOrigLine(); # Place macro arguments (space delimited unless within ") into @p # Remove " from $_, place command in $c, remainder in $joined @p = grep($_ !~ m/^\s*$/, split(/("[^"]*"|\s+)/) ); grep(s/"//g, @p); $_ = join(" ", @p); $p[0] =~ s/^\.//; $c = $p[0]; $joined = join(" ", @p[1..$#p]); $joined2 = join(" ", @p[2..$#p]); $joined3 = join(" ", @p[3..$#p]); if ($macro{$c}) # Expand macro { # Get full macro text $macro = $macro{$c}; # Interpolate arguments $macro =~ s,\\\$(\d),$p[$1],ge; #print OUT "\n"; foreach $_ (split(/\n/, $macro)) { $_ .= "\n"; preProcessLine(); processLine(); } $doneLine = 0; return; } elsif ($renamedMacro{$c}) { $c = $renamedMacro{$c}; } if ($c eq "ds") # Define string { $vars{$p[1]} = $joined2; $doneLine = 0; } elsif ($c eq "nr") # Define number register { $number{$p[1]} = evalnum($joined2); $doneLine = 0; } elsif ($c eq "ti") # Temporary indent { plainOutput("   "); } elsif ($c eq "rm") { $macroName = $p[1]; if ($macro{$macroName}) { delete $macro{$macroName}; } else { $deletedMacro{$macroName} = 1; } } elsif ($c eq "rn") { $oldName = $p[1]; $newName = $p[2]; $macro = $macro{$oldName}; if ($macro) { if ($newName =~ $reservedMacros && ! $deletedMacro{$newName}) { plainOutput("\n"); } else { $macro{$newName} = $macro; delete $deletedMacro{$newName}; } delete $macro{$oldName}; } else { # Support renaming of reserved macros by mapping occurrences of new name # to old name after macro expansion so that built in definition is still # available, also mark the name as deleted to override reservedMacro checks. plainOutput("\n"); $renamedMacro{$newName} = $oldName; $deletedMacro{$oldName} = 1; } } elsif ($c eq "de" || $c eq "ig") # Define macro or ignore { $macroName = $p[1]; if ($c eq "ig") { $delim = ".$p[1]"; } else { $delim = ".$p[2]"; } $delim = ".." if ($delim eq "."); # plainOutput("\n"); $macro = ""; $_ = getLine(); preProcessLine(); while ($_ ne $delim) { postProcessLine(); outputOrigLine(); $macro .= "$_\n"; $_ = getLine(); last if ($_ eq ""); preProcessLine(); } outputOrigLine(); # plainOutput("\n"); if ($c eq "de") { if ($macroName =~ $reservedMacros && ! $deletedMacro{$macroName}) { plainOutput("\n"); } else { $macro{$macroName} = $macro; delete $deletedMacro{$macroName}; } } } elsif ($c eq "so") # Source { plainOutput("

[Include document $p[1]]

\n"); } elsif ($c eq "TH" || $c eq "Dt") # Man page title { endParagraph(); $sectionNumber = $p[2]; $sectionName = $sectionName{"\L$sectionNumber"}; $sectionName = "Manual Reference Pages" unless ($sectionName); $pageName = "$p[1] ($sectionNumber)"; outputPageHead(); if ($c eq "TH") { $right = $p[3]; $left = $p[4]; $left = $osver unless ($left); $macroPackage = "using man macros"; } else { $macroPackage = "using doc macros"; } } elsif ($c eq "Nd") { outputLine("- $joined\n"); } elsif ($c eq "SH" || $c eq "SS" || $c eq "Sh" || $c eq "Ss") # Section/subsection { lineBreak(); endNoFill(); endParagraph(); $id = $contents{"\U$joined"}; $currentSection = $joined; if ($c eq "SH" || $c eq "Sh") { endBlockquote(); if ($firstSection++==1) # after first 'Name' section { outputContents(); } outputLine( "\n\n

$joined

\n\n\n" ); blockquote(); } elsif ($joined =~ m/\\f/) { $joined =~ s/\\f.//g; $id = $contents{"\U$joined"}; outputLine( "\n

$joined

\n" ); } else { endBlockquote(); outputLine( "\n\n

    $joined

\n
\n" ); blockquote(); } lineBreak(); } elsif ($c eq "TX" || $c eq "TZ") # Document reference { $title = $title{$p[1]}; $title = "Document [$p[1]]" unless ($title); outputLine( "\\fI$title\\fP$joined2\n" ); } elsif ($c eq "PD") # Line spacing { $noSpace = ($p[1] eq "0"); $doneLine = 0; } elsif ($c eq "TS") # Table start { unless ($macroPackage =~ /tbl/) { if ($macroPackage =~ /eqn/) { $macroPackage =~ s/eqn/eqn & tbl/; } else { $macroPackage .= " with tbl support"; } } resetStyles(); endNoFill(); $troffTable = 1; $troffSeparator = "\t"; plainOutput( "

\n" ); } elsif ($c eq "EQ") # Eqn start { unless ($macroPackage =~ /eqn/) { if ($macroPackage =~ /tbl/) { $macroPackage =~ s/tbl/tbl & eqn/; } else { $macroPackage .= " with eqn support"; } } $eqnMode = 2; } elsif ($c eq "ps") # Point size { plainOutput(&sizeChange($p[1])); } elsif ($c eq "ft") # Font change { plainOutput(&fontChange($p[1])); } elsif ($c eq "I" || $c eq "B") # Single word font change { $id = $contents{"\U$joined"}; if ($id && $joined =~ m/^[A-Z]/) { $joined = "$joined"; } outputLine( "\\f$c$joined\\fP " ); plainOutput("\n") if ($noFill); } elsif ($c eq "SM") # Single word smaller { outputLine("\\s-1$joined\\s0 "); $doneLine = 0 unless ($joined); } elsif ($c eq "SB") # Single word bold and small { outputLine("\\fB\\s-1$joined\\s0\\fP "); } elsif (m/^\.[BI]R (\S+)\s?\(\s?([0-9lL][0-9a-zA-Z]*)\s?\)(.*)$/) { # Special form, .BR is generally used for references to other pages # Annoyingly, some people have more than one per line... # Also, some people use .IR ... for ($i=1; $i<=$#p; $i+=2) { $pair = $p[$i]." ".$p[$i+1]; if ($p[$i+1] eq "(") { $pair .= $p[$i+2].$p[$i+3]; $i += 2; } if ($pair =~ m/^(\S+)\s?\(\s?([0-9lL][0-9a-zA-Z]*)\s?\)(.*)$/) { if ($cmdLineMode) { outputLine( "\\fB$1\\fR($2)$3\n" ); } else { outputLine( "$1($2)$3\n" ); } } else { outputLine( "$pair\n" ); } } } elsif ($c eq "BR" || $c eq "BI" || $c eq "IB" || $c eq "IR" || $c eq "RI" || $c eq "RB") { $f1 = (substr($c ,0,1)); $f2 = (substr($c,1,1)); # Check if first param happens to be a section name $id = $contents{"\U$p[1]"}; if ($id && $p[1] =~ m/^[A-Z]/) { $p[1] = "$p[1]"; } for ($i=1; $i<=$#p; ++$i) { $f = ($i%2 == 1) ? $f1 : $f2; outputLine("\\f$f$p[$i]"); } outputLine("\\fP "); plainOutput("\n") if ($noFill); } elsif ($c eq "nf" || $c eq "Bd") # No fill { startNoFill(); } elsif ($c eq "fi" || $c eq "Ed") # Fill { endNoFill(); } elsif ($c eq "HP") { $indent = evalnum($p[1]); if ($trapOnBreak) { plainOutput("
\n"); } else { # Outdent first line, ie. until next break $trapOnBreak = 1; $trapAction = *trapHP; newParagraph($indent); plainOutput( "   " ); } # End an existing HP/TP/IP/RS row sub endRow { if ($indent[$indentLevel] > 0) { lineBreak(); plainOutput( "\n" ); } } # Called when we output a line break tag. Only needs to be called once if # calling plainOutput, but should call before and after if using outputLine. sub lineBreak { $needBreak = 0; $textSinceBreak = 0; } # Called to reset all indents and pending paragraphs (eg. at the start of # a new top level section). sub endParagraph { ++$indentLevel; while ($indentLevel > 0) { --$indentLevel; if ($indent[$indentLevel] > 0) { endRow(); setIndent(0); } } } # Interpolate a number register (possibly autoincrementing) sub numreg { return 0 + $number{$_[0]}; } # Evaluate a numeric expression sub evalnum { $n = $_[0]; return "" if ($n eq ""); if ($n =~ m/i$/) # inches { $n =~ s/i//; $n *= 10; } return 0+$n; } sub setIndent { $tsb = $textSinceBreak; $indent = evalnum($_[0]); if ($indent==0 && $_[0] !~ m/^0/) { $indent = 6; } plainOutput("\n") if ($debug); if ($indent[$indentLevel] != $indent) { lineBreak(); if ($indent[$indentLevel] > 0) { plainOutput("") unless ($noSpace); plainOutput("
\n" ); $colState = 2; } } elsif ($c eq "IP") { $trapOnBreak = 0; $tag = $p[1]; $indent = evalnum($p[2]); newParagraph($indent); outputLine("\n$tag\n\n"); $colState = 1; lineBreak(); } elsif ($c eq "TP") { $trapOnBreak = 0; $trapLine = 1; # Next line is tag, then next column $doneLine = 0; # (But don't count this line) $trapAction = *trapTP; $indent = evalnum($p[1]); $tag = lookahead(); chop $tag; $i = ($indent ? $indent : $prevailingIndent) ; $w = width($tag); if ($w > $i) { plainOutput("\n") if ($debug); newParagraph($indent); $trapAction = *trapHP; plainOutput( "\n" ); $colState = 2; } else { newParagraph($indent); plainOutput( "\n" ); $colState = 0; } $body = lookahead(); $lookaheadPtr = 0; if ($body =~ m/^\.[HILP]?P/) { chop $body; plainOutput("\n"); $trapLine = 0; } } elsif ($c eq "LP" || $c eq "PP" || $c eq "P" || $c eq "Pp") # Paragraph { $trapOnBreak = 0; $prevailingIndent = 6; if ($indent[$indentLevel] > 0 && $docListStyle eq "") { $line = lookahead(); if ($line =~ m/^\.(TP|IP|HP)/) { plainOutput("\n"); } elsif ($line =~ m/^\.RS/) { plainOutput("

\n"); } else { endRow(); $foundTag = ""; $lookaheadPtr = 0; do { $line = lookahead(); if ($line =~ m/^\.(TP|HP|IP|RS)( \d+)?/) { $indent = $2; $indent = $prevailingIndent unless ($2); if ($indent == $indent[$indentLevel]) { $foundTag = $1; } $line = ""; } } while ($line ne "" && $line !~ m/^\.(RE|SH|SS|PD)/); $lookaheadPtr = 0; if ($foundTag) { plainOutput("\n"); plainOutput("

\n"); $colState = 2; } else { plainOutput("\n"); setIndent(0); } } } else { plainOutput("

\n"); } lineBreak(); } elsif ($c eq "br") # Break { if ($trapOnBreak) { # Should this apply to all macros that cause a break? $trapOnBreak = 0; &$trapAction(); } $needBreak = 1 if ($textSinceBreak); } elsif ($c eq "sp") # Space { lineBreak(); plainOutput("

\n"); } elsif ($c eq "RS") # Block indent start { if ($indentLevel==0 && $indent[0]==0) { blockquote(); } else { $indent = $p[1]; $indent = $prevailingIndent unless ($indent); if ($indent > $indent[$indentLevel] && !$extraIndent) { $extraIndent = 1; ++$indentLevel; $indent[$indentLevel] = 0; setIndent($indent-$indent[$indentLevel-1]); plainOutput("

\n"); $colState = 1; } elsif ($indent < $indent[$indentLevel] || $colState==2) { endRow(); setIndent($indent); plainOutput("
\n"); $colState = 1; } ++$indentLevel; $indent[$indentLevel] = 0; } $prevailingIndent = 6; } elsif ($c eq "RE") # Block indent end { if ($extraIndent) { endRow(); setIndent(0); --$indentLevel; $extraIndent = 0; } if ($indentLevel==0) { endParagraph(); if ($blockquote>0) { plainOutput("\n"); --$blockquote; } } else { endRow(); setIndent(0); --$indentLevel; } $prevailingIndent = $indent[$indentLevel]; $prevailingIndent = 6 unless($prevailingIndent); } elsif ($c eq "DT") # default tabs { @tabstops = (); } elsif ($c eq "ta") # Tab stops { @tabstops = (); for ($i=0; $i<$#p; ++$i) { $ts = $p[$i+1]; $tb = 0; if ($ts =~ m/^\+/) { $tb = $tabstops[$i-1]; $ts =~ s/^\+//; } $ts = evalnum($ts); $tabstops[$i] = $tb + $ts; } plainOutput("\n") if ($debug); } elsif ($c eq "It") # List item (mdoc) { lineBreak(); if ($docListStyle eq "-tag") { endRow() unless($multilineIt); if ($tagWidth) { setIndent($tagWidth); } else { setIndent(6); $width = ""; # let table take care of own width } if ($p[1] eq "Xo") { plainOutput("
"); } else { $tag = &mdocStyle(@p[1..$#p]); $body = lookahead(); if ($body =~ m/^\.It/) { $multilineItNext = 1; } else { $multilineItNext = 0; } if ($multilineIt) { outputLine("
\n$tag\n"); } elsif ($multilineItNext || $tagWidth>0 && width($tag)>$tagWidth) { outputLine("
$tag\n"); $colState = 2; } else { outputLine("
$tag\n"); $colState = 1; } if ($multilineItNext) { $multilineIt = 1; } else { $multilineIt = 0; if ($colState==2) { plainOutput("
 \n"); } else { plainOutput("\n"); } } } } else { plainOutput("
  • "); } lineBreak(); } elsif ($c eq "Xc") { if ($docListStyle eq "-tag") { plainOutput("
  •  \n"); } } elsif ($c eq "Bl") # Begin list (mdoc) { push @docListStyles, $docListStyle; if ($p[1] eq "-enum") { plainOutput("
      \n"); $docListStyle = $p[1]; } elsif($p[1] eq "-bullet") { plainOutput("
        \n"); $docListStyle = $p[1]; } else { $docListStyle = "-tag"; if ($p[2] eq "-width") { $tagWidth = width($p[3]); if ($tagWidth < 6) { $tagWidth = 6; } } else { $tagWidth = 0; } $multilineIt = 0; } } elsif ($c eq "El") # End list { if ($docListStyle eq "-tag") { endRow(); setIndent(0); } elsif ($docListStyle eq "-bullet") { plainOutput("
      \n"); } else { plainOutput("
    \n"); } $docListStyle = pop @docListStyles; } elsif ($c eq "Os") { $right = $joined; } elsif ($c eq "Dd") { $left = $joined; } elsif ($c eq "Sx") # See section { $id = $contents{"\U$joined"}; if ($id && $joined =~ m/^[A-Z]/) { outputLine("".&mdocStyle(@p[1..$#p])."\n"); } else { my $x = &mdocStyle(@p[1..$#p]); $x =~ s/^ //; outputLine($x."\n"); } } elsif (&mdocCallable($c)) { my $x = &mdocStyle(@p); $x =~ s/^ //; outputLine($x."\n"); } elsif ($c eq "Bx") { outputLine("BSD $joined\n"); } elsif ($c eq "Ux") { outputLine("Unix $joined\n"); } elsif ($c eq "At") { outputLine("AT&T $joined\n"); } elsif ($c =~ m/[A-Z][a-z]/) # Unsupported doc directive { outputLine("
    .$c $joined\n"); } elsif ($c eq "") # Empty line (eg. troff comment) { $doneLine = 0; } else # Unsupported directive { # Unknown macros are ignored, and don't count as a line as far as trapLine goes $doneLine = 0; plainOutput("\n"); } } sub trapTP { $lookaheadPtr = 0; $body = lookahead(); if ($body =~ m/^\.TP/) { consume(); $trapLine = 1; # restore TP trap $doneLine = 0; # don't count this line plainOutput("
    \n"); } else { plainOutput("
    \n"); $colState = 1; } lineBreak(); } sub trapHP { $lookaheadPtr = 0; $body = lookahead(); if ($body =~ m/^\.([TH]P)/) { consume(); # Restore appropriate type of trap if ($1 eq "TP") { $trapLine = 1; $doneLine = 0; # don't count this line } else { $trapOnBreak = 1; } plainOutput("
    \n"); } else { plainOutput("
    \n"); $colState = 1; } lineBreak(); } sub newParagraph { $indent = $_[0]; endRow(); startRow($indent); } sub startRow { $indent = $_[0]; $indent = $prevailingIndent unless ($indent); $prevailingIndent = $indent; setIndent($indent); plainOutput( "
    "); } if ($indent > 0) { endNoFill(); $border = ""; $border = " border=1" if ($debug>2); #plainOutput("

    ") unless ($indent[$indentLevel] > 0); plainOutput("0); if ($noSpace) { plainOutput(" cellpadding=0 cellspacing=0>\n"); } else { plainOutput(" cellpadding=3>".($tsb ? "\n\n" : "\n") ); } #$width = " width=".($indent*5); # causes text to be chopped if too big $percent = $indent; if ($indentLevel > 0) { $percent = $indent * 100 / (100-$indentLevel[0]); } $width = " width=$percent%"; } $indent[$indentLevel] = $indent; } } # Process mdoc style macros recursively, as one of the macro arguments # may itself be the name of another macro to invoke. sub mdocStyle { return "" unless @_; my ($tag, @param) = @_; my ($rest, $term); # Don't format trailing punctuation if ($param[$#param] =~ m/^[.,;:]$/) { $term = pop @param; } if ($param[$#param] =~ m/^[)\]]$/) { $term = (pop @param).$term; } if ($param[0] =~ m,\\\\,) { print STDERR "$tag: ",join(",", @param),"\n"; } $rest = &mdocStyle(@param); if ($tag eq "Op") { $rest =~ s/ //; # remove first space return " \\fP[$rest]$term"; } elsif ($tag eq "Xr") # cross reference { my $p = shift @param; my $url = $p; if (@param==1) { $url .= ".".$param[0]; $rest = "(".$param[0].")"; } else { $rest = &mdocStyle(@param); } if ($cmdLineMode) { return " ".$p."".$rest.$term; } else { return " ".$p."".$rest.$term; } } elsif ($tag eq "Fl") { my ($sofar); while (@param) { $f = shift @param; if ($f eq "Ns") # no space { chop $sofar; } elsif (&mdocCallable($f)) { unshift @param, $f; return $sofar.&mdocStyle(@param).$term; } else { $sofar .= "-$f " } } return $sofar.$term; } elsif ($tag eq "Pa" || $tag eq "Er" || $tag eq "Fn" || $tag eq "Dv") { return "\\fC$rest\\fP$term"; } elsif ($tag eq "Ad" || $tag eq "Ar" || $tag eq "Em" || $tag eq "Fa" || $tag eq "St" || $tag eq "Ft" || $tag eq "Va" || $tag eq "Ev" || $tag eq "Tn" || $tag eq "%T") { return "\\fI$rest\\fP$term"; } elsif ($tag eq "Nm") { $defaultNm = $param[0] unless ($defaultNm); $rest = $defaultNm unless ($param[0]); return "\\fB$rest\\fP$term"; } elsif ($tag eq "Ic" || $tag eq "Cm" || $tag eq "Sy") { return "\\fB$rest\\fP$term"; } elsif ($tag eq "Ta") # Tab { # Tabs are used inconsistently so this is the best we can do. Columns won't line up. Tough. return "      $rest$term"; } elsif ($tag eq "Ql") { $rest =~ s/ //; return "`$rest'$term"; } elsif ($tag eq "Dl") { return "

        $rest$term

    \n"; } elsif ($tag =~ m/^[ABDEOPQS][qoc]$/) { $lq = ""; $rq = ""; if ($tag =~ m/^A/) { $lq = "<"; $rq = ">"; } elsif ($tag =~ m/^B/) { $lq = "["; $rq = "]"; } elsif ($tag =~ m/^D/) { $lq = "\""; $rq = "\""; } elsif ($tag =~ m/^P/) { $lq = "("; $rq = ")"; } elsif ($tag =~ m/^Q/) { $lq = "\""; $rq = "\""; } elsif ($tag =~ m/^S/) { $lq = "\\'"; $rq = "\\'"; } elsif ($tag =~ m/^O/) { $lq = "["; $rq = "]"; } if ($tag =~ m/^.o/) { $rq = ""; } if ($tag =~ m/^.c/) { $lq = ""; } $rest =~ s/ //; return $lq.$rest.$rq.$term ; } elsif (&mdocCallable($tag)) # but not in list above... { return $rest.$term; } elsif ($tag =~ m/^[.,;:()\[\]]$/) # punctuation { return $tag.$rest.$term; } elsif ($tag eq "Ns") { return $rest.$term; } else { return " ".$tag.$rest.$term; } } # Determine if a macro is mdoc parseable/callable sub mdocCallable { return ($_[0] =~ m/^(Op|Fl|Pa|Er|Fn|Ns|No|Ad|Ar|Xr|Em|Fa|Ft|St|Ic|Cm|Va|Sy|Nm|Li|Dv|Ev|Tn|Pf|Dl|%T|Ta|Ql|[ABDEOPQS][qoc])$/); } # Estimate the output width of a string sub width { local($word) = $_[0]; $word =~ s,<[/A-Z][^>]*>,,g; # remove any html tags $word =~ s/^\.\S+\s//; $word =~ s/\\..//g; $x = length($word); $word =~ s/[ ()|.,!;:"']//g; # width of punctuation is about half a character return ($x + length($word)) / 2; } # Process a tbl table (between TS/TE tags) sub processTable { if ($troffTable == "1") { @troffRowDefs = (); @tableRows = (); $hadUnderscore = 0; while(1) { outputOrigLine(); if (m/;\s*$/) { $troffSeparator = quotemeta($1) if (m/tab\s*\((.)\)/); } else { s/\.\s*$//; s/\t/ /g; s/^[^lrcan^t]*//; # remove any 'modifiers' coming before tag # delimit on tags excluding s (viewed as modifier of previous column) s/([lrcan^t])/\t$1/g; s/^\t//; push @troffRowDefs, $_; last if ($origLine =~ m/\.\s*$/); } $_ = getLine(); preProcessLine(); } $troffTable = 2; return; } s/$troffSeparator/\t/g; if ($_ eq ".TE") { endTblRow(); flushTable(); $troffTable = 0; plainOutput("

    \n"); } elsif ($_ eq ".T&") { endTblRow(); flushTable(); $troffTable = 1; } elsif (m/[_=]/ && m/^[_=\t]*$/ && $troffCol==0) { if (m/^[_=]$/) { flushTable(); plainOutput("\n"); $hadUnderscore = 1; } elsif ($troffCol==0 && @troffRowDefs) { # Don't output a row, but this counts as a row as far as row defs go $rowDef = shift @troffRowDefs; @troffColDefs = split(/\t/, $rowDef); } } elsif (m/^\.sp/ && $troffCol==0 && !$hadUnderscore) { flushTable(); plainOutput("\n"); } elsif ($_ eq ".br" && $troffMultiline) { $rowref->[$troffCol] .= "
    \n"; } elsif ($_ !~ m/^\./) { $rowref = $tableRows[$#tableRows]; # reference to current row (last row in array) if ($troffCol==0 && @troffRowDefs) { $rowDef = shift @troffRowDefs; if ($rowDef =~ m/^[_=]/) { $xxx = $_; flushTable(); plainOutput("\n"); $hadUnderscore = 1; $_ = $xxx; $rowDef = shift @troffRowDefs; } @troffColDefs = split(/\t/, $rowDef); } if ($troffCol == 0 && !$troffMultiline) { $rowref = []; push(@tableRows, $rowref); #plainOutput(""); } #{ if (m/T}/) { $troffMultiline = 0; } if ($troffMultiline) { $rowref->[$troffCol] .= "$_\n"; return; } @columns = split(/\t/, $_); plainOutput("\n") if ($debug); while ($troffCol <= $#troffColDefs && @columns > 0) { $def = $troffColDefs[$troffCol]; $col = shift @columns; $col =~ s/\s*$//; $align = ""; $col = "\\^" if ($col eq "" && $def =~ m/\^/); $col = " " if ($col eq ""); $style1 = ""; $style2 = ""; if ($col ne "\\^") { if ($def =~ m/[bB]/ || $def =~ m/f3/) { $style1 = "\\fB"; $style2 = "\\fP"; } if ($def =~ m/I/ || $def =~ m/f2/) { $style1 = "\\fI"; $style2 = "\\fP"; } } if ($def =~ m/c/) { $align = " align=center"; } if ($def =~ m/[rn]/) { $align = " align=right"; } $span = $def; $span =~ s/[^s]//g; if ($span) { $align.= " colspan=".(length($span)+1); } #{ if ($col =~ m/T}/) { $rowref->[$troffCol] .= "$style2"; ++$troffCol; } elsif ($col =~ m/T{/) #} { $col =~ s/T{//; #} $rowref->[$troffCol] = "$style1$col"; $troffMultiline = 1; } else { $rowref->[$troffCol] = "$style1$col$style2"; ++$troffCol; } } endTblRow() unless ($troffMultiline); } } sub endTblRow { return if ($troffCol == 0); while ($troffCol <= $#troffColDefs) { $rowref->[$troffCol] = " "; #print OUT " "; ++$troffCol; } $troffCol = 0; #print OUT "\n" } sub flushTable { plainOutput("\n") if ($debug); # Treat rows with first cell blank or with more than one vertically # spanned row as a continuation of the previous line. # Note this is frequently a useful heuristic but isn't foolproof. for($r=0; $r<$#tableRows; ++$r) { $vspans = 0; for ($c=0; $c<=$#{$tableRows[$r+1]}; ++$c) {++$vspans if ($tableRows[$r+1][$c] =~ m,\\\^,);} if ((($vspans>1) || ($tableRows[$r+1][0] =~ m, ,)) && $#{$tableRows[$r]} == $#{$tableRows[$r+1]} && 0) { if ($debug) { plainOutput("\n"); plainOutput("\n"); plainOutput("\n"); } for ($c=0; $c<=$#{$tableRows[$r]}; ++$c) { $tableRows[$r][$c] .= $tableRows[$r+1][$c]; $tableRows[$r][$c] =~ s,\\\^,,g; # merging is stronger than spanning! $tableRows[$r][$c] =~ s,,
    ,; } @tableRows = (@tableRows[0..$r], @tableRows[$r+2 .. $#tableRows]); --$r; # process again } } # Turn \^ vertical span requests into rowspan tags for($r=0; $r<$#tableRows; ++$r) { for ($c=0; $c<=$#{$tableRows[$r]}; ++$c) { $r2 = $r+1; while ( $r2<=$#tableRows && ($tableRows[$r2][$c] =~ m,\\\^,) ) { ++$r2; } $rs = $r2-$r; if ($rs > 1) { plainOutput("\n") if ($debug); $tableRows[$r][$c] =~ s/=0; --$c) { if ($tableRows[$r][$c] =~ m/[$c]." -->\n") if ($debug); @$rowref = (@{$rowref}[0..$c-1], @{$rowref}[$c+1..$#$rowref]); } } } } # Finally, output the cells that are left for($r=0; $r<=$#tableRows; ++$r) { plainOutput("\n"); for ($c=0; $c <= $#{$tableRows[$r]}; ++$c) { outputLine($tableRows[$r][$c]); } plainOutput("\n"); } @tableRows = (); $troffCol = 0; plainOutput("\n") if ($debug); } # Use these for all font changes, including .ft, .ps, .B, .BI, .SM etc. # Need to add a mechanism to stack up these changes so tags match: ... etc. sub pushStyle { $result = ""; $type = $_[0]; $tag = $_[1]; print OUT "\n" if ($debug>1); return $result; } sub resetStyles { if (@styleStack) { print OUT "\n"; print OUT "
    resetStyles [".join(",", @styleStack)."]
    \n" if ($debug); } while (@styleStack) { $oldItem = pop @styleStack; ($oldTag) = ($oldItem =~ m/^.(\S+)/); print OUT ""; } $currentSize = 0; $currentShift = 0; } sub blockquote { print OUT "
    \n"; ++$blockquote; } sub endBlockquote { resetStyles(); while ($blockquote > 0) { print OUT "
    \n"; --$blockquote; } } sub indent { plainOutput(pushStyle("I", "TABLE")); $width = $_[0]; $width = " width=$width%" if ($width); plainOutput(" \n"); } sub outdent { plainOutput("\n"); plainOutput(pushStyle("I")); } sub inlineStyle { $_[0] =~ m/^(.)(.*)$/; if ($1 eq "f") { fontChange($2); } elsif ($1 eq "s" && ! $noFill) { sizeChange($2); } else { superSub($1); } } sub fontChange { $fnt = $_[0]; $fnt =~ s/^\(//; if ($fnt eq "P" || $fnt eq "R" || $fnt eq "1" || $fnt eq "") { $font = ""; } elsif ($fnt eq "B" || $fnt eq "3") { $font = "B"; } elsif ($fnt eq "I" || $fnt eq "2") { $font = "I"; } else { $font = "TT"; } return pushStyle("F", $font); } sub sizeChange { $size= $_[0]; if ($size =~ m/^[+-]/) { $currentSize += $size; } else { $currentSize = $size-10; } $currentSize = 0 if (! $size); $sz = $currentSize; $sz = -2 if ($sz < -2); $sz = 2 if ($sz > 2); if ($currentSize eq "0") { $size = ""; } else { $size = "FONT size=$sz"; } return pushStyle("S", $size); } sub superSub { $sub = $_[0]; ++$currentShift if ($sub eq "u"); --$currentShift if ($sub eq "d"); $tag = ""; $tag = "SUP" if ($currentShift > 0); $tag = "SUB" if ($currentShift < 0); return pushStyle("D", $tag); } sub startNoFill { print OUT "
    \n" unless($noFill);
    	$noFill = 1;
    }
    
    sub endNoFill
    {
    	print OUT "
    \n" if ($noFill); $noFill = 0; } sub processEqns { if ($eqnMode==2 && $_[0] =~ m/^\.EN/) { $eqnMode = 0; outputLine(flushEqn()); plainOutput("\n"); return; } $eqnBuffer .= $_[0]." "; } sub processEqnd { processEqns(@_); return flushEqn(); } sub flushEqn { @p = grep($_ !~ m/^ *$/, split(/("[^"]*"|\s+|[{}~^])/, $eqnBuffer) ); $eqnBuffer = ""; #return "[".join(',', @p)." -> ".&doEqn(@p)."]\n"; $res = &doEqn(@p); #$res =~ s,\\\((..),$special{$1}||"\\($1",ge; #$res =~ s,<,<,g; #$res =~ s,>,>,g; return $res; } sub doEqn { my @p = @_; my $result = ""; my $res; my $c; while (@p) { ($res, @p) = doEqn1(@p); $result .= $res; } return $result; } sub doEqn1 { my @p = @_; my $res = ""; my $c; $c = shift @p; if ($eqndefs{$c}) { @x = split(/\0/, $eqndefs{$c}); unshift @p, @x; $c = shift @p; } if ($c =~ m/^"(.*)"$/) { $res = $1; } elsif ($c eq "delim") { $c = shift @p; if ($c eq "off") { $eqnStart = ""; $eqnEnd = ""; } else { $c =~ m/^(.)(.)/; $eqnStart = quotemeta($1); $eqnEnd = quotemeta($2); } } elsif ($c eq "define" || $c eq "tdefine" || $c eq "ndefine") { $t = shift @p; $d = shift @p; $def = ""; if (length($d) != 1) { $def = $d; $def =~ s/^.(.*)./\1/; } else { while (@p && $p[0] ne $d) { $def .= shift @p; $def .= "\0"; } chop $def; shift @p; } $eqndefs{$t} = $def unless ($c eq "ndefine"); } elsif ($c eq "{") { my $level = 1; my $i; for ($i=0; $i<=$#p; ++$i) { ++$level if ($p[$i] eq "{"); --$level if ($p[$i] eq "}"); last if ($level==0); } $res = doEqn(@p[0..$i-1]); @p = @p[$i+1..$#p]; } elsif ($c eq "sup") { ($c,@p) = &doEqn1(@p); $res = "\\u$c\\d"; } elsif ($c eq "to") { ($c,@p) = &doEqn1(@p); $res = "\\u$c\\d "; } elsif ($c eq "sub" || $c eq "from") { ($c,@p) = &doEqn1(@p); $res = "\\d$c\\u"; } elsif ($c eq "matrix") { ($c,@p) = &doEqn1(@p); $res = "matrix ( $c )"; } elsif ($c eq "bold") { ($c,@p) = &doEqn1(@p); $res = "\\fB$c\\fP"; } elsif ($c eq "italic") { ($c,@p) = &doEqn1(@p); $res = "\\fI$c\\fP"; } elsif ($c eq "roman") { } elsif ($c eq "font" || $c eq "gfont" || $c eq "size" || $c eq "gsize") { shift @p; } elsif ($c eq "mark" || $c eq "lineup") { } elsif ($c eq "~" || $c eq "^") { $res = " "; } elsif ($c eq "over") { $res = " / "; } elsif ($c eq "half") { $res = "\\(12"; } elsif ($c eq "prime") { $res = "\\' "; } elsif ($c eq "dot") { $res = "\\u.\\d "; } elsif ($c eq "dotdot") { $res = "\\u..\\d "; } elsif ($c eq "tilde") { $res = "\\u~\\d "; } elsif ($c eq "hat") { $res = "\\u^\\d "; } elsif ($c eq "bar" || $c eq "vec") { $res = "\\(rn "; } elsif ($c eq "under") { $res = "_ "; } elsif ( $c eq "sqrt" || $c eq "lim" || $c eq "sum" || $c eq "pile" || $c eq "lpile" || $c eq "rpile" || $c eq "cpile" || $c eq "int" || $c eq "prod" ) { $res = " $c "; } elsif ($c eq "cdot") { $res = " . "; } elsif ($c eq "inf") { $res = "\\(if"; } elsif ($c eq "above" || $c eq "lcol" || $c eq "ccol") { $res = " "; } elsif ($c eq "sin" || $c eq "cos" || $c eq "tan" || $c eq "log" || $c eq "ln" ) { $res = " $c "; } elsif ($c eq "left" || $c eq "right" || $c eq "nothing") { } elsif ($c =~ m/^[A-Za-z]/) { $res = "\\fI$c\\fP"; } else { $res = $c; } return ($res, @p); } ##### Search manpath and initialise special char array ##### sub initialise { # Determine groff version if possible my $groffver = `groff -v`; $groffver =~ /^GNU groff version (\S+)/; $groffver = $1; # Parse the macro definition file for section names if (open(MACRO, "/usr/lib/tmac/tmac.an") || open(MACRO, "/usr/lib/tmac/an") || open(MACRO, "/usr/lib/groff/tmac/tmac.an") || open(MACRO, "/usr/lib/groff/tmac/an.tmac") || open(MACRO, "/usr/share/tmac/tmac.an") || open(MACRO, "/usr/share/groff/tmac/tmac.an") || open(MACRO, "/usr/share/groff/tmac/an.tmac") || open(MACRO, "/usr/share/groff/$groffver/tmac/an.tmac") ) { while () { chop; if (m/\$2'([0-9a-zA-Z]+)' .ds ]D (.*)$/) { $sn = $2; unless ($sn =~ m/[a-z]/) { $sn = "\u\L$sn"; $sn =~ s/ (.)/ \u\1/g; } $sectionName{"\L$1"} = $sn; } if (m/\$1'([^']+)' .ds Tx "?(.*)$/) { $title{"$1"} = $2; } if (m/^.ds ]W (.*)$/) { $osver = $1; } } } else { print STDERR "Failed to read tmac.an definitions\n" unless ($cgiMode); } if (open(MACRO, "/usr/lib/tmac/tz.map")) { while () { chop; if (m/\$1'([^']+)' .ds Tz "?(.*)$/) { $title{"$1"} = $2; } } } # Prevent redefinition of macros that have special meaning to us $reservedMacros = '^(SH|SS|Sh|Ss)$'; # Predefine special number registers $number{'.l'} = 75; # String variables defined by man package $vars{'lq'} = '“'; $vars{'rq'} = '”'; $vars{'R'} = '\\(rg'; $vars{'S'} = '\\s0'; # String variables defined by mdoc package $vars{'Le'} = '\\(<='; $vars{'<='} = '\\(<='; $vars{'Ge'} = '\\(>='; $vars{'Lt'} = '<'; $vars{'Gt'} = '>'; $vars{'Ne'} = '\\(!='; $vars{'>='} = '\\(>='; $vars{'q'} = '"'; # see also special case in preProcessLine $vars{'Lq'} = '“'; $vars{'Rq'} = '”'; $vars{'ua'} = '\\(ua'; $vars{'ga'} = '\\(ga'; $vars{'Pi'} = '\\(*p'; $vars{'Pm'} = '\\(+-'; $vars{'Na'} = 'NaN'; $vars{'If'} = '\\(if'; $vars{'Ba'} = '|'; # String variables defined by ms package (access to accented characters) $vars{'bu'} = '»'; $vars{'66'} = '“'; $vars{'99'} = '”'; $vars{'*!'} = '¡'; $vars{'ct'} = '¢'; $vars{'po'} = '£'; $vars{'gc'} = '¤'; $vars{'ye'} = '¥'; #$vars{'??'} = '¦'; $vars{'sc'} = '§'; $vars{'*:'} = '¨'; $vars{'co'} = '©'; $vars{'_a'} = 'ª'; $vars{'<<'} = '«'; $vars{'no'} = '¬'; $vars{'hy'} = '­'; $vars{'rg'} = '®'; $vars{'ba'} = '¯'; $vars{'de'} = '°'; $vars{'pm'} = '±'; #$vars{'??'} = '²'; #$vars{'??'} = '³'; $vars{'aa'} = '´'; $vars{'mu'} = 'µ'; $vars{'pg'} = '¶'; $vars{'c.'} = '·'; $vars{'cd'} = '¸'; #$vars{'??'} = '¹'; $vars{'_o'} = 'º'; $vars{'>>'} = '»'; $vars{'14'} = '¼'; $vars{'12'} = '½'; #$vars{'??'} = '¾'; $vars{'*?'} = '¿'; $vars{'`A'} = 'À'; $vars{"'A"} = 'Á'; $vars{'^A'} = 'Â'; $vars{'~A'} = 'Ã'; $vars{':A'} = 'Ä'; $vars{'oA'} = 'Å'; $vars{'AE'} = 'Æ'; $vars{',C'} = 'Ç'; $vars{'`E'} = 'È'; $vars{"'E"} = 'É'; $vars{'^E'} = 'Ê'; $vars{':E'} = 'Ë'; $vars{'`I'} = 'Ì'; $vars{"'I"} = 'Í'; $vars{'^I'} = 'Î'; $vars{':I'} = 'Ï'; $vars{'-D'} = 'Ð'; $vars{'~N'} = 'Ñ'; $vars{'`O'} = 'Ò'; $vars{"'O"} = 'Ó'; $vars{'^O'} = 'Ô'; $vars{'~O'} = 'Õ'; $vars{':O'} = 'Ö'; #$vars{'mu'} = '×'; $vars{'NU'} = 'Ø'; $vars{'`U'} = 'Ù'; $vars{"'U"} = 'Ú'; $vars{'^U'} = 'Û'; $vars{':U'} = 'Ü'; #$vars{'??'} = 'Ý'; $vars{'Th'} = 'Þ'; $vars{'*b'} = 'ß'; $vars{'`a'} = 'à'; $vars{"'a"} = 'á'; $vars{'^a'} = 'â'; $vars{'~a'} = 'ã'; $vars{':a'} = 'ä'; $vars{'oa'} = 'å'; $vars{'ae'} = 'æ'; $vars{',c'} = 'ç'; $vars{'`e'} = 'è'; $vars{"'e"} = 'é'; $vars{'^e'} = 'ê'; $vars{':e'} = 'ë'; $vars{'`i'} = 'ì'; $vars{"'i"} = 'í'; $vars{'^i'} = 'î'; $vars{':i'} = 'ï'; #$vars{'??'} = 'ð'; $vars{'~n'} = 'ñ'; $vars{'`o'} = 'ò'; $vars{"'o"} = 'ó'; $vars{'^o'} = 'ô'; $vars{'~o'} = 'õ'; $vars{':o'} = 'ö'; $vars{'di'} = '÷'; $vars{'nu'} = 'ø'; $vars{'`u'} = 'ù'; $vars{"'u"} = 'ú'; $vars{'^u'} = 'û'; $vars{':u'} = 'ü'; #$vars{'??'} = 'ý'; $vars{'th'} = 'þ'; $vars{':y'} = 'ÿ'; # troff special characters and their closest equivalent $special{'em'} = '—'; $special{'hy'} = '-'; $special{'\-'} = '–'; # was - $special{'bu'} = 'o'; $special{'sq'} = '[]'; $special{'ru'} = '_'; $special{'14'} = '¼'; $special{'12'} = '½'; $special{'34'} = '¾'; $special{'fi'} = 'fi'; $special{'fl'} = 'fl'; $special{'ff'} = 'ff'; $special{'Fi'} = 'ffi'; $special{'Fl'} = 'ffl'; $special{'de'} = '°'; $special{'dg'} = '†'; # was 182, para symbol $special{'fm'} = "\\'"; $special{'ct'} = '¢'; $special{'rg'} = '®'; $special{'co'} = '©'; $special{'pl'} = '+'; $special{'mi'} = '-'; $special{'eq'} = '='; $special{'**'} = '*'; $special{'sc'} = '§'; $special{'aa'} = '´'; # was ' $special{'ga'} = '`'; # was ` $special{'ul'} = '_'; $special{'sl'} = '/'; $special{'*a'} = 'a'; $special{'*b'} = 'ß'; $special{'*g'} = 'y'; $special{'*d'} = 'd'; $special{'*e'} = 'e'; $special{'*z'} = 'z'; $special{'*y'} = 'n'; $special{'*h'} = 'th'; $special{'*i'} = 'i'; $special{'*k'} = 'k'; $special{'*l'} = 'l'; $special{'*m'} = 'µ'; $special{'*n'} = 'v'; $special{'*c'} = '3'; $special{'*o'} = 'o'; $special{'*p'} = 'pi'; $special{'*r'} = 'p'; $special{'*s'} = 's'; $special{'*t'} = 't'; $special{'*u'} = 'u'; $special{'*f'} = 'ph'; $special{'*x'} = 'x'; $special{'*q'} = 'ps'; $special{'*w'} = 'o'; $special{'*A'} = 'A'; $special{'*B'} = 'B'; $special{'*G'} = '|\\u_\\d'; $special{'*D'} = '/\'; $special{'*E'} = 'E'; $special{'*Z'} = 'Z'; $special{'*Y'} = 'H'; $special{'*H'} = 'TH'; $special{'*I'} = 'I'; $special{'*K'} = 'K'; $special{'*L'} = 'L'; $special{'*M'} = 'M'; $special{'*N'} = 'N'; $special{'*C'} = 'Z'; $special{'*O'} = 'O'; $special{'*P'} = '||'; $special{'*R'} = 'P'; $special{'*S'} = 'S'; $special{'*T'} = 'T'; $special{'*U'} = 'Y'; $special{'*F'} = 'PH'; $special{'*X'} = 'X'; $special{'*Q'} = 'PS'; $special{'*W'} = 'O'; $special{'ts'} = 's'; $special{'sr'} = 'v/'; $special{'rn'} = '\\u–\\d'; # was 175 $special{'>='} = '>='; $special{'<='} = '<='; $special{'=='} = '=='; $special{'~='} = '~='; $special{'ap'} = '~'; # was ~ $special{'!='} = '!='; $special{'->'} = '->'; $special{'<-'} = '<-'; $special{'ua'} = '^'; $special{'da'} = 'v'; $special{'mu'} = '×'; $special{'di'} = '÷'; $special{'+-'} = '±'; $special{'cu'} = 'U'; $special{'ca'} = '^'; $special{'sb'} = '('; $special{'sp'} = ')'; $special{'ib'} = '(='; $special{'ip'} = '=)'; $special{'if'} = 'oo'; $special{'pd'} = '6'; $special{'gr'} = 'V'; $special{'no'} = '¬'; $special{'is'} = 'I'; $special{'pt'} = '~'; $special{'es'} = 'Ø'; $special{'mo'} = 'e'; $special{'br'} = '|'; $special{'dd'} = '‡'; # was 165, yen $special{'rh'} = '=>'; $special{'lh'} = '<='; $special{'or'} = '|'; $special{'ci'} = 'O'; $special{'lt'} = '('; $special{'lb'} = '('; $special{'rt'} = ')'; $special{'rb'} = ')'; $special{'lk'} = '|'; $special{'rk'} = '|'; $special{'bv'} = '|'; $special{'lf'} = '|'; $special{'rf'} = '|'; $special{'lc'} = '|'; $special{'rc'} = '|'; # Not true troff characters but very common typos $special{'cp'} = '©'; $special{'tm'} = '®'; $special{'en'} = '-'; # Build a list of directories containing man pages @manpath = (); if (open(MPC, "/etc/manpath.config") || open(MPC, "/etc/man.config")) { while () { if (m/^(MANDB_MAP|MANPATH)\s+(\S+)/) { push(@manpath, $2); } } } @manpath = split(/:/, $ENV{'MANPATH'}) unless (@manpath); @manpath = ("/usr/man") unless (@manpath); } # Search through @manpath and construct @mandirs (non-empty subsections) sub loadManDirs { return if (@mandirs); print STDERR "Searching ",join(":", @manpath)," for mandirs\n" unless($cgiMode); foreach $tld (@manpath) { $tld =~ m/^(.*)$/; $tld = $1; # untaint manpath if (opendir(DIR, $tld)) { # foreach $d (<$tld/man[0-9a-z]*>) foreach $d (sort readdir(DIR)) { if ($d =~ m/^man\w/ && -d "$tld/$d") { push (@mandirs, "$tld/$d"); } } closedir DIR; } } } ##### Utility to search manpath for a given command ##### sub findPage { $request = $_[0]; $request =~ s,^/,,; @multipleMatches = (); $file = $_[0]; return $file if (-f $file || -f "$file.gz" || -f "$file.bz2"); # Search the path for the requested man page, which may be of the form: # "/usr/man/man1/ls.1", "ls.1" or "ls". ($page,$sect) = ($request =~ m/^(.+)\.([^.]+)$/); $sect = "\L$sect"; # Search the specified section first (if specified) if ($sect) { foreach $md (@manpath) { $dir = $md; $file = "$dir/man$sect/$page.$sect"; push(@multipleMatches, $file) if (-f $file || -f "$file.gz" || -f "$file.bz2"); } } else { $page = $request; } if (@multipleMatches == 1) { return pop @multipleMatches; } # If not found need to search through each directory loadManDirs(); foreach $dir (@mandirs) { ($s) = ($dir =~ m/man([0-9A-Za-z]+)$/); $file = "$dir/$page.$s"; push(@multipleMatches, $file) if (-f $file || -f "$file.gz" || -f "$file.bz2"); $file = "$dir/$request"; push(@multipleMatches, $file) if (-f $file || -f "$file.gz" || -f "$file.bz2"); if ($sect && "$page.$sect" ne $request) { $file = "$dir/$page.$sect"; push(@multipleMatches, $file) if (-f $file || -f "$file.gz" || -f "$file.bz2"); } } if (@multipleMatches == 1) { return pop @multipleMatches; } if (@multipleMatches > 1) { return ""; } # Ok, didn't find it using section numbers. Perhaps there's a page with the # right name but wrong section number lurking there somewhere. (This search is slow) # eg. page.1x in man1 (not man1x) directory foreach $dir (@mandirs) { opendir(DIR, $dir); foreach $f (readdir DIR) { if ($f =~ m/^$page\./) { $f =~ s/\.(gz|bz2)$//; push(@multipleMatches, "$dir/$f"); } } } if (@multipleMatches == 1) { return pop @multipleMatches; } return ""; } sub loadPerlPages { my ($dir,$f,$name,@files); loadManDirs(); return if (%perlPages); foreach $dir (@mandirs) { if (opendir(DIR, $dir)) { @files = sort readdir DIR; foreach $f (@files) { next if ($f eq "." || $f eq ".." || $f !~ m/\./); next unless ("$dir/$f" =~ m/perl/); $f =~ s/\.(gz|bz2)$//; ($name) = ($f =~ m,(.+)\.[^.]*$,); $perlPages{$name} = "$dir/$f"; } closedir DIR; } } delete $perlPages{'perl'}; # too ubiquitous to be useful } sub fmtTime { my $time = $_[0]; my @days = qw (Sun Mon Tue Wed Thu Fri Sat); my @months = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$istdst) = localtime($time); return sprintf ("%s, %02d %s %4d %02d:%02d:%02d GMT", $days[$wday],$mday,$months[$mon],1900+$year,$hour,$min,$sec); }