/[ddp]/man-cgi/man.cgi
ViewVC logotype

Contents of /man-cgi/man.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5