git.maemo.org Git - maemian/blob - nokia-lintian/checks/menu-format

   1 # menu format -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 1998 by Joey Hess
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, you can find it on the World Wide
  17 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  18 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  19 # MA 02110-1301, USA.
  20
  21 # This script also checks desktop entries, since they share quite a bit of
  22 # code.  At some point, it would make sense to try to refactor this so that
  23 # shared code is in libraries.
  24 #
  25 # Further things that the desktop file validation should be checking:
  26 #
  27 #  - Encoding of the file should be UTF-8.
  28 #  - Additional Categories should be associated with Main Categories.
  29 #  - List entries (MimeType, Categories) should end with a semicolon.
  30 #  - Check for GNOME/GTK/X11/etc. dependencies and require the relevant
  31 #    Additional Category to be present.
  32 #  - Check all the escape characters supported by Exec.
  33 #  - Review desktop-file-validate to see what else we're missing.
  34
  35 package Lintian::menu_format;
  36 use strict;
  37 use Tags;
  38 use Util;
  39 use File::Basename;
  40
  41 # This is a list of all tags that should be in every menu item.
  42 my @req_tags=qw(needs section title command);
  43
  44 # This is a list of all known tags.
  45 my @known_tags=qw(
  46         needs
  47         section
  48         title
  49         sort
  50         command
  51         longtitle
  52         icon
  53         icon16x16
  54         icon32x32
  55         description
  56         hotkey
  57         hints
  58     );
  59
  60 # These 'needs' tags are always valid, no matter the context, and no other
  61 # values are valid outside the Window Managers context (don't include wm here,
  62 # in other words).  It's case insensitive, use lower case here.
  63 my @needs_tag_vals=qw(x11 text vc);
  64
  65 # Authorative source of menu sections:
  66 # http://www.debian.org/doc/packaging-manuals/menu-policy/ch2#s2.1
  67
  68 # This is a list of all valid section on the root menu.
  69 my @root_sections = ('Applications', 'Games', 'Help', 'Screen',
  70                      'Window Managers', 'FVWM Modules', 'Window Maker');
  71
  72 # This is a list of all valid sections a menu item or submenu can go in.
  73 my @sections = ('Applications/Accessibility',
  74                 'Applications/Amateur Radio',
  75                 'Applications/Data Management',
  76                 'Applications/Editors',
  77                 'Applications/Education',
  78                 'Applications/Emulators',
  79                 'Applications/File Management',
  80                 'Applications/Graphics',
  81                 'Applications/Mobile Devices',
  82                 'Applications/Network/Communication',
  83                 'Applications/Network/File Transfer',
  84                 'Applications/Network/Monitoring',
  85                 'Applications/Network/Web Browsing',
  86                 'Applications/Network/Web News',
  87                 'Applications/Office',
  88                 'Applications/Programming',
  89                 'Applications/Project Management',
  90                 'Applications/Science/Astronomy',
  91                 'Applications/Science/Biology',
  92                 'Applications/Science/Chemistry',
  93                 'Applications/Science/Data Analysis',
  94                 'Applications/Science/Electronics',
  95                 'Applications/Science/Engineering',
  96                 'Applications/Science/Geoscience',
  97                 'Applications/Science/Mathematics',
  98                 'Applications/Science/Medicine',
  99                 'Applications/Science/Physics',
 100                 'Applications/Science/Social',
 101                 'Applications/Shells',
 102                 'Applications/Sound',
 103                 'Applications/System/Administration',
 104                 'Applications/System/Hardware',
 105                 'Applications/System/Language Environment',
 106                 'Applications/System/Monitoring',
 107                 'Applications/System/Package Management',
 108                 'Applications/System/Security',
 109                 'Applications/Terminal Emulators',
 110                 'Applications/Text',
 111                 'Applications/TV and Radio',
 112                 'Applications/Video',
 113                 'Applications/Viewers',
 114                 'Applications/Web Development',
 115                 'Games/Action',
 116                 'Games/Adventure',
 117                 'Games/Blocks',
 118                 'Games/Board',
 119                 'Games/Card',
 120                 'Games/Puzzles',
 121                 'Games/Simulation',
 122                 'Games/Strategy',
 123                 'Games/Tools',
 124                 'Games/Toys',
 125                 'Help',
 126                 'Screen/Saving',
 127                 'Screen/Locking',
 128                 'Window Managers',
 129                 'FVWM Modules',
 130                 'Window Maker'
 131                );
 132
 133 # Authorative source of desktop keys:
 134 # http://standards.freedesktop.org/desktop-entry-spec/1.0/
 135 #
 136 # This is a list of all keys that should be in every desktop entry.
 137 my @req_desktop_keys = qw(Type Name);
 138
 139 # This is a list of all known keys.
 140 my %known_desktop_keys = map { $_ => 1 }
 141     qw(
 142        Type
 143        Version
 144        Name
 145        GenericName
 146        NoDisplay
 147        Comment
 148        Icon
 149        Hidden
 150        OnlyShowIn
 151        NotShowIn
 152        TryExec
 153        Exec
 154        Path
 155        Terminal
 156        MimeType
 157        Categories
 158        MimeType
 159        Categories
 160        StartupNotify
 161        StartupWMClass
 162        URL
 163       );
 164
 165 my %deprecated_desktop_keys = map { $_ => 1 }
 166     qw(
 167        Encoding
 168        MiniIcon
 169        TerminalOptions
 170        Protocols
 171        Extensions
 172        BinaryPattern
 173        MapNotify
 174        SwallowTitle
 175        SwallowExec
 176        SortOrder
 177        FilePattern
 178       );
 179
 180 # KDE uses some additional keys that should start with X-KDE but don't for
 181 # historical reasons.  Actions will in theory be in a later version of the
 182 # standard (it's not mentioned in the current standard, but is implemented by
 183 # KDE and widely used).
 184 my %kde_desktop_keys = map { $_ => 1 }
 185     qw(
 186        ServiceTypes
 187        DocPath
 188        Keywords
 189        InitialPreference
 190        Dev
 191        FSType
 192        MountPoint
 193        ReadOnly
 194        UnmountIcon
 195        Actions
 196       );
 197
 198 # Known types of desktop entries.
 199 # http://standards.freedesktop.org/desktop-entry-spec/1.0/ar01s05.html
 200 my %known_desktop_types = map { $_ => 1 }
 201     qw(
 202        Application
 203        Link
 204        Directory
 205       );
 206
 207 # Authorative source of desktop categories:
 208 # http://standards.freedesktop.org/menu-spec/1.0/apa.html
 209
 210 # This is a list of all Main Categories for .desktop files.  Application is
 211 # added as an exception; it's not listed in the standard, but it's widely used
 212 # and used as an example in the GNOME documentation.  GNUstep is added as an
 213 # exception since it's used by GNUstep packages.
 214 my %main_categories = map { $_ => 1 }
 215     qw(
 216        AudioVideo
 217        Audio
 218        Video
 219        Development
 220        Education
 221        Game
 222        Graphics
 223        Network
 224        Office
 225        Settings
 226        System
 227        Utility
 228        Application
 229        GNUstep
 230       );
 231
 232 # This is a list of all Additional Categories for .desktop files.  Ideally we
 233 # should be checking to be sure the associated Main Categories are present,
 234 # but we don't have support for that yet.
 235 my %categories = map { $_ => 1 }
 236     qw(
 237        Building
 238        Debugger
 239        IDE
 240        GUIDesigner
 241        Profiling
 242        RevisionControl
 243        Translation
 244        Calendar
 245        ContactManagement
 246        Database
 247        Dictionary
 248        Chart
 249        Email
 250        Finance
 251        FlowChart
 252        PDA
 253        ProjectManagement
 254        Presentation
 255        Spreadsheet
 256        WordProcessor
 257        2DGraphics
 258        VectorGraphics
 259        RasterGraphics
 260        3DGraphics
 261        Scanning
 262        OCR
 263        Photography
 264        Publishing
 265        Viewer
 266        TextTools
 267        DesktopSettings
 268        HardwareSettings
 269        Printing
 270        PackageManager
 271        Dialup
 272        InstantMessaging
 273        Chat
 274        IRCClient
 275        FileTransfer
 276        HamRadio
 277        News
 278        P2P
 279        RemoteAccess
 280        Telephony
 281        TelephonyTools
 282        VideoConference
 283        WebBrowser
 284        WebDevelopment
 285        Midi
 286        Mixer
 287        Sequencer
 288        Tuner
 289        TV
 290        AudioVideoEditing
 291        Player
 292        Recorder
 293        DiscBurning
 294        ActionGame
 295        AdventureGame
 296        ArcadeGame
 297        BoardGame
 298        BlocksGame
 299        CardGame
 300        KidsGame
 301        LogicGame
 302        RolePlaying
 303        Simulation
 304        SportsGame
 305        StrategyGame
 306        Art
 307        Construction
 308        Music
 309        Languages
 310        Science
 311        ArtificialIntelligence
 312        Astronomy
 313        Biology
 314        Chemistry
 315        ComputerScience
 316        DataVisualization
 317        Economy
 318        Electricity
 319        Geography
 320        Geology
 321        Geoscience
 322        History
 323        ImageProcessing
 324        Literature
 325        Math
 326        NumericalAnalysis
 327        MedicalSoftware
 328        Physics
 329        Robotics
 330        Sports
 331        ParallelComputing
 332        Amusement
 333        Archiving
 334        Compression
 335        Electronics
 336        Emulator
 337        Engineering
 338        FileTools
 339        FileManager
 340        TerminalEmulator
 341        Filesystem
 342        Monitor
 343        Security
 344        Accessibility
 345        Calculator
 346        Clock
 347        TextEditor
 348        Documentation
 349        Core
 350        KDE
 351        GNOME
 352        GTK
 353        Qt
 354        Motif
 355        Java
 356        ConsoleOnly
 357       );
 358
 359 # This is a list of Reserved Categories for .desktop files.  To use one of
 360 # these, the desktop entry must also have an OnlyShowIn key limiting the
 361 # environment to one that supports this category.
 362 my %reserved_categories = map { $_ => 1 }
 363     qw(
 364        Screensaver
 365        TrayIcon
 366        Applet
 367        Shell
 368       );
 369
 370 # Path in which to search for binaries referenced in menu entries.
 371 my @path = qw(/usr/local/bin/ /usr/bin/ /bin/ /usr/X11R6/bin/ /usr/games/);
 372
 373 my %known_tags_hash = map { $_ => 1 } @known_tags;
 374 my %needs_tag_vals_hash = map { $_ => 1 } @needs_tag_vals;
 375 my %root_sections_hash = map { $_ => 1 } @root_sections;
 376 my %sections_hash = map { $_ => 1 } @sections;
 377
 378 # Holds a hash of all files in the package, used for checking for executables.
 379 my %file_index;
 380
 381 # -----------------------------------
 382
 383 sub run {
 384
 385 my $pkg = shift;
 386 my $type = shift;
 387
 388 my @menufiles;
 389 opendir (MENUDIR, "menu/lib") or fail("cannot read menu/lib file directory.");
 390 push @menufiles, map { "menu/lib/$_" } readdir(MENUDIR);
 391 closedir MENUDIR;
 392 opendir (MENUDIR, "menu/share") or fail("cannot read menu/share file directory.");
 393 push @menufiles, map { "menu/share/$_" } readdir(MENUDIR);
 394 closedir MENUDIR;
 395
 396 # Find the desktop files in the package for verification and also build a hash
 397 # of every file in the package to use to verify that the command referenced by
 398 # a menu item or desktop entry is there.
 399 my @desktop_files;
 400 open(IN, '<', "index") or fail("cannot open index file index: $!");
 401 while (<IN>) {
 402     chomp;
 403     my ($perm, $owner, $size, $date, $time, $file) = split(' ', $_, 6);
 404     $file =~ s,^\./,/,;
 405     $file =~ s/ link to .*//;
 406     $file =~ s/ -> .*//;
 407     my $operm = perm2oct($perm);
 408     $file_index{$file} = 1;
 409
 410     if ($perm =~ m,^-, && $file =~ m,/usr/share/applications/.*\.desktop$,) {
 411         if ($perm =~ m,x,o) {
 412             tag "executable-desktop-file", sprintf("$file %04o",$operm);
 413         }
 414         unless (m,template,) {
 415             push (@desktop_files, $file);
 416         }
 417     }
 418 }
 419 close IN;
 420
 421 # Verify all the desktop files.
 422 for my $desktop_file (@desktop_files) {
 423     VerifyDesktopFile ($desktop_file, $desktop_file, $pkg);
 424 }
 425
 426 # Now all the menu files.
 427 foreach my $menufile (@menufiles) {
 428     next if -x $menufile; # don't try to parse executables
 429
 430     my $basename = basename $menufile;
 431     my $fullname = "/usr/share/menu/$basename";
 432     $fullname = "/usr/lib/menu/$basename" if $menufile =~ m,^menu/lib/,o;
 433
 434     next if $basename eq "README"; # README is a special case
 435
 436     my $menufile_line ="";
 437     open (IN, '<', $menufile) or
 438         fail("cannot open menu file $menufile for reading.");
 439     # line below is commented out in favour of the while loop
 440     # do { $_=<IN>; } while defined && (m/^\s* \#/ || m/^\s*$/);
 441     while (<IN>) {
 442         if (m/^\s*\#/ || m/^\s*$/) {
 443             next;
 444         } else {
 445             $menufile_line = $_;
 446             last;
 447         }
 448     }
 449
 450     # Check first line of file to see if it matches the old menu file format.
 451     if ($menufile_line =~ m/^(?!\?package\(.*\)).* .* .* .* "?.*"? .*$/o) {
 452         tag "old-format-menu-file", $fullname;
 453         close IN;
 454         next;
 455     } elsif ($menufile_line =~ m/^!C\s*menu-2/o) {
 456         # we can't parse that yet
 457         close IN;
 458         next;
 459     }
 460
 461     # Parse entire file as a new format menu file.
 462     my $line="";
 463     my $lc=0;
 464     do {
 465         $lc++;
 466
 467         # Ignore lines that are comments.
 468         if ($menufile_line =~ m/^\s*\#/o) {
 469             next;
 470         }
 471         $line .= $menufile_line;
 472         # Note that I allow whitespace after the continuation character.
 473         # This is caught by VerifyLine().
 474         if (! ($menufile_line =~ m/\\\s*?$/)) {
 475             VerifyLine($pkg,$type,$menufile,$fullname,$line,$lc);
 476             $line="";
 477         }
 478     } while ($menufile_line = <IN>);
 479     VerifyLine($pkg,$type,$menufile,$fullname,$line,$lc);
 480
 481     close IN;
 482 }
 483
 484 }
 485
 486 # -----------------------------------
 487
 488 # Pass this a line of a menu file, it sanitizes it and
 489 # verifies that it is correct.
 490 sub VerifyLine {
 491     my ( $pkg, $type, $menufile, $fullname, $line, $linecount ) = @_;
 492
 493     my %vals;
 494
 495     chomp $line;
 496
 497     # Replace all line continuation characters with whitespace.
 498     # (do not remove them completely, because update-menus doesn't)
 499     $line =~ s/\\\n/ /mgo;
 500
 501     # This is in here to fix a common mistake: whitespace after a '\'
 502     # character.
 503     if ($line =~ s/\\\s+\n/ /mgo) {
 504         tag "whitespace-after-continuation-character", "$fullname:$linecount";
 505     }
 506
 507     # Ignore lines that are all whitespace or empty.
 508     return if $line =~ m/^\s+$/o or ! $line;
 509
 510     # Ignore lines that are comments.
 511     return if $line =~ m/^\s*\#/o;
 512
 513     # Start by testing the package check.
 514     if (not $line =~ m/^\?package\((.*?)\):/o) {
 515         tag "bad-test-in-menu-item", "$fullname:$linecount";
 516         return;
 517     }
 518     my $pkg_test = $1;
 519     my %tested_packages = map { $_ => 1 } split( /\s*,\s*/, $pkg_test);
 520     my $tested_packages = scalar keys %tested_packages;
 521     unless (exists $tested_packages{$pkg}) {
 522         tag "pkg-not-in-package-test", "$pkg_test $fullname";
 523     }
 524     $line =~ s/^\?package\(.*?\)://;
 525
 526     # Now collect all the tag=value pairs. I've heavily commented
 527     # the killer regexp that's responsible.
 528     #
 529     # The basic idea here is we start at the beginning of the line.
 530     # Each loop pulls off one tag=value pair and advances to the next
 531     # when we have no more matches, there should be no text left on
 532     # the line - if there is, it's a parse error.
 533     while ($line =~ m/
 534            \s*?                 # allow whitespace between pairs
 535            (                    # capture what follows in $1, it's our tag
 536             [^\"\s=]            # a non-quote, non-whitespace, character
 537             *                   # match as many as we can
 538            )
 539            =
 540            (                    # capture what follows in $2, it's our value
 541             (?:
 542              \"                 # this is a quoted string
 543              (?:
 544               \\.               # any quoted character
 545               |                 # or
 546               [^\"]             # a non-quote character
 547              )
 548              *                  # repeat as many times as possible
 549              \"                 # end of the quoted value string
 550             )
 551             |                   # the other possibility is a non-quoted string
 552             (?:
 553              [^\"\s]            # a non-quote, non-whitespace character
 554              *                  # match as many times as we can
 555             )
 556            )
 557            /ogcx) {
 558         my $tag = $1;
 559         my $value = $2;
 560
 561         if (exists $vals{$tag}) {
 562             tag "duplicated-tag-in-menu-item", "$fullname $1:$linecount";
 563         }
 564
 565         # If the value was quoted, remove those quotes.
 566         if ($value =~ m/^\"(.*)\"$/) {
 567             $value = $1;
 568         } else {
 569             tag "unquoted-string-in-menu-item", "$fullname $1:$linecount";
 570         }
 571
 572         # If the value has escaped characters, remove the
 573         # escapes.
 574         $value =~ s/\\(.)/$1/g;
 575
 576         $vals{$tag} = $value;
 577     }
 578
 579     # This is not really a no-op. Note the use of the /c
 580     # switch - this makes perl keep track of the current
 581     # search position. Notice, we did it above in the loop,
 582     # too. (I have a /g here just so the /c takes affect.)
 583     # We use this below when we look at how far along in the
 584     # string we matched. So the point of this line is to allow
 585     # trailing whitespace on the end of a line.
 586     $line =~ m/\s*/ogc;
 587
 588     # If that loop didn't match up to end of line, we have a
 589     # problem..
 590     if (pos($line) < length($line)) {
 591         tag "unparsable-menu-item", "$fullname:$linecount";
 592         # Give up now, before things just blow up in our face.
 593         return;
 594     }
 595
 596     # Now validate the data in the menu file.
 597
 598     # Test for important tags.
 599     foreach my $tag (@req_tags) {
 600         unless ( exists($vals{$tag}) && defined($vals{$tag}) ) {
 601             tag "menu-item-missing-required-tag", "$tag $fullname:$linecount";
 602             # Just give up right away, if such an essential tag is missing,
 603             # chance is high the rest doesn't make sense either. And now all
 604             # following checks can assume those tags to be there
 605             return;
 606         }
 607     }
 608
 609     # Make sure all tags are known.
 610     foreach my $tag (keys %vals) {
 611         if (! $known_tags_hash{$tag}) {
 612             tag "menu-item-contains-unknown-tag", "$tag $fullname:$linecount";
 613         }
 614     }
 615
 616     # Sanitize the section tag
 617     my $section = $vals{'section'};
 618     $section =~ tr:/:/:s;       # eliminate duplicate slashes.
 619     $section =~ s:/$::;         # remove trailing slash.
 620
 621     # Be sure the command is provided by the package.
 622     my ($okay, $command) = VerifyCmd ($fullname, $linecount, $vals{'command'}, $pkg);
 623     tag "menu-command-not-in-package", "$fullname:$linecount $command"
 624         unless ($okay
 625                 or not $command
 626                 or ($tested_packages >= 2)
 627                 or ($section =~ m:^(WindowManagers/Modules|FVWM Modules|Window Maker):));
 628
 629     if (exists($vals{'icon'})) {
 630         VerifyIcon($menufile, $fullname, $linecount, $vals{'icon'}, 32);
 631     }
 632     if (exists($vals{'icon32x32'})) {
 633         VerifyIcon($menufile, $fullname, $linecount, $vals{'icon32x32'}, 32);
 634     }
 635     if (exists($vals{'icon16x16'})) {
 636         VerifyIcon($menufile, $fullname, $linecount, $vals{'icon16x16'}, 16);
 637     }
 638
 639     # Check the needs tag.
 640     my $needs = lc($vals{'needs'}); # needs is case insensitive.
 641
 642     if ($section =~ m:^(WindowManagers/Modules|FVWM Modules|Window Maker):) {
 643         # WM/Modules: needs must not be the regular ones nor wm
 644         if ($needs_tag_vals_hash{$needs} or $needs eq "wm") {
 645             tag "non-wm-module-in-wm-modules-menu-section", "$needs $fullname:$linecount";
 646         }
 647     } elsif ($section =~ m:^Window ?Managers:) {
 648         # Other WM sections: needs must be wm
 649         if ($needs ne 'wm') {
 650             tag "non-wm-in-windowmanager-menu-section", "$needs $fullname:$linecount";
 651         }
 652     } else {
 653         # Any other section: just only the general ones
 654         if ($needs eq "dwww") {
 655             tag "menu-item-needs-dwww", "$fullname:$linecount";
 656         } elsif (not $needs_tag_vals_hash{$needs}) {
 657             tag "menu-item-needs-tag-has-unknown-value", "$needs $fullname:$linecount";
 658         }
 659     }
 660
 661     # Check the section tag
 662     # Check for historical changes in the section tree.
 663     if ($section =~ m:^Apps/Games:) {
 664         tag "menu-item-uses-apps-games-section", "$fullname:$linecount";
 665         $section =~ s:^Apps/::;
 666     }
 667     if ($section =~ m:^Apps/:) {
 668         tag "menu-item-uses-apps-section", "$fullname:$linecount";
 669         $section =~ s:^Apps/:Applications/:;
 670     }
 671     if ($section =~ m:^WindowManagers:) {
 672         tag "menu-item-uses-windowmanagers-section", "$fullname:$linecount";
 673         $section =~ s:^WindowManagers:Window Managers:;
 674     }
 675
 676     # Check for Evil new root sections.
 677     my ($rootsection) = $section =~ m:([^/]*):;
 678     if (not $root_sections_hash{$rootsection}) {
 679         if (not $rootsection =~ m/$pkg/i) {
 680             tag "menu-item-creates-new-root-section", "$rootsection $fullname:$linecount";
 681         }
 682     } else {
 683         if (not $sections_hash{$section}) {
 684             tag "menu-item-creates-new-section", "$vals{section} $fullname:$linecount";
 685         }
 686     }
 687 }
 688
 689
 690 sub VerifyIcon {
 691     my ($menufile, $fullname, $linecount, $icon, $size) = @_;
 692     local *IN;
 693
 694     if ($icon eq 'none') {
 695         tag "menu-item-uses-icon-none", "$fullname:$linecount";
 696         return;
 697     }
 698
 699     if (not ($icon =~ m/\.xpm$/i)) {
 700         tag "menu-icon-not-in-xpm-format", "$icon";
 701         return;
 702     }
 703
 704     # Try the explicit location, and if that fails, try the standard path.
 705     my $iconfile = "unpacked/$icon";
 706     if (! -f $iconfile) {
 707         $iconfile = "unpacked/usr/share/pixmaps/$icon";
 708     }
 709
 710     if (! open (IN, '<', $iconfile)) {
 711         tag "menu-icon-missing", "$icon";
 712         return;
 713     }
 714
 715     my $parse = "XPM header";
 716     my $line;
 717     do { defined ($line = <IN>) or goto parse_error; }
 718     until ($line =~ /\/\*\s*XPM\s*\*\//);
 719
 720     $parse = "size line";
 721     do { defined ($line = <IN>) or goto parse_error; }
 722     until ($line =~ /"\s*([0-9]+)\s*([0-9]+)\s*([0-9]+)\s*([0-9]+)\s*"/);
 723     my $width = $1 + 0;
 724     my $height = $2 + 0;
 725     my $numcolours = $3 + 0;
 726     my $cpp = $4 + 0;
 727
 728     if ($width > $size || $height > $size) {
 729         tag "menu-icon-too-big", "$icon: ${width}x${height} > ${size}x${size}";
 730     }
 731
 732     close IN or die;
 733     return;
 734
 735 parse_error:
 736     close IN or die;
 737     tag "menu-icon-cannot-be-parsed", "$icon: looking for $parse";
 738     return;
 739 }
 740
 741
 742 # Syntax-checks a .desktop file.
 743 sub VerifyDesktopFile {
 744     my ($desktopfile, $file, $pkg) = @_;
 745     my %vals;
 746     open (DESKTOP, '<', "unpacked/$file")
 747         or fail("cannot open desktop file $file: $!");
 748     my ($line, $saw_first, $warned_cr);
 749     my @pending;
 750     while (defined ($line = <DESKTOP>)) {
 751         chomp $line;
 752         next if ($line =~ m/^\s*\#/ or $line =~ m/^\s*$/);
 753         if ($line =~ s/\r//) {
 754             tag 'desktop-entry-file-has-crs', "$file:$." unless $warned_cr;
 755             $warned_cr = 1;
 756         }
 757
 758         # Err on the side of caution for now.  If the first non-comment line
 759         # is not the required [Desktop Entry] group, ignore this file.  Also
 760         # ignore any keys in other groups.
 761         last if ($saw_first and $line =~ /^\[(.*)\]\s*$/);
 762         unless ($saw_first) {
 763             return unless $line =~ /^\[Desktop Entry\]\s*$/;
 764             $saw_first = 1;
 765         }
 766
 767         # Tag = Value.  For most errors, just add the error to pending rather
 768         # than warning on it immediately since we want to not warn on tag
 769         # errors if we didn't know the file type.
 770         #
 771         # TODO: We do not check for properly formatted localised values for
 772         # keys but might be worth checking if they are properly formatted (not
 773         # their value)
 774         if ($line =~ /^(.*?)\s*=\s*(.*)$/) {
 775             my ($tag, $value) = ($1, $2);
 776             my $basetag = $tag;
 777             my ($encoding) = ($basetag =~ s/\[([^\]]+)\]$//);
 778             if (exists $vals{$tag}) {
 779                 tag "duplicated-key-in-desktop-entry", "$file:$. $tag";
 780             } elsif ($deprecated_desktop_keys{$basetag}) {
 781                 if ($basetag eq 'Encoding') {
 782                     push (@pending, [ "desktop-entry-contains-encoding-key", "$file:$. $tag" ]);
 783                 } else {
 784                     push (@pending, [ "desktop-entry-contains-deprecated-key", "$file:$. $tag" ]);
 785                 }
 786             } elsif (    not $known_desktop_keys{$basetag}
 787                      and not $kde_desktop_keys{$basetag}
 788                      and not $basetag =~ /^X-/) {
 789                 push (@pending, [ "desktop-entry-contains-unknown-key", "$file:$. $tag" ]);
 790             }
 791             $vals{$tag} = $value;
 792         }
 793     }
 794     close DESKTOP;
 795
 796     # Now validate the data in the desktop file, but only if it's a known type.
 797     return unless ($vals{'Type'} and $known_desktop_types{$vals{'Type'}});
 798
 799     # Now we can issue any pending tags.
 800     for my $pending (@pending) {
 801         tag @$pending;
 802     }
 803
 804     # Test for important keys.
 805     for my $tag (@req_desktop_keys) {
 806         unless (defined $vals{$tag}) {
 807             tag "desktop-entry-missing-required-key", "$file $tag";
 808         }
 809     }
 810
 811     # Only test whether the binary is in the package if the desktop file is
 812     # directly under /usr/share/applications.  Too many applications use
 813     # desktop files for other purposes with custom paths.
 814     #
 815     # TODO:  Should check quoting and the check special field
 816     # codes in Exec for desktop files.
 817     if ($file =~ m,^/usr/share/applications/, and $vals{'Exec'} and $vals{'Exec'} =~ /\S/) {
 818         my ($okay, $command) = VerifyCmd ($file, undef, $vals{'Exec'}, $pkg);
 819         tag "desktop-command-not-in-package", "$file $command"
 820             unless $okay or $command eq 'kcmshell';
 821     }
 822
 823     # Check the Category tag.
 824     if (defined $vals{'Categories'}) {
 825         my @cats = split (';', $vals{'Categories'});
 826         my $saw_main;
 827         for my $cat (@cats) {
 828             next if $cat =~ /^X-/;
 829             if ($reserved_categories{$cat}) {
 830                 tag "desktop-entry-uses-reserved-category", "$cat $file"
 831                     unless $vals{'OnlyShowIn'};
 832                 $saw_main = 1;
 833             } elsif (not $categories{$cat} and not $main_categories{$cat}) {
 834                 tag "desktop-entry-invalid-category", "$cat $file";
 835             } elsif ($main_categories{$cat}) {
 836                 $saw_main = 1;
 837             }
 838         }
 839         unless ($saw_main) {
 840             tag "desktop-entry-lacks-main-category", "$file";
 841         }
 842     }
 843 }
 844
 845 # Verify whether a command is shipped as part of the package.  Takes the full
 846 # path to the file being checked (for error reporting) and the binary.
 847 # Returns a list whose first member is true if the command is present and
 848 # false otherwise, and whose second member is the command (minus any leading
 849 # su-to-root wrapper).  Shared between the desktop and menu code.
 850 sub VerifyCmd {
 851     my ($file, $line, $exec, $pkg) = @_;
 852     my $location = ($line ? "$file:$line" : $file);
 853
 854     # This routine handles su wrappers.  The option parsing here is ugly and
 855     # dead-simple, but it's hopefully good enough for what will show up in
 856     # desktop files.  su-to-root and sux require -c options, kdesu optionally
 857     # allows one, and gksu has the command at the end of its arguments.
 858     my @com = split (' ', $exec);
 859     my $cmd;
 860     if ($com[0] and $com[0] eq "/usr/sbin/su-to-root") {
 861         tag 'su-to-root-with-usr-sbin', $location;
 862     }
 863     if ($com[0] and $com[0] =~ m,^(?:/usr/s?bin/)?(su-to-root|gksu|kdesu|sux)$,) {
 864         my $wrapper = $1;
 865         shift @com;
 866         while (@com) {
 867             unless ($com[0]) {
 868                 shift @com;
 869                 next;
 870             }
 871             if ($com[0] eq '-c') {
 872                 $cmd = $com[1];
 873                 last;
 874             } elsif ($com[0] =~ /^-[Dfmupi]|^--(user|description|message)/) {
 875                 shift @com;
 876                 shift @com;
 877             } elsif ($com[0] =~ /^-/) {
 878                 shift @com;
 879             } else {
 880                 last;
 881             }
 882         }
 883         if (!$cmd && $wrapper =~ /^(gk|kde)su$/) {
 884             if (@com) {
 885                 $cmd = $com[0];
 886             } else {
 887                 $cmd = $wrapper;
 888                 undef $wrapper;
 889             }
 890         }
 891         tag 'su-wrapper-without--c', "$location $wrapper" unless $cmd;
 892         if ($wrapper && $wrapper !~ /su-to-root/ && $wrapper ne $pkg) {
 893             tag 'su-wrapper-not-su-to-root', "$location $wrapper";
 894         }
 895     } else {
 896         $cmd = $com[0];
 897     }
 898     my $okay = $cmd && ($cmd =~ /^[\'\"]/ || $file_index{$cmd} || grep { $file_index{$_ . $cmd} } @path);
 899     return ($okay, $cmd);
 900 }
 901
 902 1;
 903
 904 # Local Variables:
 905 # indent-tabs-mode: t
 906 # cperl-indent-level: 4
 907 # End:
 908 # vim: syntax=perl ts=8 sw=4