| 1 |
#!/usr/bin/perl -T
|
| 2 |
#
|
| 3 |
# Copyright (c) 1996-2007 Wolfram Schneider <wosch@FreeBSD.org>
|
| 4 |
# Modified for Debian by Javier Fernandez-Sanguino <jfs@debian.org>
|
| 5 |
# All rights reserved.
|
| 6 |
#
|
| 7 |
# Redistribution and use in source and binary forms, with or without
|
| 8 |
# modification, are permitted provided that the following conditions
|
| 9 |
# are met:
|
| 10 |
# 1. Redistributions of source code must retain the above copyright
|
| 11 |
# notice, this list of conditions and the following disclaimer.
|
| 12 |
# 2. Redistributions in binary form must reproduce the above copyright
|
| 13 |
# notice, this list of conditions and the following disclaimer in the
|
| 14 |
# documentation and/or other materials provided with the distribution.
|
| 15 |
#
|
| 16 |
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
| 17 |
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
| 18 |
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
| 19 |
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
| 20 |
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
| 21 |
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
| 22 |
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
| 23 |
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
| 24 |
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
| 25 |
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
| 26 |
# SUCH DAMAGE.
|
| 27 |
#
|
| 28 |
# man.cgi - HTML hypertext FreeBSD man page interface
|
| 29 |
#
|
| 30 |
# based on bsdi-man.pl,v 2.17 1995/10/05 16:48:58 sanders Exp
|
| 31 |
# bsdi-man -- HTML hypertext BSDI man page interface
|
| 32 |
# based on bsdi-man.pl,v 2.10 1993/10/02 06:13:23 sanders Exp
|
| 33 |
# by polk@BSDI.COM 1/10/95
|
| 34 |
# BSDI Id: bsdi-man,v 1.2 1995/01/11 02:30:01 polk Exp
|
| 35 |
# Dual CGI/Plexus mode and new interface by sanders@bsdi.com 9/22/1995
|
| 36 |
#
|
| 37 |
# $Id: man.cgi,v 1.7 2008-01-01 23:32:09 jfs Exp $
|
| 38 |
|
| 39 |
############################################################################
|
| 40 |
# !!! man.cgi is stale perl4 code !!!
|
| 41 |
############################################################################
|
| 42 |
|
| 43 |
use File::stat;
|
| 44 |
use Time::localtime;
|
| 45 |
|
| 46 |
$www{'title'} = 'Debian Hypertext Man Pages';
|
| 47 |
$www{'home'} = 'http://manpages.debian.net';
|
| 48 |
$www{'head'} = qq[<IMG height=61 width=60 SRC="http://www.debian.org/logos/openlogo-nd-50.png" Alt="[Debian Logo]"><img src="http://www.debian.org/Pics/debian.png" width="179" height="61" alt="Debian project">] .
|
| 49 |
"";
|
| 50 |
|
| 51 |
# Set this to 1 (or above) to debug the CGI script
|
| 52 |
$debug = 0;
|
| 53 |
|
| 54 |
#$command{'man'} = 'man'; # 8Bit clean man
|
| 55 |
#$command{'man'} = '/home/wosch/bin/cgi-man'; # 8Bit clean man
|
| 56 |
$command{'man'} = '/usr/bin/man'; # 8Bit clean man
|
| 57 |
|
| 58 |
|
| 59 |
# Config Options
|
| 60 |
# map sections to their man command argument(s)
|
| 61 |
%sections = (
|
| 62 |
'', '',
|
| 63 |
'All', '',
|
| 64 |
'0', '',
|
| 65 |
|
| 66 |
'1', '1',
|
| 67 |
'1c', '1',
|
| 68 |
'1C', '1',
|
| 69 |
'1g', '1',
|
| 70 |
'1m', '1',
|
| 71 |
'2', '2',
|
| 72 |
'2j', '2',
|
| 73 |
'3', '3',
|
| 74 |
'3S', '3',
|
| 75 |
'3f', '3',
|
| 76 |
'3j', '3',
|
| 77 |
'3m', '3',
|
| 78 |
'3n', '3',
|
| 79 |
'3r', '3',
|
| 80 |
'3s', '3',
|
| 81 |
'3x', '3',
|
| 82 |
'4', '4',
|
| 83 |
'5', '5',
|
| 84 |
'6', '6',
|
| 85 |
'7', '7',
|
| 86 |
'8', '8',
|
| 87 |
'8c', '8',
|
| 88 |
'9', '9',
|
| 89 |
'l', 'l',
|
| 90 |
'n', 'n',
|
| 91 |
);
|
| 92 |
|
| 93 |
$sectionpath = {
|
| 94 |
};
|
| 95 |
|
| 96 |
foreach my $os (keys %$sectionpath) {
|
| 97 |
foreach my $section (split(/:/, $sectionpath->{$os}{'path'})) {
|
| 98 |
$section =~ /(.)(.*)/;
|
| 99 |
$sectionpath->{$os}{$1} .=
|
| 100 |
($sectionpath->{$os}{$1} ? ':' : '') . $section;
|
| 101 |
}
|
| 102 |
}
|
| 103 |
|
| 104 |
|
| 105 |
%sectionName =
|
| 106 |
(
|
| 107 |
'0', 'All Sections',
|
| 108 |
'1', '1 - General Commands',
|
| 109 |
'2', '2 - System Calls',
|
| 110 |
'3', '3 - Subroutines',
|
| 111 |
'4', '4 - Special Files',
|
| 112 |
'5', '5 - File Formats',
|
| 113 |
'6', '6 - Games',
|
| 114 |
'7', '7 - Macros and Conventions',
|
| 115 |
'8', '8 - Maintenance Commands',
|
| 116 |
'9', '9 - Kernel Interface',
|
| 117 |
'n', 'n - New Commands',
|
| 118 |
);
|
| 119 |
|
| 120 |
$manLocalDir = '/home/jfs/manpages/extractor/manpages-dists';
|
| 121 |
#$manPathDefault = 'Debian Sid';
|
| 122 |
$manPathDefault = 'Debian 5.0 lenny';
|
| 123 |
|
| 124 |
%locales =
|
| 125 |
(
|
| 126 |
'cs', 'Czech',
|
| 127 |
'de', 'German',
|
| 128 |
'es', 'Spanish',
|
| 129 |
'en', 'English',
|
| 130 |
'it', 'Italian',
|
| 131 |
'fr', 'French',
|
| 132 |
'fi', 'Finnish',
|
| 133 |
'ja', 'Japanese',
|
| 134 |
'ko', 'Korean',
|
| 135 |
'nl', 'Dutch',
|
| 136 |
'pt', 'Portuguese',
|
| 137 |
'pl', 'Polish',
|
| 138 |
'ru', 'Russian',
|
| 139 |
'sv', 'Swedish',
|
| 140 |
);
|
| 141 |
# TODO: Add language support, the following isocodes are present in sid:
|
| 142 |
# bg
|
| 143 |
# de.ISO8859-1
|
| 144 |
# en
|
| 145 |
# gl
|
| 146 |
# hu
|
| 147 |
# pt_BR
|
| 148 |
# tr
|
| 149 |
# zh_CN
|
| 150 |
# zh_TW
|
| 151 |
# Language to encoding list, generated with:
|
| 152 |
# cat /etc/locale.alias |grep -v ^# | grep -v ^$ |
|
| 153 |
# while read lang enc; do echo -e "\t'$lang', '$enc',"; done
|
| 154 |
%langenc = (
|
| 155 |
'bokmal', 'no_NO.ISO-8859-1',
|
| 156 |
'catalan', 'ca_ES.ISO-8859-1',
|
| 157 |
'croatian', 'hr_HR.ISO-8859-2',
|
| 158 |
'czech', 'cs_CZ.ISO-8859-2',
|
| 159 |
'danish', 'da_DK.ISO-8859-1',
|
| 160 |
'dansk', 'da_DK.ISO-8859-1',
|
| 161 |
'deutsch', 'de_DE.ISO-8859-1',
|
| 162 |
'dutch', 'nl_NL.ISO-8859-1',
|
| 163 |
'eesti', 'et_EE.ISO-8859-1',
|
| 164 |
'estonian', 'et_EE.ISO-8859-1',
|
| 165 |
'finnish', 'fi_FI.ISO-8859-1',
|
| 166 |
'français', 'fr_FR.ISO-8859-1',
|
| 167 |
'french', 'fr_FR.ISO-8859-1',
|
| 168 |
'galego', 'gl_ES.ISO-8859-1',
|
| 169 |
'galician', 'gl_ES.ISO-8859-1',
|
| 170 |
'german', 'de_DE.ISO-8859-1',
|
| 171 |
'greek', 'el_GR.ISO-8859-7',
|
| 172 |
'hebrew', 'he_IL.ISO-8859-8',
|
| 173 |
'hrvatski', 'hr_HR.ISO-8859-2',
|
| 174 |
'hungarian', 'hu_HU.ISO-8859-2',
|
| 175 |
'icelandic', 'is_IS.ISO-8859-1',
|
| 176 |
'italian', 'it_IT.ISO-8859-1',
|
| 177 |
'japanese', 'ja_JP.eucJP',
|
| 178 |
'japanese.euc', 'ja_JP.eucJP',
|
| 179 |
'ja_JP', 'ja_JP.eucJP',
|
| 180 |
'ja_JP.ujis', 'ja_JP.eucJP',
|
| 181 |
'japanese.sjis', 'ja_JP.SJIS',
|
| 182 |
'korean', 'ko_KR.eucKR',
|
| 183 |
'korean.euc', 'ko_KR.eucKR',
|
| 184 |
'ko_KR', 'ko_KR.eucKR',
|
| 185 |
'lithuanian', 'lt_LT.ISO-8859-13',
|
| 186 |
'norwegian', 'no_NO.ISO-8859-1',
|
| 187 |
'nynorsk', 'nn_NO.ISO-8859-1',
|
| 188 |
'polish', 'pl_PL.ISO-8859-2',
|
| 189 |
'portuguese', 'pt_PT.ISO-8859-1',
|
| 190 |
'romanian', 'ro_RO.ISO-8859-2',
|
| 191 |
'russian', 'ru_RU.KOI8-R',
|
| 192 |
'slovak', 'sk_SK.ISO-8859-2',
|
| 193 |
'slovene', 'sl_SI.ISO-8859-2',
|
| 194 |
'slovenian', 'sl_SI.ISO-8859-2',
|
| 195 |
'spanish', 'es_ES.ISO-8859-1',
|
| 196 |
'swedish', 'sv_SE.ISO-8859-1',
|
| 197 |
'thai', 'th_TH.TIS-620',
|
| 198 |
'turkish', 'tr_TR.ISO-8859-9',
|
| 199 |
);
|
| 200 |
%manPath =
|
| 201 |
(
|
| 202 |
'Debian 3.0 woody', "$manLocalDir/woody/usr/share/man:$manLocalDir/woody/usr/X11R6/man",
|
| 203 |
'Debian 3.1 sarge', "$manLocalDir/sarge/usr/share/man",
|
| 204 |
'Debian 4.0 etch', "$manLocalDir/etch/usr/share/man",
|
| 205 |
'Debian 5.0 lenny', "$manLocalDir/lenny/usr/share/man",
|
| 206 |
'Debian squeeze', "$manLocalDir/squeeze/usr/share/man",
|
| 207 |
'Debian experimental', "$manLocalDir/experimental/usr/share/man",
|
| 208 |
'Debian Sid', "$manLocalDir/sid/usr/share/man",
|
| 209 |
);
|
| 210 |
|
| 211 |
# delete non-existing releases
|
| 212 |
while (($key,$val) = each %manPath) {
|
| 213 |
my $counter = 0;
|
| 214 |
|
| 215 |
# if the manpath contains colons, at least one directory must exists
|
| 216 |
foreach (split(/:/, $val)) {
|
| 217 |
$counter++ if -d;
|
| 218 |
}
|
| 219 |
|
| 220 |
# give up and delete release
|
| 221 |
delete $manPath{"$key"} if !$counter && $key ne $manPathDefault;
|
| 222 |
}
|
| 223 |
|
| 224 |
# keywords must be in lower cases.
|
| 225 |
%manPathAliases =
|
| 226 |
(
|
| 227 |
'debian', 'Debian 5.0 lenny',
|
| 228 |
'stable', 'Debian 5.0 lenny',
|
| 229 |
'testing', 'Debian squeeze',
|
| 230 |
'experimental', 'Debian experimental',
|
| 231 |
'unstable', 'Debian Sid',
|
| 232 |
);
|
| 233 |
|
| 234 |
foreach (sort keys %manPathAliases) {
|
| 235 |
# delete non-existing aliases
|
| 236 |
if (!defined($manPath{$manPathAliases{$_}})) {
|
| 237 |
undef $manPathAliases{$_};
|
| 238 |
next;
|
| 239 |
}
|
| 240 |
|
| 241 |
# add aliases, replases spaces with dashes
|
| 242 |
if (/\s/) {
|
| 243 |
local($key) = $_;
|
| 244 |
$key =~ s/\s+/-/g;
|
| 245 |
$manPathAliases{$key} = $manPathAliases{$_};
|
| 246 |
}
|
| 247 |
}
|
| 248 |
|
| 249 |
@sections = keys %sections; shift @sections; # all but the "" entry
|
| 250 |
$sections = join("|", @sections); # sections regexp
|
| 251 |
|
| 252 |
|
| 253 |
# mailto - Author
|
| 254 |
# webmaster - who runs this service
|
| 255 |
$mailto = 'wosch@FreeBSD.org';
|
| 256 |
$mailtoURL = 'http://wolfram.schneider.org';
|
| 257 |
$mailtoURL = "mailto:$mailto" if !$mailtoURL;
|
| 258 |
$webmaster = 'jfs@debian.org';
|
| 259 |
$webmasterURL = 'mailto:jfs@debian.org';
|
| 260 |
#$manstat = 'http://www.de.freebsd.org/de/stat/man';
|
| 261 |
|
| 262 |
&secure_env;
|
| 263 |
# CGI Interface -- runs at load time
|
| 264 |
&do_man(&env('SCRIPT_NAME'), &env('PATH_INFO'), &env('QUERY_STRING'))
|
| 265 |
unless defined($main'plexus_configured);
|
| 266 |
|
| 267 |
$enable_include_links = 0;
|
| 268 |
|
| 269 |
# Plexus Native Interface
|
| 270 |
sub do_man {
|
| 271 |
local($BASE, $path, $form) = @_;
|
| 272 |
local($_, %form, $query, $proto, $name, $section, $apropos);
|
| 273 |
|
| 274 |
# spinner is buggy, shit
|
| 275 |
local($u) = 'http://manpages.debian.net/cgi-bin/man.cgi';
|
| 276 |
local($u)= $BASE;
|
| 277 |
|
| 278 |
return &faq_output($u) if ($path =~ /\/(faq|help)\.html$/);
|
| 279 |
#return ©right_output($u) if ($path =~ /copyright.html$/);
|
| 280 |
return &get_the_sources if ($path =~ /source$/);
|
| 281 |
|
| 282 |
return &include_output($path)
|
| 283 |
if ($enable_include_links && $path =~ m%^/usr/include/% && -f $path);
|
| 284 |
|
| 285 |
return &indexpage if ($form eq "");
|
| 286 |
|
| 287 |
&decode_form($form, *form, 0);
|
| 288 |
|
| 289 |
$format = $form{'format'};
|
| 290 |
$format = 'html' if $format !~ /^(ps|pdf|ascii|latin1|dvi|troff)$/;
|
| 291 |
|
| 292 |
local($fform) = &dec($form);
|
| 293 |
if ($fform =~ m%^([\w\_\-\:\+\.]+)$%) {
|
| 294 |
return &man($1, '');
|
| 295 |
} elsif ($fform =~ m%^([\w\_\-\:\+\.]+)\(([0-9a-zA-Z]+)\)$%) {
|
| 296 |
return &man($1, $2);
|
| 297 |
}
|
| 298 |
|
| 299 |
# remove trailing spaces for dumb users
|
| 300 |
$form{'query'} =~ s/\s+$//;
|
| 301 |
$form{'query'} =~ s/^\s+//;
|
| 302 |
|
| 303 |
$name = $query = $form{'query'};
|
| 304 |
$section = $form{'sektion'};
|
| 305 |
$apropos = $form{'apropos'};
|
| 306 |
$alttitle = $form{'title'};
|
| 307 |
$manpath = $form{'manpath'};
|
| 308 |
$locale = $form{'locale'};
|
| 309 |
$locale = '' if $locale eq 'en'; # Default locale
|
| 310 |
$encoding = '' ; # No encoding
|
| 311 |
if (!$manpath) {
|
| 312 |
$manpath = $manPathDefault;
|
| 313 |
} elsif (!$manPath{$manpath}) {
|
| 314 |
local($m) = ($manpath =~ y/A-Z/a-z/);
|
| 315 |
if ($manPath{$manPathAliases{$manpath}}) {
|
| 316 |
$manpath = $manPathAliases{$manpath};
|
| 317 |
} else {
|
| 318 |
$manpath = $manPathDefault;
|
| 319 |
}
|
| 320 |
}
|
| 321 |
|
| 322 |
|
| 323 |
|
| 324 |
# download a man hierarchie as gzip'd tar file
|
| 325 |
return &download if ($apropos > 1);
|
| 326 |
|
| 327 |
# empty query
|
| 328 |
return &indexpage if ($manpath && $form !~ /query=/);
|
| 329 |
|
| 330 |
$section = "" if $section eq "ALL" || $section eq '';
|
| 331 |
|
| 332 |
if (!$apropos && $query =~ m/^(.*)\(([^\)]*)\)/) {
|
| 333 |
$name = $1; $section = $2;
|
| 334 |
}
|
| 335 |
|
| 336 |
$apropos ? &apropos($query) : &man($name, $section);
|
| 337 |
}
|
| 338 |
|
| 339 |
# --------------------- support routines ------------------------
|
| 340 |
|
| 341 |
sub debug {
|
| 342 |
&http_header("text/plain");
|
| 343 |
print @_,"\n----------\n\n\n";
|
| 344 |
}
|
| 345 |
|
| 346 |
sub get_the_sources {
|
| 347 |
local($file) = '/usr/lib/cgi-bin/man.cgi';
|
| 348 |
$file = $0 if ! -f $file;
|
| 349 |
|
| 350 |
open(R, $file) || &mydie("open $file: $!\n");
|
| 351 |
print "Content-type: text/plain\n\n";
|
| 352 |
while(<R>) { print }
|
| 353 |
close R;
|
| 354 |
exit;
|
| 355 |
}
|
| 356 |
|
| 357 |
# download a manual directory as gzip'd tar archive
|
| 358 |
sub download {
|
| 359 |
|
| 360 |
$| = 1;
|
| 361 |
my $filename = $manpath;
|
| 362 |
$filename =~ s/\s+/_/;
|
| 363 |
$filename = &encode_url($filename);
|
| 364 |
$filename .= '.tar.gz';
|
| 365 |
|
| 366 |
print qq{Content-type: application/x-tar\n} .
|
| 367 |
qq{Content-encoding: x-gzip\n} .
|
| 368 |
qq{Content-disposition: inline; filename="$filename"\n} .
|
| 369 |
"\n";
|
| 370 |
|
| 371 |
local(@m);
|
| 372 |
local($m) = $manPath{"$manpath"};
|
| 373 |
foreach (split(/:/, $m)) {
|
| 374 |
push(@m, $_) if s%^$manLocalDir/?%%;
|
| 375 |
}
|
| 376 |
|
| 377 |
chdir($manLocalDir) || do {
|
| 378 |
print "chdir: $!\n"; exit(0);
|
| 379 |
};
|
| 380 |
|
| 381 |
$m = join(" ", @m);
|
| 382 |
#warn "find $m -print | cpio -o -H tar 2>/dev/null | gzip -cqf";
|
| 383 |
|
| 384 |
sleep 1;
|
| 385 |
system("find $m -print | cpio -o -H tar 2>/dev/null | gzip -cqf");
|
| 386 |
exit(0);
|
| 387 |
}
|
| 388 |
|
| 389 |
sub http_header {
|
| 390 |
local($content_type) = @_;
|
| 391 |
if (defined($main'plexus_configured)) {
|
| 392 |
&main'MIME_header('ok', $content_type);
|
| 393 |
} else {
|
| 394 |
print "Content-type: $content_type\n\n";
|
| 395 |
}
|
| 396 |
}
|
| 397 |
|
| 398 |
sub env { defined($main'ENV{$_[0]}) ? $main'ENV{$_[0]} : undef; }
|
| 399 |
|
| 400 |
sub printenv {
|
| 401 |
# Print the environment, useful for debugging
|
| 402 |
while (($key,$value) = each %ENV) {
|
| 403 |
print "$key=$value\n";
|
| 404 |
}
|
| 405 |
}
|
| 406 |
|
| 407 |
sub apropos {
|
| 408 |
local($query) = @_;
|
| 409 |
local($_, $title, $head, *APROPOS);
|
| 410 |
local($names, $section, $msg, $key);
|
| 411 |
local($prefix);
|
| 412 |
|
| 413 |
$prefix = "Apropos ";
|
| 414 |
if ($alttitle) {
|
| 415 |
$prefix = "";
|
| 416 |
$title = &encode_title($alttitle);
|
| 417 |
$head = &encode_data($alttitle);
|
| 418 |
} else {
|
| 419 |
$title = &encode_title($query);
|
| 420 |
$head = &encode_data($query);
|
| 421 |
}
|
| 422 |
|
| 423 |
&http_header("text/html");
|
| 424 |
print &html_header("Apropos $title");
|
| 425 |
print "<H1>$www{'head'}</H1>\n\n";
|
| 426 |
&formquery;
|
| 427 |
|
| 428 |
local($mpath) = $manPath{$manpath};
|
| 429 |
|
| 430 |
# open(APROPOS, "env MANPATH=$mpath $command{'man'} -k . |") || do {
|
| 431 |
# if there are two paths just take the first one
|
| 432 |
my ($whatpath, $other) = split (/:/, $mpath,2);
|
| 433 |
open(APROPOS, "$whatpath/whatis.db") || do {
|
| 434 |
warn "$0: Cannot open whatis database for `mpath'\n";
|
| 435 |
print "Cannot open whatis database.\n";
|
| 436 |
print "</DL>\n</BODY>\n</HTML>\n";
|
| 437 |
return;
|
| 438 |
};
|
| 439 |
|
| 440 |
local($q) = $query;
|
| 441 |
$q =~ s/(\W)/\\W/g;
|
| 442 |
local($sectionq) = $1 if $query =~ /\(([\dnl])\)/; # Determine section index
|
| 443 |
local($acounter) = 0;
|
| 444 |
|
| 445 |
while (<APROPOS>) {
|
| 446 |
next if !/$q/oi; # Fast mach, but includes manpages which have a section in the description
|
| 447 |
$acounter++;
|
| 448 |
|
| 449 |
# matches whatis.db lines: name[, name ...] (sect) - msg
|
| 450 |
$names = $section = $msg = $key = undef;
|
| 451 |
($key, $section) = m/^([^()]+)\(([^)]*)\)\s*(\[[^\]]*\])?\s*-/;
|
| 452 |
# Skip those manpages that do not correspond to the section
|
| 453 |
next if $sectionq ne '' and $section ne $sectionq;
|
| 454 |
|
| 455 |
$key =~ s/\s+$//;
|
| 456 |
$key =~ s/.*\s+//;
|
| 457 |
($names, $msg) = m/^(.*\))\s+-\s+(.*)/;
|
| 458 |
print "<DT><A HREF=\"$BASE?query=", &encode_url($key),
|
| 459 |
"&sektion=", &encode_url($section), "&apropos=0",
|
| 460 |
"&manpath=", &encode_url($manpath), "\">",
|
| 461 |
&encode_data("$names"), "</A>\n<DD>",
|
| 462 |
&encode_data($msg), "\n";
|
| 463 |
}
|
| 464 |
if ( $sectionq ne '' ) {
|
| 465 |
print "<BR><HR>Total manpages for this section: $acounter\n";
|
| 466 |
}
|
| 467 |
close(APROPOS);
|
| 468 |
|
| 469 |
if (!$acounter) {
|
| 470 |
print "Sorry, no data found for `$query' ($acounter).\n";
|
| 471 |
}
|
| 472 |
print "</DL>\n</BODY>\n</HTML>\n";
|
| 473 |
}
|
| 474 |
|
| 475 |
sub man {
|
| 476 |
local($name, $section) = @_;
|
| 477 |
local($_, $title, $head, *MAN);
|
| 478 |
local($html_name, $html_section, $prefix);
|
| 479 |
local(@manargs);
|
| 480 |
local($query) = $name;
|
| 481 |
|
| 482 |
# $section =~ s/^([0-9ln]).*$/$1/;
|
| 483 |
$section =~ tr/A-Z/a-z/;
|
| 484 |
|
| 485 |
$prefix = "Man ";
|
| 486 |
if ($alttitle) {
|
| 487 |
$prefix = "";
|
| 488 |
$title = &encode_title($alttitle);
|
| 489 |
$head = &encode_data($alttitle);
|
| 490 |
} elsif ($section) {
|
| 491 |
$title = &encode_title("${name}($section)");
|
| 492 |
$head = &encode_data("${name}($section)");
|
| 493 |
} else {
|
| 494 |
$title = &encode_title("${name}");
|
| 495 |
$head = &encode_data("${name}");
|
| 496 |
}
|
| 497 |
|
| 498 |
# Check the locale
|
| 499 |
if ( $locale ) {
|
| 500 |
if ( $locale =~ /^([A-Za-z]{2})$/ ) {
|
| 501 |
$locale = $1;
|
| 502 |
$language = $locales{$locale};
|
| 503 |
# Set encoding locale if we find it in the language -> encoding list
|
| 504 |
$encoding = $langenc{lc($language)};
|
| 505 |
} else {
|
| 506 |
print "Sorry, locale $locale is not valid\n";
|
| 507 |
return;
|
| 508 |
}
|
| 509 |
}
|
| 510 |
#print "LANG $language and ENC $encoding\n";
|
| 511 |
$charset = '';
|
| 512 |
if ( $encoding && $encoding =~ /^[\w\_]+\.([\w\-]+)$/) {
|
| 513 |
# Find out our charset
|
| 514 |
$charset = $1;
|
| 515 |
}
|
| 516 |
|
| 517 |
if ($format eq "html") {
|
| 518 |
$header="text/html";
|
| 519 |
$header = $header."; charset=".lc($charset) if $charset;
|
| 520 |
&http_header("$header");
|
| 521 |
print &html_header("$title");
|
| 522 |
print "<H1>$www{'head'}</H1>\n\n";
|
| 523 |
&formquery;
|
| 524 |
} else {
|
| 525 |
#$format =~ /^(ps|ascii|latin1|dvi|troff)$/')
|
| 526 |
$ENV{'NROFF_FORMAT'} = $format;
|
| 527 |
|
| 528 |
# Content-encoding: x-gzip
|
| 529 |
if ($format eq "ps") {
|
| 530 |
&http_header("application/postscript");
|
| 531 |
} elsif ($format eq "pdf") {
|
| 532 |
&http_header("application/pdf");
|
| 533 |
} elsif ($format eq "dvi") {
|
| 534 |
&http_header("application/x-dvi");
|
| 535 |
} elsif ($format eq "troff") {
|
| 536 |
&http_header("application/x-troff-mandoc");
|
| 537 |
} else {
|
| 538 |
$header="text/plain";
|
| 539 |
$header = $header."; charset=".lc($charset) if $charset;
|
| 540 |
&http_header($header);
|
| 541 |
}
|
| 542 |
}
|
| 543 |
|
| 544 |
$html_name = &encode_data($name);
|
| 545 |
$html_section = &encode_data($section);
|
| 546 |
|
| 547 |
#print Dumper($sectionpath);
|
| 548 |
#print "yy $section yy $manpath\n";
|
| 549 |
if ($name =~ /^\s*$/) {
|
| 550 |
print "Empty input, no man page given.\n";
|
| 551 |
return;
|
| 552 |
}
|
| 553 |
|
| 554 |
if (index($name, '*') != -1) {
|
| 555 |
print "Invalid character input '*': $name\n";
|
| 556 |
return;
|
| 557 |
}
|
| 558 |
|
| 559 |
if ( $name =~ /^([\w\_\-\:\+\.]+)/ ) {
|
| 560 |
$name = $1
|
| 561 |
} else {
|
| 562 |
print "Sorry, name `$name' is not valid\n";
|
| 563 |
return
|
| 564 |
}
|
| 565 |
|
| 566 |
if ($section !~ /^[0-9lnpm]\w*$/ && $section ne '') {
|
| 567 |
print "Sorry, section `$section' is not valid\n";
|
| 568 |
return;
|
| 569 |
}
|
| 570 |
|
| 571 |
# Untaint the section
|
| 572 |
if ( $section =~ /^([\d\w]+)/ ) {
|
| 573 |
$section = $1;
|
| 574 |
}
|
| 575 |
|
| 576 |
if ($manpath =~ /^([\w\s\.]+)/ ) {
|
| 577 |
$manpath = $1;
|
| 578 |
} else {
|
| 579 |
print "Sorry, manpath `$manpath' is not valid\n";
|
| 580 |
return;
|
| 581 |
}
|
| 582 |
|
| 583 |
if (!$section) {
|
| 584 |
if ($sectionpath->{$manpath}) {
|
| 585 |
$section = $sectionpath->{$manpath}{'path'};
|
| 586 |
} else {
|
| 587 |
$section = '';
|
| 588 |
}
|
| 589 |
} else {
|
| 590 |
if ($sectionpath->{$manpath}{$section}) {
|
| 591 |
$section = $sectionpath->{$manpath}{$section};
|
| 592 |
}
|
| 593 |
}
|
| 594 |
|
| 595 |
if ( $encoding ) {
|
| 596 |
$main'ENV{'LANG'} = "$encoding";
|
| 597 |
push(@manargs, "-L $encoding");
|
| 598 |
}
|
| 599 |
|
| 600 |
# Adjust manpath if we are given a locale
|
| 601 |
if ( $manpath and $locale ) {
|
| 602 |
local (@locale_manpath);
|
| 603 |
foreach $mpath (split(/:/, $manPath{$manpath}) ) {
|
| 604 |
push @locale_manpath, $mpath."/".$locale
|
| 605 |
}
|
| 606 |
$manPath{$manpath} = join(':', @locale_manpath);
|
| 607 |
}
|
| 608 |
|
| 609 |
print "X $manpath - $locale - $manPath{$manpath} x\n" if $debug;
|
| 610 |
if ($manpath) {
|
| 611 |
if ($manPath{$manpath}) {
|
| 612 |
unshift(@manargs, ('-M', $manPath{$manpath}));
|
| 613 |
&groff_path($manPath{$manpath});
|
| 614 |
} elsif ($manpath{&dec($manpath)}) {
|
| 615 |
unshift(@manargs, ('-M', $manPath{&dec($manpath)}));
|
| 616 |
&groff_path( $manPath{&dec($manpath)} );
|
| 617 |
} else {
|
| 618 |
# unset invalid manpath
|
| 619 |
undef $manpath;
|
| 620 |
}
|
| 621 |
}
|
| 622 |
|
| 623 |
|
| 624 |
if ($format =~ /^(ps|pdf)$/) {
|
| 625 |
push(@manargs, '-t');
|
| 626 |
}
|
| 627 |
|
| 628 |
print "X $command{'man'} @manargs -- $section $name x\n" if $debug;
|
| 629 |
#die "Section $section is tainted\n" if is_tainted($section);
|
| 630 |
printenv() if $debug > 1;
|
| 631 |
print "X Calling $command{'man'} ".join(" ",@manargs)." for $name ($section)\n" if $debug;
|
| 632 |
&proc(*MAN, $command{'man'}, @manargs, "--", $section, $name) ||
|
| 633 |
&mydie ("$0: open of $command{'man'} command failed: $!\n");
|
| 634 |
if (eof(MAN)) {
|
| 635 |
print "X $command{'man'} @manargs -- $section $name x\n" if $debug;
|
| 636 |
print "Sorry, no data found for `$html_name" .
|
| 637 |
($html_section ? "($html_section)": '') . "'.\n";
|
| 638 |
if ( $locale) {
|
| 639 |
print "You might want to try the ".
|
| 640 |
qq{<A HREF="$BASE?query=$name&sektion=$section&apropos=0&manpath=$manpath">original (english)</A> version.\n};
|
| 641 |
}
|
| 642 |
return;
|
| 643 |
}
|
| 644 |
|
| 645 |
if ($format ne "html") {
|
| 646 |
if ($format eq "latin1" || $format eq "ascii") {
|
| 647 |
while(<MAN>) { s/.//g; print; }
|
| 648 |
} elsif ($format eq "pdf") {
|
| 649 |
#
|
| 650 |
# run a PostScript to PDF converter
|
| 651 |
#
|
| 652 |
# TODO: Use Perl's Temp:: implementation
|
| 653 |
local(@args) = ('mktemp', '/tmp/_man.cgi-ps2pdf-XXXXXXXXXXXX');
|
| 654 |
open(TMP, "-|") or
|
| 655 |
exec(@args) or die "open @args: $!\n";
|
| 656 |
local($tempfile) = <TMP>;
|
| 657 |
close TMP;
|
| 658 |
|
| 659 |
# chomp, avoid security warnings using -T switch
|
| 660 |
#chop($tempfile);
|
| 661 |
if ($tempfile =~ /(\S+)/) {
|
| 662 |
$tempfile = $1;
|
| 663 |
}
|
| 664 |
|
| 665 |
if (!$tempfile || ! -f $tempfile) {
|
| 666 |
die "Cannot create tempfile: $tempfile\n";
|
| 667 |
}
|
| 668 |
#warn $tempfile;
|
| 669 |
|
| 670 |
#$tempfile = '/tmp/bla2';
|
| 671 |
open(TMP, "> $tempfile") or die "open $tempfile: $!\n";
|
| 672 |
while(<MAN>) {
|
| 673 |
print TMP $_;
|
| 674 |
}
|
| 675 |
close TMP;
|
| 676 |
local($ENV{'PATH'}) = '/bin:/usr/bin';
|
| 677 |
open(PDF, "-|") or
|
| 678 |
exec('/usr/bin/ps2pdf', $tempfile, '/dev/stdout') or
|
| 679 |
die "open ps2pdf: $!\n";
|
| 680 |
|
| 681 |
# sleep and delete the temp file
|
| 682 |
#select(undef, undef, undef, 0.8);
|
| 683 |
#unlink($tempfile);
|
| 684 |
|
| 685 |
while(<PDF>) {
|
| 686 |
print;
|
| 687 |
}
|
| 688 |
close PDF;
|
| 689 |
unlink($tempfile);
|
| 690 |
|
| 691 |
} else {
|
| 692 |
while(<MAN>) { print; }
|
| 693 |
}
|
| 694 |
close(MAN);
|
| 695 |
exit(0);
|
| 696 |
}
|
| 697 |
|
| 698 |
local($space) = 1;
|
| 699 |
local(@sect);
|
| 700 |
local($i, $j);
|
| 701 |
&available_translations($name, $section);
|
| 702 |
print "<PRE>\n";
|
| 703 |
while(<MAN>) {
|
| 704 |
# remove tailing white space
|
| 705 |
if (/^\s+$/) {
|
| 706 |
next if $space;
|
| 707 |
$space = 1;
|
| 708 |
} else {
|
| 709 |
$space = 0;
|
| 710 |
}
|
| 711 |
|
| 712 |
$_ = &encode_data($_);
|
| 713 |
if($enable_include_links &&
|
| 714 |
m,(<B>)?\#include(</B>)?\s+(<B>)?\<\;(.*\.h)\>\;(</B>)?,) {
|
| 715 |
$match = $4; ($regexp = $match) =~ s/\./\\\./;
|
| 716 |
s,$regexp,\<A HREF=\"$BASE/usr/include/$match\"\>$match\</A\>,;
|
| 717 |
}
|
| 718 |
/^\s/ && # skip headers
|
| 719 |
s,((<[IB]>)?[\w\_\.\-]+\s*(</[IB]>)?\s*\(([1-9ln][a-zA-Z]*)\)),&mlnk($1),oige;
|
| 720 |
|
| 721 |
# detect E-Mail Addreses in manpages
|
| 722 |
if (/\@/) {
|
| 723 |
s/([a-z0-9_\-\.]+\@[a-z0-9\-\.]+\.[a-z]+)/<A HREF="mailto:$1">$1<\/A>/gi;
|
| 724 |
}
|
| 725 |
|
| 726 |
# detect URLs in manpages
|
| 727 |
if (m%tp://%) {
|
| 728 |
s,((ftp|http)://[^\s<>\)]+),<A HREF="$1">$1</A>,gi;
|
| 729 |
}
|
| 730 |
|
| 731 |
if (/^<B>\S+/ && m%^<B>([^<]+)%) {
|
| 732 |
$i = $1; $j = &encode_url($i);
|
| 733 |
s%^<B>([^<]+)</B>%<a name="$j" href="#end"><B>$i</B></a>%;
|
| 734 |
push(@sect, $1);
|
| 735 |
}
|
| 736 |
print;
|
| 737 |
}
|
| 738 |
close(MAN);
|
| 739 |
print qq{</PRE>\n<a name="end">\n<hr noshade>\n};
|
| 740 |
|
| 741 |
for ($i = 0; $i <= $#sect; $i++) {
|
| 742 |
print qq{<a href="#} . &encode_url($sect[$i]) .
|
| 743 |
qq{">$sect[$i]</a>} . ($i < $#sect ? " |\n" : "\n");
|
| 744 |
}
|
| 745 |
|
| 746 |
print "</BODY>\n";
|
| 747 |
print "</HTML>\n";
|
| 748 |
|
| 749 |
# Sleep 0.35 seconds to avoid DoS attacs
|
| 750 |
select undef, undef, undef, 0.35;
|
| 751 |
}
|
| 752 |
|
| 753 |
#
|
| 754 |
# You may need to precreate some mdoc.local files for every system you
|
| 755 |
# support (every collection of man pages), maybe like:
|
| 756 |
#
|
| 757 |
# $manLocalDir/NetBSD-1.4.2/tmac
|
| 758 |
#
|
| 759 |
# and then in your cgi script itself set the GROFF_TMAC_PATH as appropriate
|
| 760 |
# like:
|
| 761 |
#
|
| 762 |
# GROFF_TMAC_PATH=$manLocalDir/NetBSD-1.4.2/tmac:/usr/share/tmac/
|
| 763 |
#
|
| 764 |
sub groff_path {
|
| 765 |
local $manpath = shift;
|
| 766 |
|
| 767 |
local @groff_path;
|
| 768 |
foreach (split(/:/, $manpath)) {
|
| 769 |
push(@groff_path, $_ . '/tmac');
|
| 770 |
}
|
| 771 |
|
| 772 |
$ENV{'GROFF_TMAC_PATH'} = join(':', @groff_path, '/usr/share/tmac');
|
| 773 |
}
|
| 774 |
|
| 775 |
sub mlnk {
|
| 776 |
local($matched) = @_;
|
| 777 |
local($link, $section);
|
| 778 |
($link = $matched) =~ s/[\s]+//g;
|
| 779 |
$link =~ s/<\/?[IB]>//g;
|
| 780 |
($link, $section) = ($link =~ m/^([^\(]*)\((.*)\)/);
|
| 781 |
$link = &encode_url($link);
|
| 782 |
$section = &encode_url($section);
|
| 783 |
local($manpath) = &encode_url($manpath);
|
| 784 |
return qq{<A HREF="$BASE?query=$link} .
|
| 785 |
qq{&sektion=$section&apropos=0&manpath=$manpath&locale=$locale">$matched</A>};
|
| 786 |
}
|
| 787 |
|
| 788 |
sub is_tainted {
|
| 789 |
return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 };
|
| 790 |
}
|
| 791 |
|
| 792 |
sub proc {
|
| 793 |
local(*FH, $prog, @args) = @_;
|
| 794 |
local($pid) = open(FH, "-|");
|
| 795 |
return undef unless defined($pid);
|
| 796 |
# die "Program $prog is tainted\n" if is_tainted($prog);
|
| 797 |
# die "Arguments @args are tainted\n" if is_tainted(@args);
|
| 798 |
if ($pid == 0) {
|
| 799 |
exec $prog, @args;
|
| 800 |
&mydie("exec $prog failed\n");
|
| 801 |
}
|
| 802 |
1;
|
| 803 |
}
|
| 804 |
|
| 805 |
# $indent is a bit of optional data processing I put in for
|
| 806 |
# formatting the data nicely when you are emailing it.
|
| 807 |
# This is derived from code by Denis Howe <dbh@doc.ic.ac.uk>
|
| 808 |
# and Thomas A Fine <fine@cis.ohio-state.edu>
|
| 809 |
sub decode_form {
|
| 810 |
local($form, *data, $indent, $key, $_) = @_;
|
| 811 |
foreach $_ (split(/&/, $form)) {
|
| 812 |
($key, $_) = split(/=/, $_, 2);
|
| 813 |
$_ =~ s/\+/ /g; # + -> space
|
| 814 |
$key =~ s/\+/ /g; # + -> space
|
| 815 |
$_ =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig; # undo % escapes
|
| 816 |
$key =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig; # undo % escapes
|
| 817 |
$_ =~ s/[\r\n]+/\n\t/g if defined($indent); # indent data after \n
|
| 818 |
$data{$key} = &escape($_);
|
| 819 |
}
|
| 820 |
}
|
| 821 |
|
| 822 |
# block cross-site scripting attacks (css)
|
| 823 |
sub escape($) { $_ = $_[0]; s/&/&/g; s/</</g; s/>/>/g; $_; }
|
| 824 |
|
| 825 |
sub dec {
|
| 826 |
local($_) = @_;
|
| 827 |
|
| 828 |
s/\+/ /g; # '+' -> space
|
| 829 |
s/%(..)/pack("c",hex($1))/ge; # '%ab' -> char ab
|
| 830 |
|
| 831 |
return($_);
|
| 832 |
}
|
| 833 |
|
| 834 |
#
|
| 835 |
# Splits up a query request, returns an array of items.
|
| 836 |
# usage: @items = &main'splitquery($query);
|
| 837 |
#
|
| 838 |
sub splitquery {
|
| 839 |
local($query) = @_;
|
| 840 |
grep((s/%([\da-f]{1,2})/pack(C,hex($1))/eig, 1), split(/\+/, $query));
|
| 841 |
}
|
| 842 |
|
| 843 |
# encode unknown data for use in a URL <A HREF="...">
|
| 844 |
sub encode_url {
|
| 845 |
local($_) = @_;
|
| 846 |
# rfc1738 says that ";"|"/"|"?"|":"|"@"|"&"|"=" may be reserved.
|
| 847 |
# And % is the escape character so we escape it along with
|
| 848 |
# single-quote('), double-quote("), grave accent(`), less than(<),
|
| 849 |
# greater than(>), and non-US-ASCII characters (binary data),
|
| 850 |
# and white space. Whew.
|
| 851 |
s/([\000-\032\;\/\?\:\@\&\=\%\'\"\`\<\>\177-\377 ])/sprintf('%%%02x',ord($1))/eg;
|
| 852 |
s/%20/+/g;
|
| 853 |
$_;
|
| 854 |
}
|
| 855 |
# encode unknown data for use in <TITLE>...</TITILE>
|
| 856 |
sub encode_title {
|
| 857 |
# like encode_url but less strict (I couldn't find docs on this)
|
| 858 |
local($_) = @_;
|
| 859 |
s/([\000-\031\%\&\<\>\177-\377])/sprintf('%%%02x',ord($1))/eg;
|
| 860 |
$_;
|
| 861 |
}
|
| 862 |
# encode unknown data for use inside markup attributes <MARKUP ATTR="...">
|
| 863 |
sub encode_attribute {
|
| 864 |
# rfc1738 says to use entity references here
|
| 865 |
local($_) = @_;
|
| 866 |
s/([\000-\031\"\'\`\%\&\<\>\177-\377])/sprintf('\&#%03d;',ord($1))/eg;
|
| 867 |
$_;
|
| 868 |
}
|
| 869 |
# encode unknown text data for using as HTML,
|
| 870 |
# treats ^H as overstrike ala nroff.
|
| 871 |
sub encode_data {
|
| 872 |
local($_) = @_;
|
| 873 |
local($str);
|
| 874 |
|
| 875 |
# Escape &, < and >
|
| 876 |
s,\010[><&],,g;
|
| 877 |
s/\&/\&\;/g;
|
| 878 |
s/\</\<\;/g;
|
| 879 |
s/\>/\>\;/g;
|
| 880 |
|
| 881 |
if (!s,((.\010.)+\s+(.\010.)+),($str = $1) =~ s/.\010//g; "<B>$str</B>";,ge) {
|
| 882 |
s,((.\010.)+),($str = $1) =~ s/.\010//g; "<B>$str</B>";,ge;
|
| 883 |
}
|
| 884 |
|
| 885 |
s,((_\010.)+),($str = $1) =~ s/.\010//g; "<I>$str</I>";,ge;
|
| 886 |
s,(.\010)+,$1,g;
|
| 887 |
|
| 888 |
|
| 889 |
# Escape binary data except for ^H which we process below
|
| 890 |
# \375 gets turned into the & for the entity reference
|
| 891 |
#s/([^\010\012\015\032-\176])/sprintf('\375#%03d;',ord($1))/eg;
|
| 892 |
# Process ^H sequences, we use \376 and \377 (already escaped
|
| 893 |
# above) to stand in for < and > until those characters can
|
| 894 |
# be properly escaped below.
|
| 895 |
#s,\376[IB]\377_\376/[IB]\377,,g;
|
| 896 |
#s/.[\b]//g; # just do an erase for anything else
|
| 897 |
# Now convert our magic chars into our tag markers
|
| 898 |
#s/\375/\&/g; s/\376/</g; s/\377/>/g;
|
| 899 |
|
| 900 |
s,.\010,,g;
|
| 901 |
|
| 902 |
$_;
|
| 903 |
}
|
| 904 |
|
| 905 |
|
| 906 |
sub available_translations {
|
| 907 |
# Print translations available for a given manual page
|
| 908 |
local($name, $section) = @_;
|
| 909 |
return if $section eq '';
|
| 910 |
local ($locald, $path, $found);
|
| 911 |
$found = 0 ;
|
| 912 |
foreach $path (split(/:/, $manPath{$manpath}) ) {
|
| 913 |
# Remove the current locale from the path if there is one
|
| 914 |
$path =~ s/\/$locale// if $locale ne '';
|
| 915 |
# Print the location of the original english file
|
| 916 |
if ( $locale ne '' and ( -e "$path/man$section/$name.$section" or -e "$path/man$section/$name.$section.gz" ) ) {
|
| 917 |
print qq{[<A HREF="$BASE?query=$name&sektion=$section&apropos=0&manpath=$m">English</A>] };
|
| 918 |
}
|
| 919 |
|
| 920 |
foreach $locald ( keys %locales ) {
|
| 921 |
if ( -e "$path/$locald/man$section/$name.$section" or -e "$path/$locald/man$section/$name.$section.gz" ) {
|
| 922 |
if ( ! $found ) {
|
| 923 |
print "Also available in: ";
|
| 924 |
$found = 1;
|
| 925 |
}
|
| 926 |
print qq{[<A HREF="$BASE?query=$name&sektion=$section&apropos=0&manpath=$manpath&locale=$locald">$locales{$locald}</A>] };
|
| 927 |
}
|
| 928 |
}
|
| 929 |
}
|
| 930 |
print "\n" if $found;
|
| 931 |
return $found;
|
| 932 |
}
|
| 933 |
|
| 934 |
sub indexpage {
|
| 935 |
&http_header("text/html");
|
| 936 |
print &html_header("$www{'title'}: Index Page") .
|
| 937 |
"<H1>$www{'head'}</H1>\n\n" . &intro;
|
| 938 |
# If the content is out of date print a warning:
|
| 939 |
&out_of_date if is_out_of_date();
|
| 940 |
&formquery;
|
| 941 |
|
| 942 |
local($m) = ($manpath ? $manpath : $manPathDefault);
|
| 943 |
$m = &encode_url($m);
|
| 944 |
|
| 945 |
print "<B><I>Section Indexes</I></B>:\n";
|
| 946 |
foreach ('1', '2', '3', '4', '5', '6', '7', '8', '9', 'n') {
|
| 947 |
print qq{¤ } if $_ ne '1';
|
| 948 |
print qq{<A HREF="$BASE?query=($_)&sektion=&apropos=1&manpath=$m&title=Section%20$_Index">$_</A>\n};
|
| 949 |
}
|
| 950 |
|
| 951 |
print "<BR><B><I>Explanations of Man Sections:</I></B>\n";
|
| 952 |
foreach ('1', '2', '3', '4', '5', '6', '7', '8', '9') {
|
| 953 |
print qq{¤ } if $_ ne '1';
|
| 954 |
print qq{<A HREF="$BASE?query=intro&sektion=$_&apropos=0&manpath=$m&title=Introduction%20Section%20$_">intro($_)</A>\n};
|
| 955 |
}
|
| 956 |
|
| 957 |
if (0) {
|
| 958 |
print "<BR>\n<B><I>Quick Reference Categories:</I></B>\n";
|
| 959 |
foreach ('database', 'disk', 'driver', 'ethernet', 'mail', 'net', 'nfs',
|
| 960 |
'nis', 'protocol', 'ppp', 'roff', 'string', 'scsi',
|
| 961 |
'statistic', 'tcl', 'tcp', 'time')
|
| 962 |
{
|
| 963 |
print qq{¤ <A HREF="$BASE?query=$_&sektion=&apropos=1&manpath=$m&title=Quick%20Ref%20$_">$_</A>\n};
|
| 964 |
}
|
| 965 |
}
|
| 966 |
|
| 967 |
|
| 968 |
print <<ETX if $mailto;
|
| 969 |
<HR noshade>
|
| 970 |
URL: <A HREF="$BASE" target=_parent>$www{'home'}$BASE</a><br>
|
| 971 |
ETX
|
| 972 |
|
| 973 |
print "<br>\n";
|
| 974 |
print "</BODY>\n</HTML>\n";
|
| 975 |
0;
|
| 976 |
}
|
| 977 |
|
| 978 |
sub is_out_of_date {
|
| 979 |
my $ret = 0;
|
| 980 |
my $file = $manLocalDir."/timestamp";
|
| 981 |
return 1 if ! -e $file;
|
| 982 |
my $mtime = ctime(stat($file)->mtime);
|
| 983 |
# my $current_time = time();
|
| 984 |
# $diff = $current_time - $mtime;
|
| 985 |
print "<p><small>Contents last updated: $mtime</small></p>";
|
| 986 |
$ret = 1 if -M $file > 60;
|
| 987 |
return $ret;
|
| 988 |
}
|
| 989 |
|
| 990 |
|
| 991 |
|
| 992 |
sub out_of_date {
|
| 993 |
print <<ETX;
|
| 994 |
<p><STRONG><font color="#FF0000">NOTE:</font></STRONG> (2008-05-01) The content
|
| 995 |
available for this service
|
| 996 |
are currently out of date due to some <a
|
| 997 |
href="http://lists.debian.org/debian-doc/2009/01/msg00068.html">issues</a> with
|
| 998 |
its hosting site. As a consequence newer Debian releases might not be listed yet
|
| 999 |
and manpages of previous releases are not fully up to date. We are working on
|
| 1000 |
restoring the service. Sorry for the inconvenience.
|
| 1001 |
</p>
|
| 1002 |
ETX
|
| 1003 |
|
| 1004 |
}
|
| 1005 |
|
| 1006 |
|
| 1007 |
sub formquery {
|
| 1008 |
local($astring, $bstring);
|
| 1009 |
if (!$apropos) {
|
| 1010 |
$astring = " CHECKED";
|
| 1011 |
} else {
|
| 1012 |
$bstring = " CHECKED";
|
| 1013 |
}
|
| 1014 |
|
| 1015 |
print <<ETX;
|
| 1016 |
<FORM METHOD="GET" ACTION="$BASE">
|
| 1017 |
<B><I>Man Page or Keyword Search:</I></B>
|
| 1018 |
<INPUT VALUE="$query" NAME="query">
|
| 1019 |
<INPUT TYPE="submit" VALUE="Submit">
|
| 1020 |
<INPUT TYPE="reset" VALUE="Reset">
|
| 1021 |
<BR>
|
| 1022 |
<INPUT NAME="apropos" VALUE="0" TYPE="RADIO"$astring> <A HREF="$BASE?query=man&sektion=1&apropos=0">Man</A>
|
| 1023 |
<SELECT NAME="sektion">
|
| 1024 |
ETX
|
| 1025 |
|
| 1026 |
|
| 1027 |
foreach $key (sort keys %sectionName) {
|
| 1028 |
print "<OPTION" . (($key eq $section) ? ' SELECTED ' : ' ') .
|
| 1029 |
qq{VALUE="$key">$sectionName{$key}</OPTION>\n};
|
| 1030 |
};
|
| 1031 |
|
| 1032 |
|
| 1033 |
print qq{</SELECT>\n<SELECT NAME="manpath">\n};
|
| 1034 |
|
| 1035 |
local($l) = ($manpath ? $manpath : $manPathDefault);
|
| 1036 |
foreach (sort keys %manPath) {
|
| 1037 |
$key = $_;
|
| 1038 |
print "<OPTION" . (($key eq $l) ? ' SELECTED ' : ' ') .
|
| 1039 |
qq{VALUE="$key">$key</OPTION>\n};
|
| 1040 |
}
|
| 1041 |
|
| 1042 |
local($m) = &encode_url($l);
|
| 1043 |
print <<ETX;
|
| 1044 |
</SELECT>
|
| 1045 |
<BR>
|
| 1046 |
<INPUT NAME="apropos" VALUE="1" TYPE="RADIO"$bstring> <A HREF="$BASE?query=apropos&sektion=1&apropos=0">Apropos</A> Keyword Search (all sections)
|
| 1047 |
<BR>
|
| 1048 |
Output format:
|
| 1049 |
<SELECT NAME="format">
|
| 1050 |
ETX
|
| 1051 |
|
| 1052 |
foreach ('html', 'ps', 'pdf',
|
| 1053 |
# 'dvi', # you need a 8 bit clean man, e.g. jp-man
|
| 1054 |
'ascii', 'latin1') {
|
| 1055 |
print qq{<OPTION VALUE="$_">$_</OPTION>\n};
|
| 1056 |
};
|
| 1057 |
|
| 1058 |
print <<ETX;
|
| 1059 |
</SELECT>
|
| 1060 |
<BR>
|
| 1061 |
Language:
|
| 1062 |
<SELECT NAME="locale">
|
| 1063 |
ETX
|
| 1064 |
|
| 1065 |
|
| 1066 |
foreach $key (sort keys %locales) {
|
| 1067 |
print "<OPTION";
|
| 1068 |
if ( $locale ) {
|
| 1069 |
if ($key eq $locale) {
|
| 1070 |
print ' SELECTED ';
|
| 1071 |
} else {
|
| 1072 |
print ' ';
|
| 1073 |
}
|
| 1074 |
} else {
|
| 1075 |
# No locale, default to english
|
| 1076 |
if ($key eq 'en') {
|
| 1077 |
print ' SELECTED ';
|
| 1078 |
} else {
|
| 1079 |
print ' ';
|
| 1080 |
}
|
| 1081 |
}
|
| 1082 |
|
| 1083 |
print qq{VALUE="$key">$locales{$key}</OPTION>\n};
|
| 1084 |
};
|
| 1085 |
|
| 1086 |
|
| 1087 |
print qq{</SELECT>\n};
|
| 1088 |
|
| 1089 |
print <<ETX;
|
| 1090 |
</FORM>
|
| 1091 |
|
| 1092 |
<A HREF="$BASE?manpath=$m">home</A> |
|
| 1093 |
<A HREF="$BASE/help.html">help</A>
|
| 1094 |
<HR>
|
| 1095 |
ETX
|
| 1096 |
0;
|
| 1097 |
}
|
| 1098 |
|
| 1099 |
# TODO: This should be an include file
|
| 1100 |
sub copyright {
|
| 1101 |
$id = '$Id: man.cgi,v 1.7 2008-01-01 23:32:09 jfs Exp $';
|
| 1102 |
|
| 1103 |
return qq{\
|
| 1104 |
<PRE>
|
| 1105 |
Copyright (c) 1996-2007 <a href="$mailtoURL">Wolfram Schneider</A>
|
| 1106 |
Copyright (c) 1993-1995 Berkeley Software Design, Inc.
|
| 1107 |
|
| 1108 |
This data is part of a licensed program from BERKELEY SOFTWARE
|
| 1109 |
DESIGN, INC. Portions are copyrighted by BSDI, The Regents of
|
| 1110 |
the University of California, Massachusetts Institute of
|
| 1111 |
Technology, Free Software Foundation, FreeBSD Inc., and others.
|
| 1112 |
|
| 1113 |
</PRE>\n
|
| 1114 |
This script has the revsion: $id
|
| 1115 |
<p>
|
| 1116 |
|
| 1117 |
Copyright (©) for man pages by OS vendors.
|
| 1118 |
<p>
|
| 1119 |
};
|
| 1120 |
}
|
| 1121 |
|
| 1122 |
sub faq {
|
| 1123 |
|
| 1124 |
local(@list, @list2);
|
| 1125 |
local($url);
|
| 1126 |
foreach (sort keys %manPath) {
|
| 1127 |
$url = &encode_url($_);
|
| 1128 |
push(@list,
|
| 1129 |
qq{<li><a href="$BASE?apropos=2&manpath=$url">[download]} .
|
| 1130 |
qq{</a> "$_" -> $BASE?manpath=$url});
|
| 1131 |
}
|
| 1132 |
|
| 1133 |
foreach (sort keys %manPathAliases) {
|
| 1134 |
push(@list2, qq[<li>"$_" -> "$manPathAliases{$_}" -> ] .
|
| 1135 |
"$BASE?manpath=" .
|
| 1136 |
&encode_url($_) . "\n") if $manPathAliases{$_};
|
| 1137 |
}
|
| 1138 |
|
| 1139 |
local $id = '$Id: man.cgi,v 1.7 2008-01-01 23:32:09 jfs Exp $';
|
| 1140 |
return qq{\
|
| 1141 |
<PRE>
|
| 1142 |
Copyright (c) 1996-2007 <a href="$mailtoURL">Wolfram Schneider</A>
|
| 1143 |
Copyright (c) 1993-1995 Berkeley Software Design, Inc.
|
| 1144 |
|
| 1145 |
This data is part of a licensed program from BERKELEY SOFTWARE
|
| 1146 |
DESIGN, INC. Portions are copyrighted by BSDI, The Regents of
|
| 1147 |
the University of California, Massachusetts Institute of
|
| 1148 |
Technology, Free Software Foundation, FreeBSD Inc., and others.
|
| 1149 |
|
| 1150 |
</PRE>\n
|
| 1151 |
This script has the revsion: $id
|
| 1152 |
<p>
|
| 1153 |
|
| 1154 |
Copyright (c) for man pages by OS vendors.
|
| 1155 |
|
| 1156 |
<h2>FAQ</h2>
|
| 1157 |
<UL>
|
| 1158 |
<li>Troff macros works only if defined in FreeBSD/groff. OS specific
|
| 1159 |
macros like `appeared in NetBSD version 1.2' are not supported.
|
| 1160 |
<li>Netscape is buggy, you may press twice the link 'Index Page and Help'
|
| 1161 |
<li>Copyright (c) and download for man pages by
|
| 1162 |
OS vendors
|
| 1163 |
</UL>
|
| 1164 |
|
| 1165 |
<h2>Releases</h2>
|
| 1166 |
|
| 1167 |
Releases and Releases Aliases are information how
|
| 1168 |
to make a link to this script to the right OS version.
|
| 1169 |
<p>
|
| 1170 |
You may download the manpages as gzip'd tar archive
|
| 1171 |
for private use. A tarball is usually ~100MB big.
|
| 1172 |
<p>
|
| 1173 |
<ul>
|
| 1174 |
@list
|
| 1175 |
</ul>
|
| 1176 |
|
| 1177 |
<h2>Releases Aliases</h2>
|
| 1178 |
Release aliases are for lazy people. Plus, they have a longer
|
| 1179 |
lifetime, eg. 'debian' points always to the latest Debian unstable release.
|
| 1180 |
<ul>
|
| 1181 |
@list2
|
| 1182 |
</ul>
|
| 1183 |
};
|
| 1184 |
}
|
| 1185 |
|
| 1186 |
|
| 1187 |
sub intro {
|
| 1188 |
return qq{\
|
| 1189 |
<P>
|
| 1190 |
<I>Man Page Lookup</I> searches for man pages name and section as
|
| 1191 |
given in the selection menu and the query dialog. <I>Apropos
|
| 1192 |
Keyword Search</I> searches the database for the string given in
|
| 1193 |
the query dialog. There are also several hypertext links provided
|
| 1194 |
as short-cuts to various queries: <I>Section Indexes</I> is apropos
|
| 1195 |
listings of all man pages by section. <I>Explanations of Man
|
| 1196 |
Sections</I> contains pointers to the intro pages for various man
|
| 1197 |
sections.
|
| 1198 |
<P>
|
| 1199 |
};
|
| 1200 |
}
|
| 1201 |
|
| 1202 |
sub copyright_output {
|
| 1203 |
&http_header("text/html");
|
| 1204 |
print &html_header("HTML hypertext Debian man page interface") .
|
| 1205 |
"<H1>$www{'head'}</H1>\n" . ©right . qq{\
|
| 1206 |
<HR>
|
| 1207 |
|
| 1208 |
<A HREF="$_[0]">home</A>
|
| 1209 |
</BODY>
|
| 1210 |
</HTML>
|
| 1211 |
};
|
| 1212 |
}
|
| 1213 |
|
| 1214 |
sub faq_output {
|
| 1215 |
&http_header("text/html");
|
| 1216 |
print &html_header("HTML hypertext FreeBSD man page interface") .
|
| 1217 |
"<H1>$www{'head'}</H1>\n" . &faq . qq{\
|
| 1218 |
<HR>
|
| 1219 |
|
| 1220 |
<A HREF="$_[0]">home</A>
|
| 1221 |
</BODY>
|
| 1222 |
</HTML>
|
| 1223 |
};
|
| 1224 |
}
|
| 1225 |
|
| 1226 |
sub html_header {
|
| 1227 |
my $header="";
|
| 1228 |
$header = qq{<HTML>
|
| 1229 |
<HEAD>
|
| 1230 |
<TITLE>$_[0]</TITLE>
|
| 1231 |
<link rev="made" href="mailto:jfs\@debian.org">
|
| 1232 |
<META name="robots" content="nofollow">
|
| 1233 |
<meta content="text/html; charset="};
|
| 1234 |
|
| 1235 |
# Set the charset if known
|
| 1236 |
if ($charset) {
|
| 1237 |
$header = $header.$charset;
|
| 1238 |
} else {
|
| 1239 |
$header = $header."iso-8859-1";
|
| 1240 |
}
|
| 1241 |
$header = $header.qq{" http-equiv="Content-Type">
|
| 1242 |
<style type="text/css">
|
| 1243 |
<!--
|
| 1244 |
body {color:#000000;background-color:#FFFFFF}
|
| 1245 |
//-->
|
| 1246 |
</style>
|
| 1247 |
</HEAD>
|
| 1248 |
<BODY BGCOLOR="#FFFFFF" TEXT="#000000">\n\n};
|
| 1249 |
return $header;
|
| 1250 |
}
|
| 1251 |
|
| 1252 |
sub secure_env {
|
| 1253 |
$main'ENV{'PATH'} = '/bin:/usr/bin';
|
| 1254 |
$main'ENV{'MANPATH'} = $manPath{$manPathDefault};
|
| 1255 |
$main'ENV{'IFS'} = " \t\n";
|
| 1256 |
$main'ENV{'PAGER'} = 'cat';
|
| 1257 |
$main'ENV{'SHELL'} = '/bin/sh';
|
| 1258 |
# This locale might not be defined in some systems:
|
| 1259 |
# $main'ENV{'LANG'} = 'en_US.ISO_8859-1';
|
| 1260 |
$main'ENV{'LANG'} = 'C';
|
| 1261 |
undef $main'ENV{'DISPLAY'};
|
| 1262 |
}
|
| 1263 |
|
| 1264 |
sub include_output {
|
| 1265 |
local($inc) = @_;
|
| 1266 |
|
| 1267 |
&http_header("text/plain");
|
| 1268 |
open(I, "$inc") || do { print "open $inc: $!\n"; exit(1) };
|
| 1269 |
while(<I>) { print }
|
| 1270 |
close(I);
|
| 1271 |
}
|
| 1272 |
|
| 1273 |
# CGI script must die with error status 0
|
| 1274 |
sub mydie {
|
| 1275 |
local($message) = @_;
|
| 1276 |
&http_header("text/html");
|
| 1277 |
print &html_header("Error");
|
| 1278 |
print $message;
|
| 1279 |
|
| 1280 |
print qq{
|
| 1281 |
<p>
|
| 1282 |
<A HREF="$BASE">home</A>
|
| 1283 |
</BODY>
|
| 1284 |
</HTML>
|
| 1285 |
};
|
| 1286 |
|
| 1287 |
exit(0);
|
| 1288 |
}
|
| 1289 |
|
| 1290 |
1;
|
| 1291 |
|
Parent Directory
| 
Revision Log