Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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

In reply to chmug by tye

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others imbibing at the Monastery: (4)
    As of 2014-12-21 19:06 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (106 votes), past polls