Adding upstream version 2.117.0.upstream/2.117.0upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 733 insertions, 0 deletions

diff --git a/lib/Lintian/Check/InitD.pm b/lib/Lintian/Check/InitD.pm
new file mode 100644
index 0000000..304c186
--- /dev/null
+++ b/lib/Lintian/Check/InitD.pm
@@ -0,0 +1,733 @@
+# init.d -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz
+# Copyright (C) 2016-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 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::InitD;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use File::Basename qw(dirname);
+use List::Compare;
+use List::SomeUtils qw(any none);
+use Unicode::UTF8 qw(encode_utf8);
+
+const my $EMPTY => q{};
+const my $SPACE => q{ };
+const my $DOLLAR => q{$};
+
+const my $RUN_LEVEL_6 => 6;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# A list of valid LSB keywords.  The value is 0 if optional and 1 if required.
+my %LSB_KEYWORDS = (
+    provides            => 1,
+    'required-start'    => 1,
+    'required-stop'     => 1,
+    'should-start'      => 0,
+    'should-stop'       => 0,
+    'default-start'     => 1,
+    'default-stop'      => 1,
+    # These two are actually optional, but we mark
+    # them as required and give them a weaker tag if
+    # they are missing.
+    'short-description' => 1,
+    'description'       => 1
+);
+
+# These init script names should probably not be used in dependencies.
+# Instead, the corresponding virtual facility should be used.
+#
+# checkroot is not included here since cryptsetup needs the root file system
+# mounted but not any other local file systems and therefore correctly depends
+# on checkroot.  There may be other similar situations.
+my %implied_dependencies = (
+    'mountall'   => $DOLLAR . 'local_fs',
+    'mountnfs'   => $DOLLAR . 'remote_fs',
+
+    'hwclock'    => $DOLLAR . 'time',
+    'portmap'    => $DOLLAR . 'portmap',
+    'named'      => $DOLLAR . 'named',
+    'bind9'      => $DOLLAR . 'named',
+    'networking' => $DOLLAR . 'network',
+    'syslog'     => $DOLLAR . 'syslog',
+    'rsyslog'    => $DOLLAR . 'syslog',
+    'sysklogd'   => $DOLLAR . 'syslog'
+);
+
+# Regex to match names of init.d scripts; it is a bit more lax than
+# package names (e.g. allows "_").  We do not allow it to start with a
+# "dash" to avoid confusing it with a command-line option (also,
+# update-rc.d does not allow this).
+our $INITD_NAME_REGEX = qr/[\w\.\+][\w\-\.\+]*/;
+
+my $OPTS_R = qr/-\S+\s*/;
+my $ACTION_R = qr/\w+/;
+my $EXCLUDE_R = qr/if\s+\[\s+-x\s+\S*update-rc\.d/;
+
+sub installable {
+    my ($self) = @_;
+
+    my $pkg = $self->processable->name;
+    my $processable = $self->processable;
+
+    my $initd_dir = $processable->installed->resolve_path('etc/init.d/');
+    my $postinst = $processable->control->lookup('postinst');
+    my $preinst = $processable->control->lookup('preinst');
+    my $postrm = $processable->control->lookup('postrm');
+    my $prerm = $processable->control->lookup('prerm');
+
+    my (%initd_postinst, %initd_postrm);
+
+    # These will never be regular initscripts. (see #918459, #933383
+    # and #941140 etc.)
+    return
+      if $pkg eq 'initscripts'
+      || $pkg eq 'sysvinit';
+
+    # read postinst control file
+    if ($postinst and $postinst->is_file and $postinst->is_open_ok) {
+
+        open(my $fd, '<', $postinst->unpacked_path)
+          or die encode_utf8('Cannot open ' . $postinst->unpacked_path);
+
+        my $position = 1;
+        while (my $line = <$fd>) {
+
+            next
+              if $line =~ /$EXCLUDE_R/;
+
+            $line =~ s/\#.*$//;
+
+            next
+              unless $line =~ m{^(?:.+;|^\s*system[\s\(\']+)?\s*update-rc\.d\s+
+            (?:$OPTS_R)*($INITD_NAME_REGEX)\s+($ACTION_R)}x;
+
+            my ($name,$opt) = ($1,$2);
+            next
+              if $opt eq 'remove';
+
+            my $pointer = $postinst->pointer($position);
+
+            if ($initd_postinst{$name}++ == 1) {
+
+                $self->pointed_hint('duplicate-updaterc.d-calls-in-postinst',
+                    $pointer, $name);
+                next;
+            }
+
+            $self->pointed_hint(
+                'output-of-updaterc.d-not-redirected-to-dev-null',
+                $pointer, $name)
+              unless $line =~ m{>\s*/dev/null};
+
+        } continue {
+            ++$position;
+        }
+
+        close $fd;
+    }
+
+    # read preinst control file
+    if ($preinst and $preinst->is_file and $preinst->is_open_ok) {
+
+        open(my $fd, '<', $preinst->unpacked_path)
+          or die encode_utf8('Cannot open ' . $preinst->unpacked_path);
+
+        my $position = 1;
+        while (my $line = <$fd>) {
+
+            next
+              if $line =~ /$EXCLUDE_R/;
+
+            $line =~ s/\#.*$//;
+            next
+              unless $line =~ m{update-rc\.d \s+
+                       (?:$OPTS_R)*($INITD_NAME_REGEX) \s+
+                       ($ACTION_R)}x;
+
+            my $name = $1;
+            my $option = $2;
+            next
+              if $option eq 'remove';
+
+            my $pointer = $preinst->pointer($position);
+
+            $self->pointed_hint('preinst-calls-updaterc.d',
+                $pointer, $name, $option);
+
+        } continue {
+            ++$position;
+        }
+
+        close $fd;
+    }
+
+    # read postrm control file
+    if ($postrm and $postrm->is_file and $postrm->is_open_ok) {
+
+        open(my $fd, '<', $postrm->unpacked_path)
+          or die encode_utf8('Cannot open ' . $postrm->unpacked_path);
+
+        my $position = 1;
+        while (my $line = <$fd>) {
+
+            next
+              if $line =~ /$EXCLUDE_R/;
+
+            $line =~ s/\#.*$//;
+
+            next
+              unless $line =~ /update-rc\.d\s+(?:$OPTS_R)*($INITD_NAME_REGEX)/;
+
+            my $name = $1;
+
+            my $pointer = $postrm->pointer($position);
+
+            if ($initd_postrm{$name}++ == 1) {
+
+                $self->pointed_hint('duplicate-updaterc.d-calls-in-postrm',
+                    $pointer, $name);
+                next;
+            }
+
+            $self->pointed_hint(
+                'output-of-updaterc.d-not-redirected-to-dev-null',
+                $pointer, $name)
+              unless $line =~ m{>\s*/dev/null};
+
+        } continue {
+            ++$position;
+        }
+
+        close $fd;
+    }
+
+    # read prerm control file
+    if ($prerm and $prerm->is_file and $prerm->is_open_ok) {
+
+        open(my $fd, '<', $prerm->unpacked_path)
+          or die encode_utf8('Cannot open ' . $prerm->unpacked_path);
+
+        my $position = 1;
+        while (my $line = <$fd>) {
+
+            next
+              if $line =~ /$EXCLUDE_R/;
+
+            $line =~ s/\#.*$//;
+
+            next
+              unless $line =~ /update-rc\.d\s+(?:$OPTS_R)*($INITD_NAME_REGEX)/;
+
+            my $name = $1;
+
+            my $pointer = $prerm->pointer($position);
+
+            $self->pointed_hint('prerm-calls-updaterc.d', $pointer, $name);
+
+        } continue {
+            ++$position;
+        }
+
+        close $fd;
+    }
+
+    # init.d scripts have to be removed in postrm
+    for (keys %initd_postinst) {
+        if ($initd_postrm{$_}) {
+            delete $initd_postrm{$_};
+        } else {
+
+            $self->pointed_hint(
+                'postrm-does-not-call-updaterc.d-for-init.d-script',
+                $postrm->pointer, "etc/init.d/$_");
+        }
+    }
+
+    for (keys %initd_postrm) {
+        $self->pointed_hint('postrm-contains-additional-updaterc.d-calls',
+            $postrm->pointer, "etc/init.d/$_");
+    }
+
+    for my $initd_file (keys %initd_postinst) {
+
+        my $item;
+        $item = $initd_dir->child($initd_file)
+          if $initd_dir;
+
+        unless (
+            (defined $item && $item->resolve_path)
+            ||(    defined $item
+                && $item->is_symlink
+                && $item->link eq '/lib/init/upstart-job')
+        ) {
+
+            $self->hint('init.d-script-not-included-in-package',
+                "etc/init.d/$initd_file");
+
+            next;
+        }
+
+        # init.d scripts have to be marked as conffiles unless they're
+        # symlinks.
+        $self->hint('init.d-script-not-marked-as-conffile',
+            "etc/init.d/$initd_file")
+          if !defined $item
+          || ( !$processable->declared_conffiles->is_known($item->name)
+            && !$item->is_symlink);
+
+        # Check if file exists in package and check the script for
+        # other issues if it was included in the package.
+        $self->check_init($item);
+    }
+    $self->check_defaults;
+
+    return
+      unless defined $initd_dir && $initd_dir->is_dir;
+
+    # files actually installed in /etc/init.d should match our list :-)
+    for my $script ($initd_dir->children) {
+
+        next
+          if !$script->is_dir
+          && (any {$script->basename eq $_}qw(README skeleton rc rcS));
+
+        my $tag_name = 'script-in-etc-init.d-not-registered-via-update-rc.d';
+
+        # In an upstart system, such as Ubuntu, init scripts are symlinks to
+        # upstart-job which are not registered with update-rc.d.
+        $tag_name= 'upstart-job-in-etc-init.d-not-registered-via-update-rc.d'
+          if $script->is_symlink
+          && $script->link eq '/lib/init/upstart-job';
+
+        # If $initd_postinst is true for this script, we already
+        # checked the syntax in the above loop.  Check the syntax of
+        # unregistered scripts so that we get more complete Lintian
+        # coverage in the first pass.
+        unless ($initd_postinst{$script->basename}) {
+
+            $self->pointed_hint($tag_name, $script->pointer);
+            $self->check_init($script);
+        }
+    }
+
+    return;
+}
+
+sub check_init {
+    my ($self, $item) = @_;
+
+    my $processable = $self->processable;
+
+    # In an upstart system, such as Ubuntu, init scripts are symlinks to
+    # upstart-job.  It doesn't make sense to check the syntax of upstart-job,
+    # so skip the checks of the init script itself in that case.
+    return
+      if $item->is_symlink
+      && $item->link eq '/lib/init/upstart-job';
+
+    return
+      unless $item->is_open_ok;
+
+    my %saw_command;
+    my %value_by_lsb_keyword;
+    my $in_file_test = 0;
+    my $needs_fs = 0;
+
+    if ($item->interpreter eq '/lib/init/init-d-script') {
+        $saw_command{$_} = 1 for qw{start stop restart force-reload status};
+    }
+
+    $self->pointed_hint('init.d-script-uses-usr-interpreter',
+        $item->pointer(1), $item->interpreter)
+      if $item->interpreter =~ m{^ /usr/ }x;
+
+    open(my $fd, '<', $item->unpacked_path)
+      or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+    my $position = 1;
+    while (my $line = <$fd>) {
+
+        $self->pointed_hint('init.d-script-contains-skeleton-template-content',
+            $item->pointer($position))
+          if $line =~ m{Please remove the "Author" lines|Example initscript};
+
+        if ($line =~ m/^\#\#\# BEGIN INIT INFO/) {
+
+            if (defined $value_by_lsb_keyword{BEGIN}) {
+
+                $self->pointed_hint('init.d-script-has-duplicate-lsb-section',
+                    $item->pointer($position));
+                next;
+            }
+
+            $value_by_lsb_keyword{BEGIN} = [1];
+            my $final;
+
+            # We have an LSB keyword section.  Parse it and save the data
+            # in %value_by_lsb_keyword for analysis.
+            while (my $other_line = <$fd>) {
+
+                # nested while
+                ++$position;
+
+                if ($other_line =~ /^\#\#\# END INIT INFO/) {
+                    $value_by_lsb_keyword{END} = [1];
+                    last;
+
+                } elsif ($other_line !~ /^\#/) {
+                    $self->pointed_hint(
+                        'init.d-script-has-unterminated-lsb-section',
+                        $item->pointer($position));
+                    last;
+
+                } elsif ($other_line =~ /^\# ([a-zA-Z-]+):\s*(.*?)\s*$/) {
+
+                    my $keyword = lc $1;
+                    my $value = $2 // $EMPTY;
+
+                    $self->pointed_hint(
+                        'init.d-script-has-duplicate-lsb-keyword',
+                        $item->pointer($position), $keyword)
+                      if defined $value_by_lsb_keyword{$keyword};
+
+                    $self->pointed_hint(
+                        'init.d-script-has-unknown-lsb-keyword',
+                        $item->pointer($position), $keyword)
+                      unless exists $LSB_KEYWORDS{$keyword}
+                      || $keyword =~ /^x-/;
+
+                    $value_by_lsb_keyword{$keyword} = [split($SPACE, $value)];
+                    $final = $keyword;
+
+                } elsif ($other_line =~ /^\#(\t|  )/
+                    && $final eq 'description') {
+
+                    my $value = $other_line;
+                    $value =~ s/^\#\s*//;
+                    $value_by_lsb_keyword{description} .= $SPACE . $value;
+
+                } else {
+                    $self->pointed_hint('init.d-script-has-bad-lsb-line',
+                        $item->pointer($position));
+                }
+            }
+        }
+
+        # Pretty dummy way to handle conditionals, but should be enough
+        # for simple init scripts
+        $in_file_test = 1
+          if $line
+          =~ m{ \b if \s+ .*? (?:test|\[) (?: \s+ \! )? \s+ - [efr] \s+ }x;
+
+        $in_file_test = 0
+          if $line =~ m{ \b fi \b }x;
+
+        if (  !$in_file_test
+            && $line =~ m{^\s*\.\s+["'"]?(/etc/default/[\$\w/-]+)}){
+            my $sourced = $1;
+
+            $self->pointed_hint('init.d-script-sourcing-without-test',
+                $item->pointer($position), $sourced);
+        }
+
+        # Some init.d scripts source init-d-script, since (e.g.)
+        # kFreeBSD does not allow shell scripts as interpreters.
+        if ($line =~ m{\. /lib/init/init-d-script}) {
+            $saw_command{$_} = 1
+              for qw{start stop restart force-reload status};
+        }
+
+        # This should be more sophisticated: ignore heredocs, ignore quoted
+        # text and the arguments to echo, etc.
+        $needs_fs = 1
+          if $line =~ m{^[^\#]*/var/};
+
+        while ($line =~ s/^[^\#]*?(start|stop|restart|force-reload|status)//) {
+            $saw_command{$1} = 1;
+        }
+
+        # nested while
+    } continue {
+        ++$position;
+    }
+
+    close $fd;
+
+    # Make sure all of the required keywords are present.
+    if (!defined $value_by_lsb_keyword{BEGIN}) {
+        $self->pointed_hint('init.d-script-missing-lsb-section',
+            $item->pointer);
+
+    } else {
+        for my $keyword (keys %LSB_KEYWORDS) {
+
+            if ($LSB_KEYWORDS{$keyword}
+                && !defined $value_by_lsb_keyword{$keyword}) {
+
+                if ($keyword eq 'short-description') {
+                    $self->pointed_hint(
+                        'init.d-script-missing-lsb-short-description',
+                        $item->pointer);
+
+                } elsif ($keyword eq 'description') {
+                    next;
+
+                } else {
+                    $self->pointed_hint('init.d-script-missing-lsb-keyword',
+                        $item->pointer, $keyword);
+                }
+            }
+        }
+    }
+
+    # Check the runlevels.
+    my %start;
+
+    for my $runlevel (@{$value_by_lsb_keyword{'default-start'} // []}) {
+
+        if ($runlevel =~ /^[sS0-6]$/) {
+
+            $start{lc $runlevel} = 1;
+
+            $self->pointed_hint('init.d-script-starts-in-stop-runlevel',
+                $item->pointer, $runlevel)
+              if $runlevel eq '0'
+              || $runlevel eq '6';
+
+        } else {
+            $self->pointed_hint('init.d-script-has-bad-start-runlevel',
+                $item->pointer, $runlevel);
+        }
+    }
+
+    # No script should start at one of the 2-5 runlevels but not at
+    # all of them
+    my $start = join($SPACE, (sort grep { /^[2-5]$/ } keys %start));
+
+    if (length($start) > 0 and $start ne '2 3 4 5') {
+        my @missing = grep { !exists $start{$_} } qw(2 3 4 5);
+
+        $self->pointed_hint('init.d-script-missing-start', $item->pointer,
+            @missing);
+    }
+
+    my %stop;
+
+    for my $runlevel (@{$value_by_lsb_keyword{'default-stop'} // []}) {
+
+        if ($runlevel =~ /^[sS0-6]$/) {
+
+            $stop{$runlevel} = 1
+              unless $runlevel =~ /[sS2-5]/;
+
+            $self->pointed_hint('init.d-script-has-conflicting-start-stop',
+                $item->pointer, $runlevel)
+              if exists $start{$runlevel};
+
+            $self->pointed_hint('init-d-script-stops-in-s-runlevel',
+                $item->pointer)
+              if $runlevel =~ /[sS]/;
+
+        } else {
+            $self->pointed_hint('init.d-script-has-bad-stop-runlevel',
+                $item->pointer, $runlevel);
+        }
+    }
+
+    if (none { $item->basename eq $_ } qw(killprocs sendsigs halt reboot)) {
+
+        my @required = (0, 1, $RUN_LEVEL_6);
+        my $stop_lc = List::Compare->new(\@required, [keys %stop]);
+
+        my @have_some = $stop_lc->get_intersection;
+        my @missing = $stop_lc->get_Lonly;
+
+        # Scripts that stop in any of 0, 1, or 6 probably should stop in all
+        # of them, with some special exceptions.
+        $self->pointed_hint('init.d-script-possible-missing-stop',
+            $item->pointer, (sort @missing))
+          if @have_some
+          && @missing
+          && (%start != 1 || !exists $start{s});
+    }
+
+    my $provides_self = 0;
+    for my $facility (@{$value_by_lsb_keyword{'provides'} // []}) {
+
+        $self->pointed_hint('init.d-script-provides-virtual-facility',
+            $item->pointer, $facility)
+          if $facility =~ /^\$/;
+
+        $provides_self = 1
+          if $item->basename =~/^\Q$facility\E(?:.sh)?$/;
+    }
+
+    $self->pointed_hint('init.d-script-does-not-provide-itself',$item->pointer)
+      if defined $value_by_lsb_keyword{'provides'}
+      && !$provides_self;
+
+    # Separately check Required-Start and Required-Stop, since while they're
+    # similar, they're not quite identical.  This could use some further
+    # restructuring by pulling the regexes out as data tied to start/stop and
+    # remote/local and then combining the loops.
+    if (@{$value_by_lsb_keyword{'default-start'} // []}) {
+
+        my @required = @{$value_by_lsb_keyword{'required-start'} // []};
+
+        if ($needs_fs) {
+            if (none { /^\$(?:local_fs|remote_fs|all)\z/ } @required) {
+
+                $self->pointed_hint(
+                    'init.d-script-missing-dependency-on-local_fs',
+                    $item->pointer, 'required-start');
+            }
+        }
+    }
+
+    if (@{$value_by_lsb_keyword{'default-stop'} // []}) {
+
+        my @required = @{$value_by_lsb_keyword{'required-stop'} // []};
+
+        if ($needs_fs) {
+            if (none { /^(?:\$(?:local|remote)_fs|\$all|umountn?fs)\z/ }
+                @required) {
+
+                $self->pointed_hint(
+                    'init.d-script-missing-dependency-on-local_fs',
+                    $item->pointer, 'required-stop');
+            }
+        }
+    }
+
+    my $VIRTUAL_FACILITIES= $self->data->virtual_initd_facilities;
+
+    # Check syntax rules that apply to all of the keywords.
+    for
+      my $keyword (qw(required-start should-start required-stop should-stop)){
+        for my $prerequisite (@{$value_by_lsb_keyword{$keyword} // []}) {
+
+            if (exists $implied_dependencies{$prerequisite}) {
+
+                $self->pointed_hint('non-virtual-facility-in-initd-script',
+                    $item->pointer,
+                    "$prerequisite -> $implied_dependencies{$prerequisite}");
+
+            } elsif ($keyword =~ m/^required-/ && $prerequisite =~ m/^\$/) {
+
+                $self->pointed_hint(
+                    'init.d-script-depends-on-unknown-virtual-facility',
+                    $item->pointer, $prerequisite)
+                  unless ($VIRTUAL_FACILITIES->recognizes($prerequisite));
+            }
+
+            $self->pointed_hint(
+                'init.d-script-depends-on-all-virtual-facility',
+                $item->pointer, $keyword)
+              if $prerequisite =~ m/^\$all$/;
+        }
+    }
+
+    my @required_commands = qw{start stop restart force-reload};
+    my $command_lc
+      = List::Compare->new(\@required_commands, [keys %saw_command]);
+    my @missing_commands = $command_lc->get_Lonly;
+
+    # all tags included in file?
+    $self->pointed_hint('init.d-script-does-not-implement-required-option',
+        $item->pointer, $_)
+      for @missing_commands;
+
+    $self->pointed_hint('init.d-script-does-not-implement-status-option',
+        $item->pointer)
+      unless $saw_command{'status'};
+
+    return;
+}
+
+sub check_defaults {
+    my ($self) = @_;
+
+    my $processable = $self->processable;
+
+    my $dir = $processable->installed->resolve_path('etc/default/');
+    return
+      unless $dir && $dir->is_dir;
+
+    for my $item ($dir->children) {
+
+        return
+          unless $item->is_open_ok;
+
+        open(my $fd, '<', $item->unpacked_path)
+          or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+        my $position = 1;
+        while (my $line = <$fd>) {
+
+            $self->pointed_hint('init.d-script-should-always-start-service',
+                $item->pointer($position))
+              if $line
+              =~ m{^ \s* [#]* \s* (?:[A-Z]_)? (?:ENABLED|DISABLED|[A-Z]*RUN | (?:NO_)? START) = }x;
+
+        } continue {
+            ++$position;
+        }
+
+        close $fd;
+    }
+
+    return;
+}
+
+sub visit_installed_files {
+    my ($self, $item) = @_;
+
+    if ($item =~ m{etc/sv/([^/]+)/$}) {
+
+        my $service = $1;
+        my $runfile
+          = $self->processable->installed->resolve_path(
+            "etc/sv/${service}/run");
+
+        $self->pointed_hint(
+            'directory-in-etc-sv-directory-without-executable-run-script',
+            $item->pointer, $runfile)
+          unless defined $runfile && $runfile->is_executable;
+    }
+
+    return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et