#!ADE_APP_TOKEN_PERL_CMD
use strict; 
#  leave a standard path unless there is some reason not to
$ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin';
($main::progname = $0) =~ s/^.*\/([^\/]+)/$1/;
$main::svn_id = '$HeadURL$ $LastChangedRevision$';
$main::version_scheme = 'release';
$main::release_version = 'ADE_APP_TOKEN_RELEASE_ID';
my($tmp_dir) = ($ENV{'TMPDIR'}) ? $ENV{'TMPDIR'} : "ADE_APP_TOKEN_TMPDIR";

#  Defaults for options
my($dflt_simulate) = 0;

#  Option variables (needed at global level 'cos used in path reporting function)
undef my($opt_simulate);

#  Other globals

sub main
{
    my(@ARGV) = @_;
    my(%attribs, %names, %madeupdevinodes);
    my($config_file, @find_filters, @find_roots, @perm_pats, @real_perm_pats);
    my($find_filters_ref, $find_roots_ref, $perm_pat_ref, $real_perm_pat_ref);
    my($current_fadfile, $desired_fadfile, $rc, $name, $fad_record_id, $gperms);
    #  fields returned by exploding a record retrieved from the store.
    my($current_mode, $dev, $inode, $type, $uid, $gid, $nlink, $contents);
    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($currently_decided_mode, $newly_decided_mode);
    my($matched, $i, $j, $k, $junk_name, $diff_rc, $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(%pardirs_to_open, $part_current_st, $part_desired_st, $subpart_current_st, $subpart_desired_st);
    my($listpaths, $optval);

    ##########################################################################
    #
    #  PROCESS OPTIONS
    #
    ##########################################################################

    #
    #  Load option values from command line
    #
    while (defined($ARGV[0]) && $ARGV[0] =~ /^-./) {
        $_ = $ARGV[0];

        #  standard options
        if (/^(?:-V|--version)$/) {
            &ade_msg_version(\&app_version);

        } elsif (/^(-d$|--debug=)(.*)/) {
            $main::verboselevel = ($1 !~ /^-[^-]/) ? $2 : ((defined($ARGV[1])) ? scalar($optval=$ARGV[1],shift @ARGV,$optval) : &ade_msg_usage(\&app_usage, 1));

        } elsif (/^(?:-v|--verbose)$/) {
            $main::verboselevel = 3;

        } elsif (/^(?:-h|--help)$/) {
            &ade_msg_usage(\&app_usage, 0);

        } elsif (/^(?:-p|--list-paths)$/) {
            $listpaths = 1;

	#  -n is simulate
        } elsif (/^(?:-n|--simulate)$/) {
            $opt_simulate = 1;

        } elsif (/^--$/) {
            shift @ARGV;
	    last;

        } else {
            &ade_msg_usage(\&app_usage, 1);
        }

        shift @ARGV;
    }

    #
    #  Load option values from environment
    #

    #  (not supported by this program)

    #
    #  Load option values from config file
    #

    #  (not needed for this program)

    #
    #  hard-coded defaults
    #
    $opt_simulate     = $dflt_simulate            if (!defined($opt_simulate));

    #
    #  Sanity check and option rewrites
    #

    ##########################################################################
    #
    #  ARGUMENT PROCESSING
    #
    ##########################################################################

    &ade_msg_listpaths(\&app_listpaths) if ($listpaths);
    (!$ARGV[0] || $ARGV[1]) && &ade_msg_usage(\&app_usage, 1);
    $config_file = $ARGV[0];

    ##########################################################################
    #
    #  FORKING AND LOCKING
    #
    ##########################################################################

    #  (not needed for this program)

    ##########################################################################
    #
    #  GUTS STARTS HERE
    #
    ##########################################################################

    #  Read the config file in.
    &ade_msg_info("loading config file ...");
    if (! -f $config_file) {
        &ade_msg_errorerror("$config_file: can't access");
        return(1);
    }
    &load_config_file($config_file, \@find_filters, \@find_roots, \@perm_pats);

    if (($rc=&ade_usr_amiroot(\$am_i_root)) != 0) {
        ade_msg_errorerror("failed to determine if running as root");
        return($rc);
    }
    $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;

    #  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_msg_debug(20, "main: perms=${$perm_pat_ref}[0], owner=${$perm_pat_ref}[1], group=${$perm_pat_ref}[2], pattern=${$perm_pat_ref}[3]");
        #  Validate them.
        if (!&ade_smf_isvalidregexp(${$perm_pat_ref}[3])) {
            &ade_msg_errorerror("bad regexp '${$perm_pat_ref}[3]'");
            return(1);
        }
        if (${$perm_pat_ref}[0] !~ /^[-r!][-w!][-x!sS][-rc!][-wc!][-xc!sS][-rc!][-wc!][-xc!tT]$/) {
            &ade_msg_errorerror("invalid permission '${$perm_pat_ref}[0]'");
            return(1);
        }

        if (${$perm_pat_ref}[1] cmp "!" && !defined($uid=getpwnam(${$perm_pat_ref}[1]))) {
            &ade_msg_errorerror("invalid user name '${$perm_pat_ref}[1]'");
            return(1);
        } elsif (${$perm_pat_ref}[1] eq "!") {
            $uid = -1;
        } elsif ($need_to_issue_warning_if_may_have_to_change_owner) {
            &ade_msg_warning("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;
        }
       
        if (${$perm_pat_ref}[2] cmp "!" && !defined($gid=getpwnam(${$perm_pat_ref}[2]))) {
            &ade_msg_errorerror("invalid group name '${$perm_pat_ref}[2]'");
            return(1);
        } elsif (${$perm_pat_ref}[2] eq "!") {
            $gid = -1;
        } elsif ($need_to_issue_warning_if_may_have_to_change_group) {
            &ade_msg_warning("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;
        }

	#  Chop the permission up.
        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],
            #ugorwx   => ${$perm_pat_ref}[0],
        });
    }
    #  Once converted, the original generic structure is not required any more.
    undef(@perm_pats);

    #  Validate that some roots were provided. 
    if (!(@find_roots)) {
        &ade_msg_errorerror("no roots supplied");
        return(1);
    }

    #  Read the current state of the files (1 means suppress file CRCs).
    &ade_msg_info("retrieving current permissions ...");
    &findhier_to_fadstore(\@find_filters, \@find_roots, \%attribs, \%names, 
	    \%madeupdevinodes, 1);

    #  Write the current state out (only necessary 'cos diff'ing function acts of
    #  fadfile handles, not on FAD stores).
    &ade_msg_debug(20, "main: dumping FAD store (containing current state) to file ...");
    $current_fadfile = "$tmp_dir/$main::progname.$$.cur";
    &ade_tmp_register($current_fadfile);
    if (($rc=&ade_fcm_openwritecompressed($current_fadfile, \*CURRENT_HANDLE)) != 0) {
        &ade_msg_errorerror("$current_fadfile: can't open");
        return($rc);
    }
    if (($rc=&fadstore_to_fadstream($errstack_ref, \*CURRENT_HANDLE, \%attribs, \%names, \%madeupdevinodes)) != $ade_err_ok) {
        return($rc);
    }
    close CURRENT_HANDLE;
    

    #  Fix the permissions according to the config file.
    &ade_msg_info("determining desired permissions ...");
    for $name (&select_name_from_fadstore(\%attribs, \%names, \%madeupdevinodes)) {
        &ade_msg_debug(5, "main: processing $name ...");
        if (($rc=&select_fadrecord_from_fadstore_by_name($errstack_ref, $name, \%attribs, \%names, \%madeupdevinodes, \$packed_fadrec)) != $ade_err_ok) {
            return($rc);
        }
        if (($rc=&unpack_fadrec($errstack_ref, $packed_fadrec, \$unpacked_fadrec_array_ref)) != $ade_err_ok) {
            return($rc);
        }
        ($junk_name, $dev, $inode, $type, $uid, $gid, $current_mode, $nlink, $contents) = @{$unpacked_fadrec_array_ref};

        #  1 means "allow match with '.*' if present"
        if (($rc=&find_match($errstack_ref, \@real_perm_pats, $name, \$i, 1)) != $ade_err_ok) {
            &ade_msg_errorerror("error while trying to find a match");
            return($rc);
        }
        if ($i == -1) {
            &ade_msg_errorerror("$name: not matched; consider adding '!!!------ ! ! .*' at the bottom of $config_file");
            return(1);
        }
        &ade_msg_debug(5, sprintf("main: 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 $main::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)
            }

            #  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' we will deal with in just one moment. But first we 
                #  need to record the owner permissions.
                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'
                } elsif ($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_msg_debug(4, "main: 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_msg_debug(4, sprintf("main: 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_msg_debug(50, sprintf("main: 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_msg_debug(50, sprintf("main: name=%s, current_gid=%d, desired_gid=%d", $name, $current_gid, $desired_gid));

        &ade_msg_debug(5, sprintf("main: %s: setting perms %o", $name, $desired_mode));
        #  If there is a change, and the item is not a symlink, then put it in to the FAD store
        if (($type ne $main::IT_SYMLINK) && ($current_mode != $desired_mode || $current_uid != $desired_uid || $current_gid != $desired_gid)) {
            &ade_msg_debug(20, "calling modify_fadrecord_from_fadstore_by_name($name, ... pack_fadrec(...., $contents)) ...");
            if (($rc=&pack_fadrec($errstack_ref, [$name, $dev, $inode, $type, $desired_uid, $desired_gid, $desired_mode, $nlink, $contents], \$packed_fadrec)) != $ade_err_ok) {
                return($rc);
            }
            if (($rc=&modify_fadrecord_from_fadstore_by_name($name, \%attribs, \%names, \%madeupdevinodes, $packed_fadrec)) != $ade_err_ok) {
                return($rc);
            }
        }

        #  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.
        &get_pardirs_to_open($name, $desired_mode, \%pardirs_to_open, \@find_roots, \@real_perm_pats) if ($desired_mode & 0777);
  
        #  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_msg_info("determining desired permissions for intermediate directories ...");
    foreach $name (keys %pardirs_to_open) {
	#  get current perms
        if (($rc=&select_fadrecord_from_fadstore_by_name($errstack_ref, $name, \%attribs, \%names, \%madeupdevinodes, \$packed_fadrec)) != $ade_err_ok) {
            return($rc);
        }
        if (($rc=&unpack_fadrec($errstack_ref, $packed_fadrec, \$unpacked_fadrec_array_ref)) != $ade_err_ok) {
              return($rc);
        }
        ($junk_name, $dev, $inode, $type, $uid, $gid, $currently_decided_mode, $nlink, $contents) = @{$unpacked_fadrec_array_ref};
        #  *add* r-x for 'other' to the item
        $newly_decided_mode = $currently_decided_mode | $pardirs_to_open{$name};
	#  save new perms
        if (($rc=&pack_fadrec($errstack_ref, [$name, $dev, $inode, $type, $uid, $gid, $newly_decided_mode, $nlink, $contents], \$packed_fadrec)) != $ade_err_ok) {
            return($rc);
        }
        if (($rc=&modify_fadrecord_from_fadstore_by_name($name, \%attribs, \%names, \%madeupdevinodes, $packed_fadrec)) != $ade_err_ok) {
            return($rc);
        }
    }
    undef %pardirs_to_open;
    
    #  Write the fixed store out (only necessary 'cos diff'ing function acts of
    #  fadfile handles, not on FAD stores).
    &ade_msg_debug(20, "main: dumping FAD store (containing desired state) to file ...");
    $desired_fadfile = "$tmp_dir/$main::progname.$$.des";
    &ade_tmp_register($desired_fadfile);
    if (($rc=&ade_fcm_openwritecompressed($desired_fadfile, \*DESIRED_HANDLE)) != 0) {
        &ade_msg_errorerror("$desired_fadfile: can't open");
        return($rc);
    }
    if (($rc=&fadstore_to_fadstream($ade_err_ok, \*DESIRED_HANDLE, \%attribs, \%names, \%madeupdevinodes)) != $ade_err_ok) {
        return($rc);
    }
    close DESIRED_HANDLE;

    #  Now we can undef.
    &ade_msg_debug(20, "main: wiping (no longer needed) FAD store ...");
    undef %attribs;
    undef %names;
    undef %madeupdevinodes;

    #  Determine the differences and (via the callback) align them.
    &ade_msg_info("effecting desired permissions ...");
    if (($rc=&ade_fcm_openreadcompressed($current_fadfile, \*CURRENT_HANDLE)) != 0) {
        &ade_msg_errorerror("$current_fadfile: can't open");
        return($rc);
    }
    if (($rc=&ade_fcm_openreadcompressed($desired_fadfile, \*DESIRED_HANDLE)) != 0) {
        &ade_msg_errorerror("$desired_fadfile: can't open");
        return($rc);
    }

    #  Get past the headers (don't bother saving or comparing - we only just generated them so there
    #  is nothing interesting in them.
    &read_fad_header(\*CURRENT_HANDLE, undef);
    &read_fad_header(\*DESIRED_HANDLE, undef);

    #  Now generate the diffs and pass to locally supplied callback function. Note that the
    #  FAD callback mechanism (currently) does not provide a mechanism for passing in
    #  arbirary variables. The only way is to copy them in and out of globals around the 
    #  call to the FAD function which will call the callback. Here we pass in $am_i_root.
    $main::am_i_root = $am_i_root;
    $rc = &fadstreams_to_diffstream(\*CURRENT_HANDLE, \*DESIRED_HANDLE, \&fadfixperms_cb, undef, \$diff_rc);

    #  Tidy up
    &ade_msg_debug(20, "main: tidying up ...");
    close CURRENT_HANDLE;
    close DESIRED_HANDLE;
    unlink $current_fadfile;
    &ade_tmp_deregister($current_fadfile);
    unlink $desired_fadfile;
    &ade_tmp_deregister($desired_fadfile);

    #  This was delayed until after the tidying up which has to be done 
    #  regardless of whether &fadstreams_to_diffstream was successful or not.
    if ($rc != 0) {
        &ade_msg_errorerror("failed to generate/process change list");
        return($rc);
    }

    return(0);
}

sub find_match
{
    my($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) {
            if ($name =~ /^${$perm_pats_ref}[$i]{pattern}$/) {
                ${$match_idx_ref} = $i;
                return(0);
            }
        }
    }

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

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

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

    while (1) {
        #  if containee is a root, then stop; we cannot modify the container because it is
        #  outside the scope of responsibility of this function.
        foreach $find_root (@{$find_roots_ref}) {
            return(0) if ($find_root eq $containee_name);
        }
      
        #  Determine container name.
        $container_name = &ade_fnm_dirname($containee_name);
        #  If there is a rule for the container then do not fix its permssions as part of
        #  the ascent of parents, but rather return and let it get fixed when the main
        #  scanning process finds it.
        if (($rc=&find_match($perm_pats_ref, $container_name, \$match_index, 0)) != 0) {
            return($rc);
        }
        #return(0) 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_msg_debug(5, sprintf("get_pardirs_to_open: $container_perms: pattern for container exists, merging %o", $container_perms));

        } else {
            $container_perms = ($containee_perms & 0444) | (($containee_perms & 0444) >> 2) | ($containee_perms & 0200) | ($containee_perms & 0111);
            &ade_msg_debug(5, sprintf("get_pardirs_to_open: $container_perms: pattern for container does not exist, merging %o", $container_perms));
        }

        #  Record container name and perms.
        &ade_msg_debug(5, sprintf("get_pardirs_to_open: %s: merging perms %o", $container_name, $container_perms));
        ${$pardirs_to_open_ref}{$container_name} |= $container_perms;

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

sub fadfixperms_cb
{
    my($outhandle, $file, @changes) = @_;
    my($change, $oldstate, $newstate, $changetype, $am_i_root);

    #  the FAD function callback mechanism has a fixed interface. It is extended simply be 
    #  copying stuff in and out of globals on either side of the call.
    $am_i_root = $main::am_i_root;

    &ade_msg_debug(20, "fadfixperms_cb: processing file $file");
    #  Analyse the changes that are in @changes
    foreach $change (@changes) {
	#  set up handy aliases
        $changetype = $change->{change_type};
        $oldstate = $change->{old_value};
        $newstate = $change->{new_value};
        &ade_msg_debug(20, "fadfixperms_cb: processing change ($changetype, $oldstate, $newstate) ...");

        if ($changetype eq $main::CT_MODE) {
            #  oldstate and newstate are *already* octal strings; they shouldn't be but 
	    #  it seems everything is coded that way!
            &ade_msg_debug(20, sprintf("fadfixperms_cb: need to chmod %s %o -> %o", $file, oct($oldstate), oct($newstate)));
            if ($opt_simulate) {
                print STDERR "chmod $newstate $file\n";
            } else {
                chmod oct($newstate), $file;
            }
        } elsif ($changetype eq $main::CT_OWNER) {
            &ade_msg_debug(20, sprintf("fadfixperms_cb: need to chown %s %s -> %s", $file, $oldstate, $newstate));
            if (!$am_i_root) {
                &ade_msg_errorerror("need to change owner and cannot because not running as root");
                return(1);
            }
            if ($opt_simulate) {
                print STDERR "chown $newstate $file\n";
            } else {
                chown $newstate, -1, $file;
            }
        } elsif ($changetype eq $main::CT_GROUP) {
            &ade_msg_debug(20, sprintf("fadfixperms_cb: need to chgrp %s %s -> %s", $file, $oldstate, $newstate));
            if (!$am_i_root) {
                &ade_msg_errorerror("need to change group and cannot because not running as root");
                return(1);
            }
            if ($opt_simulate) {
                print STDERR "chgrp $newstate $file\n";
            } else {
                chown -1, $newstate, $file;
            }
        } else {
            &ade_err_internal("fadfixperms_cb: unexpected change (file=$file, changetype=$changetype, oldstate=$oldstate, newstate=$newstate)") if ($changetype ne $main::CT_MODE);
        }
    }
}

sub app_version
{
    my($version_ref) = @_;

    ${$version_ref} = $main::version;

    return(0);
}

sub app_usage
{
    print "Usage:   $main::progname [ <options> ] <cfgfile>\n";
    print "\n";
    #  standard options
    print "Options: -V | --version         display program version\n";
    print "         -v | --verbose         verbose\n";
    print "         -d | --debug=<level>   set debug level\n";
    print "         -h | --help            display this text\n";
    print "         -p | --list-paths      list paths used by this program\n";
    #  application-specific option
    print "         -n | --simulate        don't do anything\n";
    print "\n";

    return(0);
}

sub app_listpaths
{
    #  If there is only one log file use this
    #print "Log-File: $main::log_file\n"

    #  If there are several, then just report the directory
    #print "Log-Directory: $main::log_dir\n"

    return(0);
}
