bike
/
gbootroot
mirror of https://github.com/fspc/gbootroot.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

Now in BootRoot::lsMode

master
freesource 24 years ago
parent
520e1053df
commit
75828634b6
1 changed files with 0 additions and 289 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 289
      lsMode.pm

289
lsMode.pm
View File

@ -1,289 +0,0 @@
#
#
# 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.3 $ $Date: 1998/04/20 18:24:53 $
package 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<ls -l> 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<Stat::lsMode> generates mode and permission strings that look like
the ones generated by the Unix C<ls -l> 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<Stat::lsMode> 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<stat> call.
=head2 C<format_mode>
Given a mode number (such as the third element of the list returned by
C<stat>), return the appopriate ten-character mode string as it would
have been generated by C<ls -l>. 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<format_mode> will return the string
C<drwxr-xr-x>.
If C<format_mode> 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<format_mode(0755)> will
return just C<rwxr-xr-x>, without the leading C<d>.
=head2 C<file_mode>
Given a filename, do C<lstat> 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<rw-r--r-->.
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<stat.h> 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<file_mode> 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<ls -Ll> does.
=head1 SEE ALSO
=over 4
=item *
C<http://www.plover.com/~mjd/perl/lsMode/>.
=item *
L<ls>
=item *
L<chmod>
=item *
L<stat>
=back
=head1 AUTHOR
Mark-Jason Dominus (C<mjd-perl-lsmode-id-i0k+gzzokd+@plover.com>).
=cut
Write Preview
Loading…
Cancel
Save