vcs.maemo.org Git - maemian/blob - checks/manpages

   1 # manpages -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 1998 Christian Schwarz
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, you can find it on the World Wide
  17 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  18 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  19 # MA 02110-1301, USA.
  20
  21 package Maemian::manpages;
  22 use strict;
  23 use Tags;
  24 use Util;
  25
  26 sub run {
  27
  28 my $pkg = shift;
  29 my $type = shift;
  30 my $info = shift;
  31
  32 use File::Basename;
  33
  34 my %binary;
  35 my %link;
  36 # my %sect_by_binary;
  37 # my %sect_by_manpage;
  38 my %manpage;
  39
  40 # Read package contents...
  41 foreach my $file (sort keys %{$info->index}) {
  42     my $index_info = $info->index->{$file};
  43     my $file_info = $info->file_info->{$file};
  44     my $link = $index_info->{link} || '';
  45     my $perm = $index_info->{type};
  46     my ($fname, $path, $suffix) = fileparse($file);
  47
  48     # Binary that wants a manual page?
  49     #
  50     # It's tempting to check the section of the man page depending on the
  51     # location of the binary, but there are too many mismatches between
  52     # bin/sbin and 1/8 that it's not clear it's the right thing to do.
  53     if (($perm =~ m,^[\-lh],o) and
  54         (($path =~ m,^bin/$,o) or
  55          ($path =~ m,^sbin/$,o) or
  56          ($path =~ m,^usr/bin/$,o) or
  57          ($path =~ m,^usr/bin/X11/$,o) or
  58          ($path =~ m,^usr/bin/mh/$,o) or
  59          ($path =~ m,^usr/sbin/$,o) or
  60          ($path =~ m,^usr/games/$,o) or
  61          ($path =~ m,^usr/X11R6/bin/$,o) )) {
  62
  63         my $bin = $fname;
  64         $binary{$bin} = $file;
  65         $link{$bin} = $link if $link;
  66
  67         next;
  68     }
  69
  70     if (($path =~ m,usr/(share|X11R6)/man/$,) and ($fname ne "")) {
  71         tag "manpage-in-wrong-directory", "$file";
  72         next;
  73     }
  74
  75     # manual page?
  76     next unless ($perm =~ m,^[\-lh],o) and
  77         (($path =~ m,^usr/man(/\S+),o)
  78          or ($path =~ m,^usr/X11R6/man(/\S+),o)
  79          or ($path =~ m,^usr/share/man(/\S+),o) );
  80
  81     my $t = $1;
  82     if (not $t =~ m,^.*man(\d)/$,o) {
  83         tag "manpage-in-wrong-directory", "$file";
  84         next;
  85     }
  86     my ($section,$name) = ($1,$fname);
  87     my $lang = "";
  88        $lang = $1 if $t =~ m,^/([^/]+)/man\d/$,o;
  89
  90     # The country should not be part of the man page locale directory unless
  91     # it's one of the known cases where the language is significantly
  92     # different between countries.
  93     if ($lang =~ /_/ && $lang !~ /^(pt_BR|zh_[A-Z][A-Z])$/) {
  94         tag "manpage-locale-dir-country-specific", "$file";
  95     }
  96
  97     my @pieces = split(/\./, $name);
  98     my $ext = pop @pieces;
  99     if ($ext ne 'gz') {
 100         push @pieces, $ext;
 101         tag "manpage-not-compressed", "$file";
 102     } elsif ($perm =~ m,^[-h],o) { # so it's .gz... files first; links later
 103         if ($file_info !~ m/gzip compressed data/o) {
 104             tag "manpage-not-compressed-with-gzip", "$file";
 105         } elsif ($file_info !~ m/max compression/o) {
 106             tag "manpage-not-compressed-with-max-compression", "$file";
 107         }
 108     }
 109     my $fn_section = pop @pieces;
 110     my $section_num = $fn_section;
 111     if (scalar @pieces && $section_num =~ s/^(\d).*$/$1/) {
 112         my $bin = join(".", @pieces);
 113                $manpage{$bin} = [] unless $manpage{$bin};
 114         push @{$manpage{$bin}}, { file => $file, lang => $lang };
 115
 116         # number of directory and manpage extension equal?
 117         if ($section_num != $section) {
 118             tag "manpage-in-wrong-directory", "$file";
 119         }
 120     } else {
 121         tag "manpage-has-wrong-extension", "$file";
 122     }
 123
 124     # special check for manual pages for X11 games
 125     if ($path =~ m,^usr/X11R6/man/man6/,o) {
 126         tag "x11-games-should-be-in-usr-games", "$file";
 127     }
 128
 129     # check symbolic links to other manual pages
 130     if ($perm =~ m,^l,o) {
 131         if ($link =~ m,(^|/)undocumented,o) {
 132             if ($path =~ m,^usr/share/man,o) {
 133                 # undocumented link in /usr/share/man -- possibilities
 134                 #    undocumented... (if in the appropriate section)
 135                 #    ../man?/undocumented...
 136                 #    ../../man/man?/undocumented...
 137                 #    ../../../share/man/man?/undocumented...
 138                 #    ../../../../usr/share/man/man?/undocumented...
 139                 if ((($link =~ m,^undocumented\.([237])\.gz,o) and
 140                     ($path =~ m,^usr/share/man/man$1,)) or
 141                     ($link =~ m,^\.\./man[237]/undocumented\.[237]\.gz$,o) or
 142                     ($link =~ m,^\.\./\.\./man/man[237]/undocumented\.[237]\.gz$,o) or
 143                     ($link =~ m,^\.\./\.\./\.\./share/man/man[237]/undocumented\.[237]\.gz$,o) or
 144                     ($link =~ m,^\.\./\.\./\.\./\.\./usr/share/man/man[237]/undocumented\.[237]\.gz$,o)) {
 145                     tag "link-to-undocumented-manpage", "$file";
 146                 } else {
 147                     tag "bad-link-to-undocumented-manpage", "$file";
 148                 }
 149             } else {
 150                 # undocumented link in /usr/X11R6/man -- possibilities:
 151                 #    ../../../share/man/man?/undocumented...
 152                 #    ../../../../usr/share/man/man?/undocumented...
 153                 if (($link =~ m,^\.\./\.\./\.\./share/man/man[237]/undocumented\.[237]\.gz$,o) or
 154                     ($link =~ m,^\.\./\.\./\.\./\.\./usr/share/man/man[237]/undocumented\.[237]\.gz$,o)) {
 155                     tag "link-to-undocumented-manpage", "$file";
 156                 } else {
 157                     tag "bad-link-to-undocumented-manpage", "$file";
 158                 }
 159             }
 160         }
 161     } else { # not a symlink
 162         open (MANFILE, '-|', "zcat unpacked/\Q$file\E 2>/dev/null")
 163             or fail("cannot open $file: $!");
 164         my @manfile = ();
 165         while (<MANFILE>) { push @manfile, $_; }
 166         close MANFILE;
 167         # Is it a .so link?
 168         if ($index_info->{size} < 256) {
 169             my ($i, $first) = (0, "");
 170             do {
 171                 $first = $manfile[$i++] || "";
 172             } while ($first =~ /^\.\\"/ && $manfile[$i]); #");
 173
 174             unless ($first) {
 175                 tag "empty-manual-page", "$file";
 176             } elsif ($first =~ /^\.so\s+(.+)?$/) {
 177                 my $dest = $1;
 178                 if ($dest =~ m,^([^/]+)/(.+)$,) {
 179                     my ($manxorlang, $rest) = ($1, $2);
 180                     if ($manxorlang !~ /^man\d+$/) {
 181                         # then it's likely a language subdir, so let's run
 182                         # the other component through the same check
 183                         if ($rest =~ m,^([^/]+)/(.+)$,) {
 184                             my ($lang, $rest) = ($1, $2);
 185                             if ($rest !~ m,^[^/]+\.\d(?:\S+)?(?:\.gz)?$,) {
 186                                 tag "bad-so-link-within-manual-page", "$file";
 187                             }
 188                         } else {
 189                             tag "bad-so-link-within-manual-page", "$file";
 190                         }
 191                     }
 192                 } else {
 193                     tag "bad-so-link-within-manual-page", "$file";
 194                 }
 195                 next;
 196             }
 197         }
 198
 199         # If it's not a .so link, use lexgrog to find out if the man page
 200         # parses correctly and make sure the short description is reasonable.
 201         #
 202         # This check is currently not applied to pages in language-specific
 203         # hierarchies, because those pages are not currently scanned by
 204         # mandb (bug #29448), and because lexgrog can't handle pages in all
 205         # languages at the moment, leading to huge numbers of false
 206         # negatives. When man-db is fixed, this limitation should be
 207         # removed.
 208         if ($path =~ m,/man/man\d/,) {
 209             my $pid = open LEXGROG, '-|';
 210             if (not defined $pid) {
 211                 fail("cannot run lexgrog: $!");
 212             } elsif ($pid == 0) {
 213                 my %newenv = (LANG => 'C', PATH => $ENV{PATH});
 214                 undef %ENV;
 215                 %ENV = %newenv;
 216                 exec "lexgrog unpacked/\Q$file\E 2>&1"
 217                     or fail("cannot run lexgrog: $!");
 218             }
 219             my $desc = <LEXGROG>;
 220             $desc =~ s/^[^:]+: \"(.*)\"$/$1/;
 221             if ($desc =~ /(\S+)\s+-\s+manual page for \1/i) {
 222                 tag "manpage-has-useless-whatis-entry", "$file";
 223             } elsif ($desc =~ /(\S+)\s+-\s+programs? to do something/i) {
 224                 tag "manpage-is-dh_make-template", "$file";
 225             }
 226             1 while <LEXGROG>;
 227             close LEXGROG;
 228             tag "manpage-has-bad-whatis-entry", "$file" if $? != 0;
 229         }
 230
 231         # If it's not a .so link, run it through "man" to check for errors.
 232         # If it is in a directory with the standard man layout, cd to the
 233         # parent directory before running man so that .so directives are
 234         # processed properly.  (Yes, there are man pages that include other
 235         # pages with .so but aren't simple links; rbash, for instance.)
 236         my $cmd;
 237         if ($file =~ m,^(.*)/(man\d/.*)$,) {
 238             $cmd = "cd unpacked/\Q$1\E && man --warnings -E UTF-8 -l \Q$2\E";
 239         } else {
 240             $cmd = "man --warnings -E UTF-8 -l unpacked/\Q$file\E";
 241         }
 242         my $pid = open MANERRS, '-|';
 243         if (not defined $pid) {
 244             fail("cannot run man -E UTF-8 -l: $!");
 245         } elsif ($pid == 0) {
 246             my %newenv = (LANG => 'C', PATH => $ENV{PATH}, MANWIDTH => 80);
 247             undef %ENV;
 248             %ENV = %newenv;
 249             exec "($cmd >/dev/null) 2>&1"
 250                 or fail("cannot run man -E UTF-8 -l: $!");
 251         }
 252         while (<MANERRS>) {
 253             # ignore progress information from man
 254             next if /^Reformatting/;
 255             next if /^\s*$/;
 256             # ignore errors from gzip, will be dealt with at other places
 257             next if /^(man|gzip)/;
 258             # ignore wrapping failures for Asian man pages (groff problem)
 259             if ($lang =~ /^(?:ja|ko|zh)/) {
 260                 next if /warning \[.*\]: cannot adjust line/;
 261                 next if /warning \[.*\]: can\'t break line/;
 262             }
 263             # ignore wrapping failures if they contain URLs
 264             next if /:(\d+): warning \[.*\]: (can\'t break|cannot adjust) line/
 265                 and $manfile[$1 - 1] =~ m,(?:http|ftp)://.+,i;
 266             # ignore common undefined macros from pod2man << Perl 5.10
 267             next if /warning: \`(Tr|IX)\' not defined/;
 268             chomp;
 269             s/^[^:]+://o;
 270             tag "manpage-has-errors-from-man", "$file", "$_";
 271             last;
 272         }
 273         close(MANERRS);
 274         # Now we search through the whole man page for some common errors
 275         my $lc = 0;
 276         my $hc = 0;
 277         foreach my $line (@manfile) {
 278             $lc++;
 279             chomp $line;
 280             next if $line =~ /^\.\\\"/o; # comments .\"
 281             if ($line =~ /^\.TH\s/) { # header
 282                 require Text::ParseWords;
 283                 my ($th_command, $th_title, $th_section, $th_date ) =
 284                     Text::ParseWords::parse_line( '\s+', 0, $line);
 285                 if ($th_section && (lc($fn_section) ne lc($th_section))) {
 286                     tag "manpage-section-mismatch", "$file:$lc $fn_section != $th_section";
 287                 }
 288             }
 289             # Catch hyphens used as minus signs by looking for ones at the
 290             # beginning of a word, but don't generate false positives on \s-1
 291             # (small font), \*(-- (pod2man long dash), or things like \h'-1'.
 292             if ($line =~ /^(
 293                             ([^\.].*)?
 294                             [\s\'\"\`\(\[]
 295                             (?<! \\s | \*\( | \(- | \w\' )
 296                            )?
 297                            (--?\w+)/ox) {
 298                 $hc++;
 299                 tag "hyphen-used-as-minus-sign", "$file:$lc" if $hc <= 10 or $ENV{'MAEMIAN_DEBUG'};
 300             }
 301             if (($line =~ m,(/usr/(dict|doc|etc|info|man|adm|preserve)/),o)
 302                 || ($line =~ m,(/var/(adm|catman|named|nis|preserve)/),o)) {
 303                 # FSSTND dirs in man pages
 304                 # regexes taken from checks/files
 305                 tag "FSSTND-dir-in-manual-page", "$file:$lc $1";
 306             }
 307             if ($line =~ m/^.SH "POD ERRORS"$/) {
 308                 tag "manpage-has-errors-from-pod2man", "$file:$lc";
 309             }
 310         }
 311         tag "hyphen-used-as-minus-sign", $file, ($hc-10), "more occurrences not shown" if $hc > 10 and ! $ENV{'MAEMIAN_DEBUG'};
 312     }
 313 }
 314
 315 for my $f (sort keys %binary) {
 316     if (exists $manpage{$f}) {
 317         # X11 binary?  This shouldn't happen any more; these are no longer
 318         # allowed.
 319         if ($binary{$f} =~ m,usr/X11R6, or
 320              ($link{$f} && $link{$f} =~ m,(\.\.|usr)/X11R6,)) {
 321             # yes. manpage in X11 too?
 322             for my $manp_info (@{$manpage{$f}}) {
 323                 if ($manp_info->{file} =~ m/X11R6/) {
 324                     # ok.
 325                 } else {
 326                     tag "manpage-for-x11-binary-in-wrong-directory", "$binary{$f} $manp_info->{file}";
 327                 }
 328             }
 329         } else {
 330             for my $manp_info (@{$manpage{$f}}) {
 331                 # no. manpage in X11?
 332                 if ($manp_info->{file} =~ m/X11R6/) {
 333                     tag "manpage-for-non-x11-binary-in-wrong-directory", "$binary{$f} $manp_info->{file}";
 334                 } else {
 335                     # ok.
 336                 }
 337             }
 338         }
 339
 340         if (not grep { $_->{lang} eq "" } @{$manpage{$f}}) {
 341             tag "binary-without-english-manpage", "$binary{$f}";
 342         }
 343     } else {
 344         tag "binary-without-manpage", "$binary{$f}";
 345     }
 346 }
 347
 348 }
 349
 350 1;
 351
 352 # Local Variables:
 353 # indent-tabs-mode: t
 354 # cperl-indent-level: 4
 355 # End:
 356 # vim: syntax=perl sw=4 ts=8