diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-14 13:42:30 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-14 13:42:30 +0000 |
commit | 75808db17caf8b960b351e3408e74142f4c85aac (patch) | |
tree | 7989e9c09a4240248bf4658a22208a0a52d991c4 /lib/Lintian/Check/MaintainerScripts | |
parent | Initial commit. (diff) | |
download | lintian-75808db17caf8b960b351e3408e74142f4c85aac.tar.xz lintian-75808db17caf8b960b351e3408e74142f4c85aac.zip |
Adding upstream version 2.117.0.upstream/2.117.0upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'lib/Lintian/Check/MaintainerScripts')
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Adduser.pm | 96 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/AncientVersion.pm | 180 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Diversion.pm | 369 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/DpkgStatoverride.pm | 148 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Empty.pm | 144 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Generated.pm | 85 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Helper/Dpkg.pm | 183 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Killall.pm | 131 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Ldconfig.pm | 60 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Mknod.pm | 131 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/Systemctl.pm | 76 | ||||
-rw-r--r-- | lib/Lintian/Check/MaintainerScripts/TemporaryFiles.pm | 144 |
12 files changed, 1747 insertions, 0 deletions
diff --git a/lib/Lintian/Check/MaintainerScripts/Adduser.pm b/lib/Lintian/Check/MaintainerScripts/Adduser.pm new file mode 100644 index 0000000..f8bbea4 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Adduser.pm @@ -0,0 +1,96 @@ +# maintainer_scripts::adduser -- lintian check script -*- perl -*- + +# Copyright (C) 2020 Topi Miettinen +# +# 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::MaintainerScripts::Adduser; + +use v5.20; +use warnings; +use utf8; + +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub visit_control_files { + my ($self, $item) = @_; + + # get maintainer scripts + return + unless $item->is_maintainer_script; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $continuation = undef; + + my $position = 1; + while (my $line = <$fd>) { + + chomp $line; + + # merge lines ending with '\' + if (defined $continuation) { + $line = $continuation . $line; + $continuation = undef; + } + + if ($line =~ /\\$/) { + $continuation = $line; + $continuation =~ s/\\$/ /; + next; + } + + # trim right + $line =~ s/\s+$//; + + # skip empty lines + next + if $line =~ /^\s*$/; + + # skip comments + next + if $line =~ /^[#\n]/; + + $self->pointed_hint('adduser-with-home-var-run', + $item->pointer($position)) + if $line =~ /adduser .*--home +\/var\/run/; + + } 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 diff --git a/lib/Lintian/Check/MaintainerScripts/AncientVersion.pm b/lib/Lintian/Check/MaintainerScripts/AncientVersion.pm new file mode 100644 index 0000000..9fac1c5 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/AncientVersion.pm @@ -0,0 +1,180 @@ +# maintainer-scripts/ancient-version -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 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::MaintainerScripts::AncientVersion; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use POSIX qw(strftime); +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +# date --date="Sat, 14 Aug 2021 17:41:41 -0400" +%s +# https://lists.debian.org/debian-announce/2021/msg00003.html +const my $OLDSTABLE_RELEASE_EPOCH => 1_628_977_301; + +# When detecting commands inside shell scripts, use this regex to match the +# beginning of the command rather than checking whether the command is at the +# beginning of a line. +const my $LEADING_PATTERN=> +'(?:(?:^|[`&;(|{])\s*|(?:if|then|do|while|!)\s+|env(?:\s+[[:alnum:]_]+=(?:\S+|\"[^"]*\"|\'[^\']*\'))*\s+)'; +const my $LEADING_REGEX => qr/$LEADING_PATTERN/; + +has old_versions => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my %old_versions; + for my $entry ( + $self->processable->changelog + ? @{$self->processable->changelog->entries} + : () + ) { + my $timestamp = $entry->Timestamp // $OLDSTABLE_RELEASE_EPOCH; + $old_versions{$entry->Version} = $timestamp + if $timestamp < $OLDSTABLE_RELEASE_EPOCH; + } + + return \%old_versions; + } +); + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + for my $old_version (keys %{$self->old_versions}) { + + next + if $old_version =~ /^\d+$/; + + if ($line + =~m{$LEADING_REGEX(?:/usr/bin/)?dpkg\s+--compare-versions\s+.*\b\Q$old_version\E(?!\.)\b} + ) { + my $date + = strftime('%Y-%m-%d', + gmtime $self->old_versions->{$old_version}); + my $epoch + = strftime('%Y-%m-%d', gmtime $OLDSTABLE_RELEASE_EPOCH); + + my $pointer = $item->pointer($position); + + $self->pointed_hint( + 'maintainer-script-supports-ancient-package-version', + $pointer, $old_version,"($date < $epoch)", + ); + } + } + + } continue { + ++$position; + } + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +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/MaintainerScripts/Diversion.pm b/lib/Lintian/Check/MaintainerScripts/Diversion.pm new file mode 100644 index 0000000..e786422 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Diversion.pm @@ -0,0 +1,369 @@ +# maintainer-scripts/diversion -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 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::MaintainerScripts::Diversion; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(any none); +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +# When detecting commands inside shell scripts, use this regex to match the +# beginning of the command rather than checking whether the command is at the +# beginning of a line. +const my $LEADING_PATTERN=> +'(?:(?:^|[`&;(|{])\s*|(?:if|then|do|while|!)\s+|env(?:\s+[[:alnum:]_]+=(?:\S+|\"[^"]*\"|\'[^\']*\'))*\s+)'; +const my $LEADING_REGEX => qr/$LEADING_PATTERN/; + +has added_diversions => (is => 'rw', default => sub { {} }); +has removed_diversions => (is => 'rw', default => sub { {} }); +has expand_diversions => (is => 'rw', default => 0); + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + my $pointer = $item->pointer($position); + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + if ( $line =~ m{$LEADING_REGEX(?:/usr/sbin/)?dpkg-divert\s} + && $line !~ /--(?:help|list|truename|version)/) { + + $self->pointed_hint('package-uses-local-diversion',$pointer) + if $line =~ /--local/; + + my $mode = $line =~ /--remove/ ? 'remove' : 'add'; + + my ($divert) = ($line =~ /dpkg-divert\s*(.*)$/); + + $divert =~ s{\s*(?:\$[{]?[\w:=-]+[}]?)*\s* + # options without arguments + --(?:add|quiet|remove|rename|no-rename|test|local + # options with arguments + |(?:admindir|divert|package) \s+ \S+) + \s*}{}gxsm; + + # Remove unpaired opening or closing parenthesis + 1 while ($divert =~ m/\G.*?\(.+?\)/gc); + $divert =~ s/\G(.*?)[()]/$1/; + pos($divert) = undef; + + # Remove unpaired opening or closing braces + 1 while ($divert =~ m/\G.*?{.+?}/gc); + $divert =~ s/\G(.*?)[{}]/$1/; + pos($divert) = undef; + + # position after the last pair of quotation marks, if any + 1 while ($divert =~ m/\G.*?(["']).+?\1/gc); + + # Strip anything matching and after '&&', '||', ';', or '>' + # this is safe only after we are positioned after the last pair + # of quotation marks + $divert =~ s/\G.+?\K(?: && | \|\| | ; | \d*> ).*$//x; + pos($divert) = undef; + + # Remove quotation marks, they affect: + # * our var to regex trick + # * stripping the initial slash if the path was quoted + $divert =~ s/[\"\']//g; + + # remove the leading / because it's not in the index hash + $divert =~ s{^/}{}; + + # trim both ends + $divert =~ s/^\s+|\s+$//g; + + $divert = quotemeta($divert); + + # For now just replace variables, they will later be normalised + $self->expand_diversions(1) + if $divert =~ s/\\\$\w+/.+/g; + + $self->expand_diversions(1) + if $divert =~ s/\\\$\\[{]\w+.*?\\[}]/.+/g; + + # handle $() the same way: + $self->expand_diversions(1) + if $divert =~ s/\\\$\\\(.+?\\\)/.+/g; + + my %diversion; + $diversion{script} = $item; + $diversion{position} = $position; + + $self->added_diversions->{$divert} = \%diversion + if $mode eq 'add'; + + push(@{$self->removed_diversions->{$divert}}, \%diversion) + if $mode eq 'remove'; + + die encode_utf8("mode has unknown value: $mode") + if none { $mode eq $_ } qw{add remove}; + } + + } continue { + ++$position; + } + + return; +} + +sub installable { + my ($self) = @_; + + # If any of the maintainer scripts used a variable in the file or + # diversion name normalise them all + if ($self->expand_diversions) { + + for my $divert ( + keys %{$self->removed_diversions}, + keys %{$self->added_diversions} + ) { + + # if a wider regex was found, the entries might no longer be there + next + unless exists $self->removed_diversions->{$divert} + || exists $self->added_diversions->{$divert}; + + my $widerrx = $divert; + my $wider = $widerrx; + $wider =~ s/\\//g; + + # find the widest regex: + my @matches = grep { + my $lrx = $_; + my $l = $lrx; + $l =~ s/\\//g; + + if ($wider =~ m/^$lrx$/) { + $widerrx = $lrx; + $wider = $l; + 1; + } elsif ($l =~ m/^$widerrx$/) { + 1; + } else { + 0; + } + } ( + keys %{$self->removed_diversions}, + keys %{$self->added_diversions} + ); + + # replace all the occurrences with the widest regex: + for my $k (@matches) { + + next + if $k eq $widerrx; + + if (exists $self->removed_diversions->{$k}) { + + $self->removed_diversions->{$widerrx} + = $self->removed_diversions->{$k}; + + delete $self->removed_diversions->{$k}; + } + + if (exists $self->added_diversions->{$k}) { + + $self->added_diversions->{$widerrx} + = $self->added_diversions->{$k}; + + delete $self->added_diversions->{$k}; + } + } + } + } + + for my $divert (keys %{$self->removed_diversions}) { + + if (exists $self->added_diversions->{$divert}) { + # just mark the entry, because a --remove might + # happen in two branches in the script, i.e. we + # see it twice, which is not a bug + $self->added_diversions->{$divert}{removed} = 1; + + } else { + + for my $item (@{$self->removed_diversions->{$divert}}) { + + my $script = $item->{script}; + my $position = $item->{position}; + + next + unless $script->name eq 'postrm'; + + # Allow preinst and postinst to remove diversions the + # package doesn't add to clean up after previous + # versions of the package. + + my $unquoted = unquote($divert, $self->expand_diversions); + + my $pointer = $script->pointer($position); + + $self->pointed_hint('remove-of-unknown-diversion', $pointer, + $unquoted); + } + } + } + + for my $divert (keys %{$self->added_diversions}) { + + my $script = $self->added_diversions->{$divert}{script}; + my $position = $self->added_diversions->{$divert}{position}; + + my $pointer = $script->pointer($script); + $pointer->position($position); + + my $divertrx = $divert; + my $unquoted = unquote($divert, $self->expand_diversions); + + $self->pointed_hint('orphaned-diversion', $pointer, $unquoted) + unless exists $self->added_diversions->{$divertrx}{removed}; + + # Handle man page diversions somewhat specially. We may + # divert away a man page in one section without replacing that + # same file, since we're installing a man page in a different + # section. An example is diverting a man page in section 1 + # and replacing it with one in section 1p (such as + # libmodule-corelist-perl at the time of this writing). + # + # Deal with this by turning all man page diversions into + # wildcard expressions instead that match everything in the + # same numeric section so that they'll match the files shipped + # in the package. + if ($divertrx =~ m{^(usr\\/share\\/man\\/\S+\\/.*\\\.\d)\w*(\\\.gz\z)}) + { + $divertrx = "$1.*$2"; + $self->expand_diversions(1); + } + + if ($self->expand_diversions) { + + $self->pointed_hint('diversion-for-unknown-file', $pointer, + $unquoted) + unless (any { /$divertrx/ } + @{$self->processable->installed->sorted_list}); + + } else { + $self->pointed_hint('diversion-for-unknown-file', $pointer, + $unquoted) + unless $self->processable->installed->lookup($unquoted); + } + } + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +sub unquote { + my ($string, $replace_regex) = @_; + + $string =~ s{\\}{}g; + + $string =~ s{\.\+}{*}g + if $replace_regex; + + return $string; +} + +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/MaintainerScripts/DpkgStatoverride.pm b/lib/Lintian/Check/MaintainerScripts/DpkgStatoverride.pm new file mode 100644 index 0000000..6b8347c --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/DpkgStatoverride.pm @@ -0,0 +1,148 @@ +# maintainer-scripts/dpkg-statoverride -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 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::MaintainerScripts::DpkgStatoverride; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +# When detecting commands inside shell scripts, use this regex to match the +# beginning of the command rather than checking whether the command is at the +# beginning of a line. +const my $LEADING_PATTERN=> +'(?:(?:^|[`&;(|{])\s*|(?:if|then|do|while|!)\s+|env(?:\s+[[:alnum:]_]+=(?:\S+|\"[^"]*\"|\'[^\']*\'))*\s+)'; +const my $LEADING_REGEX => qr/$LEADING_PATTERN/; + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $saw_statoverride_list = 0; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + my $pointer = $item->pointer($position); + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + if ($line =~ m{$LEADING_REGEX(?:/usr/bin/)?dpkg-statoverride\s}) { + + $saw_statoverride_list = 1 + if $line =~ /--list/; + + if ($line =~ /--add/) { + + $self->pointed_hint('unconditional-use-of-dpkg-statoverride', + $pointer) + unless $saw_statoverride_list; + } + } + + } continue { + ++$position; + } + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +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/MaintainerScripts/Empty.pm b/lib/Lintian/Check/MaintainerScripts/Empty.pm new file mode 100644 index 0000000..298eb0a --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Empty.pm @@ -0,0 +1,144 @@ +# maintainer-scripts/empty -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 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::MaintainerScripts::Empty; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $has_code = 0; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + # Don't consider the standard dh-make boilerplate to be code. This + # means ignoring the framework of a case statement, the labels, the + # echo complaining about unknown arguments, and an exit. + if ( $line !~ /^\s*set\s+-\w+\s*$/ + && $line !~ /^\s*case\s+\"?\$1\"?\s+in\s*$/ + && $line !~ /^\s*(?:[a-z|-]+|\*)\)\s*$/ + && $line !~ /^\s*[:;]+\s*$/ + && $line !~ /^\s*echo\s+\"[^\"]+\"(?:\s*>&2)?\s*$/ + && $line !~ /^\s*esac\s*$/ + && $line !~ /^\s*exit\s+\d+\s*$/) { + + $has_code = 1; + last; + } + + } continue { + ++$position; + } + + $self->pointed_hint('maintainer-script-empty', $item->pointer) + unless $has_code; + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +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/MaintainerScripts/Generated.pm b/lib/Lintian/Check/MaintainerScripts/Generated.pm new file mode 100644 index 0000000..bf00910 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Generated.pm @@ -0,0 +1,85 @@ +# maintainer-scripts/generated -- lintian check script -*- perl -*- +# +# 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::MaintainerScripts::Generated; + +use v5.20; +use warnings; +use utf8; + +use List::SomeUtils qw(uniq); +use Path::Tiny; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub installable { + my ($self) = @_; + + my @tools_seen; + + # get maintainer scripts + my @control + = grep { $_->is_maintainer_script } + @{$self->processable->control->sorted_list}; + + for my $file (@control) { + + my $hashbang = $file->hashbang; + next + unless length $hashbang; + + next + unless $file->is_open_ok; + + my @lines = path($file->unpacked_path)->lines; + + # scan contents + for (@lines) { + + # skip empty lines + next + if /^\s*$/; + + if (/^# Automatically added by (\S+)\s*$/) { + my $tool = $1; +# remove trailing ":" from dh_python +# https://sources.debian.org/src/dh-python/4.20191017/dhpython/debhelper.py/#L200 + $tool =~ s/:\s*$//g; + push(@tools_seen, $tool); + } + } + } + + $self->hint('debhelper-autoscript-in-maintainer-scripts', $_) + for uniq @tools_seen; + + 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/MaintainerScripts/Helper/Dpkg.pm b/lib/Lintian/Check/MaintainerScripts/Helper/Dpkg.pm new file mode 100644 index 0000000..ef87c40 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Helper/Dpkg.pm @@ -0,0 +1,183 @@ +# maintainer-scripts/helper/dpkg -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 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::MaintainerScripts::Helper::Dpkg; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::Compare; +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +# When detecting commands inside shell scripts, use this regex to match the +# beginning of the command rather than checking whether the command is at the +# beginning of a line. +const my $LEADING_PATTERN=> +'(?:(?:^|[`&;(|{])\s*|(?:if|then|do|while|!)\s+|env(?:\s+[[:alnum:]_]+=(?:\S+|\"[^"]*\"|\'[^\']*\'))*\s+)'; +const my $LEADING_REGEX => qr/$LEADING_PATTERN/; + +has seen_helper_commands => (is => 'rw', default => sub { {} }); + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + if ($line + =~ m{$LEADING_REGEX(?:/usr/bin/)?dpkg-maintscript-helper\s(\S+)}){ + + my $command = $1; + + $self->seen_helper_commands->{$command} //= []; + push(@{$self->seen_helper_commands->{$command}}, $item->name); + } + + } continue { + ++$position; + } + + close $fd; + + return; +} + +sub installable { + my ($self) = @_; + + for my $command (keys %{$self->seen_helper_commands}) { + + # entering the loop means there is at least one member + my @have = @{$self->seen_helper_commands->{$command} // [] }; + next + unless @have; + + # dpkg-maintscript-helper(1) recommends the snippets are in all + # maintainer scripts but they are not strictly required in prerm. + my @wanted = qw{preinst postinst postrm}; + + my $lc = List::Compare->new(\@wanted, \@have); + + my @missing = $lc->get_Lonly; + + for my $name (@missing) { + + my $item = $self->processable->control->lookup($name); + + if (defined $item) { + + $self->pointed_hint('missing-call-to-dpkg-maintscript-helper', + $item->pointer, $command); + + } else { + # file does not exist + $self->hint('missing-call-to-dpkg-maintscript-helper', + $command, "[$name]"); + } + } + } + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +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/MaintainerScripts/Killall.pm b/lib/Lintian/Check/MaintainerScripts/Killall.pm new file mode 100644 index 0000000..2c3dd09 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Killall.pm @@ -0,0 +1,131 @@ +# maintainer-scripts/killall -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 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::MaintainerScripts::Killall; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + my $pointer = $item->pointer($position); + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + $self->pointed_hint('killall-is-dangerous', $pointer) + if $line =~ /^\s*killall(?:\s|\z)/; + + } continue { + ++$position; + } + + close $fd; + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +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/MaintainerScripts/Ldconfig.pm b/lib/Lintian/Check/MaintainerScripts/Ldconfig.pm new file mode 100644 index 0000000..22e64d2 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Ldconfig.pm @@ -0,0 +1,60 @@ +# maintainer-scripts/ldconfig -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz +# Copyright (C) 2018-2019 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::MaintainerScripts::Ldconfig; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless $item->decoded_utf8 =~ /^ [^\#]* \b ldconfig \b /mx; + + $self->pointed_hint('udeb-postinst-calls-ldconfig', $item->pointer) + if $item->name eq 'postinst' + && $self->processable->type eq 'udeb'; + + $self->pointed_hint('maintscript-calls-ldconfig', $item->pointer) + if $item->name ne 'postinst' + || $self->processable->type ne 'udeb'; + + 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/MaintainerScripts/Mknod.pm b/lib/Lintian/Check/MaintainerScripts/Mknod.pm new file mode 100644 index 0000000..e7269ea --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Mknod.pm @@ -0,0 +1,131 @@ +# maintainer-scripts/mknod -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 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::MaintainerScripts::Mknod; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + my $pointer = $item->pointer($position); + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + $self->pointed_hint('mknod-in-maintainer-script', $pointer) + if $line =~ /^\s*mknod(?:\s|\z)/ && $line !~ /\sp\s/; + + } continue { + ++$position; + } + + close $fd; + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +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/MaintainerScripts/Systemctl.pm b/lib/Lintian/Check/MaintainerScripts/Systemctl.pm new file mode 100644 index 0000000..c5e1654 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/Systemctl.pm @@ -0,0 +1,76 @@ +# masitainer-scripts/systemctl -- lintian check script -*- perl -*- +# +# Copyright (C) 2013 Michael Stapelberg +# Copyright (C) 2016-2020 Chris Lamb <lamby@debian.org> +# Copyright (C) 2021 Felix Lechner +# +# based on the apache2 checks file by: +# Copyright (C) 2012 Arno Toell +# +# 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::MaintainerScripts::Systemctl; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + # look only at shell scripts + return + unless $item->hashbang =~ /^\S*sh\b/; + + my @lines = split(/\n/, $item->decoded_utf8); + + my $position = 1; + for my $line (@lines) { + + next + if $line =~ /^#/; + + my $pointer = $item->pointer($position); + + # systemctl should not be called in maintainer scripts at all, + # except for systemctl daemon-reload calls. + $self->pointed_hint('maintainer-script-calls-systemctl', $pointer) + if $line =~ /^(?:.+;)?\s*systemctl\b/ + && $line !~ /daemon-reload/; + + } continue { + ++$position; + } + + 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/MaintainerScripts/TemporaryFiles.pm b/lib/Lintian/Check/MaintainerScripts/TemporaryFiles.pm new file mode 100644 index 0000000..f6d1164 --- /dev/null +++ b/lib/Lintian/Check/MaintainerScripts/TemporaryFiles.pm @@ -0,0 +1,144 @@ +# maintainer-scripts/temporary-files -- lintian check script -*- perl -*- +# +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# Copyright (C) 2016-2019 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::MaintainerScripts::TemporaryFiles; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +sub visit_control_files { + my ($self, $item) = @_; + + return + unless $item->is_maintainer_script; + + return + unless length $item->interpreter; + + return + unless $item->is_open_ok; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $stashed = $EMPTY; + + my $position = 1; + while (my $possible_continuation = <$fd>) { + + my $pointer = $item->pointer($position); + + chomp $possible_continuation; + + # skip empty lines + next + if $possible_continuation =~ /^\s*$/; + + # skip comment lines + next + if $possible_continuation =~ /^\s*\#/; + + my $no_comment = remove_comments($possible_continuation); + + # Concatenate lines containing continuation character (\) + # at the end + if ($no_comment =~ s{\\$}{}) { + + $stashed .= $no_comment; + + next; + } + + my $line = $stashed . $no_comment; + $stashed = $EMPTY; + + if ($line =~ m{ \W ( (?:/var)?/tmp | \$TMPDIR /[^)\]\}\s]+ ) }x) { + + my $indicator = $1; + + $self->pointed_hint( + 'possibly-insecure-handling-of-tmp-files-in-maintainer-script', + $pointer, + $indicator + ) + if $line !~ /\bmks?temp\b/ + && $line !~ /\btempfile\b/ + && $line !~ /\bmkdir\b/ + && $line !~ /\bXXXXXX\b/ + && $line !~ /\$RANDOM/; + } + + } continue { + ++$position; + } + + close $fd; + + return; +} + +sub remove_comments { + my ($line) = @_; + + return $line + unless length $line; + + my $simplified = $line; + + # Remove quoted strings so we can more easily ignore comments + # inside them + $simplified =~ s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + $simplified =~ s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing (if required) and return it. + if ($simplified =~ m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + + my $comment = $1; + + # eat comment + $line =~ s/\Q$comment\E//; + } + + return $line; +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |