#! /usr/bin/perl

# man
# Put in cgi-bin to enable public viewing of man pages
# Limitations:
# Only looks under /usr/share/man
#
# Copyright (C) 2005, 2006  Nick Urbanik <nicku@nicku.org>

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use strict;
use warnings;
use CGI qw/:standard/;

use Readonly;

Readonly my $MAN2HTML => "/usr/bin/man2html";
Readonly my $ZCAT => "/bin/zcat";
Readonly my $CAT => "/bin/cat";
Readonly my $URL_PATH => "/cgi-bin/man";
Readonly my $MANDIR => "/usr/share/man/";

# From MANSECT    1:1p:8:2:3:3p:4:5:6:7:9:0p:tcl:n:l:p:o in man.conf:
our @mansect = qw/1 1p 8 2 3 3p 4 5 6 7 9 0p tcl n l p o/;

# display the message on the user's web browser:
sub show_error(@) {
    my @message = @_;
    print +header, start_html, "@message", end_html;
    exit 1;
}

# Details of message go into apache's error logs (don't help an attacker):
sub error(@) {
    my @message = @_;
    print +header, start_html, "A bit of a problem, Grommit.", end_html;
    die "@message";
}

sub slurp_file($) {
    my ( $file_name ) = @_;
    open my $fh, '<', $file_name
        or die "unable to open $file_name: $!";
    return do { local $/; <$fh> };
}

sub cat_man_file_contents($) {
    my ( $manpage ) = @_;
    if ( $manpage =~ m{\.gz$}xms ) {
        return qx!$ZCAT $manpage!;
    } else {
        return slurp_file $manpage;
    }
}

# Given a section number and topic, search for the man page with:
# 1. Try with topic.section.gz at the end
# 2. Try with topic.section at the end
# 3. if section == 3, try with topic.3pm at the end
# 4. if section == 3, try with topic.3pm.gz at the end
sub find_closest_filename($$) {
    my ( $section, $topic ) = @_;
    my $manpage = $MANDIR . "man$section/$topic.$section.gz";
    return $manpage if -e $manpage;
    $manpage = $MANDIR . "man$section/$topic.$section";
    return $manpage if -e $manpage;
    return unless $section == 3;
    $manpage = $MANDIR . "man$section/$topic.3pm";
    return $manpage if -e $manpage;
    $manpage = $MANDIR . "man$section/$topic.3pm.gz";
    return $manpage if -e $manpage;
    return;
}

# Small "man pages" are rather like symbolic links, containing the name
# of the actual file we need to open up.
# For example, the file man3p/posix_trace_set_filter.3p.gz
# contains the one line:
# .so man3p/posix_trace_get_filter.3p
# I call this ".so expansion".
sub so_expand($) {
    my ( $manpage ) = @_;
    return $manpage if -s $manpage > 100;
    my $newpath = cat_man_file_contents $manpage;
    chomp $newpath;
    return $manpage unless $newpath =~ m{\.so\s.*/(.*)$}xms;
    my $newfile = $1;
    $manpage =~ s!(.*/).*?(\.gz)?$!$1$newfile$2!;
    return $manpage;
}

# This actually displays the web page if the man page is available:

sub lookup($) {
    my ( $manpage ) = @_;
    warn "Cannot read manpage '$manpage'" unless -r $manpage;
    show_error "Cannot read manpage" unless -r $manpage;
    $manpage = so_expand $manpage;
    my $cmd = " $manpage | $MAN2HTML -H $ENV{SERVER_NAME} "
        . "-M $URL_PATH -D $manpage";
    if ( $manpage =~ m{\.gz$}xms ) {
        $cmd = $ZCAT . $cmd;
    } else {
        $cmd = $CAT . $cmd;
    }
    warn "executing '$cmd'\n";
    print qx!$cmd!; 
    exit 0;
}

#print header, start_html('VARS');

# foreach my $n ( sort keys %ENV ) {
#     print "$n = $ENV{$n}<br>\n";
# }

unless ( $ENV{QUERY_STRING} ) {
    error "No query String\n";
}

our ( $section, $topic );
if ( $ENV{QUERY_STRING} =~ /(.*)\+(.*)/ ) {
    ( $section, $topic ) = ( $1, $2 );
    error "No topic with query" unless $topic;
} else {
    $topic = $ENV{QUERY_STRING};
}

# Launder the topic name:
#find /usr/share/man | grep -v '^[A-Za-z_.0-9/:+-]\+$'
show_error "Bad input '$topic'" unless $topic =~ /^[A-Za-z_.0-9:+-]+$/;
show_error "Bad input '$topic'" if $topic =~ /\.\./;

# If we have a section, see if that section is in the list.
# exit if not.
# If in the list, check to see if the file exists
# exit if not.

my $manpage;
if ( $section and grep { $_ eq $section } @mansect ) {
    warn "Found valid section $section.\n";
    $manpage = find_closest_filename $section, $topic;
    if ( $manpage ) {
        lookup $manpage;
    } else {
        warn "'$manpage' does not exist\n";
        show_error "'$topic' does not exist\n";
    }
} elsif ( $section ) {
    show_error "No such section '$section'\n";
}

# If no section, search for the file in each section.

foreach my $s ( @mansect ) {
    $manpage = find_closest_filename $s, $topic;
    if ( $manpage ) {
        lookup $manpage;
    }
}

show_error "No manpage for $topic\n";