diff options
Diffstat (limited to 'lib/Lintian/Check/MenuFormat.pm')
| -rw-r--r-- | lib/Lintian/Check/MenuFormat.pm | 907 |
1 files changed, 907 insertions, 0 deletions
diff --git a/lib/Lintian/Check/MenuFormat.pm b/lib/Lintian/Check/MenuFormat.pm new file mode 100644 index 0000000..c9d40a8 --- /dev/null +++ b/lib/Lintian/Check/MenuFormat.pm @@ -0,0 +1,907 @@ +# menu format -- lintian check script -*- perl -*- + +# Copyright (C) 1998 by Joey Hess +# Copyright (C) 2017-2018 Chris Lamb <lamby@debian.org> +# +# 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. + +# This script also checks desktop entries, since they share quite a bit of +# code. At some point, it would make sense to try to refactor this so that +# shared code is in libraries. +# +# Further things that the desktop file validation should be checking: +# +# - Encoding of the file should be UTF-8. +# - Additional Categories should be associated with Main Categories. +# - List entries (MimeType, Categories) should end with a semicolon. +# - Check for GNOME/GTK/X11/etc. dependencies and require the relevant +# Additional Category to be present. +# - Check all the escape characters supported by Exec. +# - Review desktop-file-validate to see what else we're missing. + +package Lintian::Check::MenuFormat; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use File::Basename; +use List::SomeUtils qw(any first_value); +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; +const my $SLASH => q{/}; + +const my $MAXIMUM_SIZE_STANDARD_ICON => 32; +const my $MAXIMUM_SIZE_32X32_ICON => 32; +const my $MAXIMUM_SIZE_16X16_ICON => 16; + +# This is a list of all tags that should be in every menu item. +my @req_tags = qw(needs section title command); + +# This is a list of all known tags. +my @known_tags = qw( + needs + section + title + sort + command + longtitle + icon + icon16x16 + icon32x32 + description + hotkey + hints +); + +# These 'needs' tags are always valid, no matter the context, and no other +# values are valid outside the Window Managers context (don't include wm here, +# in other words). It's case insensitive, use lower case here. +my @needs_tag_vals = qw(x11 text vc); + +has MENU_SECTIONS => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my %menu_sections; + + my $data = $self->data->load('menu-format/menu-sections'); + + for my $key ($data->all) { + + my ($root, $under) = split(m{/}, $key, 2); + + $under //= $EMPTY; + + # $under is empty if this is just a root section + $menu_sections{$root}{$under} = 1; + } + + return \%menu_sections; + } +); + +# Authoritative source of desktop keys: +# https://specifications.freedesktop.org/desktop-entry-spec/latest/ +# +# This is a list of all keys that should be in every desktop entry. +my @req_desktop_keys = qw(Type Name); + +# This is a list of all known keys. +has KNOWN_DESKTOP_KEYS => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return $self->data->load('menu-format/known-desktop-keys'); + } +); + +has DEPRECATED_DESKTOP_KEYS => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return $self->data->load('menu-format/deprecated-desktop-keys'); + } +); + +# KDE uses some additional keys that should start with X-KDE but don't for +# historical reasons. +has KDE_DESKTOP_KEYS => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return $self->data->load('menu-format/kde-desktop-keys'); + } +); + +# Known types of desktop entries. +# https://specifications.freedesktop.org/desktop-entry-spec/latest/ar01s06.html +my %known_desktop_types = map { $_ => 1 } qw( + Application + Link + Directory +); + +# Authoritative source of desktop categories: +# https://specifications.freedesktop.org/menu-spec/latest/apa.html + +# This is a list of all Main Categories for .desktop files. Application is +# added as an exception; it's not listed in the standard, but it's widely used +# and used as an example in the GNOME documentation. GNUstep is added as an +# exception since it's used by GNUstep packages. +my %main_categories = map { $_ => 1 } qw( + AudioVideo + Audio + Video + Development + Education + Game + Graphics + Network + Office + Science + Settings + System + Utility + Application + GNUstep +); + +# This is a list of all Additional Categories for .desktop files. Ideally we +# should be checking to be sure the associated Main Categories are present, +# but we don't have support for that yet. +has ADD_CATEGORIES => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + return $self->data->load('menu-format/add-categories'); + } +); + +# This is a list of Reserved Categories for .desktop files. To use one of +# these, the desktop entry must also have an OnlyShowIn key limiting the +# environment to one that supports this category. +my %reserved_categories = map { $_ => 1 } qw( + Screensaver + TrayIcon + Applet + Shell +); + +# Path in which to search for binaries referenced in menu entries. These must +# not have leading slashes. +my @path = qw(usr/local/bin/ usr/bin/ bin/ usr/games/); + +my %known_tags_hash = map { $_ => 1 } @known_tags; +my %needs_tag_vals_hash = map { $_ => 1 } @needs_tag_vals; + +# ----------------------------------- + +sub installable { + my ($self) = @_; + + my $index = $self->processable->installed; + + my (@menufiles, %desktop_cmds); + for my $dirname (qw(usr/share/menu/ usr/lib/menu/)) { + if (my $dir = $index->resolve_path($dirname)) { + push(@menufiles, $dir->children); + } + } + + # Find the desktop files in the package for verification. + my @desktop_files; + for my $subdir (qw(applications xsessions)) { + if (my $dir = $index->lookup("usr/share/$subdir/")) { + for my $item ($dir->children) { + next + unless $item->is_file; + + next + if $item->is_dir; + + next + unless $item->basename =~ /\.desktop$/; + + $self->pointed_hint('executable-desktop-file', $item->pointer, + $item->octal_permissions) + if $item->is_executable; + + push(@desktop_files, $item) + unless $item->name =~ / template /msx; + } + } + } + + # Verify all the desktop files. + for my $desktop_file (@desktop_files) { + $self->verify_desktop_file($desktop_file, \%desktop_cmds); + } + + # Now all the menu files. + for my $menufile (@menufiles) { + # Do not try to parse executables + next if $menufile->is_executable or not $menufile->is_open_ok; + + # README is a special case + next if $menufile->basename eq 'README' && !$menufile->is_dir; + my $menufile_line =$EMPTY; + + open(my $fd, '<', $menufile->unpacked_path) + or die encode_utf8('Cannot open ' . $menufile->unpacked_path); + + # line below is commented out in favour of the while loop + # do { $_=<IN>; } while defined && (m/^\s* \#/ || m/^\s*$/); + while (my $line = <$fd>) { + if ($line =~ /^\s*\#/ || $line =~ /^\s*$/) { + next; + + } else { + $menufile_line = $line; + last; + } + } + + # Check first line of file to see if it matches the new menu + # file format. + if ($menufile_line =~ m/^!C\s*menu-2/) { + # we can't parse that yet + close($fd); + next; + } + + # Parse entire file as a new format menu file. + my $line=$EMPTY; + my $lc=0; + do { + $lc++; + + # Ignore lines that are comments. + if ($menufile_line =~ m/^\s*\#/) { + next; + } + $line .= $menufile_line; + # Note that I allow whitespace after the continuation character. + # This is caught by verify_line(). + if (!($menufile_line =~ m/\\\s*?$/)) { + $self->verify_line($menufile, $line,$lc,\%desktop_cmds); + $line=$EMPTY; + } + } while ($menufile_line = <$fd>); + $self->verify_line($menufile, $line,$lc,\%desktop_cmds); + + close($fd); + } + + return; +} + +# ----------------------------------- + +# Pass this a line of a menu file, it sanitizes it and +# verifies that it is correct. +sub verify_line { + my ($self, $menufile, $line, $position,$desktop_cmds) = @_; + + my $pointer = $menufile->pointer($position); + my %vals; + + chomp $line; + + # Replace all line continuation characters with whitespace. + # (do not remove them completely, because update-menus doesn't) + $line =~ s/\\\n/ /mg; + + # This is in here to fix a common mistake: whitespace after a '\' + # character. + if ($line =~ s/\\\s+\n/ /mg) { + $self->pointed_hint('whitespace-after-continuation-character', + $pointer); + } + + # Ignore lines that are all whitespace or empty. + return if $line =~ m/^\s*$/; + + # Ignore lines that are comments. + return if $line =~ m/^\s*\#/; + + # Start by testing the package check. + if (not $line =~ m/^\?package\((.*?)\):/) { + $self->pointed_hint('bad-test-in-menu-item', $pointer); + return; + } + my $pkg_test = $1; + my %tested_packages = map { $_ => 1 } split(/\s*,\s*/, $pkg_test); + my $tested_packages = scalar keys %tested_packages; + unless (exists $tested_packages{$self->processable->name}) { + $self->pointed_hint('pkg-not-in-package-test', $pointer, $pkg_test); + } + $line =~ s/^\?package\(.*?\)://; + + # Now collect all the tag=value pairs. I've heavily commented + # the killer regexp that's responsible. + # + # The basic idea here is we start at the beginning of the line. + # Each loop pulls off one tag=value pair and advances to the next + # when we have no more matches, there should be no text left on + # the line - if there is, it's a parse error. + while ( + $line =~ m{ + \s*? # allow whitespace between pairs + ( # capture what follows in $1, it's our tag + [^\"\s=] # a non-quote, non-whitespace, character + * # match as many as we can + ) + = + ( # capture what follows in $2, it's our value + (?: + \" # this is a quoted string + (?: + \\. # any quoted character + | # or + [^\"] # a non-quote character + ) + * # repeat as many times as possible + \" # end of the quoted value string + ) + | # the other possibility is a non-quoted string + (?: + [^\"\s] # a non-quote, non-whitespace character + * # match as many times as we can + ) + ) + }gcx + ) { + my $tag = $1; + my $value = $2; + + if (exists $vals{$tag}) { + $self->pointed_hint('duplicate-tag-in-menu', $pointer, $1); + } + + # If the value was quoted, remove those quotes. + if ($value =~ m/^\"(.*)\"$/) { + $value = $1; + } else { + $self->pointed_hint('unquoted-string-in-menu-item',$pointer, $1); + } + + # If the value has escaped characters, remove the + # escapes. + $value =~ s/\\(.)/$1/g; + + $vals{$tag} = $value; + } + + # This is not really a no-op. Note the use of the /c + # switch - this makes perl keep track of the current + # search position. Notice, we did it above in the loop, + # too. (I have a /g here just so the /c takes affect.) + # We use this below when we look at how far along in the + # string we matched. So the point of this line is to allow + # trailing whitespace on the end of a line. + $line =~ m/\s*/gc; + + # If that loop didn't match up to end of line, we have a + # problem.. + if (pos($line) < length($line)) { + $self->pointed_hint('unparsable-menu-item', $pointer); + # Give up now, before things just blow up in our face. + return; + } + + # Now validate the data in the menu file. + + # Test for important tags. + for my $tag (@req_tags) { + unless (exists($vals{$tag}) && defined($vals{$tag})) { + $self->pointed_hint('menu-item-missing-required-tag', + $pointer, $tag); + # Just give up right away, if such an essential tag is missing, + # chance is high the rest doesn't make sense either. And now all + # following checks can assume those tags to be there + return; + } + } + + # Make sure all tags are known. + for my $tag (keys %vals) { + if (!$known_tags_hash{$tag}) { + $self->pointed_hint('menu-item-contains-unknown-tag', + $pointer, $tag); + } + } + + # Sanitize the section tag + my $section = $vals{'section'}; + $section =~ tr:/:/:s; # eliminate duplicate slashes. # Hallo emacs ;; + $section =~ s{/$}{} # remove trailing slash + unless $section eq $SLASH; # - except if $section is '/' + + # Be sure the command is provided by the package. + my ($okay, $command) + = $self->verify_cmd($pointer, $vals{'command'}); + + $self->pointed_hint('menu-command-not-in-package', $pointer, $command) + if !$okay + && length $command + && $tested_packages < 2 + && $section !~ m{^(?:WindowManagers/Modules|FVWM Modules|Window Maker)}; + + if (length $command) { + $command =~ s{^(?:usr/)?s?bin/}{}; + $command =~ s{^usr/games/}{}; + + $self->pointed_hint('command-in-menu-file-and-desktop-file', + $pointer, $command) + if $desktop_cmds->{$command}; + } + + $self->verify_icon('icon', $vals{'icon'},$MAXIMUM_SIZE_STANDARD_ICON, + $pointer); + $self->verify_icon('icon32x32', $vals{'icon32x32'}, + $MAXIMUM_SIZE_32X32_ICON, $pointer); + $self->verify_icon('icon16x16', $vals{'icon16x16'}, + $MAXIMUM_SIZE_16X16_ICON, $pointer); + + # needs is case insensitive + my $needs = lc($vals{'needs'}); + + if ($section =~ m{^(WindowManagers/Modules|FVWM Modules|Window Maker)}) { + # WM/Modules: needs must not be the regular ones nor wm + $self->pointed_hint('non-wm-module-in-wm-modules-menu-section', + $pointer, $needs) + if $needs_tag_vals_hash{$needs} || $needs eq 'wm'; + + } elsif ($section =~ m{^Window ?Managers}) { + # Other WM sections: needs must be wm + $self->pointed_hint('non-wm-in-windowmanager-menu-section', + $pointer, $needs) + unless $needs eq 'wm'; + + } else { + # Any other section: just only the general ones + if ($needs eq 'dwww') { + $self->pointed_hint('menu-item-needs-dwww', $pointer); + + } elsif (!$needs_tag_vals_hash{$needs}) { + $self->pointed_hint('menu-item-needs-tag-has-unknown-value', + $pointer, $needs); + } + } + + # Check the section tag + # Check for historical changes in the section tree. + if ($section =~ m{^Apps/Games}) { + $self->pointed_hint('menu-item-uses-apps-games-section', $pointer); + $section =~ s{^Apps/}{}; + } + + if ($section =~ m{^Apps/}) { + $self->pointed_hint('menu-item-uses-apps-section', $pointer); + $section =~ s{^Apps/}{Applications/}; + } + + if ($section =~ m{^WindowManagers}) { + $self->pointed_hint('menu-item-uses-windowmanagers-section', $pointer); + $section =~ s{^WindowManagers}{Window Managers}; + } + + # Check for Evil new root sections. + my ($rootsec, $sect) = split(m{/}, $section, 2); + + my $root_data = $self->MENU_SECTIONS->{$rootsec}; + + if (!defined $root_data) { + + my $pkg = $self->processable->name; + $self->pointed_hint('menu-item-creates-new-root-section', + $pointer, $rootsec) + unless $rootsec =~ /$pkg/i; + + } else { + + $self->pointed_hint('menu-item-creates-new-section', + $pointer, $vals{section}) + if (length $sect && !exists $root_data->{$sect}) + || (!length $sect && !exists $root_data->{$EMPTY}); + } + + return; +} + +sub verify_icon { + my ($self, $tag, $name, $size, $pointer)= @_; + + return + unless length $name; + + if ($name eq 'none') { + + $self->pointed_hint('menu-item-uses-icon-none', $pointer, $tag); + return; + } + + $self->pointed_hint('menu-icon-uses-relative-path', $pointer, $tag, $name) + unless $name =~ s{^/+}{}; + + if ($name !~ /\.xpm$/i) { + + $self->pointed_hint('menu-icon-not-in-xpm-format', + $pointer, $tag, $name); + return; + } + + my @packages = ( + $self->processable, + @{ $self->group->direct_dependencies($self->processable) } + ); + + my @candidates; + for my $processable (@packages) { + + push(@candidates, $processable->installed->resolve_path($name)); + push(@candidates, + $processable->installed->resolve_path("usr/share/pixmaps/$name")); + } + + my $iconfile = first_value { defined } @candidates; + + if (!defined $iconfile || !$iconfile->is_open_ok) { + + $self->pointed_hint('menu-icon-missing', $pointer, $tag, $name); + return; + } + + open(my $fd, '<', $iconfile->unpacked_path) + or die encode_utf8('Cannot open ' . $iconfile->unpacked_path); + + my $parse = 'XPM header'; + + my $line; + do { defined($line = <$fd>) or goto PARSE_ERROR; } + until ($line =~ /\/\*\s*XPM\s*\*\//); + + $parse = 'size line'; + + do { defined($line = <$fd>) or goto PARSE_ERROR; } + until ($line =~ /"\s*([0-9]+)\s*([0-9]+)\s*(?:[0-9]+)\s*(?:[0-9]+)\s*"/); + my $width = $1 + 0; + my $height = $2 + 0; + + if ($width > $size || $height > $size) { + $self->pointed_hint('menu-icon-too-big', $pointer, $tag, + "$name: ${width}x${height} > ${size}x${size}"); + } + + close($fd); + + return; + + PARSE_ERROR: + close($fd); + $self->pointed_hint('menu-icon-cannot-be-parsed', $pointer, $tag, + "$name: looking for $parse"); + + return; +} + +# Syntax-checks a .desktop file. +sub verify_desktop_file { + my ($self, $item, $desktop_cmds) = @_; + + my ($saw_first, $warned_cr, %vals, @pending); + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $position = 1; + while (my $line = <$fd>) { + + chomp $line; + + my $pointer = $item->pointer($position); + + next + if $line =~ /^\s*\#/ || $line =~ /^\s*$/; + + if ($line =~ s/\r//) { + $self->pointed_hint('desktop-entry-file-has-crs', $pointer) + unless $warned_cr; + $warned_cr = 1; + } + + # Err on the side of caution for now. If the first non-comment line + # is not the required [Desktop Entry] group, ignore this file. Also + # ignore any keys in other groups. + last + if $saw_first && $line =~ /^\[(.*)\]\s*$/; + + unless ($saw_first) { + return + unless $line =~ /^\[(KDE )?Desktop Entry\]\s*$/; + $saw_first = 1; + $self->pointed_hint('desktop-contains-deprecated-key', $pointer) + if $line =~ /^\[KDE Desktop Entry\]\s*$/; + } + + # Tag = Value. For most errors, just add the error to pending rather + # than warning on it immediately since we want to not warn on tag + # errors if we didn't know the file type. + # + # TODO: We do not check for properly formatted localised values for + # keys but might be worth checking if they are properly formatted (not + # their value) + if ($line =~ /^(.*?)\s*=\s*(.*)$/) { + my ($tag, $value) = ($1, $2); + my $basetag = $tag; + $basetag =~ s/\[([^\]]+)\]$//; + if (exists $vals{$tag}) { + $self->pointed_hint('duplicate-key-in-desktop', $pointer,$tag); + } elsif ($self->DEPRECATED_DESKTOP_KEYS->recognizes($basetag)) { + if ($basetag eq 'Encoding') { + push(@pending, + ['desktop-entry-contains-encoding-key',$pointer, $tag] + ); + } else { + push( + @pending, + [ + 'desktop-entry-contains-deprecated-key', + $pointer, $tag + ] + ); + } + } elsif (not $self->KNOWN_DESKTOP_KEYS->recognizes($basetag) + and not $self->KDE_DESKTOP_KEYS->recognizes($basetag) + and not $basetag =~ /^X-/) { + push(@pending, + ['desktop-entry-contains-unknown-key', $pointer, $tag]); + } + $vals{$tag} = $value; + } + + } continue { + ++$position; + } + + close($fd); + + # Now validate the data in the desktop file, but only if it's a known type. + # Warn if it's not. + my $type = $vals{'Type'}; + return + unless defined $type; + + unless ($known_desktop_types{$type}) { + $self->pointed_hint('desktop-entry-unknown-type', $item->pointer, + $type); + return; + } + + $self->pointed_hint(@{$_}) for @pending; + + # Test for important keys. + for my $tag (@req_desktop_keys) { + unless (defined $vals{$tag}) { + $self->pointed_hint('desktop-entry-missing-required-key', + $item->pointer, $tag); + } + } + + # test if missing Keywords (only if NoDisplay is not set) + if (!defined $vals{NoDisplay}) { + + $self->pointed_hint('desktop-entry-lacks-icon-entry', $item->pointer) + unless defined $vals{Icon}; + + $self->pointed_hint('desktop-entry-lacks-keywords-entry', + $item->pointer) + if !defined $vals{Keywords} && $vals{'Type'} eq 'Application'; + } + + # Only test whether the binary is in the package if the desktop file is + # directly under /usr/share/applications. Too many applications use + # desktop files for other purposes with custom paths. + # + # TODO: Should check quoting and the check special field + # codes in Exec for desktop files. + if ( $item->name =~ m{^usr/share/applications/} + && $vals{'Exec'} + && $vals{'Exec'} =~ /\S/) { + + my ($okay, $command) + = $self->verify_cmd($item->pointer, $vals{'Exec'}); + + $self->pointed_hint('desktop-command-not-in-package', + $item->pointer, $command) + unless $okay + || $command eq 'kcmshell'; + + $command =~ s{^(?:usr/)?s?bin/}{}; + $desktop_cmds->{$command} = 1 + unless $command =~ m/^(?:su-to-root|sux?|(?:gk|kde)su)$/; + } + + # Check the Category tag. + my $in_reserved; + if (defined $vals{'Categories'}) { + + my $saw_main; + + my @categories = split(/;/, $vals{'Categories'}); + for my $category (@categories) { + + next + if $category =~ /^X-/; + + if ($reserved_categories{$category}) { + $self->pointed_hint('desktop-entry-uses-reserved-category', + $item->pointer,$category) + unless $vals{'OnlyShowIn'}; + + $saw_main = 1; + $in_reserved = 1; + + } elsif (!$self->ADD_CATEGORIES->recognizes($category) + && !$main_categories{$category}) { + $self->pointed_hint('desktop-entry-invalid-category', + $item->pointer, $category); + + } elsif ($main_categories{$category}) { + $saw_main = 1; + } + } + + $self->pointed_hint('desktop-entry-lacks-main-category',$item->pointer) + unless $saw_main; + } + + # Check the OnlyShowIn tag. If this is not an application in a reserved + # category, warn about any desktop entry that specifies OnlyShowIn for + # more than one environment. In that case, the application probably + # should be using NotShowIn instead. + if (defined $vals{OnlyShowIn} and not $in_reserved) { + my @envs = split(/;/, $vals{OnlyShowIn}); + if (@envs > 1) { + $self->pointed_hint('desktop-entry-limited-to-environments', + $item->pointer); + } + } + + # Check that the Exec tag specifies how to pass a filename if MimeType + # tags are present. + if ($item->name =~ m{^usr/share/applications/} + && defined $vals{'MimeType'}) { + + $self->pointed_hint('desktop-mime-but-no-exec-code', $item->pointer) + unless defined $vals{'Exec'} + && $vals{'Exec'} =~ /(?:^|[^%])%[fFuU]/; + } + + return; +} + +# Verify whether a command is shipped as part of the package. Takes the full +# path to the file being checked (for error reporting) and the binary. +# Returns a list whose first member is true if the command is present and +# false otherwise, and whose second member is the command (minus any leading +# su-to-root wrapper). Shared between the desktop and menu code. +sub verify_cmd { + my ($self, $pointer, $exec) = @_; + + my $index = $self->processable->installed; + + # This routine handles su wrappers. The option parsing here is ugly and + # dead-simple, but it's hopefully good enough for what will show up in + # desktop files. su-to-root and sux require -c options, kdesu optionally + # allows one, and gksu has the command at the end of its arguments. + my @components = split($SPACE, $exec); + my $cmd; + + $self->pointed_hint('su-to-root-with-usr-sbin', $pointer) + if $components[0] && $components[0] eq '/usr/sbin/su-to-root'; + + if ( $components[0] + && $components[0] =~ m{^(?:/usr/s?bin/)?(su-to-root|gksu|kdesu|sux)$}){ + + my $wrapper = $1; + shift @components; + + while (@components) { + unless ($components[0]) { + shift @components; + next; + } + + if ($components[0] eq '-c') { + $cmd = $components[1]; + last; + + } elsif ( + $components[0] =~ /^-[Dfmupi]|^--(user|description|message)/) { + shift @components; + shift @components; + + } elsif ($components[0] =~ /^-/) { + shift @components; + + } else { + last; + } + } + + if (!$cmd && $wrapper =~ /^(gk|kde)su$/) { + if (@components) { + $cmd = $components[0]; + } else { + $cmd = $wrapper; + undef $wrapper; + } + } + + $self->pointed_hint('su-wrapper-without--c', $pointer, $wrapper) + unless $cmd; + + $self->pointed_hint('su-wrapper-not-su-to-root', $pointer, $wrapper) + if $wrapper + && $wrapper !~ /su-to-root/ + && $wrapper ne $self->processable->name; + + } else { + $cmd = $components[0]; + } + + my $cmd_file = $cmd; + if ($cmd_file) { + $cmd_file =~ s{^/}{}; + } + + my $okay = $cmd + && ( $cmd =~ /^[\'\"]/ + || $index->lookup($cmd_file) + || $cmd =~ m{^(/bin/)?sh} + || $cmd =~ m{^(/usr/bin/)?sensible-(pager|editor|browser)} + || any { $index->lookup($_ . $cmd) } @path); + + return ($okay, $cmd_file); +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |