#!/usr/bin/perl use strict; use warnings; my($app_svnid) = '$HeadURL$ $LastChangedRevision$'; ## no critic (RequireInterpolationOfMetachars) use lib substr(`ade-config ade_share_prefix`,0,-1) . '/include'; ## no critic (ProhibitBacktickOperators) use ADE; use lib substr(`fad-config fad_share_prefix`,0,-1) . '/include'; ## no critic (ProhibitBacktickOperators) use FAD; use Getopt::Long qw(:config no_ignore_case); use Data::Dumper; use Fatal qw( close unlink ); # obviate checking close()'s return code use experimental 'smartmatch'; my(%fadfixperms_defined_errors) = ( fadfixperms_err_access => { fmt => '%s: can\'t %s' }, fadfixperms_err_misc => { fmt => '%s' }, ); # Options my($opt_simulate); sub fadfixperms ## no critic (ProhibitExcessComplexity) { my($errstack_ref) = @_; my($config_file, @perm_pats, @real_perm_pats); my($desired_mode, $part_desired_mode, $subpart_desired_mode); my($current_uid, $current_gid, $desired_uid, $desired_gid); my($part_current_mode, $subpart_current_mode); my($readchar, $writechar, $execchar); my($owner_subpart_desired_read_mode, $owner_subpart_desired_write_mode); my($owner_subpart_desired_exec_mode); my($need_to_issue_warning_if_may_have_to_change_owner, $am_i_root); my($need_to_issue_warning_if_may_have_to_change_group); my($rc, %desired_keyed_on_devinode, %current_keyed_on_devinode, %devinodes_keyed_on_filename); my(%upward_dir_permissions, $part_current_st, $part_desired_st, $subpart_current_st, $subpart_desired_st); my($uid, $gid, $current_mode); my($i, $j, $k); my($char, $infile, $in_handle, $collected_info_ref); # Set ADE options ADE::register_error_types(\%fadfixperms_defined_errors); # Defaults for options $opt_simulate = 0; # Register options if (($rc=ADE::register_options($errstack_ref, 'n', 'simulate', 'main::fadfixperms_opt_handler_%s')) != $ADE::OK) { return($rc); } # Register handler functions if (($rc=ADE::set_callbacks($errstack_ref, \&fadfixperms_usage_help, \&fadfixperms_version, \&fadfixperms_paths)) != $ADE::OK) { return($rc); } # Process options ADE::debug($errstack_ref, 10, 'fadfixperms: processing options ...'); if (($rc=ADE::process_options($errstack_ref)) != $ADE::OK) { return($rc); } # Process arguments ADE::show_bad_usage($errstack_ref) if (not defined $ARGV[1] or defined $ARGV[2]); $config_file = $ARGV[0]; $infile = $ARGV[1]; # Sanity checks and derivations # Guts ADE::debug($errstack_ref, 10, 'fadfixperms: checking config file access ...'); # Config file can be file or device (e.g. /dev/null) if (! -e $config_file) { ADE::error($errstack_ref, 'fadfixperms_err_access', $config_file, 'stat'); return($ADE::FAIL); } ADE::debug($errstack_ref, 10, 'fadfixperms: loading config file ...'); if (($rc=load_config_file($errstack_ref, $config_file, \@perm_pats)) != $ADE::OK) { return($rc); } ADE::debug($errstack_ref, 10, 'fadfixperms: checking if root ...'); return ($rc) if (($rc=ADE::validate_root_user($errstack_ref, \$am_i_root)) != $ADE::OK); $need_to_issue_warning_if_may_have_to_change_owner = ($am_i_root) ? 0 : 1; $need_to_issue_warning_if_may_have_to_change_group = ($am_i_root) ? 0 : 1; ADE::debug($errstack_ref, 10, "fadfixperms: need_to_issue_warning_if_may_have_to_change_owner=$need_to_issue_warning_if_may_have_to_change_owner, need_to_issue_warning_if_may_have_to_change_group=$need_to_issue_warning_if_may_have_to_change_group"); ADE::debug($errstack_ref, 10, 'fadfixperms: parsing generically slurped config data ...'); # Squeeze the generically slurped config data into application-specific structures. foreach my $perm_pat_ref (@perm_pats) { # second word on line is the pattern, first word is the permissions ADE::debug($errstack_ref, 20, "fadfixperms: perms=${$perm_pat_ref}[0], owner=${$perm_pat_ref}[1], group=${$perm_pat_ref}[2], pattern=${$perm_pat_ref}[3]"); ADE::debug($errstack_ref, 10, 'fadfixperms: validating regexp ...'); if (($rc=ADE::validate_regexp($errstack_ref, ${$perm_pat_ref}[3])) != $ADE::OK) { return($rc); } ADE::debug($errstack_ref, 10, 'fadfixperms: validating mode ...'); if (${$perm_pat_ref}[0] !~ /^[-r!][-w!][-x!sS][-rc!][-wc!][-xc!sS][-rc!][-wc!][-xc!tT]$/) { ADE::error($errstack_ref, 'fadfixperms_err_misc', "${$perm_pat_ref}[0]: invalid mode"); return($ADE::FAIL); } ADE::debug($errstack_ref, 10, 'fadfixperms: validating username ...'); # brackets for precendence not functionalisation of 'defined'. if (${$perm_pat_ref}[1] cmp '!' and not defined ($uid=getpwnam ${$perm_pat_ref}[1])) { ADE::error($errstack_ref, 'fadfixperms_err_misc', "${$perm_pat_ref}[1]: invalid user"); return($ADE::FAIL); } elsif (${$perm_pat_ref}[1] eq '!') { $uid = -1; } elsif ($need_to_issue_warning_if_may_have_to_change_owner) { ADE::warning($errstack_ref, 'fadfixperms_err_misc', 'entry with changed user name; if this pattern is matched an error will follow'); $need_to_issue_warning_if_may_have_to_change_owner = 0; } ADE::debug($errstack_ref, 10, 'fadfixperms: validating groupname ...'); # brackets for precendence not functionalisation of 'defined'. if (${$perm_pat_ref}[2] cmp '!' and not defined ($gid=getpwnam ${$perm_pat_ref}[2])) { ADE::error($errstack_ref, 'fadfixperms_err_misc', "${$perm_pat_ref}[2]: invalid group"); return($ADE::FAIL); } elsif (${$perm_pat_ref}[2] eq '!') { $gid = -1; } elsif ($need_to_issue_warning_if_may_have_to_change_group) { ADE::warning($errstack_ref, 'fadfixperms_err_misc', 'entry with changed group name; if this pattern is matched an error will follow'); $need_to_issue_warning_if_may_have_to_change_group = 0; } ADE::debug($errstack_ref, 10, 'fadfixperms: chopping up mode ...'); push @real_perm_pats, { uread => (split //, ${$perm_pat_ref}[0])[0], uwrite => (split //, ${$perm_pat_ref}[0])[1], uexec => (split //, ${$perm_pat_ref}[0])[2], gread => (split //, ${$perm_pat_ref}[0])[3], gwrite => (split //, ${$perm_pat_ref}[0])[4], gexec => (split //, ${$perm_pat_ref}[0])[5], oread => (split //, ${$perm_pat_ref}[0])[6], owrite => (split //, ${$perm_pat_ref}[0])[7], oexec => (split //, ${$perm_pat_ref}[0])[8], uid => $uid, gid => $gid, pattern => ${$perm_pat_ref}[3], }; } # Once converted, the original generic structure is not required any more. undef @perm_pats; ADE::debug($errstack_ref, 10, "fadfixperms: getting info on files specified in $infile ..."); if ($infile eq '-') { $in_handle = \*STDIN; } elsif (!open $in_handle, '<', $infile) { ADE::error($errstack_ref, 'fadfixperms_err_access', $infile, 'open'); return($rc); } $rc = $ADE::OK; ADE::info($errstack_ref, 'examining current permissions ...'); while (<$in_handle>) { chomp; # refuse non-absolute stuff if (!/^\//) { $rc = $ADE::FAIL; # Raise error but delay return until we close the filehandle. ADE::error($errstack_ref, 'fadfixperms_err_misc', "$_: not absolute"); last; } # Always strip trailing slashes (unless its *just* a slash). We need this to ensure # that the directories that are stored in the FAD store have the same names as that # names we generate when deciding what an item's parent directories are. (Without them # being the same then any permission modifications will be applied to names not actually # in the store.) s/\/$// if (!/^\/$/); # 1 means don't collect CRCs. return($rc) if (($rc=FAD::fad_collect_info($errstack_ref, $_, 1, \$collected_info_ref)) != $ADE::OK); return($rc) if (($rc=FAD::fad_insert_info($errstack_ref, \%current_keyed_on_devinode, $collected_info_ref)) != $ADE::OK); } if ($infile ne '-') { close $in_handle; } # This is the return from the non-absolute error raised above, but delayed until file close completed. return($rc) if ($rc != $ADE::OK); # Clone store in order to work on that ADE::info($errstack_ref, 'determining desired permissions ...'); ADE::debug($errstack_ref, 10, 'fadfixperms: cloning store ...'); return($rc) if (($rc=FAD::fad_clone($errstack_ref, \%current_keyed_on_devinode, \%desired_keyed_on_devinode)) != $ADE::OK); # Generate hash of filename=>datakey ADE::debug($errstack_ref, 10, 'fadfixperms: creating filename=>datakey hash ...'); # undef means don't bother also making an ordered array of filenames if (($rc=FAD::fad_index($errstack_ref, \%desired_keyed_on_devinode, \%devinodes_keyed_on_filename, undef)) != $ADE::OK) { return($rc); } # Fix the permissions according to the config file. ADE::debug($errstack_ref, 10, 'fadfixperms: determining desired permissions ...'); for my $name (keys %devinodes_keyed_on_filename) { $uid = $desired_keyed_on_devinode{$devinodes_keyed_on_filename{$name}}{'data'}{'owner'}; $gid = $desired_keyed_on_devinode{$devinodes_keyed_on_filename{$name}}{'data'}{'group'}; $current_mode = $desired_keyed_on_devinode{$devinodes_keyed_on_filename{$name}}{'data'}{'mode'}; ADE::debug($errstack_ref, 5, sprintf "fadfixperms: processing %s (uid=$uid, gid=$gid, current_mode=%04o) ...", $name, $current_mode); ADE::debug($errstack_ref, 5, 'fadfixperms: finding a matching rule to apply ...'); # 1 means "allow match with '.*' if present" if (($rc=find_match($errstack_ref, \@real_perm_pats, $name, \$i, 1)) != $ADE::OK) { ADE::error($errstack_ref, 'fadfixperms_err_misc', 'error while trying to find a match'); return($rc); } if ($i == -1) { ADE::error($errstack_ref, 'fadfixperms_err_misc', "$name: not matched; consider adding '!!!------ ! ! .*' at the bottom of $config_file"); return($ADE::FAIL); } ADE::debug($errstack_ref, 5, sprintf 'fadfixperms: matched %s with %s', $name, $real_perm_pats[$i]{'pattern'}); # Don't try to change symlink permissions: if a file has 'c-c' (i.e. to # be opened and a symlink to it has '---' then, since there is no # portable way to make chown act on the symlink, the resulting permissions # will depend on the order of execution. # # Note that we used to here just execute: # # next if ($type eq $IT_SYMLINK); # # but this is not good enough. We *still* need to open up parent directories # of symlinks even if we do not actually chmod/own/grp them themselves. # # Note also that the desired permission of the symlink (even though we won't # set it affects the desired permission of the parent directories. So even # for symlinks we still need to go through working out *its* desired permissions. # Calculate $desired_mode $desired_mode = 0000; foreach my $j (2, 1, 0) { # On first loop stuff user permissions into generic variables if ($j==2) { $readchar = $real_perm_pats[$i]{'uread'}; $writechar = $real_perm_pats[$i]{'uwrite'}; $execchar = $real_perm_pats[$i]{'uexec'}; $part_current_mode = ($current_mode & oct 700) >> 6; $part_current_st = $current_mode & oct 4000; # On second loop stuff group permissions into generic variables } elsif ($j==1) { $readchar = $real_perm_pats[$i]{'gread'}; $writechar = $real_perm_pats[$i]{'gwrite'}; $execchar = $real_perm_pats[$i]{'gexec'}; $part_current_mode = ($current_mode & oct 70) >> 3; $part_current_st = $current_mode & oct 2000; # On third loop stuff other permissions into generic variables } else { $readchar = $real_perm_pats[$i]{'oread'}; $writechar = $real_perm_pats[$i]{'owrite'}; $execchar = $real_perm_pats[$i]{'oexec'}; $part_current_mode = ($current_mode & oct 7) >> 0; $part_current_st = $current_mode & oct 1000; } ADE::debug($errstack_ref, 4, "fadfixperms: done extracting info for this loop (name=$name, j=$j, k=$j, part_current_mode=$part_current_mode, part_current_st=$part_current_st"); # Within each of those iterations, deal with each of read, write and execute # in iterations of an inner loop $part_desired_mode = 0; $part_desired_st = 0; foreach my $k (0, 1, 2) { # On first inner loop stuff read permission into generic variables if ($k==0) { $char = $readchar; $subpart_current_mode = ($part_current_mode & oct 4) >> 2; $subpart_current_st = 0; # On second inner loop stuff write permission into generic variables } elsif ($k == 1) { $char = $writechar; $subpart_current_mode = ($part_current_mode & oct 2) >> 1; $subpart_current_st = 0; # On third inner loop stuff execute permission into generic variables } else { $char = $execchar; $subpart_current_mode = ($part_current_mode & oct 1) >> 0; # This saves flattening it by shifting $subpart_current_st = !(!$part_current_st); } $subpart_desired_mode = 0; # '-' means we don't want it if ($char eq '-') { $subpart_desired_mode = 0; $subpart_desired_st = 0; # 'r' or 'w' or 'x' means we do want it } elsif ($char =~ /^[rwx]$/) { $subpart_desired_mode = 1; $subpart_desired_st = 0; # 's' or 't' means we want perm and setuid/gid/sticky } elsif ($char =~ /^[st]$/) { $subpart_desired_mode = 1; $subpart_desired_st = 1; # 'S' or 'T' means we don't want perm but do want setuid/gid/sticky } elsif ($char =~ /^[ST]$/) { $subpart_desired_mode = 0; $subpart_desired_st = 1; # '!' means keep current permission } elsif ($char eq '!') { $subpart_desired_mode = $subpart_current_mode; $subpart_desired_st = $subpart_current_st; # 'c' means copy from owner, but we need to note the owner first. } elsif ($char eq 'c' and $j==2) { ADE::internal($errstack_ref, 'fadfixperms: copy not allowed for user (shouldn\'t this have already been checked?)'); } elsif ($char eq 'c') { # Before we deal with this one we need to have already decided # the new mode for the owner (done above) and cached this (not # done yet) so we'll deal with it in a minute. } else { ADE::internal($errstack_ref, "fadfixperms: $char: unexpected value for \$char (\%real_perm_pats[$i]" . Dumper($real_perm_pats[$i])); } # First time round the loop (when dealing with the owner's mode) # cache the desired mode; this is so as to be able to copy it to # the group or others if we encounter a 'c' in *their* slots. if ($j==2) { if ($k==0) { $owner_subpart_desired_read_mode = $subpart_desired_mode; } elsif ($k==1) { $owner_subpart_desired_write_mode = $subpart_desired_mode; } else { $owner_subpart_desired_exec_mode = $subpart_desired_mode; } } # Now we can deal with 'c' (we are already certain that we are # dealing with the group or other, as the c/owner combination has # been excluded by the error check above). if ($char eq 'c') { if ($k==0) { $subpart_desired_mode = $owner_subpart_desired_read_mode; # never copy setuid/gid/sticky $subpart_desired_st = 0; } elsif ($k==1) { $subpart_desired_mode = $owner_subpart_desired_write_mode; # never copy setuid/gid/sticky $subpart_desired_st = 0; } else { $subpart_desired_mode = $owner_subpart_desired_exec_mode; # never copy setuid/gid/sticky $subpart_desired_st = 0; } } ADE::debug($errstack_ref, 4, "fadfixperms: name=$name, j=$j,k=$k,subpart_desired_mode=$subpart_desired_mode, subpart_desired_st=$subpart_desired_st"); # Ok, we extracted and right-shifted twice (once to get the rwx-tuple out # of the rwxrwxrwx-tuple, and the one to get the r or w or x out of # the rwx-tuple, now we have just a single '1' or '0'. We need to left # shift this twice to restore it to its proper position in the full # rwxrwxrwx sequence. if ($k==0) { $part_desired_mode |= ($subpart_desired_mode << 2); $part_desired_st |= $subpart_desired_st; } elsif ($k==1) { $part_desired_mode |= ($subpart_desired_mode << 1); $part_desired_st |= $subpart_desired_st; } else { $part_desired_mode |= ($subpart_desired_mode << 0); $part_desired_st |= $subpart_desired_st; } } if ($j==2) { $desired_mode |= ($part_desired_mode << 6) | ($part_desired_st * oct 4000); } elsif ($j==1) { $desired_mode |= ($part_desired_mode << 3) | ($part_desired_st * oct 2000); } else { $desired_mode |= ($part_desired_mode << 0) | ($part_desired_st * oct 1000); } } ADE::debug($errstack_ref, 4, sprintf 'fadfixperms: name=%s, current_mode=%04o, desired_mode=%04o', $name, $current_mode, $desired_mode); $current_uid = $uid; $desired_uid = ($real_perm_pats[$i]{'uid'} == -1) ? $current_uid : $real_perm_pats[$i]{'uid'}; ADE::debug($errstack_ref, 50, sprintf 'fadfixperms: name=%s, current_uid=%d, desired_uid=%d', $name, $current_uid, $desired_uid); $current_gid = $gid; $desired_gid = ($real_perm_pats[$i]{'gid'} == -1) ? $current_gid : $real_perm_pats[$i]{'gid'}; ADE::debug($errstack_ref, 50, sprintf 'fadfixperms: name=%s, current_gid=%d, desired_gid=%d', $name, $current_gid, $desired_gid); ADE::debug($errstack_ref, 5, sprintf 'fadfixperms: %s: setting perms %04o', $name, $desired_mode); # Write desired settings back (easier than checking for changes and only if there is # one then writing back). $desired_keyed_on_devinode{$devinodes_keyed_on_filename{$name}}{'data'}{'owner'} = $desired_uid; $desired_keyed_on_devinode{$devinodes_keyed_on_filename{$name}}{'data'}{'group'} = $desired_gid; $desired_keyed_on_devinode{$devinodes_keyed_on_filename{$name}}{'data'}{'mode'} = $desired_mode; # If the object is now any of r/w/x to others (either because # it was already or we have decided it should be) (or it # was a symlink which hasn't actually been changed, but would # have been if it wasn't a symlink) then add the appropriate # permissions to the objects in between # the list of things to open up a bit. Really, we should check # that $name is not one of the roots of the scan, otherwise # ade_get_dirname'ing it could possibly hop us over the name # of the root we is used by get_upward_dir_permissions to determine # when it has added enough parent directories. if ($desired_mode & oct 777) { ADE::debug($errstack_ref, 5, "fadfixperms: $name: investigating requirements for intermediate directories ..."); if (($rc=get_upward_dir_permissions($errstack_ref, $name, $desired_mode, \%upward_dir_permissions, \@real_perm_pats)) != $ADE::OK) { return($rc); } } # We can't actually change work out the new permissions here # because later processed files will overwrite the decided # permissions. All we do is *note* that they need changing # with the above code, and then once outside the file processing # loop then we actually add the read and execute permissions to # the intermediate directories. # # To clarify, consider that the root is /a and that /a/b/c/d # is a file to have write permission added to it. Then a, a/b # and a/b/c will need to have read and execute added. But, # if there is an additional final pattern - a catchall - # which specifies that '.*' is to have r,w & x stripped, # then the order would be - if we did the permission calculation # in the loop, (1) work out perms for a/b/c/d, (2) work out # opening perms for a/b/c, a/b and a (3) work out closing perms # for the same things (as the 'find' processes them). } # Now, regardless of whatever the permissions on those objects in between # the specified items and the root directories, add sufficient access # rights so that people can get to them. ADE::debug($errstack_ref, 10, 'fadfixperms: applying extended permissions for intermediate directories ...'); foreach my $upward_dir (keys %upward_dir_permissions) { # This is hideous! We need to adjust the information about a parent # directory and that may *not* have already been collected. E.g. # If scanning /a/b/c we'll need to adjust the permissions of /, # /a, /a/b but we've not collected info about those. This is definitely a bug! if (!($devinodes_keyed_on_filename{$upward_dir} ~~ [ keys %desired_keyed_on_devinode ])) { ADE::debug($errstack_ref, 10, "fadfixperms: we are missing info about $upward_dir"); } else { $desired_keyed_on_devinode{$devinodes_keyed_on_filename{$upward_dir}}{'data'}{'mode'} |= $upward_dir_permissions{$upward_dir}; } } ADE::info($errstack_ref, 'applying desired permissions ...'); ADE::debug($errstack_ref, 10, 'fadfixperms: diffing current and desires stores with callback handling diffs ...'); if (($rc=FAD::fad_diff($errstack_ref, \%current_keyed_on_devinode, \%desired_keyed_on_devinode, \&processdiff_cb, { am_i_root => $am_i_root, simulate => $opt_simulate })) != $ADE::OK) { return($rc); } return($ADE::OK); } sub fadfixperms_opt_handler_n ## no critic (RequireArgUnpacking) { return(fadfixperms_opt_handler_simulate(@_)); } sub fadfixperms_opt_handler_simulate { my($errstack_ref) = @_; $opt_simulate = 1; return($ADE::OK); } sub fadfixperms_version { my($errstack_ref, $version_text_ref) = @_; return(ADE::extract_version($errstack_ref, $app_svnid, $version_text_ref)); } sub fadfixperms_paths { my($errstack_ref, $pathlist_text_ref) = @_; my($rc); ${$pathlist_text_ref} = undef; return($ADE::OK); } sub fadfixperms_usage_help { my($errstack_ref, $usage_text_short_ref, $usage_text_long_ref) = @_; ${$usage_text_short_ref} = ' '; ${$usage_text_long_ref} = " -n | --simulate don't do anything for real\n"; return($ADE::OK); } sub find_match { my($errstack_ref, $perm_pats_ref, $name, $match_idx_ref, $allow_dotstar_match) = @_; # Look for the first pattern which applies to this record's filename foreach my $i (0..$#{$perm_pats_ref}) { if (((${$perm_pats_ref}[$i]{'pattern'} cmp '.*') or $allow_dotstar_match) and ($name =~ /^${$perm_pats_ref}[$i]{'pattern'}$/)) { ${$match_idx_ref} = $i; return($ADE::OK); } } ${$match_idx_ref} = -1; return($ADE::OK); } sub get_upward_dir_permissions { my ($errstack_ref, $containee_name, $containee_perms, $upward_dir_permissions_ref, $perm_pats_ref) = @_; my ($container_name, $container_perms, $match_index, $rc); ADE::debug($errstack_ref, 5, sprintf 'get_upward_dir_permissions: containee_name=%s: containee_perms=%04o', $containee_name, $containee_perms); while (1) { last if ($containee_name eq '/'); # Determine container name. if (($rc=ADE::get_dirname($errstack_ref, $containee_name, \$container_name)) != $ADE::OK) { return ($rc); } # If there is a rule for the container then do not fix its permissions as part of # the ascent of parents, but rather return and let it get fixed when the main # scanning process finds it. ADE::debug($errstack_ref, 5, "get_upward_dir_permissions: $container_name: scanning for patterns matching this container ..."); if (($rc=find_match($errstack_ref, $perm_pats_ref, $container_name, \$match_index, 0)) != 0) { return($rc); } #return($ADE::OK) if ($match_index != -1); # If we have encountered a later pattern which provides permissions for the container # then we used to stop ascending in the assumption that when the container was scanned, # as part of the main scanning loop, then the patterns - which of course the user # has correctly set - would be applied to the container, as desired, and it would # all work out fine. Unfortunately, this is not the case. If we encounter a pattern # that provides perms for the container, then we must ensure that the container *still* # has enough openness for the containee to be reached. This probably doesn't have # to be more than directory-execute permission though. So let's ensure that we continue # ascending, but not applying read permission, only directory-execute. if ($match_index != -1) { $container_perms = (($containee_perms & oct 444) >> 2) | ($containee_perms & oct 200) | ($containee_perms & oct 111); ADE::debug($errstack_ref, 5, sprintf 'get_upward_dir_permissions: %s: match found; due to this containee, will extend permissions with %04o later', $container_name, $container_perms); } else { # term #1: same people can execute container as can execute containee # term #2: same people can read container as can execute containee (>>2 is same as /4) # term #3: owner can write container if can write containee # term #4: same people can read container as can read containee $container_perms = ($containee_perms & oct 444) | (($containee_perms & oct 444) >> 2) | ($containee_perms & oct 200) | ($containee_perms & oct 111); ADE::debug($errstack_ref, 5, sprintf 'get_upward_dir_permissions: %s: no match found; due to this containee, will extend permissions with %04o later', $container_name, $container_perms); } # Record container name and perms (or-ed because other items at the same level # may trigger the *same* parents to be changed. ${$upward_dir_permissions_ref}{$container_name} |= $container_perms; ADE::debug($errstack_ref, 5, sprintf 'get_upward_dir_permissions: %s: cummulatively, will extend permissions with %04o later', $container_name, ${$upward_dir_permissions_ref}{$container_name}); # Prepare for next loop. $containee_name = $container_name; $containee_perms = $container_perms; } return($ADE::OK); } sub processdiff_cb { my($errstack_ref, $param, $change_ref) = @_; my($oldstate, $newstate, $file, $changetype); my($am_i_root, $simulate, $i); # Unpack the two parameters from the one the callback interface allowed to pass. $am_i_root = ${$param}{'am_i_root'}; $simulate = ${$param}{'simulate'}; # For each sort of difference detected for the one file for which this callback was called ... foreach my $i (0..$#{@{$change_ref}{'changes'}}) { # Create some aliases $changetype = ${$change_ref}{'changes'}[$i]{'type'}; $oldstate = ${$change_ref}{'changes'}[$i]{'old'}; $newstate = ${$change_ref}{'changes'}[$i]{'new'}; $file = ${$change_ref}{'file'}; ADE::debug($errstack_ref, 4, "faddiff_cb: changetype=$changetype, oldstate=$oldstate, newstate=$newstate, file=$file"); # Symlinks are always 777 on Linux so don't bother trying to modify them. if (-l $file) { ADE::debug($errstack_ref, 20, sprintf 'processdiff_cb: %s: ignoring symlink', $file); } elsif ($changetype eq $FAD::CT_MODE) { # oldstate and newstate are *already* octal strings; they shouldn't be but # it seems everything is coded that way! ADE::debug($errstack_ref, 20, sprintf 'processdiff_cb: %s: need to chmod %04o -> %04o', $file, $oldstate, $newstate); if ($simulate) { printf STDERR "chmod %04o %s\n", $newstate, $file; } elsif (chmod($newstate, $file) != 1) { ADE::warning($errstack_ref, 'fadfixperms_err_access', $file, 'chmod'); next; } } elsif ($changetype eq $FAD::CT_OWNER) { ADE::debug($errstack_ref, 20, sprintf 'processdiff_cb: %s: need to chown %s -> %s', $file, $oldstate, $newstate); if (!$am_i_root) { ADE::warning($errstack_ref, 'fadfixperms_err_misc', "$file: need to change owner and cannot because not running as root"); next; } if ($simulate) { print STDERR "chown $newstate $file\n"; } elsif (chown($newstate, -1, $file) != 1) { ADE::warning($errstack_ref, 'fadfixperms_err_access', $file, 'chown'); next; } } elsif ($changetype eq $FAD::CT_GROUP) { ADE::debug($errstack_ref, 20, sprintf 'processdiff_cb: %s: need to chgrp %s -> %s', $file, $oldstate, $newstate); if (!$am_i_root) { ADE::warning($errstack_ref, 'fadfixperms_err_misc', "$file: need to change group and cannot because not running as root"); next; } if ($simulate) { print STDERR "chgrp $newstate $file\n"; } elsif (chown(-1, $newstate, $file) != 1) { ADE::warning($errstack_ref, 'fadfixperms_err_access', $file, 'chgrp'); next; } } else { ADE::internal($errstack_ref, "processdiff_cb: unexpected change (file=$file, changetype=$changetype, oldstate=$oldstate, newstate=$newstate)") if ($changetype ne $FAD::CT_MODE); } } # Deliberately no return value. return $ADE::OK; } sub load_config_file { my($errstack_ref, $config_file, $other_tuples_ref) = @_; my($lineno, $config_handle); if (not defined $other_tuples_ref) { ADE::internal($errstack_ref, "load_config_file: $config_file:$lineno: entry"); } if (!open $config_handle, '<', $config_file) { ADE::error($errstack_ref, 'fadfixperms_err_access', $config_file, 'open'); return($ADE::FAIL); } while (<$config_handle>) { chomp; $lineno++; # Ignore blank lines and hash-led comments next if (/^\s*$/ or /^\s*\#.*$/); # Fan out other lines into generic structures push @{$other_tuples_ref}, [ split ]; } close $config_handle; return($ADE::OK); } ADE::main(\&fadfixperms);