summaryrefslogtreecommitdiffstats
path: root/lib/Lintian/Check/Documentation
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/Lintian/Check/Documentation.pm246
-rw-r--r--lib/Lintian/Check/Documentation/Devhelp.pm87
-rw-r--r--lib/Lintian/Check/Documentation/Devhelp/Standard.pm47
-rw-r--r--lib/Lintian/Check/Documentation/Doxygen.pm75
-rw-r--r--lib/Lintian/Check/Documentation/Examples.pm48
-rw-r--r--lib/Lintian/Check/Documentation/Manual.pm663
-rw-r--r--lib/Lintian/Check/Documentation/Texinfo.pm195
7 files changed, 1361 insertions, 0 deletions
diff --git a/lib/Lintian/Check/Documentation.pm b/lib/Lintian/Check/Documentation.pm
new file mode 100644
index 0000000..364ecde
--- /dev/null
+++ b/lib/Lintian/Check/Documentation.pm
@@ -0,0 +1,246 @@
+# documentation -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Documentation;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use List::SomeUtils qw(any);
+use Unicode::UTF8 qw(encode_utf8);
+
+const my $VERTICAL_BAR => q{|};
+
+# 276 is 255 bytes (maximal length for a filename) plus gzip overhead
+const my $MAXIMUM_EMPTY_GZIP_SIZE => 276;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# a list of regex for detecting non documentation files checked against basename (xi)
+my @NOT_DOCUMENTATION_FILE_REGEXES = qw{
+ ^dependency_links[.]txt$
+ ^entry_points[.]txt$
+ ^requires[.]txt$
+ ^top_level[.]txt$
+ ^requirements[.]txt$
+ ^namespace_packages[.]txt$
+ ^bindep[.]txt$
+ ^version[.]txt$
+ ^robots[.]txt$
+ ^cmakelists[.]txt$
+};
+
+# a list of regex for detecting documentation file checked against basename (xi)
+my @DOCUMENTATION_FILE_REGEXES = qw{
+ [.]docx?$
+ [.]html?$
+ [.]info$
+ [.]latex$
+ [.]markdown$
+ [.]md$
+ [.]odt$
+ [.]pdf$
+ [.]readme$
+ [.]rmd$
+ [.]rst$
+ [.]rtf$
+ [.]tex$
+ [.]txt$
+ ^code[-_]of[-_]conduct$
+ ^contribut(?:e|ing)$
+ ^copyright$
+ ^licen[sc]es?$
+ ^howto$
+ ^patents?$
+ ^readme(?:[.]?first|[.]1st|[.]debian|[.]source)?$
+ ^todos?$
+};
+
+# an OR (|) regex of all compressed extension
+has COMPRESS_FILE_EXTENSIONS_OR_ALL => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my $COMPRESS_FILE_EXTENSIONS
+ = $self->data->load('files/compressed-file-extensions',qr/\s+/);
+
+ my $text = join($VERTICAL_BAR,
+ (map { quotemeta } $COMPRESS_FILE_EXTENSIONS->all));
+
+ return qr/$text/;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ my $ppkg = quotemeta($self->processable->name);
+
+ if ( $self->processable->type eq 'udeb'
+ && $item->name =~ m{^usr/share/(?:doc|info)/\S}) {
+
+ $self->pointed_hint('udeb-contains-documentation-file',$item->pointer);
+ return;
+ }
+
+ $self->pointed_hint('package-contains-info-dir-file', $item->pointer)
+ if $item->name =~ m{^ usr/share/info/dir (?:[.]old)? (?:[.]gz)? $}x;
+
+ # doxygen md5sum
+ $self->pointed_hint('useless-autogenerated-doxygen-file', $item->pointer)
+ if $item->name =~ m{^ usr/share/doc/ $ppkg / [^/]+ / .+ [.]md5$ }sx
+ && $item->parent_dir->child('doxygen.png');
+
+ my $regex = $self->COMPRESS_FILE_EXTENSIONS_OR_ALL;
+
+ # doxygen compressed map
+ $self->pointed_hint('compressed-documentation', $item->pointer)
+ if $item->name
+ =~ m{^ usr/share/doc/ (?:.+/)? (?:doxygen|html) / .* [.]map [.] $regex }sx;
+
+ if ($item->is_file
+ and any { $item->basename =~ m{$_}xi } @DOCUMENTATION_FILE_REGEXES
+ and any { $item->basename !~ m{$_}xi } @NOT_DOCUMENTATION_FILE_REGEXES)
+ {
+
+ $self->pointed_hint(
+ 'package-contains-documentation-outside-usr-share-doc',
+ $item->pointer)
+ unless $item->name =~ m{^etc/}
+ || $item->name =~ m{^usr/share/(?:doc|help)/}
+ # see Bug#981268
+ # usr/lib/python3/dist-packages/*.dist-info/entry_points.txt
+ || $item->name =~ m{^ usr/lib/python3/dist-packages/
+ .+ [.] dist-info/entry_points.txt $}sx
+ # No need for dh-r packages to automatically
+ # create overrides if we just allow them all to
+ # begin with.
+ || $item->dirname =~ 'usr/lib/R/site-library/'
+ # SNMP MIB files, see Bug#971427
+ || $item->dirname eq 'usr/share/snmp/mibs/'
+ # see Bug#904852
+ || $item->dirname =~ m{templates?(?:[.]d)?/}
+ || ( $item->basename =~ m{^README}xi
+ && $item->bytes =~ m{this directory}xi)
+ # see Bug#1009679, not documentation, just an unlucky suffix
+ || $item->name =~ m{^var/lib/ocaml/lintian/.+[.]info$}
+ # see Bug#970275
+ || $item->name =~ m{^usr/share/gtk-doc/html/.+[.]html?$};
+ }
+
+ if ($item->name =~ m{^usr/share/doc/\S}) {
+
+ # file not owned by root?
+ unless ($item->identity eq 'root/root' || $item->identity eq '0/0') {
+ $self->pointed_hint('bad-owner-for-doc-file', $item->pointer,
+ $item->identity,'!= root/root (or 0/0)');
+ }
+
+ # executable in /usr/share/doc ?
+ if ( $item->is_file
+ && $item->name !~ m{^usr/share/doc/(?:[^/]+/)?examples/}
+ && $item->is_executable) {
+
+ if ($item->is_script) {
+ $self->pointed_hint('script-in-usr-share-doc', $item->pointer);
+ } else {
+ $self->pointed_hint('executable-in-usr-share-doc',
+ $item->pointer,(sprintf '%04o', $item->operm));
+ }
+ }
+
+ # zero byte file in /usr/share/doc/
+ if ($item->is_regular_file and $item->size == 0) {
+ # Exceptions: examples may contain empty files for various
+ # reasons, Doxygen generates empty *.map files, and Python
+ # uses __init__.py to mark module directories.
+ unless ($item->name =~ m{^usr/share/doc/(?:[^/]+/)?examples/}
+ || $item->name
+ =~ m{^usr/share/doc/(?:.+/)?(?:doxygen|html)/.*[.]map$}s
+ || $item->name=~ m{^usr/share/doc/(?:.+/)?__init__[.]py$}s){
+
+ $self->pointed_hint('zero-byte-file-in-doc-directory',
+ $item->pointer);
+ }
+ }
+
+ if ( $item->name =~ / [.]gz $/msx
+ && $item->is_regular_file
+ && $item->size <= $MAXIMUM_EMPTY_GZIP_SIZE
+ && $item->file_type =~ / gzip \s compressed /msx) {
+
+ open(my $fd, '<:gzip', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ my $f = <$fd>;
+ close($fd);
+
+ unless (defined $f and length $f) {
+ $self->pointed_hint('zero-byte-file-in-doc-directory',
+ $item->pointer);
+ }
+ }
+ }
+
+ # file directly in /usr/share/doc ?
+ $self->pointed_hint('file-directly-in-usr-share-doc', $item->pointer)
+ if $item->is_file
+ && $item->name =~ m{^ usr/share/doc/ [^/]+ $}x;
+
+ # contains an INSTALL file?
+ $self->pointed_hint('package-contains-upstream-installation-documentation',
+ $item->pointer)
+ if $item->name =~ m{^ usr/share/doc/ $ppkg / INSTALL (?: [.] .+ )* $}sx;
+
+ # contains a README for another distribution/platform?
+ $self->pointed_hint('package-contains-readme-for-other-platform-or-distro',
+ $item->pointer)
+ if $item->name =~ m{^usr/share/doc/$ppkg/readme[.]
+ (?:apple|aix|atari|be|beos|bsd|bsdi
+ |cygwin|darwin|irix|gentoo|freebsd|mac|macos
+ |macosx|netbsd|openbsd|osf|redhat|sco|sgi
+ |solaris|suse|sun|vms|win32|win9x|windows
+ )(?:[.]txt)?(?:[.]gz)?$}xi;
+
+ # contains a compressed version of objects.inv in
+ # sphinx-generated documentation?
+ $self->pointed_hint('compressed-documentation', $item->pointer)
+ if $item->name
+ =~ m{^ usr/share/doc/ $ppkg / (?: [^/]+ / )+ objects [.]inv [.]gz $}x
+ && $item->file_type =~ m{gzip compressed};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Documentation/Devhelp.pm b/lib/Lintian/Check/Documentation/Devhelp.pm
new file mode 100644
index 0000000..cd186a5
--- /dev/null
+++ b/lib/Lintian/Check/Documentation/Devhelp.pm
@@ -0,0 +1,87 @@
+# documentation/devhelp -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2022 Felix Lechner
+#
+# 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 https://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::Check::Documentation::Devhelp;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use List::SomeUtils qw(none);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# *.devhelp and *.devhelp2 files must be accessible from a directory in
+# the devhelp search path: /usr/share/devhelp/books and
+# /usr/share/gtk-doc/html. We therefore look for any links in one of
+# those directories to another directory. The presence of such a link
+# blesses any file below that other directory.
+has reachable_folders => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my @reachable_folders;
+
+ for my $item (@{$self->processable->installed->sorted_list}) {
+
+ # in search path
+ next
+ unless $item->name
+ =~ m{^ usr/share/ (?: devhelp/books | gtk-doc/html ) / }x;
+
+ next
+ unless length $item->link;
+
+ my $followed = $item->link_normalized;
+
+ # drop broken links
+ push(@reachable_folders, $followed)
+ if length $followed;
+ }
+
+ return \@reachable_folders;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # locate Devhelp files not discoverable by Devhelp
+ $self->pointed_hint('stray-devhelp-documentation', $item->pointer)
+ if $item->name =~ m{ [.]devhelp2? (?: [.]gz )? $}x
+ && $item->name !~ m{^ usr/share/ (?: devhelp/books | gtk-doc/html ) / }x
+ && (none { $item->name =~ /^\Q$_\E/ } @{$self->reachable_folders});
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Documentation/Devhelp/Standard.pm b/lib/Lintian/Check/Documentation/Devhelp/Standard.pm
new file mode 100644
index 0000000..05d77db
--- /dev/null
+++ b/lib/Lintian/Check/Documentation/Devhelp/Standard.pm
@@ -0,0 +1,47 @@
+# documentation/devhelp/standard -- lintian check script -*- perl -*-
+
+# Copyright (C) 2022 Felix Lechner
+#
+# 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 https://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::Check::Documentation::Devhelp::Standard;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ $self->pointed_hint('old-devhelp-standard', $item->pointer)
+ if $item->name =~ m{ [.]devhelp (?: [.]gz )? $}x;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Documentation/Doxygen.pm b/lib/Lintian/Check/Documentation/Doxygen.pm
new file mode 100644
index 0000000..206a4b8
--- /dev/null
+++ b/lib/Lintian/Check/Documentation/Doxygen.pm
@@ -0,0 +1,75 @@
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 1999 Joey Hess
+# Copyright (C) 2000 Sean 'Shaleh' Perry
+# Copyright (C) 2002 Josip Rodin
+# Copyright (C) 2007 Russ Allbery
+# Copyright (C) 2013-2018 Bastien ROUCARIES
+# Copyright (C) 2017-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020-2021 Felix Lechner
+#
+# 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 https://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::Check::Documentation::Doxygen;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ $self->pointed_hint('source-contains-prebuilt-doxygen-documentation',
+ $item->parent_dir->pointer)
+ if $item->basename =~ m{^doxygen.(?:png|sty)$}
+ && $self->processable->source_name ne 'doxygen';
+
+ return
+ unless $item->basename =~ /\.(?:x?html?\d?|xht)$/i;
+
+ my $contents = $item->decoded_utf8;
+ return
+ unless length $contents;
+
+ my $lowercase = lc($contents);
+
+ # Identify and ignore documentation templates by looking
+ # for the use of various interpolated variables.
+ # <http://www.doxygen.nl/manual/config.html#cfg_html_header>
+ $self->pointed_hint('source-contains-prebuilt-doxygen-documentation',
+ $item->pointer)
+ if $lowercase =~ m{<meta \s+ name="generator" \s+ content="doxygen}smx
+ && $lowercase
+ !~ /\$(?:doxygenversion|projectname|projectnumber|projectlogo)\b/;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Documentation/Examples.pm b/lib/Lintian/Check/Documentation/Examples.pm
new file mode 100644
index 0000000..4c1b84a
--- /dev/null
+++ b/lib/Lintian/Check/Documentation/Examples.pm
@@ -0,0 +1,48 @@
+# documentation/examples -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+#
+# 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 https://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::Check::Documentation::Examples;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ $self->pointed_hint('nested-examples-directory', $item->pointer)
+ if $item->is_dir
+ && $item->name =~ m{^usr/share/doc/[^/]+/examples/examples/?$};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Documentation/Manual.pm b/lib/Lintian/Check/Documentation/Manual.pm
new file mode 100644
index 0000000..4171ef6
--- /dev/null
+++ b/lib/Lintian/Check/Documentation/Manual.pm
@@ -0,0 +1,663 @@
+# documentation/manual -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz
+# Copyright (C) 2019-2020 Felix Lechner
+#
+# 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 https://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::Check::Documentation::Manual;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Cwd qw(getcwd);
+use File::Basename;
+use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
+use IPC::Run3;
+use List::Compare;
+use List::SomeUtils qw(any none);
+use Path::Tiny;
+use Text::Balanced qw(extract_delimited);
+use Unicode::UTF8 qw(valid_utf8 decode_utf8 encode_utf8);
+
+use Lintian::Spelling qw(check_spelling);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $EMPTY => q{};
+const my $COLON => q{:};
+const my $COMMA => q{,};
+const my $DOT => q{.};
+const my $NEWLINE => qq{\n};
+
+const my $USER_COMMAND_SECTION => 1;
+const my $SYSTEM_COMMAND_SECTION => 8;
+
+const my $WAIT_STATUS_SHIFT => 8;
+const my $MINIMUM_SHARED_OBJECT_SIZE => 256;
+const my $WIDE_SCREEN => 120;
+
+has local_manpages => (is => 'rw', default => sub { {} });
+
+sub spelling_tag_emitter {
+ my ($self, $tag_name, $pointer, @orig_args) = @_;
+
+ return sub {
+ return $self->pointed_hint($tag_name, $pointer, @orig_args, @_);
+ };
+}
+
+my @user_locations= qw(bin/ usr/bin/ usr/bin/X11/ usr/bin/mh/ usr/games/);
+my @admin_locations= qw(sbin/ usr/sbin/ usr/libexec/);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # no man pages in udebs
+ return
+ if $self->processable->type eq 'udeb';
+
+ if ($item->name =~ m{^usr/share/man/\S+}) {
+
+ $self->pointed_hint('manual-page-in-udeb', $item->pointer)
+ if $self->processable->type eq 'udeb';
+
+ if ($item->is_dir) {
+ $self->pointed_hint('stray-folder-in-manual', $item->pointer)
+ unless $item->name
+ =~ m{^usr/(?:X11R6|share)/man/(?:[^/]+/)?(?:man\d/)?$};
+
+ } elsif ($item->is_file && $item->is_executable) {
+ $self->pointed_hint('executable-manual-page', $item->pointer);
+ }
+ }
+
+ return
+ unless $item->is_file || $item->is_symlink;
+
+ my ($manpage, $page_path, undef) = fileparse($item);
+
+ if ($page_path eq 'usr/share/man/' && $manpage ne $EMPTY) {
+ $self->pointed_hint('odd-place-for-manual-page', $item->pointer);
+ return;
+ }
+
+ # manual page?
+ my ($subdir) = ($page_path =~ m{^usr/share/man(/\S+)});
+ return
+ unless defined $subdir;
+
+ $self->pointed_hint('build-path-in-manual', $item->pointer)
+ if $item =~ m{/_build_} || $item =~ m{_tmp_buildd};
+
+ $self->pointed_hint('manual-page-with-generic-name', $item->pointer)
+ if $item =~ m{/README\.};
+
+ my ($section) = ($subdir =~ m{^.*man(\d)/$});
+ unless (defined $section) {
+ $self->pointed_hint('odd-place-for-manual-page', $item->pointer);
+ return;
+ }
+
+ my ($language) = ($subdir =~ m{^/([^/]+)/man\d/$});
+ $language //= $EMPTY;
+
+ # 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.
+ $self->pointed_hint('country-in-manual', $item->pointer)
+ if $language =~ /_/ && $language !~ /^(?:pt_BR|zh_[A-Z][A-Z])$/;
+
+ my @pieces = split(/\./, $manpage);
+ my $ext = pop @pieces;
+
+ if ($ext ne 'gz') {
+
+ push @pieces, $ext;
+ $self->pointed_hint('uncompressed-manual-page', $item->pointer);
+
+ } elsif ($item->is_file) { # so it's .gz... files first; links later
+
+ if ($item->file_type !~ m/gzip compressed data/) {
+ $self->pointed_hint('wrong-compression-in-manual-page',
+ $item->pointer);
+
+ } elsif ($item->file_type !~ m/max compression/) {
+ $self->pointed_hint('poor-compression-in-manual-page',
+ $item->pointer);
+ }
+ }
+
+ my $fn_section = pop @pieces;
+ my $section_num = $fn_section;
+
+ if (scalar @pieces && $section_num =~ s/^(\d).*$/$1/) {
+
+ my $bin = join($DOT, @pieces);
+ $self->local_manpages->{$bin} = []
+ unless $self->local_manpages->{$bin};
+
+ push @{$self->local_manpages->{$bin}},
+ { file => $item, language => $language, section => $section };
+
+ # number of directory and manpage extension equal?
+ if ($section_num != $section) {
+ $self->pointed_hint('odd-place-for-manual-page', $item->pointer);
+ }
+
+ } else {
+ $self->pointed_hint('wrong-name-for-manual-page', $item->pointer);
+ }
+
+ # check symbolic links to other manual pages
+ if ($item->is_symlink) {
+ if ($item->link =~ m{(^|/)undocumented}) {
+ # 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 (
+ (
+ $item->link =~ m{^undocumented\.([237])\.gz}
+ && $page_path =~ m{^usr/share/man/man$1}
+ )
+ || $item->link =~ m{^\.\./man[237]/undocumented\.[237]\.gz$}
+ || $item->link
+ =~ m{^\.\./\.\./man/man[237]/undocumented\.[237]\.gz$}
+ || $item->link
+ =~ m{^\.\./\.\./\.\./share/man/man[237]/undocumented\.[237]\.gz$}
+ || $item->link
+ =~ m{^\.\./\.\./\.\./\.\./usr/share/man/man[237]/undocumented\.[237]\.gz$}
+ ) {
+ $self->pointed_hint('undocumented-manual-page',$item->pointer);
+ } else {
+ $self->pointed_hint('broken-link-to-undocumented',
+ $item->pointer);
+ }
+ }
+ } else { # not a symlink
+
+ my $fd;
+ if ($item->file_type =~ m/gzip compressed/) {
+
+ open($fd, '<:gzip', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ } else {
+
+ open($fd, '<', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+ }
+
+ my @manfile = <$fd>;
+ close $fd;
+
+ # Is it a .so link?
+ if ($item->size < $MINIMUM_SHARED_OBJECT_SIZE) {
+
+ my ($i, $first) = (0, $EMPTY);
+ do {
+ $first = $manfile[$i++] || $EMPTY;
+ } while ($first =~ /^\.\\"/ && $manfile[$i]); #");
+
+ unless ($first) {
+ $self->pointed_hint('empty-manual-page', $item->pointer);
+ return;
+
+ } elsif ($first =~ /^\.so\s+(.+)?$/) {
+ my $dest = $1;
+ if ($dest =~ m{^([^/]+)/(.+)$}) {
+
+ my ($manxorlang, $remainder) = ($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 ($remainder =~ m{^([^/]+)/(.+)$}) {
+
+ my $rest = $2;
+ $self->pointed_hint(
+ 'bad-so-link-within-manual-page',
+ $item->pointer)
+ unless $rest =~ m{^[^/]+\.\d(?:\S+)?(?:\.gz)?$};
+
+ } else {
+ $self->pointed_hint(
+ 'bad-so-link-within-manual-page',
+ $item->pointer);
+ }
+ }
+
+ } else {
+ $self->pointed_hint('bad-so-link-within-manual-page',
+ $item->pointer);
+ }
+ return;
+ }
+ }
+
+ # 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 ($page_path =~ m{/man/man\d/}) {
+
+ delete local $ENV{$_}
+ for grep { $_ ne 'PATH' && $_ ne 'TMPDIR' } keys %ENV;
+ local $ENV{LC_ALL} = 'C.UTF-8';
+
+ my @command = ('lexgrog', $item->unpacked_path);
+
+ my $stdout;
+ my $stderr;
+
+ run3(\@command, \undef, \$stdout, \$stderr);
+
+ my $exitcode = $?;
+ my $status = ($exitcode >> $WAIT_STATUS_SHIFT);
+
+ $self->pointed_hint('bad-whatis-entry', $item->pointer)
+ if $status == 2;
+
+ if ($status != 0 && $status != 2) {
+ my $message = "Non-zero status $status from @command";
+ $message .= $COLON . $NEWLINE . $stderr
+ if length $stderr;
+
+ warn encode_utf8($message);
+
+ } else {
+ my $desc = $stdout;
+ $desc =~ s/^[^:]+: \"(.*)\"$/$1/;
+
+ if ($desc =~ /(\S+)\s+-\s+manual page for \1/i) {
+ $self->pointed_hint('useless-whatis-entry',$item->pointer);
+
+ } elsif ($desc =~ /\S+\s+-\s+programs? to do something/i) {
+ $self->pointed_hint('manual-page-from-template',
+ $item->pointer);
+ }
+ }
+ }
+
+ # 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.)
+ {
+ delete local $ENV{$_}
+ for grep { $_ ne 'PATH' && $_ ne 'TMPDIR' } keys %ENV;
+ local $ENV{LC_ALL} = 'C.UTF-8';
+
+ local $ENV{MANROFFSEQ} = $EMPTY;
+
+ # set back to 80 when Bug#892423 is fixed in groff
+ local $ENV{MANWIDTH} = $WIDE_SCREEN;
+
+ my $stdout;
+ my $stderr;
+
+ my @command = qw(man --warnings -E UTF-8 -l -Tutf8 -Z);
+ push(@command, $item->unpacked_path);
+
+ my $localdir = path($item->unpacked_path)->parent->stringify;
+ $localdir =~ s{^(.*)/man\d\b}{$1}s;
+
+ my $savedir = getcwd;
+ chdir($localdir)
+ or die encode_utf8('Cannot change directory ' . $localdir);
+
+ run3(\@command, \undef, \$stdout, \$stderr);
+
+ my $exitcode = $?;
+ my $status = ($exitcode >> $WAIT_STATUS_SHIFT);
+
+ my @lines = split(/\n/, $stderr);
+
+ my $position = 1;
+ for my $line (@lines) {
+
+ chomp $line;
+
+ # Devel::Cover causes some annoying deep recursion
+ # warnings and sometimes in our child process.
+ # Filter them out, but only during coverage.
+ next
+ if $ENV{LINTIAN_COVERAGE}
+ && $line =~ m{
+ \A Deep [ ] recursion [ ] on [ ] subroutine [ ]
+ "[^"]+" [ ] at [ ] .*B/Deparse.pm [ ] line [ ]
+ \d+}xsm;
+
+ # ignore progress information from man
+ next
+ if $line =~ /^Reformatting/;
+
+ next
+ if $line =~ /^\s*$/;
+
+ # ignore errors from gzip; dealt with elsewhere
+ next
+ if $line =~ /^\bgzip\b/;
+
+ # ignore wrapping failures for Asian man pages (groff problem)
+ if ($language =~ /^(?:ja|ko|zh)/) {
+ next
+ if $line =~ /warning \[.*\]: cannot adjust line/;
+ next
+ if $line =~ /warning \[.*\]: can\'t break line/;
+ }
+
+ # ignore wrapping failures if they contain URLs (.UE is an
+ # extension for marking the end of a URL).
+ next
+ if $line
+ =~ /:(\d+): warning \[.*\]: (?:can\'t break|cannot adjust) line/
+ && ( $manfile[$1 - 1] =~ m{(?:https?|ftp|file)://.+}i
+ || $manfile[$1 - 1] =~ m{^\s*\.\s*UE\b});
+
+ # ignore common undefined macros from pod2man << Perl 5.10
+ next
+ if $line =~ /warning: (?:macro )?\'(?:Tr|IX)\' not defined/;
+
+ $line =~ s/^[^:]+: //;
+ $line =~ s/^<standard input>://;
+
+ $self->pointed_hint('groff-message',
+ $item->pointer($position), $line);
+ } continue {
+ ++$position;
+ }
+
+ chdir($savedir)
+ or die encode_utf8('Cannot change directory ' . $savedir);
+
+ }
+
+ # Now we search through the whole man page for some common errors
+ my $position = 1;
+ my $seen_python_traceback;
+ for my $line (@manfile) {
+
+ chomp $line;
+
+ next
+ if $line =~ /^\.\\\"/; # comments .\"
+
+ if ($line =~ /^\.TH\s/) {
+
+ # title header
+ my $consumed = $line;
+ $consumed =~ s/ [.]TH \s+ //msx;
+
+ my ($delimited, $after_names) = extract_delimited($consumed);
+ unless (length $delimited) {
+ $consumed =~ s/ ^ \s* \S+ , //gmsx;
+ $consumed =~ s/ ^ \s* \S+ //msx;
+ $after_names = $consumed;
+ }
+
+ my ($th_section) = extract_delimited($after_names);
+ if (length $th_section) {
+
+ # drop initial delimiter
+ $th_section =~ s/ ^. //msx;
+
+ # drop final delimiter
+ $th_section =~ s/ .$ //msx;
+
+ # unescape
+ $th_section =~ s/ [\\](.) /$1/gmsx;
+
+ } elsif (length $after_names
+ && $after_names =~ / ^ \s* (\S+) /msx) {
+ $th_section = $1;
+ }
+
+ $self->pointed_hint(
+ 'wrong-manual-section',
+ $item->pointer($position),
+ "$fn_section != $th_section"
+ )if length $th_section && fc($th_section) ne fc($fn_section);
+ }
+
+ if ( ($line =~ m{(/usr/(dict|doc|etc|info|man|adm|preserve)/)})
+ || ($line =~ m{(/var/(adm|catman|named|nis|preserve)/)})){
+ # FSSTND dirs in man pages
+ # regexes taken from checks/files
+ $self->pointed_hint('FSSTND-dir-in-manual-page',
+ $item->pointer($position), $1);
+ }
+
+ if ($line eq '.SH "POD ERRORS"') {
+ $self->pointed_hint('pod-conversion-message',
+ $item->pointer($position));
+ }
+
+ if ($line =~ /Traceback \(most recent call last\):/) {
+ $self->pointed_hint('python-traceback-in-manpage',
+ $item->pointer)
+ unless $seen_python_traceback;
+ $seen_python_traceback = 1;
+ }
+
+ # Check for spelling errors if the manpage is English
+ my $stag_emitter
+ = $self->spelling_tag_emitter('typo-in-manual-page',
+ $item->pointer($position));
+ check_spelling($self->data, $line,
+ $self->group->spelling_exceptions,
+ $stag_emitter, 0)
+ if $page_path =~ m{/man/man\d/};
+
+ } continue {
+ ++$position;
+ }
+ }
+
+ # most man pages are zipped
+ my $bytes;
+ if ($item->file_type =~ /gzip compressed/) {
+
+ my $path = $item->unpacked_path;
+ gunzip($path => \$bytes)
+ or die encode_utf8("gunzip $path failed: $GunzipError");
+
+ } elsif ($item->file_type =~ /^troff/ || $item->file_type =~ /text$/) {
+ $bytes = $item->bytes;
+ }
+
+ return
+ unless length $bytes;
+
+ # another check complains about invalid encoding
+ return
+ unless valid_utf8($bytes);
+
+ my $contents = decode_utf8($bytes);
+ my @lines = split(/\n/, $contents);
+
+ my $position = 1;
+ for my $line (@lines) {
+
+ # see Bug#554897 and Bug#507673; exclude string variables
+ $self->pointed_hint('acute-accent-in-manual-page',
+ $item->pointer($position))
+ if $line =~ /\\'/ && $line !~ /^\.\s*ds\s/;
+
+ } continue {
+ $position++;
+ }
+
+ return;
+}
+
+sub installable {
+ my ($self) = @_;
+
+ # no man pages in udebs
+ return
+ if $self->processable->type eq 'udeb';
+
+ my %local_user_executables;
+ my %local_admin_executables;
+
+ for my $item (@{$self->processable->installed->sorted_list}) {
+
+ next
+ unless $item->is_symlink || $item->is_file;
+
+ my ($name, $path, undef) = fileparse($item->name);
+
+ $local_user_executables{$name} = $item
+ if any { $path eq $_ } @user_locations;
+
+ $local_admin_executables{$name} = $item
+ if any { $path eq $_ } @admin_locations;
+ }
+
+ my %local_executables= (%local_user_executables, %local_admin_executables);
+ my @local_commands = keys %local_executables;
+
+ my @direct_reliants
+ =@{$self->group->direct_reliants($self->processable) // []};
+ my @reliant_files = map { @{$_->installed->sorted_list} } @direct_reliants;
+
+ # for executables, look at packages relying on the current processable
+ my %distant_executables;
+ for my $item (@reliant_files) {
+
+ next
+ unless $item->is_file || $item->is_symlink;
+
+ my ($name, $path, undef) = fileparse($item, qr{\..+$});
+
+ $distant_executables{$name} = $item
+ if any { $path eq $_ } (@user_locations, @admin_locations);
+ }
+
+ my @distant_commands = keys %distant_executables;
+ my @related_commands = (@local_commands, @distant_commands);
+
+ my @direct_prerequisites
+ =@{$self->group->direct_dependencies($self->processable) // []};
+ my@prerequisite_files
+ = map { @{$_->installed->sorted_list} } @direct_prerequisites;
+
+ # for manpages, look at packages the current processable relies upon
+ my %distant_manpages;
+ for my $item (@prerequisite_files) {
+
+ next
+ unless $item->is_file || $item->is_symlink;
+
+ my ($name, $path, undef) = fileparse($item, qr{\..+$});
+
+ next
+ unless $path =~ m{^usr/share/man/\S+};
+
+ next
+ unless $path =~ m{man\d/$};
+
+ my ($language) = ($path =~ m{/([^/]+)/man\d/$});
+ $language //= $EMPTY;
+ $language = $EMPTY if $language eq 'man';
+
+ $distant_manpages{$name} //= [];
+
+ push @{$distant_manpages{$name}},
+ {file => $item, language => $language};
+ }
+
+ my %local_manpages = %{$self->local_manpages};
+ my %related_manpages = (%local_manpages, %distant_manpages);
+
+ # provides sorted output
+ my $related
+ = List::Compare->new(\@local_commands, [keys %related_manpages]);
+ my @documented = $related->get_intersection;
+ my @manpage_missing = $related->get_Lonly;
+
+ my @english_missing = grep {
+ none {$_->{language} eq $EMPTY}
+ @{$related_manpages{$_} // []}
+ } @documented;
+
+ for my $command (keys %local_admin_executables) {
+
+ my $item = $local_admin_executables{$command};
+ my @manpages = @{$related_manpages{$command} // []};
+
+ my @sections = grep { defined } map { $_->{section} } @manpages;
+ $self->pointed_hint('manual-page-for-system-command', $item->pointer)
+ if $item->is_regular_file
+ && any { $_ == $USER_COMMAND_SECTION } @sections;
+ }
+
+ for (map {$local_executables{$_}} @english_missing) {
+ $self->pointed_hint('no-english-manual-page', $_->pointer)
+ unless $_->name =~ m{/libexec/};
+ }
+
+ for (map {$local_executables{$_}} @manpage_missing) {
+ $self->pointed_hint('no-manual-page', $_->pointer)
+ unless $_->name =~ m{/libexec/};
+ }
+
+ # surplus manpages only for this package; provides sorted output
+ my $local = List::Compare->new(\@related_commands, [keys %local_manpages]);
+ my @surplus_manpages = $local->get_Ronly;
+
+ # filter out sub commands, underscore for libreswan; see Bug#947258
+ for my $command (@related_commands) {
+ @surplus_manpages = grep { !/^$command(?:\b|_)/ } @surplus_manpages;
+ }
+
+ for my $manpage (map { @{$local_manpages{$_} // []} } @surplus_manpages) {
+
+ my $item = $manpage->{file};
+ my $section = $manpage->{section};
+
+ $self->pointed_hint('spare-manual-page', $item->pointer)
+ if $section == $USER_COMMAND_SECTION
+ || $section == $SYSTEM_COMMAND_SECTION;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Documentation/Texinfo.pm b/lib/Lintian/Check/Documentation/Texinfo.pm
new file mode 100644
index 0000000..cc4be39
--- /dev/null
+++ b/lib/Lintian/Check/Documentation/Texinfo.pm
@@ -0,0 +1,195 @@
+# documentation/texinfo -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz
+# Copyright (C) 2001 Josip Rodin
+#
+# 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 https://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::Check::Documentation::Texinfo;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Unicode::UTF8 qw(encode_utf8);
+use List::SomeUtils qw(uniq);
+
+use Lintian::Util qw(normalize_link_target);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $EMPTY => q{};
+
+sub binary {
+ my ($self) = @_;
+
+ my $info_dir
+ = $self->processable->installed->resolve_path('usr/share/info/');
+ return
+ unless $info_dir;
+
+ # Read package contents...
+ for my $item ($info_dir->descendants) {
+
+ next
+ unless $item->is_symlink
+ || $item->is_file;
+
+ # Ignore dir files. That's a different error which we already catch in
+ # the files check.
+ next
+ if $item->basename =~ /^dir(?:\.old)?(?:\.gz)?/;
+
+ # Analyze the file names making sure the documents are named
+ # properly. Note that Emacs 22 added support for images in
+ # info files, so we have to accept those and ignore them.
+ # Just ignore .png files for now.
+ my @fname_pieces = split(m{ [.] }x, $item->basename);
+ my $extension = pop @fname_pieces;
+
+ if ($extension eq 'gz') { # ok!
+ if ($item->is_file) {
+
+ # compressed with maximum compression rate?
+ if ($item->file_type !~ m/gzip compressed data/) {
+ $self->pointed_hint(
+ 'info-document-not-compressed-with-gzip',
+ $item->pointer);
+
+ } else {
+ if ($item->file_type !~ m/max compression/) {
+ $self->pointed_hint(
+'info-document-not-compressed-with-max-compression',
+ $item->pointer
+ );
+ }
+ }
+ }
+
+ } elsif ($extension =~ m/^(?:png|jpe?g)$/) {
+ next;
+
+ } else {
+ push(@fname_pieces, $extension);
+ $self->pointed_hint('info-document-not-compressed',$item->pointer);
+ }
+
+ my $infoext = pop @fname_pieces;
+ unless ($infoext && $infoext =~ /^info(-\d+)?$/) { # it's not foo.info
+
+ # it's not foo{,-{1,2,3,...}}
+ $self->pointed_hint('info-document-has-wrong-extension',
+ $item->pointer)
+ if @fname_pieces;
+ }
+
+ # If this is the main info file (no numeric extension). make
+ # sure it has appropriate dir entry information.
+ if ( $item->basename !~ /-\d+\.gz/
+ && $item->file_type =~ /gzip compressed data/) {
+
+ # unsafe symlink, skip. Actually, this should never
+ # be true as "$file_type" for symlinks will not be
+ # "gzip compressed data". But for good measure.
+ next
+ unless $item->is_open_ok;
+
+ open(my $fd, '<:gzip', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ my ($section, $start, $end);
+ while (my $line = <$fd>) {
+
+ $section = 1
+ if $line =~ /^INFO-DIR-SECTION\s+\S/;
+
+ $start = 1
+ if $line =~ /^START-INFO-DIR-ENTRY\b/;
+
+ $end = 1
+ if $line =~ /^END-INFO-DIR-ENTRY\b/;
+ }
+
+ close $fd;
+
+ $self->pointed_hint('info-document-missing-dir-section',
+ $item->pointer)
+ unless $section;
+
+ $self->pointed_hint('info-document-missing-dir-entry',
+ $item->pointer)
+ unless $start && $end;
+ }
+
+ # Check each [image src=""] form in the info files. The src
+ # filename should be in the package. As of Texinfo 5 it will
+ # be something.png or something.jpg, but that's not enforced.
+ #
+ # See Texinfo manual (info "(texinfo)Info Format Image") for
+ # details of the [image] form. Bytes \x00,\x08 introduce it
+ # (and distinguishes it from [image] appearing as plain text).
+ #
+ # String src="..." part has \" for literal " and \\ for
+ # literal \, though that would be unlikely in filenames. For
+ # the tag() message show $src unbackslashed since that's the
+ # filename sought.
+ #
+ if ($item->is_file && $item->basename =~ /\.info(?:-\d+)?\.gz$/) {
+
+ open(my $fd, '<:gzip', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ my $position = 1;
+ while (my $line = <$fd>) {
+
+ my @missing;
+ while ($line =~ /[\0][\b]\[image src="((?:\\.|[^\"])+)"/smg) {
+
+ my $src = $1;
+ $src =~ s/\\(.)/$1/g; # unbackslash
+
+ push(@missing, $src)
+ unless $self->processable->installed->lookup(
+ normalize_link_target('usr/share/info', $src));
+ }
+
+ $self->pointed_hint('info-document-missing-image-file',
+ $item->pointer($position), $_)
+ for uniq @missing;
+
+ } continue {
+ ++$position;
+ }
+
+ close $fd;
+ }
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 07:19:02 +0000