Bug #71054 for File-Listing: file_mode() is broken

1) file_mode() doesn't recognize when the set-user-ID bit (file mode bit 04000), set-group-ID bit (file mode bit 02000), or sticky bit (file mode bit 01000) is set. For instance, the following perl -MFile::Listing -we 'printf "%05o", 07777 & File::Listing::file_mode(shift)' -- -rwsrwsrwt prints "00776", but should print "07777". (The reason for the bug is that the file type character is stripped off with the line "s/^(.)// and $type = $1;", so the later code, "$mode |= 0004000 if /^..s....../i; ..." will never match.) 2) The output above also reveals another bug, that file_mode() doesn't handle the least significant bit (file mode bit 00001) properly, since it returns "...76", not "...77". 3) When the set-group-ID bit (file mode bit 02000) is set, and the group execution bit (file mode bit 00020) is unset, and it is a regular file, some implementations of "ls" use the letter "S", others use "l" or "L". For instance, the mode "07767" might be reported as "rwsrwlrwx", "rwsrwSrwx", or "rwsrwLrwx". file_mode() doesn't handle the variants using "l" or "L". 4) file_mode() only knows about directories, symlinks, and regular files. It would be nice if it also knew about fifos (pipes) etc. I have attached a patch and four test files, testing all 4096 possible permission modes (00000 .. 07777) given by for 4 different implementations of "ls". Not all implementations of "ls" map the 4096 unique input values to 4096 unique strings, though.

--- lib/File/Listing.pm.orig 2011-03-20 12:42:00.000000000 +0100 +++ lib/File/Listing.pm 2011-09-18 13:00:42.000000000 +0200 @@ -35,30 +35,47 @@ sub file_mode ($) { + Carp::croak("Input to file_mode() must be a 10 character string.") + unless length($_[0]) == 10; + # This routine was originally borrowed from Graham Barr's # Net::FTP package. local $_ = shift; my $mode = 0; - my($type,$ch); + my($type); s/^(.)// and $type = $1; + # When the set-group-ID bit (file mode bit 02000) is set, and the group + # execution bit (file mode bit 00020) is unset, and it is a regular file, + # some implementations of `ls' use the letter `S', others use `l' or `L'. + # Convert this `S'. + + s/[Ll](...)$/S$1/; + while (/(.)/g) { $mode <<= 1; $mode |= 1 if $1 ne "-" && $1 ne 'S' && - $1 ne 't' && $1 ne 'T'; } - $type eq "d" and $mode |= 0040000 or # Directory - $type eq "l" and $mode |= 0120000 or # Symbolic Link - $mode |= 0100000; # Regular File - - $mode |= 0004000 if /^...s....../i; - $mode |= 0002000 if /^......s.../i; - $mode |= 0001000 if /^.........t/i; + $mode |= 0004000 if /^..s....../i; + $mode |= 0002000 if /^.....s.../i; + $mode |= 0001000 if /^........t/i; + + # De facto standard definitions. From 'stat.h' on Solaris 9. + + $type eq "p" and $mode |= 0010000 or # fifo + $type eq "c" and $mode |= 0020000 or # character special + $type eq "d" and $mode |= 0040000 or # directory + $type eq "b" and $mode |= 0060000 or # block special + $type eq "-" and $mode |= 0100000 or # regular + $type eq "l" and $mode |= 0120000 or # symbolic link + $type eq "s" and $mode |= 0140000 or # socket + $type eq "D" and $mode |= 0150000 or # door + Carp::croak("Unknown file type: $type"); $mode; }