vcs.maemo.org Git - maemian/blob - 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 Maemian::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.  These must
 371 # not have leading slashes.
 372 my @path = qw(usr/local/bin/ usr/bin/ bin/ usr/X11R6/bin/ usr/games/);
 373
 374 my %known_tags_hash = map { $_ => 1 } @known_tags;
 375 my %needs_tag_vals_hash = map { $_ => 1 } @needs_tag_vals;
 376 my %root_sections_hash = map { $_ => 1 } @root_sections;
 377 my %sections_hash = map { $_ => 1 } @sections;
 378
 379 # -----------------------------------
 380
 381 sub run {
 382
 383 my $pkg = shift;
 384 my $type = shift;
 385 my $info = shift;
 386
 387 my @menufiles;
 388 opendir (MENUDIR, "menu/lib") or fail("cannot read menu/lib file directory.");
 389 push @menufiles, map { "menu/lib/$_" } readdir(MENUDIR);
 390 closedir MENUDIR;
 391 opendir (MENUDIR, "menu/share") or fail("cannot read menu/share file directory.");
 392 push @menufiles, map { "menu/share/$_" } readdir(MENUDIR);
 393 closedir MENUDIR;
 394
 395 # Find the desktop files in the package for verification.
 396 my @desktop_files;
 397 foreach my $file (sort keys %{$info->index}) {
 398     my $index_info = $info->index->{$file};
 399     my $operm = $index_info->{operm};
 400
 401     tag 'deprecated-kdelnk-file', "/$file" if ($file =~ m,\.kdelnk$,);
 402
 403     if ($index_info->{type} =~ m/[-h]/ &&
 404         $file =~ m,usr/share/applications/.*\.desktop$,) {
 405
 406         if ($operm & 0100 or $operm & 010 or $operm & 01) {
 407            tag "executable-desktop-file", sprintf("/$file %04o",$operm);
 408         }
 409         unless ($file =~ m,template,) {
 410             push (@desktop_files, $file);
 411         }
 412     }
 413 }
 414
 415 # Verify all the desktop files.
 416 for my $desktop_file (@desktop_files) {
 417     VerifyDesktopFile($desktop_file, $desktop_file, $pkg, $info);
 418 }
 419
 420 # Now all the menu files.
 421 foreach my $menufile (@menufiles) {
 422     next if -x $menufile; # don't try to parse executables
 423
 424     my $basename = basename $menufile;
 425     my $fullname = "/usr/share/menu/$basename";
 426     $fullname = "/usr/lib/menu/$basename" if $menufile =~ m,^menu/lib/,o;
 427
 428     next if $basename eq "README"; # README is a special case
 429
 430     my $menufile_line ="";
 431     open (IN, '<', $menufile) or
 432         fail("cannot open menu file $menufile for reading.");
 433     # line below is commented out in favour of the while loop
 434     # do { $_=<IN>; } while defined && (m/^\s* \#/ || m/^\s*$/);
 435     while (<IN>) {
 436         if (m/^\s*\#/ || m/^\s*$/) {
 437             next;
 438         } else {
 439             $menufile_line = $_;
 440             last;
 441         }
 442     }
 443
 444     # Check first line of file to see if it matches the old menu file format.
 445     if ($menufile_line =~ m/^(?!\?package\(.*\)).* .* .* .* "?.*"? .*$/o) {
 446         tag "old-format-menu-file", $fullname;
 447         close IN;
 448         next;
 449     } elsif ($menufile_line =~ m/^!C\s*menu-2/o) {
 450         # we can't parse that yet
 451         close IN;
 452         next;
 453     }
 454
 455     # Parse entire file as a new format menu file.
 456     my $line="";
 457     my $lc=0;
 458     do {
 459         $lc++;
 460
 461         # Ignore lines that are comments.
 462         if ($menufile_line =~ m/^\s*\#/o) {
 463             next;
 464         }
 465         $line .= $menufile_line;
 466         # Note that I allow whitespace after the continuation character.
 467         # This is caught by VerifyLine().
 468         if (! ($menufile_line =~ m/\\\s*?$/)) {
 469             VerifyLine($pkg, $info, $type, $menufile, $fullname, $line, $lc);
 470             $line="";
 471         }
 472     } while ($menufile_line = <IN>);
 473     VerifyLine($pkg, $info, $type, $menufile, $fullname, $line, $lc);
 474
 475     close IN;
 476 }
 477
 478 }
 479
 480 # -----------------------------------
 481
 482 # Pass this a line of a menu file, it sanitizes it and
 483 # verifies that it is correct.
 484 sub VerifyLine {
 485     my ($pkg, $info, $type, $menufile, $fullname, $line, $linecount) = @_;
 486
 487     my %vals;
 488
 489     chomp $line;
 490
 491     # Replace all line continuation characters with whitespace.
 492     # (do not remove them completely, because update-menus doesn't)
 493     $line =~ s/\\\n/ /mgo;
 494
 495     # This is in here to fix a common mistake: whitespace after a '\'
 496     # character.
 497     if ($line =~ s/\\\s+\n/ /mgo) {
 498         tag "whitespace-after-continuation-character", "$fullname:$linecount";
 499     }
 500
 501     # Ignore lines that are all whitespace or empty.
 502     return if $line =~ m/^\s+$/o or ! $line;
 503
 504     # Ignore lines that are comments.
 505     return if $line =~ m/^\s*\#/o;
 506
 507     # Start by testing the package check.
 508     if (not $line =~ m/^\?package\((.*?)\):/o) {
 509         tag "bad-test-in-menu-item", "$fullname:$linecount";
 510         return;
 511     }
 512     my $pkg_test = $1;
 513     my %tested_packages = map { $_ => 1 } split( /\s*,\s*/, $pkg_test);
 514     my $tested_packages = scalar keys %tested_packages;
 515     unless (exists $tested_packages{$pkg}) {
 516         tag "pkg-not-in-package-test", "$pkg_test $fullname";
 517     }
 518     $line =~ s/^\?package\(.*?\)://;
 519
 520     # Now collect all the tag=value pairs. I've heavily commented
 521     # the killer regexp that's responsible.
 522     #
 523     # The basic idea here is we start at the beginning of the line.
 524     # Each loop pulls off one tag=value pair and advances to the next
 525     # when we have no more matches, there should be no text left on
 526     # the line - if there is, it's a parse error.
 527     while ($line =~ m/
 528            \s*?                 # allow whitespace between pairs
 529            (                    # capture what follows in $1, it's our tag
 530             [^\"\s=]            # a non-quote, non-whitespace, character
 531             *                   # match as many as we can
 532            )
 533            =
 534            (                    # capture what follows in $2, it's our value
 535             (?:
 536              \"                 # this is a quoted string
 537              (?:
 538               \\.               # any quoted character
 539               |                 # or
 540               [^\"]             # a non-quote character
 541              )
 542              *                  # repeat as many times as possible
 543              \"                 # end of the quoted value string
 544             )
 545             |                   # the other possibility is a non-quoted string
 546             (?:
 547              [^\"\s]            # a non-quote, non-whitespace character
 548              *                  # match as many times as we can
 549             )
 550            )
 551            /ogcx) {
 552         my $tag = $1;
 553         my $value = $2;
 554
 555         if (exists $vals{$tag}) {
 556             tag "duplicated-tag-in-menu-item", "$fullname $1:$linecount";
 557         }
 558
 559         # If the value was quoted, remove those quotes.
 560         if ($value =~ m/^\"(.*)\"$/) {
 561             $value = $1;
 562         } else {
 563             tag "unquoted-string-in-menu-item", "$fullname $1:$linecount";
 564         }
 565
 566         # If the value has escaped characters, remove the
 567         # escapes.
 568         $value =~ s/\\(.)/$1/g;
 569
 570         $vals{$tag} = $value;
 571     }
 572
 573     # This is not really a no-op. Note the use of the /c
 574     # switch - this makes perl keep track of the current
 575     # search position. Notice, we did it above in the loop,
 576     # too. (I have a /g here just so the /c takes affect.)
 577     # We use this below when we look at how far along in the
 578     # string we matched. So the point of this line is to allow
 579     # trailing whitespace on the end of a line.
 580     $line =~ m/\s*/ogc;
 581
 582     # If that loop didn't match up to end of line, we have a
 583     # problem..
 584     if (pos($line) < length($line)) {
 585         tag "unparsable-menu-item", "$fullname:$linecount";
 586         # Give up now, before things just blow up in our face.
 587         return;
 588     }
 589
 590     # Now validate the data in the menu file.
 591
 592     # Test for important tags.
 593     foreach my $tag (@req_tags) {
 594         unless ( exists($vals{$tag}) && defined($vals{$tag}) ) {
 595             tag "menu-item-missing-required-tag", "$tag $fullname:$linecount";
 596             # Just give up right away, if such an essential tag is missing,
 597             # chance is high the rest doesn't make sense either. And now all
 598             # following checks can assume those tags to be there
 599             return;
 600         }
 601     }
 602
 603     # Make sure all tags are known.
 604     foreach my $tag (keys %vals) {
 605         if (! $known_tags_hash{$tag}) {
 606             tag "menu-item-contains-unknown-tag", "$tag $fullname:$linecount";
 607         }
 608     }
 609
 610     # Sanitize the section tag
 611     my $section = $vals{'section'};
 612     $section =~ tr:/:/:s;       # eliminate duplicate slashes.
 613     $section =~ s:/$::;         # remove trailing slash.
 614
 615     # Be sure the command is provided by the package.
 616     my ($okay, $command) = VerifyCmd ($fullname, $linecount, $vals{'command'},
 617                                       $pkg, $info);
 618     tag "menu-command-not-in-package", "$fullname:$linecount $command"
 619         unless ($okay
 620                 or not $command
 621                 or ($tested_packages >= 2)
 622                 or ($section =~ m:^(WindowManagers/Modules|FVWM Modules|Window Maker):));
 623
 624     if (exists($vals{'icon'})) {
 625         VerifyIcon($menufile, $fullname, $linecount, $vals{'icon'}, 32);
 626     }
 627     if (exists($vals{'icon32x32'})) {
 628         VerifyIcon($menufile, $fullname, $linecount, $vals{'icon32x32'}, 32);
 629     }
 630     if (exists($vals{'icon16x16'})) {
 631         VerifyIcon($menufile, $fullname, $linecount, $vals{'icon16x16'}, 16);
 632     }
 633
 634     # Check the needs tag.
 635     my $needs = lc($vals{'needs'}); # needs is case insensitive.
 636
 637     if ($section =~ m:^(WindowManagers/Modules|FVWM Modules|Window Maker):) {
 638         # WM/Modules: needs must not be the regular ones nor wm
 639         if ($needs_tag_vals_hash{$needs} or $needs eq "wm") {
 640             tag "non-wm-module-in-wm-modules-menu-section", "$needs $fullname:$linecount";
 641         }
 642     } elsif ($section =~ m:^Window ?Managers:) {
 643         # Other WM sections: needs must be wm
 644         if ($needs ne 'wm') {
 645             tag "non-wm-in-windowmanager-menu-section", "$needs $fullname:$linecount";
 646         }
 647     } else {
 648         # Any other section: just only the general ones
 649         if ($needs eq "dwww") {
 650             tag "menu-item-needs-dwww", "$fullname:$linecount";
 651         } elsif (not $needs_tag_vals_hash{$needs}) {
 652             tag "menu-item-needs-tag-has-unknown-value", "$needs $fullname:$linecount";
 653         }
 654     }
 655
 656     # Check the section tag
 657     # Check for historical changes in the section tree.
 658     if ($section =~ m:^Apps/Games:) {
 659         tag "menu-item-uses-apps-games-section", "$fullname:$linecount";
 660         $section =~ s:^Apps/::;
 661     }
 662     if ($section =~ m:^Apps/:) {
 663         tag "menu-item-uses-apps-section", "$fullname:$linecount";
 664         $section =~ s:^Apps/:Applications/:;
 665     }
 666     if ($section =~ m:^WindowManagers:) {
 667         tag "menu-item-uses-windowmanagers-section", "$fullname:$linecount";
 668         $section =~ s:^WindowManagers:Window Managers:;
 669     }
 670
 671     # Check for Evil new root sections.
 672     my ($rootsection) = $section =~ m:([^/]*):;
 673     if (not $root_sections_hash{$rootsection}) {
 674         if (not $rootsection =~ m/$pkg/i) {
 675             tag "menu-item-creates-new-root-section", "$rootsection $fullname:$linecount";
 676         }
 677     } else {
 678         if (not $sections_hash{$section}) {
 679             tag "menu-item-creates-new-section", "$vals{section} $fullname:$linecount";
 680         }
 681     }
 682 }
 683
 684
 685 sub VerifyIcon {
 686     my ($menufile, $fullname, $linecount, $icon, $size) = @_;
 687     local *IN;
 688
 689     if ($icon eq 'none') {
 690         tag "menu-item-uses-icon-none", "$fullname:$linecount";
 691         return;
 692     }
 693
 694     if (not ($icon =~ m/\.xpm$/i)) {
 695         tag "menu-icon-not-in-xpm-format", "$icon";
 696         return;
 697     }
 698
 699     # Try the explicit location, and if that fails, try the standard path.
 700     my $iconfile = "unpacked/$icon";
 701     if (! -f $iconfile) {
 702         $iconfile = "unpacked/usr/share/pixmaps/$icon";
 703     }
 704
 705     if (! open (IN, '<', $iconfile)) {
 706         tag "menu-icon-missing", "$icon";
 707         return;
 708     }
 709
 710     my $parse = "XPM header";
 711     my $line;
 712     do { defined ($line = <IN>) or goto parse_error; }
 713     until ($line =~ /\/\*\s*XPM\s*\*\//);
 714
 715     $parse = "size line";
 716     do { defined ($line = <IN>) or goto parse_error; }
 717     until ($line =~ /"\s*([0-9]+)\s*([0-9]+)\s*([0-9]+)\s*([0-9]+)\s*"/);
 718     my $width = $1 + 0;
 719     my $height = $2 + 0;
 720     my $numcolours = $3 + 0;
 721     my $cpp = $4 + 0;
 722
 723     if ($width > $size || $height > $size) {
 724         tag "menu-icon-too-big", "$icon: ${width}x${height} > ${size}x${size}";
 725     }
 726
 727     close IN or die;
 728     return;
 729
 730 parse_error:
 731     close IN or die;
 732     tag "menu-icon-cannot-be-parsed", "$icon: looking for $parse";
 733     return;
 734 }
 735
 736
 737 # Syntax-checks a .desktop file.
 738 sub VerifyDesktopFile {
 739     my ($desktopfile, $file, $pkg, $info) = @_;
 740     my %vals;
 741     open (DESKTOP, '<', "unpacked/$file")
 742         or fail("cannot open desktop file $file: $!");
 743     my ($line, $saw_first, $warned_cr);
 744     my @pending;
 745     while (defined ($line = <DESKTOP>)) {
 746         chomp $line;
 747         next if ($line =~ m/^\s*\#/ or $line =~ m/^\s*$/);
 748         if ($line =~ s/\r//) {
 749             tag 'desktop-entry-file-has-crs', "/$file:$." unless $warned_cr;
 750             $warned_cr = 1;
 751         }
 752
 753         # Err on the side of caution for now.  If the first non-comment line
 754         # is not the required [Desktop Entry] group, ignore this file.  Also
 755         # ignore any keys in other groups.
 756         last if ($saw_first and $line =~ /^\[(.*)\]\s*$/);
 757         unless ($saw_first) {
 758             return unless $line =~ /^\[(KDE )?Desktop Entry\]\s*$/;
 759             $saw_first = 1;
 760             tag 'desktop-contains-deprecated-header', "/$file:$." if ($line =~ /^\[KDE Desktop Entry\]\s*$/);
 761         }
 762
 763         # Tag = Value.  For most errors, just add the error to pending rather
 764         # than warning on it immediately since we want to not warn on tag
 765         # errors if we didn't know the file type.
 766         #
 767         # TODO: We do not check for properly formatted localised values for
 768         # keys but might be worth checking if they are properly formatted (not
 769         # their value)
 770         if ($line =~ /^(.*?)\s*=\s*(.*)$/) {
 771             my ($tag, $value) = ($1, $2);
 772             my $basetag = $tag;
 773             my ($encoding) = ($basetag =~ s/\[([^\]]+)\]$//);
 774             if (exists $vals{$tag}) {
 775                 tag "duplicated-key-in-desktop-entry", "/$file:$. $tag";
 776             } elsif ($deprecated_desktop_keys{$basetag}) {
 777                 if ($basetag eq 'Encoding') {
 778                     push (@pending, [ "desktop-entry-contains-encoding-key", "/$file:$. $tag" ]);
 779                 } else {
 780                     push (@pending, [ "desktop-entry-contains-deprecated-key", "$file:$. $tag" ]);
 781                 }
 782             } elsif (    not $known_desktop_keys{$basetag}
 783                      and not $kde_desktop_keys{$basetag}
 784                      and not $basetag =~ /^X-/) {
 785                 push (@pending, [ "desktop-entry-contains-unknown-key", "/$file:$. $tag" ]);
 786             }
 787             $vals{$tag} = $value;
 788         }
 789     }
 790     close DESKTOP;
 791
 792     # Now validate the data in the desktop file, but only if it's a known type.
 793     return unless ($vals{'Type'} and $known_desktop_types{$vals{'Type'}});
 794
 795     # Now we can issue any pending tags.
 796     for my $pending (@pending) {
 797         tag @$pending;
 798     }
 799
 800     # Test for important keys.
 801     for my $tag (@req_desktop_keys) {
 802         unless (defined $vals{$tag}) {
 803             tag "desktop-entry-missing-required-key", "/$file $tag";
 804         }
 805     }
 806
 807     # Only test whether the binary is in the package if the desktop file is
 808     # directly under /usr/share/applications.  Too many applications use
 809     # desktop files for other purposes with custom paths.
 810     #
 811     # TODO:  Should check quoting and the check special field
 812     # codes in Exec for desktop files.
 813     if ($file =~ m,^usr/share/applications/, and $vals{'Exec'} and $vals{'Exec'} =~ /\S/) {
 814         my ($okay, $command) = VerifyCmd ($file, undef, $vals{'Exec'}, $pkg,
 815                                           $info);
 816         tag "desktop-command-not-in-package", "/$file $command"
 817             unless $okay or $command eq 'kcmshell';
 818     }
 819
 820     # Check the Category tag.
 821     if (defined $vals{'Categories'}) {
 822         my @cats = split (';', $vals{'Categories'});
 823         my $saw_main;
 824         for my $cat (@cats) {
 825             next if $cat =~ /^X-/;
 826             if ($reserved_categories{$cat}) {
 827                 tag "desktop-entry-uses-reserved-category", "$cat /$file"
 828                     unless $vals{'OnlyShowIn'};
 829                 $saw_main = 1;
 830             } elsif (not $categories{$cat} and not $main_categories{$cat}) {
 831                 tag "desktop-entry-invalid-category", "$cat /$file";
 832             } elsif ($main_categories{$cat}) {
 833                 $saw_main = 1;
 834             }
 835         }
 836         unless ($saw_main) {
 837             tag "desktop-entry-lacks-main-category", "/$file";
 838         }
 839     }
 840 }
 841
 842 # Verify whether a command is shipped as part of the package.  Takes the full
 843 # path to the file being checked (for error reporting) and the binary.
 844 # Returns a list whose first member is true if the command is present and
 845 # false otherwise, and whose second member is the command (minus any leading
 846 # su-to-root wrapper).  Shared between the desktop and menu code.
 847 sub VerifyCmd {
 848     my ($file, $line, $exec, $pkg, $info) = @_;
 849     $file = '/' . $file unless $file =~ m,^/,;
 850     my $location = ($line ? "$file:$line" : $file);
 851
 852     # This routine handles su wrappers.  The option parsing here is ugly and
 853     # dead-simple, but it's hopefully good enough for what will show up in
 854     # desktop files.  su-to-root and sux require -c options, kdesu optionally
 855     # allows one, and gksu has the command at the end of its arguments.
 856     my @com = split (' ', $exec);
 857     my $cmd;
 858     if ($com[0] and $com[0] eq "/usr/sbin/su-to-root") {
 859         tag 'su-to-root-with-usr-sbin', $location;
 860     }
 861     if ($com[0] and $com[0] =~ m,^(?:/usr/s?bin/)?(su-to-root|gksu|kdesu|sux)$,) {
 862         my $wrapper = $1;
 863         shift @com;
 864         while (@com) {
 865             unless ($com[0]) {
 866                 shift @com;
 867                 next;
 868             }
 869             if ($com[0] eq '-c') {
 870                 $cmd = $com[1];
 871                 last;
 872             } elsif ($com[0] =~ /^-[Dfmupi]|^--(user|description|message)/) {
 873                 shift @com;
 874                 shift @com;
 875             } elsif ($com[0] =~ /^-/) {
 876                 shift @com;
 877             } else {
 878                 last;
 879             }
 880         }
 881         if (!$cmd && $wrapper =~ /^(gk|kde)su$/) {
 882             if (@com) {
 883                 $cmd = $com[0];
 884             } else {
 885                 $cmd = $wrapper;
 886                 undef $wrapper;
 887             }
 888         }
 889         tag 'su-wrapper-without--c', "$location $wrapper" unless $cmd;
 890         if ($wrapper && $wrapper !~ /su-to-root/ && $wrapper ne $pkg) {
 891             tag 'su-wrapper-not-su-to-root', "$location $wrapper";
 892         }
 893     } else {
 894         $cmd = $com[0];
 895     }
 896     my $cmd_file = $cmd;
 897     if ($cmd_file) {
 898         $cmd_file =~ s,^/,,;
 899     }
 900     my $okay = $cmd
 901         && ($cmd =~ /^[\'\"]/
 902             || $info->index->{$cmd_file}
 903             || $cmd =~ m,^(/bin/)?sh,
 904             || $cmd =~ m,^(/usr/bin/)?sensible-(pager|editor|browser),
 905             || grep { $info->index->{$_ . $cmd} } @path);
 906     return ($okay, $cmd);
 907 }
 908
 909 1;
 910
 911 # Local Variables:
 912 # indent-tabs-mode: t
 913 # cperl-indent-level: 4
 914 # End:
 915 # vim: syntax=perl ts=8 sw=4