From bae762d124c6bfd2bb14b8b37e989699cd624577 Mon Sep 17 00:00:00 2001 From: freesource Date: Tue, 31 Jul 2001 05:13:58 +0000 Subject: [PATCH] BootRoot::lsMode --- BootRoot/lsMode.pm | 289 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 289 insertions(+) create mode 100644 BootRoot/lsMode.pm diff --git a/BootRoot/lsMode.pm b/BootRoot/lsMode.pm new file mode 100644 index 0000000..33667dd --- /dev/null +++ b/BootRoot/lsMode.pm @@ -0,0 +1,289 @@ +# +# +# Stat::lsMode +# +# Copyright 1998 M-J. Dominus +# (mjd-perl-lsmode-id-i0k+gzzokd+@plover.com) +# +# You may distribute this module under the same terms as Perl itself. +# +# $Revision: 1.1 $ $Date: 2000/12/23 07:42:57 $ + + +package BootRoot::lsMode; + +$VERSION = '0.50'; + +use Carp; +use Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(format_mode file_mode format_perms lsmode); + +@perms = qw(--- --x -w- -wx r-- r-x rw- rwx); +%smerp = map {$perms[$_] => $_} (0 .. $#perms); +@ftype = ('', qw(p c ? d ? b ? - ? l ? s ? ? ?)); +%typef = map {$ftype[$_] => $_} (0 .. $#ftype); + +$NOVICE_MODE = 1; # Default on? +sub novice { + my $pack = shift; + croak "novice_mode requires one boolean argument" unless @_ == 1; + my $old = $NOVICE_MODE; # Should this be localized t $pack? + $NOVICE_MODE = $_[0]; + $old; +} + +sub format_mode { + croak "format_mode requires a mode as an argument" unless @_ >= 1; + my $mode = shift; + my %opts = @_; + + unless (defined $mode) { + return wantarray() ? () : undef; + } + + _novice_warning($mode) if $NOVICE_MODE; + + my $setids = ($mode & 07000)>>9; + my @permstrs = @perms[($mode&0700)>>6, ($mode&0070)>>3, $mode&0007]; + my $ftype = $ftype[($mode & 0170000)>>12]; + my @ftype = $opts{no_ftype} ? () : ($ftype); + + if ($setids) { + if ($setids & 01) { # Sticky bit + $permstrs[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e; + } + if ($setids & 04) { # Setuid bit + $permstrs[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e; + } + if ($setids & 02) { # Setgid bit + # Maybe substr($permstrs[1], -1) =~ tr/-x/Ss/; instead. LOD! + $permstrs[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e; + } + } + + if (wantarray) { + (@ftype, @permstrs); + } else { + join '', @ftype, @permstrs; + } +} + +sub file_mode { + croak "file_mode requires one filename as an argument" unless @_ == 1; + my $file = shift; + my $mode = (lstat $file)[2]; + + unless (defined $mode) { + if (wantarray) { + return (); + } else { + carp "Couldn't get mode for file `$file': $!" if $NOVICE_MODE; + return undef; + } + } + + format_mode($mode, @_); +} + + +# This was suggested by Colin Kuskie +sub lsmode { + my $lsmode = shift; + my ($t, $u, $g, $o); + my $ld; + + if (length($lsmode) == 9) { + ($u, $g, $o) = unpack "A3 A3 A3", $lsmode; + $ld = 0; + } elsif (length($lsmode) == 10) { + ($t, $u, $g, $o) = unpack "A1 A3 A3 A3", $lsmode; + $ld = $typef{$t} + or croak("Mode `$lsmode' begins with unrecognized character `$t'"); + $ld = sprintf "%01o", $ld; + } else { + croak "Unrecognizable mode `$lsmode'"; + } + + # Fix sticky bit? + if ($o =~ /s$/i) { + croak "Mode `$lsmode' may not end with `s'; aborting"; + } + + my $octperm = ''; + my $setuid = 0; + foreach $perm ($u, $g, $o) { + # LOD + $setuid = $setuid * 2 + ($perm =~ s/([st])$/($1 eq lc $1)?'x':'-'/ie); + $octperm .= $smerp{$perm}; + } + + my $perm = oct(sprintf "0$ld$setuid$octperm"); + $perm; +} + + +sub format_perms { + croak "format_perms requires a permission mode as an argument" unless @_ == 1; + format_mode($_[0], no_ftype => 1); +} + +# None of these are really plausible modes. +# They are all almost certain to have occurred +# when someone used decimal instead of octal to specify a mode. + +@badmodes = (777, 775, 755, 770, 700, 750, + 751, + 666, 664, 644, 660, 600, 640, + 444, 440, + 400, # 400 = rw--w---- which is just barely plausible. + # 000 *is* OK. It means just what you think. + 711, 771, 751, 551, 111, + ); +%badmode = map {($_ => 1)} @badmodes; + +# Novices like to ask for the bits for mode `666' instead of `0666'. +# Try to detect and diagnose that. +sub _novice_warning { + my $mode = shift; + if ($badmode{$mode}) { + carp "mode $mode is very surprising. Perhaps you meant 0$mode"; + } +} + +=head1 NAME + +Stat::lsMode - format file modes like the C command does + +=head1 SYNOPSIS + + use Stat::lsMode; + + $mode = (stat $file)[2]; + $permissions = format_mode($mode); + # $permissions is now something like `drwxr-xr-x' + + $permissions = file_mode($file); # Same as above + + $permissions = format_perms(0644); # Produces just 'rw-r--r--' + + $permissions = format_perms(644); # This generates a warning message: + # mode 644 is very surprising. Perhaps you meant 0644... + + Stat::lsMode->novice(0); # Disable warning messages + +=head1 DESCRIPTION + +C generates mode and permission strings that look like +the ones generated by the Unix C command. For example, a +regular file that is readable by everyone and writable only by its +owner has the mode string C<-rw-r--r-->. C will either +examine the file and produce the right mode string for you, or you can +pass it the mode that you get back from Perl's C call. + +=head2 C + +Given a mode number (such as the third element of the list returned by +C), return the appopriate ten-character mode string as it would +have been generated by C. For example, +consider a directory that is readable and searchable by everyone, and +also writable by its owner. Such a directory will have mode 040755. +When passed this value, C will return the string +C. + +If C is passed a permission number like C<0755>, it will +return a nine-character string insted, with no leading character to +say what the file type is. For example, C will +return just C, without the leading C. + +=head2 C + +Given a filename, do C on the file to determine the mode, and +return the mode, formatted as above. + +=head2 Novice Operation Mode + +A common mistake when dealing with permission modes is to use C<644> +where you meant to use C<0644>. Every permission has a numeric +representation, but the representation only makes sense when you write +the number in octal. The decimal number 644 corresponds to a +permission setting, but not the one you think. If you write it in +octal you get 01204, which corresponds to the unlikely permissions +C<-w----r-T>, not to C. + +The appearance of the bizarre permission C<-w----r-T> in a program is +almost a sure sign that someone used C<644> when they meant to use +C<0644>. By default, this module will detect the use of such unlikely +permissions and issue a warning if you try to format them. To disable +these warnings, use + + Stat::lsMode->novice(0); # disable novice mode + + Stat::lsMode->novice(1); # enable novice mode again + +The surprising permissions that are diagnosed by this mode are: + + 111 => --xr-xrwx + 400 => rw--w---- + 440 => rw-rwx--- + 444 => rw-rwxr-- + 551 => ---r--rwt + 600 => --x-wx--T + 640 => -w------T + 644 => -w----r-T + 660 => -w--w-r-T + 664 => -w--wx--T + 666 => -w--wx-wT + 700 => -w-rwxr-T + 711 => -wx---rwt + 750 => -wxr-xrwT + 751 => -wxr-xrwt + 751 => -wxr-xrwt + 755 => -wxrw--wt + 770 => r------wT + 771 => r------wt + 775 => r-----rwt + 777 => r----x--t + +Of these, only 400 is remotely plausible. + +=head1 BUGS + +As far as I know, the precise definition of the mode bits is portable +between varieties of Unix. The module should, however, examine +C or use some other method to find out if there are any local +variations, because Unix being Unix, someone somewhere probably does +it differently. + +Maybe C should have an option that says that if the file +is a symlink, to format the mode of the pointed to file instead of the +mode of the link itself, the way C does. + +=head1 SEE ALSO + +=over 4 + +=item * + +C. + +=item * + +L + +=item * + +L + +=item * + +L + +=back + +=head1 AUTHOR + +Mark-Jason Dominus (C). + +=cut +