#! /bin/sh /usr/share/dpatch/dpatch-run
## 800-correct-perm2oct.dpatch by Eero Häkkinen <eero.hakkinen@nokia.com>
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Fix perm2oct to correctly detect set-{user,group}-ID and sticky bits.

@DPATCH@
diff -urNad lintian-1.23.8~/checks/control-files lintian-1.23.8/checks/control-files
--- lintian-1.23.8~/checks/control-files	2006-07-18 12:12:55.000000000 +0000
+++ lintian-1.23.8/checks/control-files	2006-07-18 12:15:10.000000000 +0000
@@ -20,6 +20,7 @@
 
 package Lintian::control_files;
 use strict;
+use PermModes;
 use Tags;
 
 sub run {
@@ -104,30 +105,6 @@
 
 } # </run>
 
-# translate permission strings like `-rwxrwxrwx' into an octal number
-sub perm2oct {
-    my ($t) = @_;
-
-    my $o = 0;
-
-    $t =~ m/^.(.)(.)(.)(.)(.)(.)(.)(.)(.)/o;
-
-    $o += 04000 if $3 eq 's';	# set-uid
-    $o += 02000 if $6 eq 's';	# set-gid
-    $o += 01000 if $9 eq 't';	# sticky bit
-    $o += 00400 if $1 ne '-';	# owner read
-    $o += 00200 if $2 ne '-';	# owner write
-    $o += 00100 if $3 ne '-';	# owner execute
-    $o += 00040 if $4 ne '-';	# owner read
-    $o += 00020 if $5 ne '-';	# owner write
-    $o += 00010 if $6 ne '-';	# owner execute
-    $o += 00004 if $7 ne '-';	# owner read
-    $o += 00002 if $8 ne '-';	# owner write
-    $o += 00001 if $9 ne '-';	# owner execute
-
-    return $o;
-}
-
 1;
 
 # vim: syntax=perl sw=4 ts=8
diff -urNad lintian-1.23.8~/checks/files lintian-1.23.8/checks/files
--- lintian-1.23.8~/checks/files	2006-07-18 12:14:48.000000000 +0000
+++ lintian-1.23.8/checks/files	2006-07-18 12:15:10.000000000 +0000
@@ -21,6 +21,7 @@
 package Lintian::files;
 use strict;
 use Dep;
+use PermModes;
 use Tags;
 use Util;
 
@@ -763,30 +764,6 @@
 
 }
 
-# translate permission strings like `-rwxrwxrwx' into an octal number
-sub perm2oct {
-    my ($t) = @_;
-
-    my $o = 0;
-
-    $t =~ m/^.(.)(.)(.)(.)(.)(.)(.)(.)(.)/;
-
-    $o += 04000 if $3 eq 's';	# set-uid
-    $o += 02000 if $6 eq 's';	# set-gid
-    $o += 01000 if $9 eq 't';	# sticky bit
-    $o += 00400 if $1 ne '-';	# owner read
-    $o += 00200 if $2 ne '-';	# owner write
-    $o += 00100 if $3 ne '-';	# owner execute
-    $o += 00040 if $4 ne '-';	# owner read
-    $o += 00020 if $5 ne '-';	# owner write
-    $o += 00010 if $6 ne '-';	# owner execute
-    $o += 00004 if $7 ne '-';	# owner read
-    $o += 00002 if $8 ne '-';	# owner write
-    $o += 00001 if $9 ne '-';	# owner execute
-
-    return $o;
-}
-
 1;
 
 # vim: syntax=perl ts=8 sw=4
diff -urNad lintian-1.23.8~/checks/menus lintian-1.23.8/checks/menus
--- lintian-1.23.8~/checks/menus	2006-07-18 12:12:55.000000000 +0000
+++ lintian-1.23.8/checks/menus	2006-07-18 12:16:29.000000000 +0000
@@ -22,6 +22,7 @@
 
 package Lintian::menus;
 use strict;
+use PermModes;
 use Tags;
 use Util;
 
@@ -207,30 +208,6 @@
 
 # -----------------------------------
 
-# translate permission strings like `-rwxrwxrwx' into an octal number
-sub perm2oct {
-    my ($t) = @_;
-
-    my $o = 0;
-
-    $t =~ /^.(.)(.)(.)(.)(.)(.)(.)(.)(.)/o;
-
-    $o += 04000 if $3 eq 's';	# set-uid
-    $o += 02000 if $6 eq 's';	# set-gid
-    $o += 01000 if $9 eq 't';	# sticky bit
-    $o += 00400 if $1 ne '-';	# owner read
-    $o += 00200 if $2 ne '-';	# owner write
-    $o += 00100 if $3 ne '-';	# owner execute
-    $o += 00040 if $4 ne '-';	# owner read
-    $o += 00020 if $5 ne '-';	# owner write
-    $o += 00010 if $6 ne '-';	# owner execute
-    $o += 00004 if $7 ne '-';	# owner read
-    $o += 00002 if $8 ne '-';	# owner write
-    $o += 00001 if $9 ne '-';	# owner execute
-
-    return $o;
-}
-
 sub check_script {
     my ($script,$pres) = @_;
     my ($no_check_menu,$no_check_installdocs,$no_check_wmmenu,$calls_wmmenu);
diff -urNad lintian-1.23.8~/checks/shared-libs lintian-1.23.8/checks/shared-libs
--- lintian-1.23.8~/checks/shared-libs	2006-07-18 12:14:48.000000000 +0000
+++ lintian-1.23.8/checks/shared-libs	2006-07-18 12:15:10.000000000 +0000
@@ -20,6 +20,7 @@
 
 package Lintian::shared_libs;
 use strict;
+use PermModes;
 use Tags;
 use File::Basename;
 use Util;
@@ -395,30 +396,6 @@
 
 }
 
-# translate permission strings like `-rwxrwxrwx' into an octal number
-sub perm2oct {
-    my ($t) = @_;
-
-    my $o = 0;
-
-    $t =~ m/^.(.)(.)(.)(.)(.)(.)(.)(.)(.)/o;
-
-    $o += 04000 if $3 eq 's';	# set-uid
-    $o += 02000 if $6 eq 's';	# set-gid
-    $o += 01000 if $9 eq 't';	# sticky bit
-    $o += 00400 if $1 ne '-';	# owner read
-    $o += 00200 if $2 ne '-';	# owner write
-    $o += 00100 if $3 ne '-';	# owner execute
-    $o += 00040 if $4 ne '-';	# owner read
-    $o += 00020 if $5 ne '-';	# owner write
-    $o += 00010 if $6 ne '-';	# owner execute
-    $o += 00004 if $7 ne '-';	# owner read
-    $o += 00002 if $8 ne '-';	# owner write
-    $o += 00001 if $9 ne '-';	# owner execute
-
-    return $o;
-}
-
 # make /tmp/baz/baz.txt from /tmp/foo/../bar/../baz/baz.txt
 sub abs_path {
     my $path = shift;
diff -urNad lintian-1.23.8~/lib/PermModes.pm lintian-1.23.8/lib/PermModes.pm
--- lintian-1.23.8~/lib/PermModes.pm	1970-01-01 00:00:00.000000000 +0000
+++ lintian-1.23.8/lib/PermModes.pm	2006-07-18 12:15:10.000000000 +0000
@@ -0,0 +1,52 @@
+# Hey emacs! This is a -*- Perl -*- script!
+# PermModes -- Perl file permission mode functions for lintian
+
+# Copyright (C) 2006 Nokia Corporation.
+#
+# 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 http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package PermModes;
+use strict;
+use warnings;
+
+use Exporter;
+our @ISA    = qw( Exporter );
+our @EXPORT = qw(
+	perm2oct
+	);
+
+# translate permission strings like `-rwxrwxrwx' into an octal number
+sub perm2oct($)
+{
+	my @c = split "", shift, 11;
+	my $oct = 0;
+	$oct |= 04000 if $c[3] =~ /s/i;          # set-user-ID
+	$oct |= 02000 if $c[6] =~ /s/i;          # set-group-ID
+	$oct |= 01000 if $c[9] =~ /t/i;          # sticky
+	$oct |= 00400 if $c[1] eq 'r';           # user readable
+	$oct |= 00200 if $c[2] eq 'w';           # user writable
+	$oct |= 00100 if $c[3] =~ /[[:lower:]]/; # user executable
+	$oct |= 00040 if $c[4] eq 'r';           # group readable
+	$oct |= 00020 if $c[5] eq 'w';           # group writable
+	$oct |= 00010 if $c[6] =~ /[[:lower:]]/; # group executable
+	$oct |= 00004 if $c[7] eq 'r';           # world readable
+	$oct |= 00002 if $c[8] eq 'w';           # world writable
+	$oct |= 00001 if $c[9] =~ /[[:lower:]]/; # world executable
+	return $oct;
+}
+
+1;