#!/usr/bin/perl
use strict;
my($app_svnid) = '$HeadURL$ $LastChangedRevision$';
#  Allow bare words, so &ade_err_error() calls look nicer.
no strict 'subs';
use lib substr `ade-config ade_include_prefix`,0,-1;
use ADE;
use lib substr `fad-config fad_include_prefix`,0,-1;
use FAD;
use Getopt::Long qw(:config no_ignore_case);
#use File::Find;
#use Sys::Hostname;
use Data::Dumper;

#  Without predeclaring variables returned by fad-config, an error will be generated 
#  (probably because of 'use strict' above).  If ade-app-config is modified to generate a 
#  'my' itself then somehow the 'my' narrows the scope of the assignment to within the 
#  backquotes. Try running:
#
#      perl -e 'eval "my(\$x)=4"; print "x=$x\n";'
# 
#  with and without the 'my' to see what I mean. This means that we should not willy
#  nilly just run: 
#
#      eval `fad-config --format=perl`
#
#  Because if a new variable is added to the output then it will break this script. So
#  this script must (1) do 'my' for anything it wants, (2) specify explicitly anything
#  it wants from fad-config as a way of preventing fad-config from showing assignments
#  for more variables than we have 'my'ed.

my($fad_etc_prefix, $fad_log_prefix, $fad_state_prefix);
eval `fad-config --format=perl fad_etc_prefix fad_log_prefix fad_state_prefix`;

my(%fadfixperms_defined_errors) = (
    fadfixperms_err_access   => { fmt => "%s: can't %s" },
    fadfixperms_err_misc     => { fmt => "%s" },
);

#  Options
my($opt_simulate);

#my(@find_roots, $fileset);
#my($all_cnt, $del_cnt, $own_cnt, $grp_cnt, $mde_cnt, $typ_cnt, $lnk_cnt);
#my($crc_cnt, $mmn_cnt, $add_cnt, $sym_cnt, $schedflag_file, $hostname); 
##  The names of the days and monthes, used in date conversion
#my(@day_names)  = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");

#  Log and state files should not be readable by common users
#umask 077;

sub fadfixperms
{
    my($errstack_ref) = @_;
    my($config_file, @perm_pats, @real_perm_pats);
    my($perm_pat_ref, $real_perm_pat_ref);
    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, $copy_source_char);
    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_store, %current_store, %desired_store_hashed_on_filename);
    my(%pardirs_to_open, $part_current_st, $part_desired_st, $subpart_current_st, $subpart_desired_st);
    my($uid, $gid, $current_mode, $am_i_root, $name);
    my($need_to_issue_warning_if_may_have_to_change_owner);
    my($need_to_issue_warning_if_may_have_to_change_group);
    my($i, $j, $k);
    my($char);
    my($config_file, $infile, $in_handle, $collected_info_ref);

    ###########################################################################
    #
    #  Set ADE options
    #
    ###########################################################################

    #  Register application-specific errors
    &ade_err_registerdefderrs(\%fadfixperms_defined_errors);

    ##########################################################################
    #
    #  Process options
    #
    ##########################################################################

    #  Defaults for options
    $opt_simulate = 0;

    #  Register options
    if (($rc=&ade_opt_register($errstack_ref, "n", "simulate", "main::fadfixperms_opt_handler_%s")) != $ade_err_ok) {
        return($rc);
    }

    #  Register handler functions
    if (($rc=&ade_msg_register($errstack_ref, \&fadfixperms_usage, \&fadfixperms_version, \&fadfixperms_listpaths)) != $ade_err_ok) {
        return($rc);
    } 

    #  Process options
    &ade_err_debug($errstack_ref, 10, "fadfixperms: processing options ...");
    if (($rc=&ade_opt_process($errstack_ref)) != $ade_err_ok) {
        return($rc);
    }

    ##########################################################################
    #
    #  Process arguments
    #
    ##########################################################################

    &ade_msg_usage($errstack_ref) if (!defined($ARGV[1]) || defined($ARGV[2]));
    $config_file = $ARGV[0];
    $infile      = $ARGV[1];

    ##########################################################################
    #
    #  Sanity checks and derivations
    #
    ##########################################################################

    ##########################################################################
    #
    #  Guts
    #
    ##########################################################################

    &ade_err_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_err_error($errstack_ref, fadfixperms_err_access, $config_file, "stat");
        return($ade_err_fail);
    }

    &ade_err_debug($errstack_ref, 10, "fadfixperms: loading config file ...");
    if (($rc=&load_config_file($errstack_ref, $config_file, \@perm_pats)) != $ade_err_ok) {
        return($rc);
    }

    &ade_err_debug($errstack_ref, 10, "fadfixperms: checking if root ...");
    return ($rc) if (($rc=&ade_usr_amiroot($errstack_ref, \$am_i_root)) != $ade_err_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_err_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_err_debug($errstack_ref, 10, "fadfixperms: parsing generically slurped config data ...");
    #  Squeeze the generically slurped config data into application-specific structures.
    foreach $perm_pat_ref (@perm_pats) {
        #  second word on line is the pattern, first word is the permissions
        &ade_err_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_err_debug($errstack_ref, 10, "fadfixperms: validating regexp ...");
        if (($rc=&ade_smf_isvalidregexp($errstack_ref, ${$perm_pat_ref}[3])) != $ade_err_ok) {
            return($rc);
        }

        &ade_err_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_err_error($errstack_ref, fadfixperms_err_misc, "${$perm_pat_ref}[0]: invalid mode");
            return($ade_err_fail);
        }

        &ade_err_debug($errstack_ref, 10, "fadfixperms: validating username ...");
        if (${$perm_pat_ref}[1] cmp "!" && !defined($uid=getpwnam(${$perm_pat_ref}[1]))) {
            &ade_err_error($errstack_ref, fadfixperms_err_misc, "${$perm_pat_ref}[1]: invalid user");
            return($ade_err_fail);
        } elsif (${$perm_pat_ref}[1] eq "!") {
            $uid = -1;
        } elsif ($need_to_issue_warning_if_may_have_to_change_owner) {
            &ade_err_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_err_debug($errstack_ref, 10, "fadfixperms: validating groupname ...");
        if (${$perm_pat_ref}[2] cmp "!" && !defined($gid=getpwnam(${$perm_pat_ref}[2]))) {
            &ade_err_error($errstack_ref, fadfixperms_err_misc, "${$perm_pat_ref}[2]: invalid group");
            return($ade_err_fail);
        } elsif (${$perm_pat_ref}[2] eq "!") {
            $gid = -1;
        } elsif ($need_to_issue_warning_if_may_have_to_change_group) {
            &ade_err_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_err_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_err_debug($errstack_ref, 10, "fadfixperms: getting info on files specified in $infile ...");
    if ($infile eq "-") {
        $in_handle = \*STDIN;
    } elsif (!open(IN_HANDLE, $infile)) {
        &ade_err_error($errstack_ref, fadfixperms_err_access, $infile, "open");
        return($rc);
    } else {
        $in_handle = \*IN_HANDLE;
    }
    $rc = $ade_err_ok;
    &ade_err_info($errstack_ref, "examining current permissions ...");
    while (<$in_handle>) {
        chomp;
        #  refuse non-absolute stuff
        if (!/^\//) {
            $rc = $ade_err_fail;
            #  Raise error but delay return until we close the filehandle.
            &ade_err_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_collect_info($errstack_ref, $_, 1, \$collected_info_ref)) != $ade_err_ok);
        return($rc) if (($rc=&fad_insert_info($errstack_ref, \%current_store, $collected_info_ref)) != $ade_err_ok);
    }
    if ($infile eq "-") {
        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_err_ok);

    #  Clone store in order to work on that 
    &ade_err_info($errstack_ref, "determining desired permissions ...");
    &ade_err_debug($errstack_ref, 10, "fadfixperms: cloning store ...");
    return($rc) if (($rc=&fad_clone($errstack_ref, \%current_store, \%desired_store)) != $ade_err_ok);

    #  Generate hash of filename=>datakey 
    &ade_err_debug($errstack_ref, 10, "fadfixperms: creating filename=>datakey hash ...");
    #  undef means don't bother also making an ordered array of filenames
    if (($rc=&fad_index($errstack_ref, \%desired_store, \%desired_store_hashed_on_filename, undef)) != $ade_err_ok) {
        return($rc);
    }

    #  Fix the permissions according to the config file.
    &ade_err_debug($errstack_ref, 10, "fadfixperms: determining desired permissions ...");
    for $name (keys %desired_store_hashed_on_filename) {
        $uid          = $desired_store{$desired_store_hashed_on_filename{$name}}{data}{owner};
        $gid          = $desired_store{$desired_store_hashed_on_filename{$name}}{data}{group};
        $current_mode = $desired_store{$desired_store_hashed_on_filename{$name}}{data}{mode};
        &ade_err_debug($errstack_ref, 5, sprintf("fadfixperms: processing %s (uid=$uid, gid=$gid, current_mode=%04o) ...", $name, $current_mode));

        &ade_err_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_err_ok) {
            &ade_err_error($errstack_ref, fadfixperms_err_misc, "error while trying to find a match");
            return($rc);
        }
        if ($i == -1) {
            &ade_err_error($errstack_ref, fadfixperms_err_misc, "$name: not matched; consider adding '!!!------ ! ! .*' at the bottom of $config_file");
            return($ade_err_fail);
        }
        &ade_err_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;
        for ($j=2; $j>=0; $j--) {
            #  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 & 0700) >> 6;
                $part_current_st   = ($current_mode & 04000)

            #  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 & 0070) >> 3;
                $part_current_st   = ($current_mode & 02000)

            #  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 & 0007) >> 0;
                $part_current_st   = ($current_mode & 01000)
            }
            &ade_err_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 = 0000;
            $part_desired_st   = 0000;
            for ($k=0; $k<3; $k++) {
                #  On first inner loop stuff read permission into generic variables
                if ($k==0) {
                    $char = $readchar;
                    $subpart_current_mode = ($part_current_mode & 0004) >> 2;
                    $subpart_current_st   = 0;
                    #$copy_source_char  = $real_perm_pats[$i]{uread};
                    #  reduce it to 0 or 1.

                #  On second inner loop stuff write permission into generic variables
                } elsif ($k == 1) {
                    $char = $writechar;
                    $subpart_current_mode = ($part_current_mode & 0002) >> 1;
                    $subpart_current_st   = 0;
                    #$copy_source_char  = $real_perm_pats[$i]{uwrite};

                #  On third inner loop stuff execute permission into generic variables
                } else {
                    $char = $execchar;
                    $subpart_current_mode = ($part_current_mode & 0001) >> 0;
                    #  This saves flattening it by shifting
                    $subpart_current_st   = !(!$part_current_st);
                    #$copy_source_char  = $real_perm_pats[$i]{uexec};
                }
  
                $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' && $j==2) {
                    &ade_err_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_err_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_err_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 * 04000);
            } elsif ($j==1) {
                $desired_mode |= ($part_desired_mode << 3) | ($part_desired_st * 02000);
            } else {
                $desired_mode |= ($part_desired_mode << 0) | ($part_desired_st * 01000);
            }
        }
        &ade_err_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_err_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_err_debug($errstack_ref, 50, sprintf("fadfixperms: name=%s, current_gid=%d, desired_gid=%d", $name, $current_gid, $desired_gid));

        &ade_err_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_store{$desired_store_hashed_on_filename{$name}}{data}{owner} = $desired_uid;
        $desired_store{$desired_store_hashed_on_filename{$name}}{data}{group} = $desired_gid;
        $desired_store{$desired_store_hashed_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_fnm_dirname'ing it could possibly hop us over the name
        #  of the root we is used by get_pardirs_to_open to determine
        #  when it has added enough parent directories.
        if ($desired_mode & 0777) {
            &ade_err_debug($errstack_ref, 5, "fadfixperms: $name: investigating requirements for intermediate directories ...");
            if (($rc=&get_pardirs_to_open($errstack_ref, $name, $desired_mode, \%pardirs_to_open, \@real_perm_pats)) != $ade_err_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_err_debug($errstack_ref, 10, "fadfixperms: applying extended permissions for intermediate directories ...");
    foreach $name (keys %pardirs_to_open) {
        &ade_err_debug($errstack_ref, 10, sprintf("$desired_store_hashed_on_filename{$name}: adding %04o ...", $pardirs_to_open{$name}));
        $desired_store{$desired_store_hashed_on_filename{$name}}{data}{mode} |= $pardirs_to_open{$name};
    }

    &ade_err_info($errstack_ref, "applying desired permissions ...");
    &ade_err_debug($errstack_ref, 10, "fadfixperms: diffing current and desires stores with callback handling diffs ...");
    if (($rc=&fad_diff($errstack_ref, \%current_store, \%desired_store, \&processdiff_cb, { am_i_root => $am_i_root, simulate => $opt_simulate })) != $ade_err_ok) {
        return($rc);
    }

    return($ade_err_ok);
}

sub fadfixperms_opt_handler_n
{
    return(&fadfixperms_opt_handler_simulate(@_));
}

sub fadfixperms_opt_handler_simulate
{
    my($errstack_ref) = @_;

    $opt_simulate = 1;

    return($ade_err_ok);
}

sub fadfixperms_version
{
    my($errstack_ref, $version_text_ref) = @_;

    return(&ade_smf_extractversionfromsvnstring($errstack_ref, $app_svnid, $version_text_ref));
}

sub fadfixperms_listpaths
{
    my($errstack_ref, $pathlist_text_ref) = @_;
    my($rc);

    ${$pathlist_text_ref} = undef;

    return($ade_err_ok);
}

sub fadfixperms_usage
{
    my($errstack_ref, $usage_text_ref, $passno) = @_;

    if ($passno == 1) {
        ${$usage_text_ref} = "<config-file> <filelist-file>";
    } elsif ($passno == 2) {
        ${$usage_text_ref} = "         -n        | --simulate              don't do anything for real";
    }

    return($ade_err_ok);
} 

sub find_match
{
    my($errstack_ref, $perm_pats_ref, $name, $match_idx_ref, $allow_dotstar_match) = @_;
    my($i);

    #  Look for the first pattern which applies to this record's filename
    for ($i=0; $i <= $#{$perm_pats_ref}; $i++) {
        if (((${$perm_pats_ref}[$i]{pattern} cmp ".*") || $allow_dotstar_match) && ($name =~ /^${$perm_pats_ref}[$i]{pattern}$/)) {
            ${$match_idx_ref} = $i;
            return($ade_err_ok);
        }
    }

    ${$match_idx_ref} = -1;
    return($ade_err_ok);
}

sub get_pardirs_to_open
{
    my ($errstack_ref, $containee_name, $containee_perms, $pardirs_to_open_ref, $perm_pats_ref) = @_;
    my ($container_name, $container_perms, $match_index, $rc, $extra_perms);

    &ade_err_debug($errstack_ref, 5, sprintf("get_pardirs_to_open: containee_name=%s: containee_perms=%04o", $containee_name, $containee_perms));

    while (1) {
        last if ($containee_name eq "/");
      
        #  Determine container name.
        if (($rc=&ade_fnm_dirname($errstack_ref, $containee_name, \$container_name)) != $ade_err_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_err_debug($errstack_ref, 5, "get_pardirs_to_open: $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_err_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 & 0444) >> 2) | ($containee_perms & 0200) | ($containee_perms & 0111);
            &ade_err_debug($errstack_ref, 5, sprintf("get_pardirs_to_open: %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 & 0444) | (($containee_perms & 0444) >> 2) | ($containee_perms & 0200) | ($containee_perms & 0111);
            &ade_err_debug($errstack_ref, 5, sprintf("get_pardirs_to_open: %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.
        ${$pardirs_to_open_ref}{$container_name} |= $container_perms;
        &ade_err_debug($errstack_ref, 5, sprintf("get_pardirs_to_open: %s: cummulatively, will extend permissions with %04o later", $container_name, ${$pardirs_to_open_ref}{$container_name}));

        #  Prepare for next loop.
        $containee_name  = $container_name;
        $containee_perms = $container_perms;
    }

    return($ade_err_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 ...
    for ($i=0; $i<$#{@{$change_ref}{changes}}+1; $i++) {
  
        #  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_err_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_err_debug($errstack_ref, 20, sprintf("processdiff_cb: %s: ignoring symlink", $file));
        
        } elsif ($changetype eq $CT_MODE) {
            #  oldstate and newstate are *already* octal strings; they shouldn't be but 
	    #  it seems everything is coded that way!
            &ade_err_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_err_error($errstack_ref, fadfixperms_err_access, $file, "chmod");
                return($ade_err_fail);
            }

        } elsif ($changetype eq $CT_OWNER) {
            &ade_err_debug($errstack_ref, 20, sprintf("processdiff_cb: %s: need to chown %s -> %s", $file, $oldstate, $newstate));
            if (!$am_i_root) {
                &ade_err_error($errstack_ref, fadfixperms_err_misc, "$file: need to change owner and cannot because not running as root");
                return($ade_err_fail);
            }
            if ($simulate) {
                print STDERR "chown $newstate $file\n";
            } elsif (chown($newstate, -1, $file) != 1) {
                &ade_err_error($errstack_ref, fadfixperms_err_access, $file, "chown");
                return($ade_err_fail);
            }
        } elsif ($changetype eq $CT_GROUP) {
            &ade_err_debug($errstack_ref, 20, sprintf("processdiff_cb: %s: need to chgrp %s -> %s", $file, $oldstate, $newstate));
            if (!$am_i_root) {
                &ade_err_error($errstack_ref, fadfixperms_err_misc, "$file: need to change group and cannot because not running as root");
                return($ade_err_fail);
            }
            if ($simulate) {
                print STDERR "chgrp $newstate $file\n";
            } elsif (chown(-1, $newstate, $file) != 1) {
                &ade_err_error($errstack_ref, fadfixperms_err_access, $file, "chgrp");
                return($ade_err_fail);
            }
        } else {
            &ade_err_internal($errstack_ref, "processdiff_cb: unexpected change (file=$file, changetype=$changetype, oldstate=$oldstate, newstate=$newstate)") if ($changetype ne $CT_MODE);
        }
    }
}

sub load_config_file
{
    my($errstack_ref, $config_file, $other_tuples_ref) = @_;
    my($lineno);

    if (!defined($other_tuples_ref)) {
        &ade_err_internal($errstack_ref, "load_config_file: $config_file:$lineno: entry");
    }

    if (!open(CONFIG_HANDLE, $config_file)) {
         &ade_err_error($errstack_ref, fadfixperms_err_access, $config_file, "open");
         return($ade_err_fail);
    }

    while (<CONFIG_HANDLE>) {
        chomp;
        $lineno++;
  
        #  Ignore blank lines and hash-led comments
        next if (/^\s*$/ || /^\s*\#.*$/);

        #  Fan out other lines into generic structures
        push(@{$other_tuples_ref}, [ split ]);
    }
    close CONFIG_HANDLE;

    return($ade_err_ok);
}

&ade_gep_main(\&fadfixperms);
