X-Git-Url: https://vcs.maemo.org/git/?a=blobdiff_plain;f=nokia-lintian%2Fchecks%2Fmanpages;fp=nokia-lintian%2Fchecks%2Fmanpages;h=0000000000000000000000000000000000000000;hb=bf47c4c43f1f5f4986e85b74fc82b32048aeb846;hp=ce0d4d0e434d4b0cf24034aba219e72cb24ef1e2;hpb=19fdce4b743853cee27edb892096cf64295c2874;p=maemian diff --git a/nokia-lintian/checks/manpages b/nokia-lintian/checks/manpages deleted file mode 100644 index ce0d4d0..0000000 --- a/nokia-lintian/checks/manpages +++ /dev/null @@ -1,404 +0,0 @@ -# manpages -- lintian check script -*- perl -*- - -# Copyright (C) 1998 Christian Schwarz -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, you can find it on the World Wide -# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free -# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, -# MA 02110-1301, USA. - -package Lintian::manpages; -use strict; -use Dep; -use Tags; -use Util; - -# Set to true if the man program supports --warnings based on its version -# number. This is probed if this variable is undefined and set to 0 or 1. -our $MAN_WARNINGS; - -sub run { - -my $pkg = shift; -my $type = shift; - -use File::Basename; - -my %file_info; -my %binary; -my %link; -# my %sect_by_binary; -# my %sect_by_manpage; -my %manpage; - -# Read file info... -open(IN, '<', "file-info") - or fail("cannot find file-info for $type package $pkg"); -while () { - chop; - - m/^(.*?):\s+(.*)$/o or fail("an error in the file pkg is preventing lintian from checking this package: $_"); - my ($file,$info) = ($1,$2); - - next unless $file =~ m/man/o; - $file =~ s,^(\./)?,,; - - $file_info{$file} = $info; -} -close(IN); - -# Read package contents... -open(IN, '<', "index") or fail("cannot open index file index: $!"); -while () { - chop; - - my ($perm,$owner,$size,$date,$time,$file) = split(' ', $_, 6); - my $link; - - $file =~ s,^(\./),,; - $file =~ s/ link to .*//; - - if ($perm =~ m/^l/) { - ($file, $link) = split(' -> ', $file); - } - - my ($fname,$path,$suffix) = fileparse($file); - - # Binary that wants a manual page? - # - # It's tempting to check the section of the man page depending on the - # location of the binary, but there are too many mismatches between - # bin/sbin and 1/8 that it's not clear it's the right thing to do. - if (($perm =~ m,^[\-l],o) and - (($path =~ m,^bin/$,o) or - ($path =~ m,^sbin/$,o) or - ($path =~ m,^usr/bin/$,o) or - ($path =~ m,^usr/bin/X11/$,o) or - ($path =~ m,^usr/bin/mh/$,o) or - ($path =~ m,^usr/sbin/$,o) or - ($path =~ m,^usr/games/$,o) or - ($path =~ m,^usr/X11R6/bin/$,o) )) { - - my $bin = $fname; - - $binary{$bin} = $file; - $link{$bin} = $link if $link; - - next; - } - - if (($path =~ m,usr/(share|X11R6)/man/$,) and ($fname ne "")) { - tag "manpage-in-wrong-directory", "$file"; - next; - } - - # manual page? - next unless ($perm =~ m,^[\-l],o) and - (($path =~ m,^usr/man(/\S+),o) - or ($path =~ m,^usr/X11R6/man(/\S+),o) - or ($path =~ m,^usr/share/man(/\S+),o) ); - - my $t = $1; - if (not $t =~ m,^.*man(\d)/$,o) { - tag "manpage-in-wrong-directory", "$file"; - next; - } - my ($section,$name) = ($1,$fname); - my $lang = ""; - $lang = $1 if $t =~ m,^/([^/]+)/man\d/$,o; - - # The country should not be part of the man page locale directory unless - # it's one of the known cases where the language is significantly - # different between countries. - if ($lang =~ /_/ && $lang !~ /^(pt_BR|zh_[A-Z][A-Z])$/) { - tag "manpage-locale-dir-country-specific", "$file"; - } - - my @pieces = split(/\./, $name); - my $ext = pop @pieces; - if ($ext ne 'gz') { - push @pieces, $ext; - tag "manpage-not-compressed", "$file"; - } elsif ($perm =~ m,^-,o) { # so it's .gz... files first; links later - my $info = $file_info{$file}; - if ($info !~ m/gzip compressed data/o) { - tag "manpage-not-compressed-with-gzip", "$file"; - } elsif ($info !~ m/max compression/o) { - tag "manpage-not-compressed-with-max-compression", "$file"; - } - } - my $fn_section = pop @pieces; - my $section_num = $fn_section; - if (scalar @pieces && $section_num =~ s/^(\d).*$/$1/) { - my $bin = join(".", @pieces); - $manpage{$bin} = [] unless $manpage{$bin}; - push @{$manpage{$bin}}, { file => $file, lang => $lang }; - - # number of directory and manpage extension equal? - if ($section_num != $section) { - tag "manpage-in-wrong-directory", "$file"; - } - } else { - tag "manpage-has-wrong-extension", "$file"; - } - - # special check for manual pages for X11 games - if ($path =~ m,^usr/X11R6/man/man6/,o) { - tag "x11-games-should-be-in-usr-games", "$file"; - } - - # check symbolic links to other manual pages - if ($perm =~ m,^l,o) { - if ($link =~ m,(^|/)undocumented,o) { - if ($path =~ m,^usr/share/man,o) { - # undocumented link in /usr/share/man -- possibilities - # undocumented... (if in the appropriate section) - # ../man?/undocumented... - # ../../man/man?/undocumented... - # ../../../share/man/man?/undocumented... - # ../../../../usr/share/man/man?/undocumented... - if ((($link =~ m,^undocumented\.([237])\.gz,o) and - ($path =~ m,^usr/share/man/man$1,)) or - ($link =~ m,^\.\./man[237]/undocumented\.[237]\.gz$,o) or - ($link =~ m,^\.\./\.\./man/man[237]/undocumented\.[237]\.gz$,o) or - ($link =~ m,^\.\./\.\./\.\./share/man/man[237]/undocumented\.[237]\.gz$,o) or - ($link =~ m,^\.\./\.\./\.\./\.\./usr/share/man/man[237]/undocumented\.[237]\.gz$,o)) { - tag "link-to-undocumented-manpage", "$file"; - } else { - tag "bad-link-to-undocumented-manpage", "$file"; - } - } else { - # undocumented link in /usr/X11R6/man -- possibilities: - # ../../../share/man/man?/undocumented... - # ../../../../usr/share/man/man?/undocumented... - if (($link =~ m,^\.\./\.\./\.\./share/man/man[237]/undocumented\.[237]\.gz$,o) or - ($link =~ m,^\.\./\.\./\.\./\.\./usr/share/man/man[237]/undocumented\.[237]\.gz$,o)) { - tag "link-to-undocumented-manpage", "$file"; - } else { - tag "bad-link-to-undocumented-manpage", "$file"; - } - } - } - } else { # not a symlink - open (MANFILE, '-|', "zcat unpacked/\Q$file\E 2>/dev/null") - or fail("cannot open $file: $!"); - my @manfile = (); - while () { push @manfile, $_; } - close MANFILE; - # Is it a .so link? - if ($size < 256) { - my ($i, $first) = (0, ""); - do { - $first = $manfile[$i++] || ""; - } while ($first =~ /^\.\\"/ && $manfile[$i]); #"); - - unless ($first) { - tag "empty-manual-page", "$file"; - } elsif ($first =~ /^\.so\s+(.+)?$/) { - my $dest = $1; - if ($dest =~ m,^([^/]+)/(.+)$,) { - my ($manxorlang, $rest) = ($1, $2); - if ($manxorlang !~ /^man\d+$/) { - # then it's likely a language subdir, so let's run - # the other component through the same check - if ($rest =~ m,^([^/]+)/(.+)$,) { - my ($lang, $rest) = ($1, $2); - if ($rest !~ m,^[^/]+\.\d(?:\S+)?(?:\.gz)?$,) { - tag "bad-so-link-within-manual-page", "$file"; - } - } else { - tag "bad-so-link-within-manual-page", "$file"; - } - } - } else { - tag "bad-so-link-within-manual-page", "$file"; - } - next; - } - } - - # If it's not a .so link, use lexgrog to find out if the man page - # parses correctly and make sure the short description is reasonable. - # - # This check is currently not applied to pages in language-specific - # hierarchies, because those pages are not currently scanned by - # mandb (bug #29448), and because lexgrog can't handle pages in all - # languages at the moment, leading to huge numbers of false - # negatives. When man-db is fixed, this limitation should be - # removed. - if ($path =~ m,/man/man\d/,) { - my $pid = open LEXGROG, '-|'; - if (not defined $pid) { - fail("cannot run lexgrog: $!"); - } elsif ($pid == 0) { - my %newenv = (LANG => 'C', PATH => $ENV{PATH}); - undef %ENV; - %ENV = %newenv; - exec "lexgrog unpacked/\Q$file\E 2>&1" - or fail("cannot run lexgrog: $!"); - } - my $desc = ; - $desc =~ s/^[^:]+: \"(.*)\"$/$1/; - if ($desc =~ /(\S+)\s+-\s+manual page for \1/i) { - tag "manpage-has-useless-whatis-entry", "$file"; - } elsif ($desc =~ /(\S+)\s+-\s+programs? to do something/i) { - tag "manpage-is-dh_make-template", "$file"; - } - 1 while ; - close LEXGROG; - tag "manpage-has-bad-whatis-entry", "$file" if $? != 0; - } - - # If we've not probed yet, determine if man supports --warnings. - # This can be removed once man 2.5.1 makes it to testing. - unless (defined $MAN_WARNINGS) { - my $version = `man -V 2>&1`; - if ($? == 0 && $version =~ / (\d+\.[\d.]+)(,|\Z)/) { - $MAN_WARNINGS = Dep::versions_gte($1, '2.5.1'); - } else { - $MAN_WARNINGS = 0; - } - } - - # If it's not a .so link, run it through "man" to check for errors. - # If it is in a directory with the standard man layout, cd to the - # parent directory before running man so that .so directives are - # processed properly. (Yes, there are man pages that include other - # pages with .so but aren't simple links; rbash, for instance.) - my $cmd; - my $warnings = $MAN_WARNINGS ? ' --warnings' : ''; - if ($file =~ m,^(.*)/(man\d/.*)$,) { - $cmd = "cd unpacked/\Q$1\E && man$warnings -l \Q$2\E"; - } else { - $cmd = "man$warnings -l unpacked/\Q$file\E"; - } - my $pid = open MANERRS, '-|'; - if (not defined $pid) { - fail("cannot run man -l: $!"); - } elsif ($pid == 0) { - my %newenv = (LANG => 'C', PATH => $ENV{PATH}); - undef %ENV; - %ENV = %newenv; - exec "($cmd >/dev/null) 2>&1" - or fail("cannot run man -l: $!"); - } - while () { - # ignore progress information from man - next if /^Reformatting/; - next if /^\s*$/; - # ignore errors from gzip, will be dealt with at other places - next if /^(man|gzip)/; - # ignore wrapping failures for Asian man pages (groff problem) - if ($lang =~ /^(?:ja|ko|zh)/) { - next if /warning \[.*\]: cannot adjust line/; - next if /warning \[.*\]: can\'t break line/; - } - # ignore charset issues with old versions of man for all man pages - # since we can't know, with old versions, whether that was just a - # Unicode issue - if (!$MAN_WARNINGS and - (m/warning: can\'t find numbered character/ - or m/a magic token is not allowed in a name/ - or m/name expected \(got a magic token\)/)) { - next; - } - # ignore common undefined macros from pod2man << Perl 5.10 - next if /warning: \`(Tr|IX)\' not defined/; - chomp; - s/^[^:]+://o; - tag "manpage-has-errors-from-man", "$file", "$_"; - last; - } - close(MANERRS); - # Now we search through the whole man page for some common errors - my $lc = 0; - my $hc = 0; - foreach my $line (@manfile) { - $lc++; - chomp $line; - next if $line =~ /^\.\\\"/o; # comments .\" - if ($line =~ /^\.TH\s/) { # header - require Text::ParseWords; - my ($th_command, $th_title, $th_section, $th_date ) = - Text::ParseWords::parse_line( '\s+', 0, $line); - if ($th_section && (lc($fn_section) ne lc($th_section))) { - tag "manpage-section-mismatch", "$file:$lc $fn_section != $th_section"; - } - } - # Catch hyphens used as minus signs by looking for ones at the - # beginning of a word, but don't generate false positives on \s-1 - # (small font), \*(-- (pod2man long dash), or things like \h'-1'. - if ($line =~ /^( - ([^\.].*)? - [\s\'\"\`\(\[] - (? 10 and ! $ENV{'LINTIAN_DEBUG'}; - } -} -close(IN); - -for my $f (sort keys %binary) { - if (exists $manpage{$f}) { - # X11 binary? This shouldn't happen any more; these are no longer - # allowed. - if ($binary{$f} =~ m,usr/X11R6, or - ($link{$f} && $link{$f} =~ m,(\.\.|usr)/X11R6,)) { - # yes. manpage in X11 too? - for my $manp_info (@{$manpage{$f}}) { - if ($manp_info->{file} =~ m/X11R6/) { - # ok. - } else { - tag "manpage-for-x11-binary-in-wrong-directory", "$binary{$f} $manp_info->{file}"; - } - } - } else { - for my $manp_info (@{$manpage{$f}}) { - # no. manpage in X11? - if ($manp_info->{file} =~ m/X11R6/) { - tag "manpage-for-non-x11-binary-in-wrong-directory", "$binary{$f} $manp_info->{file}"; - } else { - # ok. - } - } - } - - if (not grep { $_->{lang} eq "" } @{$manpage{$f}}) { - tag "binary-without-english-manpage", "$binary{$f}"; - } - } else { - tag "binary-without-manpage", "$binary{$f}"; - } -} - -} - -1; - -# Local Variables: -# indent-tabs-mode: t -# cperl-indent-level: 4 -# End: -# vim: syntax=perl sw=4 ts=8