| Category: | Utility Scripts |
| Author/Contact Info | tye |
| Description: | A perl-only replacement for chmod, chown, and chgrp that I found very convenient when I was a Unix sys admin. It lets you change the mode, owning user, and owning group all at once (or any combinations thereof). This is some pretty old code (last updated in 1995) but it doesn't look horrendous so I thought I'd add it to the archive. |
#!/usr/bin/perl # chmug - Change mode, user (owner), and/or group of file(s) # @(#)chmug.pl 1.11, 95/11/27 09:24:38 # See usage message (in "sub Usage" below) for more details. # By Tye McQueen, tye@metronet.com, see http://www.metronet.com/~tye/ #Bugs: # "u+s+x" "intentionally" ignores "u+s" but "u+x+s" and "u+sx" work as + "u+xs". # Unlike BSD, /[ugoa]+-X/ is useful, removing "x" if _not_ a directory + _and_ # some slots _don't_ have "x". # Unlike BSD, /(^|,)-[rwx]+/ is useful, only removing bits _set_ in um +ask. # "chmug -R" may temporilly do "chmod u+rx" to a subdirectory so that +it can # recurse into it. When it finishes in that subdirectory, it will +restore # the previous mode then make any changes to it as requested on the + command # line. So if it dies before then, one line of directories may be +left # with "u+rx" applied to them. Also, "chmug -R" will not fail on y +our # directories, even if you have denied yourself the right to use th +em. # The Usage message doesn't tell you that "chmug -q" suppresses some w +arnings # including the logging of the "temporary" changes described above. # The Usage messages doesn't tell that you can set the CHMUG environme +nt # variable to contain default flags (CHMUG="-v -P", for example). # Gobal variables: use strict; # Complain about any undeclared variables. my( $Mode, $User, $Group, @Mode ); # Set by &ParseChange. ( my $Self= $0 ) =~ s#^/(.*/)?##; # This program's name, for err +ors. my $ModeBits= "rwxXlstugo"; # Valid chars after /[ugoa]*[- ++=]/. my $Recurse= 0; # Should we recurse into directories? ##my $ModLink= 0; # Modify symbolic link rather than file link p +oints to? my $Debug= 0; # Log what we do as we go along? my $Model= ""; # Model file to copy owner/mode settings from +(none). my $First= 1; # Are we changing our first file? Else don't +rewarn. my $ActLike= "mug"; # Are we chmug, chmod, chown, or chgrp? my $Colon= ":"; # Will be ":." if -P used to allow "user.group +". my $Period= "."; # Will be "" if -P used so ("." can't be in us +ername). my %Usage= split( /\n/, <<END ); # Our usage message, based on +$ActLike: mug Usage: $Self [-RvqP] { [mode][[,]usr][:[grp]] | -f model } file [file +...] mod Usage: $Self [-RvqP] { [mode][[,]usr][:[grp]] | -f model } file [file +...] own Usage: $Self [-RvqP] { [[,]usr][:[grp]] | -f model } file [file...] grp Usage: $Self [-RvqP] { [:]grp | -f model } file [file...] END # Pseudo-declaration "Global( =x, y=, z )" means "x" is a read-only gl +obal # variable, "y" is a write-only global, and "z" is a read/write global +. # Subroutines: (Program execution begins after "main {" below) sub WhoAmI { if( $Self =~ m#mod[^/]*$# || $Self =~ m#perm[^/]*$# ) { "mod"; } elsif( $Self =~ m#own[^/]*$# || $Self =~ m#use?r[^/]*$# ) { "own"; } elsif( $Self =~ m#gr[ou]*p[^/]*$# ) { "grp"; } else { "mug"; } } sub Usage { # Print usage message then die +: # Global( =$Self, =@ARGV, =$ModeBits ); # &Usage() shows long usage me +ssage. local( $_ ); warn "$Self: @_\n" if @_; # &Usage("err") shows error te +xt warn $Usage{$ActLike}, "\n"; # then short usage message. die qq<(Enter "$Self -H" for long usage message.)\n> if @_; ( $_= <<END ) =~ s/^#.*\n//mg; # Grab uncommented lines: ##Usage with possible future enhancements: ##Usg: chmug [-R[k=v[,...]] [-hvqP] {[mode][[,]usr][:[grp]]|-f model} +file [...] "mode" can be a base-8 number or match /^[ugoa]*([-+=][$ModeBits]*)+(, +...)*\$/. "usr" can be username or UID number ("," needed before UID or if after + "mode"). #"usr" can be a username or ("," needed before numbers or if "mode"). #If specifying both "mode" and "usr", the "," is required. "grp" can be a group name or a group ID number (leading ":" always req +uired). "-f model" duplicates the mode, user, and group of the file "model". "-R" recursively modifies all files under any directories listed. "-P" ("period") lets you use "user.group" as well as "user:group". ##"-Rtype=f,mtime+5,user!root" does "find file -type f -mtime +5 ! -us +er root" ## "-h" changes the user/group of a symbolic link rather than the file + that ## the link points to (you cannot specify a mode with "-h"). "-v" ("verbose") logs changes to STDOUT ("-vv" is more verbose). "-q" ("quiet") undoes a previous "-v" (in case "-v" is in your default + alias). Specifying "usr:" sets the group to that user's "primary group". "t" is the sticky bit (invalid after /g[-+=]/ or /o[-+=]/). "s" is either the set-UID or set-GID bit (invalid after /o[-+=]/). "l" is mandatory locking ("g+s,g-x" except "-x" implies "-s"; "+s" nee +ds "+x"). "g=u" sets the group bits to what the user bits where before any chang +es, "u+g" adds to the user bits what the group bits where before any chang +es, etc. /[+=]X/ adds "x" only on files that (now) have an "x" set and on direc +tories, while "-X" only changes non-directories with at least one "x" _not_ se +t. [-+=] not after [ugoa] is like /a[-+=]/ but only sets (clears) bits _n +ot_ set (unset) in umask ("u-w+r" = "u-w,u+r"; "u-r,+x" = "u-r,a+x" w/ umask o +n "+x"). For directories, "g-s" and "g+s" are the *only* ways to change that bi +t. A base-8 numeric mode has the following meaning: Bits User Group + Other (Bits: "u"=Set-UID "g"=Set-GID "t"="Sticky" bit) ugt rwx rwx + rwx So "4751" is "u=rwxs,g=rx,o=x". 421 421 421 + 421 END my( $NoMode )= "own" eq $ActLike || "grp" eq $ActLike; s#^"mode".*\n##m if $NoMode; s#^"usr".*\n##m if "grp" eq $ActLike; s# \("," needed .* "mode"\)##m if "own" eq $ActLike; s# \(leading "\:" always required\)##m if "grp" eq $ActLike; if( "mod" eq $ActLike ) { s#(duplicates the )mode, user, and group( of)#$1mode$2#; } elsif( "own" eq $ActLike ) { s#(duplicates the )mode, user, and group( of)#$1owner and grou +p$2#; } elsif( "grp" eq $ActLike ) { s#(duplicates the )mode, user, and group( of)#$1group$2#; } s#^.*"usr\:".*\n##m if "grp" eq $ActLike; s#^"t".*421\n##ms if $NoMode; $_ .= qq<[This is really the "chmug" commmand pretending to be $Se +lf]\n> unless "mug" eq $ActL +ike; die $_; } # End of &Usage sub ParseFlags { # Parse flags given on command line: # Global( @ARGV, =$ModeBits, $Recurse, $Debug, $ModLink, =$Self ); my( $arg ); # For POSIX: "-" => stdin, "--" ends flags, "--x" => +reserved if( defined( $ENV{'CHMUG'} ) ) { my( @flags )= split( ' ', $ENV{'CHMUG'} ); @flags= grep( /^-[^-]/ ? 1 : ( warn(qq<$Self: Invalid flag in CHMUG >, qq<environment variable, "$_", ignored +.\n>), 0 ), @flags ); unshift( @ARGV, @flags ); } while( @ARGV && $ARGV[0] =~ /^-[^-]/ ) { # so /^-[^-]/ +is flag. # "-x" is mode "a-x" w/ umask applied and so isn't a flag: last if $ARGV[0] =~ /^-[$ModeBits]+([-+=,.]|$)/o; ( $arg= shift(@ARGV) ) =~ s/^-//; # Get next arg, drop t +he "-". do { # While unprocessed flags left in argu +ment: if( $arg =~ s/^H// ) { # "-H": &Usage(); # Show long usage mess +age. ##} elsif( $arg =~ s/^E// ) { # "-E" (not supported) +: ##&Usage(); # Show examples and mo +re help. } elsif( $arg =~ s/^R// ) { # "-R": $Recurse= 1; # Recurse into subdire +ctories. } elsif( $arg =~ s/^P// ) { # "-P" ("period"): $Colon= ":."; # Allow "usr.grp" as " +usr:grp". $Period= ""; # Don't allow "." in u +sername. } elsif( $arg =~ s/^v// ) { # "-v" ("verbose"): $Debug++; # Log to STDOUT what w +e do. } elsif( $arg =~ s/^q// ) { # "-q" ("quiet"): $Debug= "" if --$Debug < 0; # Log less to STDOUT. +[""<"0"] ##} elsif( $arg =~ s/^h// ) { # "-h": ## $ModLink= 1; # Modify a symbolic li +nk. } elsif( $arg =~ s/^f// ) { # "-f model_file": $Model= $arg; # In case no space aft +er "-f". if( "" eq $Model ) { # Maybe "-f model" use +d: &Usage( "No model file name given after -f" ) unless "" ne ( $Model= shift(@ARGV) ); } $arg= ""; # Don't process file name as f +lags. } else { &Usage( "Unknown switch (-$arg)" ); } } while( "" ne $arg ); # No more flags in this argume +nt. } shift( @ARGV ) if "--" eq $ARGV[0]; # Don't leave "--" as +an arg. } # End of &ParseFlags sub ModelFile { # Grab mode, user, and group of model file. # Global( =$Model ); # Insert command-line argument to set m, u, an +d/or g. my( $mode, $owner, $group )= (stat($Model))[2,4,5]; if( "" eq $mode ) { die "$Self: Can't stat() model file ($Model): $!\n"; } if( "mod" eq $ActLike ) { # Acting like "chmod": unshift( @ARGV, sprintf("0%o",$mode) ); # Only change modes. } elsif( "own" eq $ActLike ) { # Acting like "chown": unshift( @ARGV, ",$owner:$group" ); # Only change owners a +nd groups. } elsif( "grp" eq $ActLike ) { # Acting like "chgrp": unshift( @ARGV, ":$group" ); # Only change groups. } else { # Acting like the real + "chmug": unshift( @ARGV, sprintf("0%o",$mode).",$owner:$group" ); # Cha +nge all! } } sub ParseChange { # Parse first argument ("[mode][[,]user][:[gro +up]]"): my( $change )= @_; # Value of first command-line +argument. # Global( $Mode=, @Mode=, $User=, $Group=, =$Self ); # Update this line if your system allows '-', '/', '$', etc. in user +names: my( $l )= $Period ? "[\\w$Period]" : "\\w"; # Okay char +in name. my( $number )= "[0-7]+"; # Numeric file mode my( $symbol )= "(?:a|[ugo]*)(?:[-+=][$ModeBits]*)+"; # Symb +olic mode my( $mode )= "(?:$number|(?:$symbol(?:,$symbol)*))"; # Eith +er mode my( $user )= "(?:\\,$l|[a-zA-Z_])$l*"; # User name/number my( $group )= "[$Colon]$l*"; # Group name/n +umber my( @x ); # For user/gro +up info unless( ( $Mode, $User, $Group )= # Break $change into m +, u, g. $change =~ m#^($mode)?($user)?($group)?$#o ) { &Usage( "Invalid mode/user/group ($change)" ); # Go ahead, write the code to tell them *what* is invalid abou +t it! } if( ! defined($Mode) ) { # So "perl -w" won't complain... $Mode= ""; # about "Use of uninitialized value" +. } elsif( $Mode =~ m#^$number$#o ) { # Numeric mode given: $Mode= oct($Mode); # Turn "40" or "040" to 040 (a +ka 32). @Mode= (); # Tell subs to use $Mode, not +@Mode. } elsif( $Mode ne "" ) { # Symbolic mode(s) given: my( $mode ); # Split into single bit-mask o +ps: @Mode= map { # First, split on ",". if( m#[-+=].*[-+=]# ) { # Then "ug+rw-x" => "ug+rw","u +g-x": # Split on "nothing followed by -, +, or =": my( $who, @what )= split( /(?=[-+=])/, $_ ); # "+r-x" => $who:"+r",@what:"-x" => $who:"",@what:("+r +","-x"): ( @what, $who )= ( $who, @what ) if $who =~ m#^[-+= +]#; foreach( @what ) { $_= "$who$_"; } @what; } else { $_; } } split( /,/, $Mode ); # `First, split on ",".' if( $_= ( grep(/[-+]$/,@Mode) )[0] ) { # "o=" OK, "o+ +" not: &Usage( qq<+/- must be followed by one of [$ModeBits]: "$_ +"> ); } } if( ! defined($User) ) { # So "perl -w" won't complain... $User= ""; # about "Use of uninitialized value" +. } elsif( "" ne $User ) { # Convert user name to user ID number: $User =~ s#^\,##; # Trim optional leading "," (a delimit +er). if( @x= getpwnam($User) ) { # Look up username [even if /^ +\d+$/]: $User= $x[2]; # Found it, change to UID numb +er. } elsif( $User !~ /^\d+$/ ) { # Not a name. Is it a number? + No: die "$Self: No such user ($User).\n"; } # Show back translation in case more than one user w/ +that UID: print "Using UID=$User(", (getpwuid($User))[0], "). " if 1 +< $Debug; } if( ! defined($Group) ) { # So "perl -w" won't complain... $Group= ""; # about "Use of uninitialized value" +. } elsif( "" ne $Group ) { # Convert group name to group ID numbe +r: $Group =~ s#^[$Colon]##;# Trim required leading ":" (a delimit +er). if( $Group eq "" ) { # "user:" means use user's primary gro +up: &Usage( qq<":" given ($change) but no user or group> ) if "" eq $User; # "usr:", ":grp", and "usr:grp" OK; ": +" BAD. $Group= $x[3]; # $User's primary group number. } elsif( @x= getgrnam($Group) ) { # Look up group name: $Group= $x[2]; # Found it, change to GID number. } elsif( $Group !~ /^\d+$/ ) { # Is it a Number? No: die "$Self: No such group ($Group).\n"; } # Show back translation in case not just one group w/ +that GID: print "Using GID=$Group(", (getgrgid($Group))[0], ")." if 1 +< $Debug; } else { $Group= ""; } # So can put "Using UID=... Using GID=..." on same line: print "\n" if 1 < $Debug && ( $User ne "" || $Group ne "" + ); } # End of &ParseChange sub BitOp { # Return $mode but with $mask bits set (cleared if "-" + eq $op): my( $mode, $op, $mask )= @_; if( "-" eq $op ) { $mode & ~ $mask; # Clear bits of $mode that are set in +$mask. } else { $mode | $mask; # Set bits of $mode that are set in $m +ask. } } # End of &BitOp sub SetBit { # Apply a single "(a|[ugo]*)[-+=][$ModeBits]" to $mode +: my( $mode, $bit, $where, $top, $start, $who, $op, $change, $file )= +@_; # Global( =$Self ); if( "r" eq $bit ) { # Set/clear "read" bit +(s): $mode= &BitOp( $mode, $op, $where << 2 ); # "4" bit(s) } elsif( "w" eq $bit ) { # Set/clear "write" bi +t(s): $mode= &BitOp( $mode, $op, $where << 1 ); # "2" bit(s) } elsif( "x" eq $bit ) { # Set/clear "execute" +bit(s): $mode= &BitOp( $mode, $op, $where ); # "1" bit(s) if( "-" eq $op ) { # -x implies -s: if( 0 != ( $mode & $top ) && $change !~ /s/ ) { warn qq<$Self: Note, "$who$op$change" removed "s" mod +e bit>, qq< along with "x" ($file).\n> unless "" eq $D +ebug; $mode= &BitOp( $mode, $op, $top ); } } } elsif( "X" eq $bit ) { # Set/clear "execute" bit(s) s +ometimes: # Set "x"s if started with an "x" set or is a directory; # Clear "x"s if not a directory and started with an "x" unset: if( "-" ne $op && ( -d _ || 0 != ( $mode & 0111 ) ) || "-" eq $op && ( ! -d _ && 0111 != ( $mode & 0111 ) ) ) + { $mode= &BitOp( $mode, $op, $where ); if( "-" eq $op ) { # -x implies - +s: if( 0 != ( $mode & $top ) && $change !~ /s/ ) { warn qq<$Self: Note, "$who$op$change" removed "s" + mode>, qq< bit along with "x" ($file).\n> unless "" eq $Debug; $mode= &BitOp( $mode, $op, $top ); } } } } elsif( "s" eq $bit ) { # Set/clear set-UID/set-GID bi +t(s): if( 0 == $top ) { # Must be /o[-+=]s/ or somethi +ng: warn qq<$Self: Warning, "s" ignored after "$who" >, qq<($who$op$change)\n> if $First; # Don't repeat + warning. } elsif( "-" ne $op && $change !~ /x/ # +s,=s requir +es +x,=x: && (1*$where) != ( $mode & (1*$where) ) ) { # Unless "x" w +as set. warn qq<$Self: Note, no "x" access so set-ID bits not set + >, qq<by "$who$op$change" ($file).\n> unless "" eq $D +ebug; } else { $mode= &BitOp( $mode, $op, $top ); } } elsif( "t" eq $bit ) { # Set/clear "sticky" b +it: if( $who =~ /^[go]+$/ ) { warn qq<$Self: Warning, "t" ignored after "$who" >, qq<($who$op$change)\n> if $First; # Don't repeat + warning. } else { $mode= &BitOp( $mode, $op, 01000 ); } } elsif( "l" eq $bit ) { # Set/clear mandatory record l +ocking: ##if( $who =~ /^[go]+$/ ) { ##warn qq<$Self: Warning, "l" ignored after "$who" >, ## "($who$op$change)\n" if $First; # Don't repeat + warning. ##} els # UnixWare chmod(1) allows this so I will too. if( "-" eq $op ) { # "-l" always +works: $mode &= ~ 02000 if 02000 == ( 02010 & $mode ); } elsif( 0 != ( 00010 & $mode ) ) { # Group exec a +llowed: warn qq<$Self: Warning, "l" ignored ($who$op$change) sinc +e "g+x">, qq< set ($file).\n> unless "" eq $Debug;# so can't +set "+l". } else { $mode &= ~ 02010; $mode |= 02000; # Set "+l". } } elsif( "u" eq $bit ) { # Apply previous "u" b +its: $mode= &BitOp( $mode, $op, $where * ( 7 & ($start>>6) ) ); # Should /u[-+=]g/ really change "u+s" based on "g+s"??? if( 0 != ( 04000 & $start ) ) { # "u+s" was set... $mode= &BitOp( $mode, $op, $top ); # so modify "s" bit(s) +. } } elsif( "g" eq $bit ) { # Apply previous "g" b +its: $mode= &BitOp( $mode, $op, $where * ( 7 & ($start>>3) ) ); # Should /g[-+=]u/ really change "u+s" based on "g+s"??? if( 0 != ( 02000 & $start ) ) { # "g+s" was set... $mode= &BitOp( $mode, $op, $top ); # so modify "s" bit(s) +. } } elsif( "o" eq $bit ) { # Apply previous "o" b +its: $mode= &BitOp( $mode, $op, $where * ( 7 & ($start) ) ); } else { # Unreachable code: die "$Self: Imposible mode letter ($bit)"; } $mode; # Return modified value of mode bits. } # End of &SetBit sub ModePart { # Apply $change to $mode bits, returning new $mode ($s +tart... my( $start, $mode, $change, $file )= @_; # is mode before any c +hanges). my( $who, $op )= ( $change =~ m#^(a|[ugo]*)([-+=])# ); # Get first 2 + parts. $change =~ s###; # Leave only 3rd part in $change. my( $where, $top )= ( 0111, 06000 ); # Defaults for "a=..." and "=. +..". # The bits that may change are those set in $top | 7*$where. my( $mask )= $mode; # Save $mode before change so can apply umask +to change. if( "a" ne $who && "" ne $who ) { # Must be /[ugo]+/: $where= $top= 0; # Start w/ 0 then "or" + in bits. if( $who =~ /u/ ) # Change user mode bit +s: { $where |= 0100; $top |= 04000; } if( $who =~ /g/ ) # Change group mode bi +ts: { $where |= 0010; $top |= 02000; } if( $who =~ /o/ ) # Change other mode bi +ts: { $where |= 0001; } } # Else use default $where and $top from declaration. if( "=" eq $op ) { # Clear unmentioned bits: $mode &= ~ (7*$where); # Clear all u, g, and/or o "rwx" mode +bits. if( -d _ ) { # For directories... $mode &= ~ ( $top & ~02000 ); # don't clear "g=s" bi +ts. } else { # For non-directories... $mode &= ~ ($top); # clear "u=s" and/or "g=s" bit +s. } } { my( $bit ); # For each character past /[-+ +=]/: foreach $bit ( split( //, $change ) ) { $mode= &SetBit( $mode, $bit, $where, $top, $start, # Chan +ge... $who, $op, $change, $file ); # bits of $mode based +on char. } } if( "" eq $who ) { # Apply "umask" to these mode bit chan +ges: my( $umask )= umask; # Since umask doesn't mention ug=s... $umask |= 04000 if 0 != ( 0100 & $umask ); # Do u-s if do +ing u-x. $umask |= 02000 if 0 != ( 0010 & $umask ); # Do g-s if do +ing g-x. # Find bits turned on[off] in the $mask=>$mode transition # then turn off[on] any of these that are also set[clear] in u +mask: $mode &= ~ ( $mode & ~$mask & $umask ); # (The "turn off bits" + part.) $mode |= ( ~$mode & $mask & ~$umask ); # (The "turn on bits" +part.) } $mode; # Return modified mode bits. } # End of &ModePart sub SetMode { # Apply all "mode" changes to one file: my( $file, $mode )= @_; # File to change and its current mode +bits. # Global( =@Mode, =$Mode, =$Self ); if( ! @Mode ) { # Simple numeric mode specified (not s +ymbolic): my( $gid )= 02000 & $mode; # Check current "g+s" (for directorie +s). $mode &= ~ 07777; # Clear out all of the bits. $mode |= $Mode; # Set the bits as requested. if( -d _ ) # Except "g+s" on directories stays sa +me: { $mode &= ~ 02000; $mode |= $gid; } } else { # Symbolic mode change(s) given: my( $start )= $mode; # Record "initial" mode for "g+u", etc +. my( $change ); foreach $change ( @Mode ) { # Apply each comma-separated p +art: $mode= &ModePart( $start, $mode, $change, $file ); } } chmod( $mode, $file ) || warn "$Self: ", "Can't change mode (", sprintf("0%o",$mode), ") on file ($file): + $!\n"; my( $end )= 07777 & (stat($file))[2]; # Fetch actual mode after chan +ge. $mode &= 07777; # Check for mode bit changes that chmo +d()... if( $end != $mode ) { # silently ignored and announce them: if( $_= $end & ~$mode ) { warn "$Self: Bits that chmod(2) would not turn off: ", sprintf( "%05.5o", $end & ~$mode ), " ($file)\n" unless "" eq $Debug; } if( $_= $mode & ~$end ) { warn "$Self: Bits that chmod(2) would not turn on: ", sprintf( "%05.5o", $mode & ~$end ), " ($file)\n" unless "" eq $Debug; } } $First= 0; # We've changed a file; don't repeat some warnings on n +ext file. } # End of &SetMode sub ModeStr { # Take numeric file mode bits, return "rwxrwxrwx" stri +ng: my( $mode )= @_; # Numeric mode (an integer, not an octal strin +g). my( $str )= ""; # Start building the string that represents it +. $str .= ( 0400 & $mode ) ? "r" : "-"; $str .= ( 0200 & $mode ) ? "w" : "-"; if( 00100 == ( 04100 & $mode ) ) { $str .= "x"; } elsif( 00000 == ( 04100 & $mode ) ) { $str .= "-"; } elsif( 04100 == ( 04100 & $mode ) ) { $str .= "s"; } else { $str .= "S"; } $str .= ( 0040 & $mode ) ? "r" : "-"; $str .= ( 0020 & $mode ) ? "w" : "-"; if( 00010 == ( 02010 & $mode ) ) { $str .= "x"; } elsif( 00000 == ( 02010 & $mode ) ) { $str .= "-"; } elsif( 02010 == ( 02010 & $mode ) ) { $str .= "s"; } else { $str .= "l"; } $str .= ( 0004 & $mode ) ? "r" : "-"; $str .= ( 0002 & $mode ) ? "w" : "-"; if( 00001 == ( 01001 & $mode ) ) { $str .= "x"; } elsif( 00000 == ( 01001 & $mode ) ) { $str .= "-"; } elsif( 01001 == ( 01001 & $mode ) ) { $str .= "t"; } else { $str .= "T"; } $str; # Return constructed string. } # End of &ModeStr sub LogChange { # Describe how a file's mode, user, and group were cha +nged: # For example: ":1=:other -> :3=:sys; changed.group" or # ".-x.w.r.- => rwsr-x--x; 101:1=tye:other -> 0:3=root:sys; file.na +me" my( $file, $Omode, $Ouser, $Ogrp )= @_; # Filename, previous a +ttributes. my( $Nmode, $Nuser, $Ngrp )= (stat($file))[2,4,5]; # Get new attr +ibutes. my( $notice )= ""; # Notice string that will be d +isplayed. if( "" ne $Ouser ) { # Describe any changes to user and/or group ownership: $notice .= (getpwuid($Ouser))[0] if $Ouser != +$Nuser; $notice .= ":".(getgrgid($Ogrp))[0] if $Ogrp != $ +Ngrp; $notice .= "=" if "" ne $not +ice; $notice .= $Ouser if $Ouser != +$Nuser; $notice .= ":".$Ogrp if $Ogrp != $ +Ngrp; $notice .= " -> " if "" ne $not +ice; $notice .= "$Nuser" if $Ouser != +$Nuser; $notice .= ":$Ngrp" if $Ogrp != $ +Ngrp; $notice .= "=" if "" ne $not +ice; $notice .= (getpwuid($Nuser))[0] if $Ouser != +$Nuser; $notice .= ":".(getgrgid($Ngrp))[0] if $Ogrp != $ +Ngrp; $notice .= "; " if "" ne $not +ice; } if( $Omode != $Nmode ) { # Describe changes to mode (permis +sions): my( $Ostr, $Nstr )= ( &ModeStr($Omode), &ModeStr($Nmode) ); foreach ( 0 .. length($Ostr)-1 ) { # Turn unchanged bits +of... substr($Ostr,$_,1)= "." # old mode string into + "."s. if substr($Ostr,$_,1) eq substr($Nstr,$_,1); } $notice= "$Ostr => $Nstr; $notice"; } $notice= "(no change) " if "" eq $notice && 1 < $Debug; $notice= "Temporary: " . $notice if "" eq $Ouser; print "$notice $file\n" unless "" eq $notice; } # End of &LogChange sub ChangeFile { # Change mode, user, and/or group owner of one + file: my( $file )= @_; # Name of file to change. # Global( =$ModLink, =$User, =$Group, =$Mode, =$Self, =$Debug ); ##Local( $ModLink ); ##$ModLink= $ModLink && -l $file; ##if( ! $ModLink && ! -e $file ) { ##} if( ! -e $file ) { warn "$Self: Can't find file ($file): $!\n"; } else { my( $mode, $user, $group )= (stat(_))[2,4,5]; # If I'm not root and am changing owner, chmod while I still o +wn it: if( 0 != $> && "" ne $User ) { &SetMode( $file, $mode ) if "" ne $Mode; } ##if( $ModLink ) { ## lchown( $user, $group, $file ); ##} els if( "" ne $User || "" ne $Group ) { # Need to call + chown(): chown( "" ne $User ? $User : $user, # User or grou +p might... "" ne $Group ? $Group : $group, $file ) # stay + the same. || warn "$Self: Can't change owner/group of file ($file +): $!\n"; } # If don't have to chmod first, chmod last so "+s" will take e +ffect: if( 0 == $> || "" eq $User ) { # Exact opposite of ab +ove test. &SetMode( $file, $mode ) if "" ne $Mode; } # Tell the user what we changed, if in +terested: &LogChange( $file, $mode, $user, $group ) if $Debug; } } # End of &ChangeFile sub MungFile { # Modify file and possibly recurse into subdirectories +. my( $file )= @_; # Name of file to change. # Global( =$Self, =$Debug, =$Recurse ); if( ! $Recurse || -l $file || ! -d _ ) { &ChangeFile( $file ); } else { # Recurse into subdirectory: my( $dir )= $file; my( $omode )= ""; my( @dirs ); if( 0 != $> && ! -x _ || ! -r _ ) { $omode= (stat(_))[2]; # So can we undo this +later. # "chmod u+rx" so can recurse into this subdirectory: if( chmod( 0500 | $omode, $dir ) && "" ne $Debug ) { &LogChange( $dir, $omode, "", "" ); } } if( ! opendir( DIR, $dir ) ) { warn "$Self: Can't read subdirectory " . "to recurse into ($dir): $!\n"; } else { while( defined( $file= readdir(DIR) ) ) { # So "sub/0/di +r" OK. if( -l "$dir/$file" || ! -d _ ) { &ChangeFile( "$dir/$file" ); } elsif( $file !~ m#^\.{1,2}$# ) { push( @dirs, $file ); } # Don't recurse into "." nor ".." (infinite lo +op). } closedir( DIR ); while( @dirs ) { &MungFile( "$dir/" . pop(@dirs) ); } } chmod( $omode, $dir ) if "" ne $omode; &ChangeFile( $dir ); } } # End of &MungFile # sub main { # Program execution starts here: $ActLike= &WhoAmI; # Returns "mug", "mod", "own", or "grp". &ParseFlags; # Parse command-line flags (set globals, adjus +t @ARGV). &ModelFile if "" ne $Model; # Copy owner/mode from model (unshifts + @ARGV). if( @ARGV < 2 ) { # "chmug change file" is minimum invokation: &Usage( "Too few arguments" ); # Give helpful usage message. } if( "own" eq $ActLike && "," ne substr($ARGV[0],0,1) ) { # Be " +chown": $ARGV[0]= ",$ARGV[0]"; # "chown usr file" -> "chmug ,usr file +" } elsif( "grp" eq $ActLike && ":" ne substr($ARGV[0],0,1) ) { # Be + "chgrp": $ARGV[0]= ":$ARGV[0]"; # "chgrp grp file" -> "chmug :grp file +" } &ParseChange( shift(@ARGV) ); # Parse mode/user/group arg into globa +ls. ##if( $ModLink && "" ne $Mode ) { ## die "$Self: Do not specify mode ($Mode) when using -h.\n" ##} { my( $file ); foreach $file ( @ARGV ) { # Change each file listed: &MungFile( $file ); # (possibly recursing into directories +) } } # } # end of "main" __END__ Technical notes: If run as chmod (ie. if file name contains "mod"), "-f model" only changes mode bits (not user or group). If run as chown (ie file name matches /own/ or /use?r/), can't specify a mode (just "[[,]usr][:[grp]]") and "-f model" only changes user and group (not mode bits). If run as chgrp (ie file name matches /gr[ou]*p/), can't specify a mode nor a user (just "[:][grp]") and "-f model" only changes group (not mode bits nor user). Should /u[-+=]g/ really change "u+s" based on "g+s"??? /[-+=][ugo]/ uses what the mode bits where on the file _before any cha +nges were made_ while all other operations (/[-+=]X/, /[+=]s/) that look at + the "current" mode bits, use the mode bits _after_ applying whatever chang +es appear before (to the left of) that operation. So "+s" always works i +n "g+xs", "g+x+s", "g+x,g+s" because it can see the preceeding "+x". Fo +r convenience, /[+=]s/ can also see an "x" that follows it as part of th +e same operation (no [-+=] between the "s" and the "x") so the "s" will +always work in "g+sx" because it can see the nearby "+x" but "+s" will fail i +n "g+s+x" and "g+s,g+x" if the file was "g-x" at that point. Examples: "chmug =" = "chmug -rwx" turn off all bits set in umask |
|
Back to
Code Catacombs