#! /usr/bin/env perl # "rectify-perms-perl-sitedirs" - does about what it's called. # (C) 2003 Soren Andersen, All Rights Reserved. This software # may be modified or redistributed under the same terms as Perl # itself. Free Software. Absolutely no warrantee. # Version 03.08.01 use strict; use warnings; use Config; use File::Find (); use Cwd (); # Tell me the known group with access rights "+w" to the Perl site loc +ation: my $STAFF = 'staff'; # Adjust for your os. # for the convenience of &wanted calls, including -eval statements: use vars qw/*name *dir *prune/; *name = *File::Find::name; *dir = *File::Find::dir; *prune = *File::Find::prune; my (%gid, %group); my $cwd = Cwd::cwd(); while (my ($name, $pw, $gid) = getgrent) { $gid{$name} = $gid{$gid} = $gid; } my @Searchin; for my $thistop ($Config::Config{sitearchexp} , $Config::Config{siteli +bexp}) { push @Searchin , $thistop unless do { my $other = $thistop eq $Config::Config{sitelibexp} ? $Config::Config{sitearchexp} : $Config::Config{si +telibexp}; $other =~/^$thistop\w+/; }; } # Traverse site(arch|lib)exp filesystems, fix perms when wrong. File::Find::find({wanted => \&wanted}, @Searchin); exit; sub Can_Chgrp { return 1; # TODO } sub wanted { my ($dev,$ino,$mode,$nlink,$uid,$gid); unless (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) { die "Could not lstat() \"$_\", terminating!\n"; } unless ($gid == $gid{$STAFF}) { &doexec(1, 'chgrp', '-c', $STAFF, '{}') if &Can_Chgrp(); } if ( -d _ && ($gid == $gid{$STAFF}) && ! (($mode & 0660) == 0660) ) { &doexec(1, 'chmod','-c','ug+w','{}'); } } sub doexec { my $ok = shift; my $confit; my @pargs = @_; for my $word (@pargs) { ($word =~s#{}#$name#g) && ($confit = $word); } if ($ok) { my $old = select(STDOUT); $| = 1; print "Do this: " ,join(" ",@pargs), " ? "; select($old); return 0 unless <STDIN> =~ /^y/i; } chdir $cwd; #sigh system @pargs; chdir $File::Find::dir; return !$?; } __END__ On Debian GNU/Linux "woody", Perl release 5.6.1 has these build-time d +irectory params: archlib='/usr/lib/perl/5.6.1' archlibexp='/usr/lib/perl/5.6.1' privlib='/usr/share/perl/5.6.1' privlibexp='/usr/share/perl/5.6.1' bin='/usr/bin' binexp='/usr/bin' sitebin='/usr/local/bin' sitebinexp='/usr/local/bin' sitearch='/usr/local/lib/perl/5.6.1' sitearchexp='/usr/local/lib/perl/5.6.1' sitelib='/usr/local/share/perl/5.6.1' sitelibexp='/usr/local/share/perl/5.6.1'
In reply to Let the staff back in! by Intrepid
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |