[Initscripts-ng-commits] r994 - /trunk/src/insserv/debian/check-archive-initd-scripts

[pere at users.alioth.debian.org]

Author: pere
Date: Fri Sep 11 22:08:37 2009
New Revision: 994

URL: http://svn.debian.org/wsvn/initscripts-ng/?sc=1&rev=994
Log:
Improve output and recognize -font-server.

Modified:
    trunk/src/insserv/debian/check-archive-initd-scripts

Modified: trunk/src/insserv/debian/check-archive-initd-scripts
URL: http://svn.debian.org/wsvn/initscripts-ng/trunk/src/insserv/debian/check-archive-initd-scripts?rev=994&op=diff
==============================================================================
--- trunk/src/insserv/debian/check-archive-initd-scripts (original)
+++ trunk/src/insserv/debian/check-archive-initd-scripts Fri Sep 11 22:08:37 2009
@@ -9,16 +9,17 @@
 
 my $warn = 1;
 
+my $basedir = "/org/lintian.debian.org/laboratory/binary";
+
 my @scripts = @ARGV;
- at scripts = </org/lintian.debian.org/laboratory/binary/*/init.d/*>
-    unless @scripts;
+ at scripts = <$basedir/*/init.d/*> unless (@scripts);
 
 my %scriptinfo;
 my %provides;
 
 my @virts = qw($local_fs $remote_fs $syslog $time $named
                $portmap $network $all
-               $mail-transport-agent
+               $mail-transport-agent $x-font-server
                );
 my @depheaders = qw(required-start required-stop should-start
                     should-stop x-start-before x-stop-after);
@@ -58,7 +59,7 @@
         map { $script{basename($_)} = 1; } @{$provides{$provide}};
         if (1 < scalar keys %script) {
             error("duplicate provide '$provide' in scripts "
-                  . join(" ", @{$provides{$provide}}));
+                  . join(" ", short_name(@{$provides{$provide}})));
         }
     }
 }
@@ -66,6 +67,7 @@
 # Second pass, to see which dependencies are missing
 for my $initdscript (@scripts) {
     next unless ($scriptinfo{$initdscript}->{'found'});
+    my $short = short_name($initdscript);
     my %checked;
     my @missing = ();
     for my $header (@depheaders) {
@@ -78,16 +80,16 @@
                 unless exists $provides{$facility};
         }
     }
-    error("script $initdscript relate to non-existing provides: "
+    error("script $short relate to non-existing provides: "
           . join(" ", @missing)) if (@missing);
 
     if (!exists $checked{'$remote_fs'}
         && $scriptinfo{$initdscript}->{'need_remove_fs'}) {
-        warning("script $initdscript possibly missing dependency on \$remote_fs");
+        warning("script $short possibly missing dependency on \$remote_fs");
     } elsif (!exists $checked{'$local_fs'}
              && !exists $checked{'$remote_fs'}
              && $scriptinfo{$initdscript}->{'need_local_fs'}) {
-        warning("script $initdscript possibly missing dependency on \$local_fs");
+        warning("script $short possibly missing dependency on \$local_fs");
     }
 
     my %provided;
@@ -97,7 +99,7 @@
     }
 
     my $basename = basename($initdscript, ".sh");
-    warning("script $initdscript do not provide its own name")
+    warning("script $short do not provide its own name")
         unless exists $provided{$basename};
 
     # Detect common problems with runlevel settings.
@@ -114,12 +116,12 @@
         # Most scripts either start in rcS.d, or in runlevels 2-5
         if (!array_equal(['2', '3', '4', '5'], \@startrl) &&
             !array_equal(['s'], \@startrl)) {
-            warning("script $initdscript do not start in the usual runlevels");
+            warning("script $short do not start in the usual runlevels");
         }
         # And most scripts stop in runlevel 1 or runlevels 0, 1 and 6
         if (!array_equal(['0', '1', '6'], \@stoprl) &&
             !array_equal(['1'], \@stoprl)) {
-            warning("script $initdscript do not stop in the usual runlevels");
+            warning("script $short do not stop in the usual runlevels");
         }
     }
 }
@@ -128,9 +130,10 @@
 
 sub parse_lsb_header {
     my $initdscript = shift;
+    my $short = short_name($initdscript);
     my %lsbinfo;
     unless (open(INIT, "<", $initdscript)) {
-        error("unable to read $initdscript");
+        error("unable to read $short");
         return ();
     }
     my $inheader = 0;
@@ -154,15 +157,29 @@
 
     # Check that all the required headers are present
     if (!$lsbinfo{'found'}) {
-        error("script $initdscript is missing LSB header");
+        error("script $short is missing LSB header");
     } else {
         for my $key (split(/\|/, lc($lsbheaders))) {
             if (!exists $lsbinfo{$key}) {
-                error("$initdscript missing LSB keyword '$key'");
+                error("script $short missing LSB keyword '$key'");
             }
         }
     }
     return %lsbinfo
+}
+
+sub short_name {
+    my @scripts;
+    for my $script ( @_ ) {
+        my $copy = $script;
+        $copy =~ s%$basedir/%%g;
+        push @scripts, $copy;
+    }
+    if (wantarray) {
+        return @scripts;
+    } else {
+        return $scripts[0];
+    }
 }
 
 sub array_equal {