summaryrefslogtreecommitdiffstats
path: root/lib/Lintian/Check/MenuFormat.pm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/Lintian/Check/MenuFormat.pm907
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 07:50:13 +0000