#!/usr/bin/perl
#
# home_perms [options]
#
# Read a configuration file and set permissions of the files in my home
# directory according to that file.  What permissions should be set is
# controlled by a special "perm_list" data file. If the permissions of a file
# is correct no changes are made (preserving timestamps).
#
# Options:
#     --help          List Options
#     --doc           Output Documentation
#     -q              Be quiet, don't report directory progress
#     -dl             Debugging List Read
#     -dc             Debugging Permission Checks
#     -n              Dry Run, don't actually fix anything, just report them
#     -f perm_list    The permissions list to use (relative to your home)
#                     The default file is "lib/perm_list".
#
###
# Configuration File Format...
#
# Other than comments (starting with '#') the permissions list file can contain
# two types of entries: 'directory defaults' which will end in a '/' on the
# filepath, or an entry for 'specific files'.
#
# Directory Entries...
#
# These controled what directories will be looked in to set the permissions.
#
# If the filename ends in '/' it specified that this is a directory entry.
#
# For Example...
#   Directory/Path/    dir_perm  executable_perm  files_perm [flag]
#
# By default this entry will set the permissions for both the directory and the
# contents of that directory.  The directory itself will get the 'dir_perm'
# permissions unless a specific 'File' entry for that directory overrides this
# setting, (without a '/').
#
# The directories will be looked at in the order given in the "perm_list" file.
# If another 'deeper' directory entry is found for a sub-directory, the current
# entry will ignore it, and the program will process it, in turn.
#
# If the 'R' flag is provided then sub-directories content are also
# recursivally set. If it is NOT provided then only the top-level contents will
# have permsssions set.  Deeper directories entries will override this, perhaps
# stopping the recursion, unless that entry is also flagged to be recursive.
#
# If an 'I' flag is given then only the permissions of the directory itself
# will be set.  The contents of the directory will be completely ignored.  In
# this case executable and file permissions will neven be used.
#
# The entry is much like a 'File' entry, but can be used to stop recursion from
# a different (higher level) directory entry from going any deeper than this
# point.  That is if a area of the directory tree is covered by two directory
# entries only the deeper, more specific directory entry, will be executed,
# including whether recursion is to be used or not.
#
# This can save a LOT of time for extrememly large directories.
#
#
# File Entries...
#
# If entry does not end in a '/' then the entry is for a specific file.
#
# For Example...
#   Directory/Path/File        file_perm
#
#
# File entries are found and checked as the program recurses though a recursive
# directory entry.  If a File entry is NOT under a recursive directory entry it
# will not be checked.
#
# Basically these entries override the defaults set by a 'Directory Entry'.
#
# A special GLOB expression of '*' will match any character but '/' including
# hidden files (starting with '.', but excluding '.' and '..').  While a GLOB
# expression '**/' can be used to match any directory path.  The globs are
# expanded into a larger list of file entries, so you should limit the use of
# globs as much as posible.
#
#
# Permission Setting...
#
# A file's permissions is only updated if they are different.  That is the main
# point of this script, verses one that blindly and continuiously sets file
# permissions every time, thus updating the change date on the file.
#
# The special permission setting of "-" or "---" means to ignore and make no
# change to the current file permssion settings.  This can be used to in
# special cases to ignore special or transient files, or for the useless
# permissions in a 'I' flags directory entry.
#
# Here is an example "perm_list" file...
#
#   #
#   # Home File Permissions List
#   #
#   # Top level - make all top level files and directories private by default.
#   # This is especially important for 'dot' files.
#   #                       DIRS  EXEC  DATA
#   ./                       700   700   600
#   # But do allow access by other users into my home directory.
#   .                        755
#
#   # Ignore temporary VIM swp files (caution: global glob)
#   **/.*.swp                            ---
#
#   # Publically accessable 'dot' files
#   #                       DIRS  EXEC  DATA
#   .plan                                644
#   .project                             644
#   .forward*                            644
#   .procmailrc                          644
#
#   # Enforce closure of this directory (or SSH does not work!)
#   .ssh/                    700   600   600
#
#   # Public Data for Web server is open for read
#   # Only "CGI" script are to be exectuable, and logs writable
#   #                       DIRS  EXEC  DATA
#   public_html/             755   644   644    R
#   public_html/**/*.cgi           755
#   public_html/**/*.log                 666
#
#   # Bin is mostly open, but not the admin area
#   #                       DIRS  EXEC  DATA
#   bin/                     755   755   644    R
#   bin/admin/               700   700   700    R
#   bin/admin/*.template                 600
#
#   # Set 'storage' directory permission,
#   # But ignore all contents and sub-directories
#   #                       DIRS  EXEC  DATA
#   storage/                 700   ---   ---    I
#
# A file will not be looked at unless it is in a listed directory,
#
# If a file does not match a 'specific' entry, it will use the parent
# directories permission settings (unless 'I' ignored), otherise no permision
# change will be made.
#
# This script should be called from a daily run cron script, and as nessary, to
# ensure all the specified file permissions remain in good working order.
#
#####
#
# ASIDE: The linux "systemd-tmpfiles" program with its user level "tmpfiles.d"
# configuration files, can do something similar, via its 'z' and 'Z' types
# (adjust mode, glob, recursive). It does not however make distinctions between
# data files, executables, and directories, leaving it up to the config file.
#
# Original Written:  Anthony Thyssen, 1995
#
use strict;
use FindBin;
use File::Find;
my $PROGNAME = $FindBin::Script;

# ensure environment is as expected (not actually needed)
$ENV{PATH} = '/bin:/usr/bin:/usr/sbin:/opt/bin:' . $ENV{PATH};
select((select(STDOUT), $| = 1)[$[]);  # auto flush
select((select(STDERR), $| = 1)[$[]);

chdir $ENV{HOME};             # go home
my $permlist = 'perm_list';   # config file relative to your home directory
$permlist = "$FindBin::Bin/$permlist"  if -r "$FindBin::Bin/perm_list";
$permlist = "$FindBin::Bin/../lib/$permlist"
                                       if -r "$FindBin::Bin/../lib/perm_list";
$permlist = 'lib/perm_list'            if -r 'lib/perm_list';

sub Usage {
  print STDERR "$PROGNAME: ", @_, "\n"  if @_;
  @ARGV = ( "$FindBin::Bin/$PROGNAME" ); # locate script file
  while( <> ) {
    next if 1 .. 2;
    last if /^###/;
    last unless /^#/;
    s/^#$//; s/^# //;
    last if /^$/;
    print STDERR "Usage: " if 3 .. 3;
    print STDERR;
  }
  print STDERR "For full manual use --help\n";
  exit 10;
}
sub Help {
  @ARGV = ( "$FindBin::Bin/$PROGNAME" ); # locate script file
  while( <> ) {
    next if $. == 1;
    last if /^###/;
    last unless /^#/;
    s/^#$//; s/^# //;
    print STDERR;
  }
  exit 10;
}
sub Doc {
  @ARGV = ( "$FindBin::Bin/$PROGNAME" ); # locate script file
  while( <> ) {
    next if $. == 1;
    last if /^#####/;
    last unless /^#/;
    s/^#$//; s/^# //;
    print STDERR;
  }
  exit 10;
}

# --------------------------------------------------------------------------
# The file defining what permissions are to be set
#
my $verbose = 1;
my $update = 1;
my $db_list = 0;
my $db_chk = 0;

OPTION:  # Multi-switch option handling
while( @ARGV && $ARGV[0] =~ s/^-(?=.)// ) {
  $_ = shift; {
    m/^$/  && do { next };   # Next option
    m/^-$/ && do { last };   # End of options   '--'
    m/^\?/       && Usage;   # Usage Help       '-?'
    m/^-help$/   && Help;    # quick help       '--help'
    m/^-doc$/ && Doc;        # inline manual    '--doc'

    s/^q//  && do { $verbose  = 0;           redo }; # be quite
    s/^f//  && do { $permlist = $_ || shift; next }; # perm config file
    s/^n//  && do { $update   = 0;           redo }; # dry run, just report

    s/^dl// && do { $db_list = 1;            redo }; # debug list read
    s/^dc// && do { $db_chk  = 1;            redo }; # debug perm checks

    Usage( "$PROGNAME: Unknown Option \"-$_\"\n" );
  } continue { next OPTION }; last OPTION;
}
Usage( "Unwanted Arguments Given \"$ARGV[0]\"\n" ) if @ARGV;

Usage( "Unable to locate permissions list data file: \"$permlist\"\n" )
  unless  -r $permlist;

my %dir_perms;    # permisions for directories (posibily resursive)
my %file_perms;   # permissions for specific listed files
my @dirs;         # directories to look at (in sequence found in perms_list)

# --------------------------------------------------------------------------

# Convert a 'glob' into a perl-RE, (code extracted from "find2perl" script)
sub fileglob_to_re ($) {
    my $x = shift;
    $x =~ s#([./^\$()+])#\\$1#g;
    $x =~ s#([?*])#.$1#g;
    "^$x\\z";
}

# Read and pre-glob the 'Permissions file'
# also allow use of '**' recursive glob
#
# Note: It would be good if files could be compared directly against the glob
# patterns rather than pre-expanding globs to an internal file/directory list,
# but I did not figure out a good way to do this.
#
print STDERR "DB: Reading Permissons from \"$permlist\"\n" if $db_list;
open( PERMS, $permlist )
   or die("$FindBin::Script: Open failure for \"$permlist\" : $!\n");

while( <PERMS> ) {
  s/#.*//g;
  s/\s+$//g;
  next  if /^$/;
  print STDERR "DB: perm: $_\n" if $db_list;

  my ( $file, @args ) = split;

  # Directory Entry   EG: filename ends in /
  if ( $file =~ s/\/$// ) {
    warn "Duplicate directory entry at line $., \"$file\"\n"
                                      if $dir_perms{$file};
    warn "Invalid number of arguments for dir entry at $., \"$file\"\n"
                                       if @args != 3 && @args != 4;
    warn "Invalid permissions for dir entry at $., \"$file\"  $args[0]\n"
                                       if $args[0] !~ /^([0-7]{3,4}|-+)$/;
    warn "Invalid permissions for dir entry at $., \"$file\"  $args[1]\n"
                                       if $args[1] !~ /^([0-7]{3,4}|-+)$/;
    warn "Invalid permissions for dir entry at $., \"$file\"  $args[2]\n"
                                       if $args[2] !~ /^([0-7]{3,4}|-+)$/;
    warn "Invalid recurse flag for dir entry at $., \"$file\"\n"
             if $args[3]  && $args[3] ne 'R' && $args[3] ne 'I' ;
    $file =~ s/^.\///;
    $file = '.'  unless length $file;

    # Expand directory glob expressions
    for my $dir ( glob( $file ) ) {
      $dir_perms{$dir} = [ @args ];
      push(@dirs, $dir);     # Order of the directories (recursive or not)
      #$file_perms{$dir} = $args[0];  # The directory entry's permissions
    }
    next;
  }

  # Specific file permisions
  warn "Duplicate specific file entry at line $., \"$file\"\n"
                                       if $file_perms{$file};
  warn "Invalid number of arguments for file entry at $., \"$file\"\n"
                                       if @args != 1;
  warn "Invalid permissions for file entry at $., \"$file\"  $args[0]\n"
                                       if $args[0] !~ /^([0-7]{3,4}|-+)$/;

  # Expand globs into a list of specific filenames and their permissions
  # Without this, searching for the permissions of a specific file in
  # the %file_perms table would be near imposible to manage.
  #
  # Note a specific file may be matched by multiple glob expressions.
  # For example:  "**/*.gif"  and "**/animate_*" matchs  "animate_rot.gif"
  # Uncomment the warning below to find such multiple matches.
  #
  # For now use the first set of permissions given in a multiple file match.
  # But this is still subject to change.
  #

  # Look for and expand a recursive '**/' glob expression
  if ( $file =~ /\*\*\// ) {
    my $dir = $`;                    # the directory before the recursion.
    $dir = '.' unless length $dir;   # search from top level directory
    my $name = fileglob_to_re($');   # the filename after the '**/'
    my @dir = glob( $dir );          # directory(s) to look for filename
    if ( $db_list ) {
      print STDERR "DB: perm recurse $_\n";
      print STDERR "    RE name: $name\n";
      print STDERR "    Glob dir: @dir\n";
    }
    find( sub {
            #return if -l $_;        # ignore symbolic links
            return unless /$name/;   # recursivally look for this file
            $_ = $File::Find::name;
            s/^\.\///;               # remove any './' prefix
            warn "File \"$_\" listed twice (different perms) at $.\n"
              if defined $file_perms{$_} && $file_perms{$_} != $args[0];
            $file_perms{$_} = $args[0] unless defined $file_perms{$_};
          }, @dir )  if @dir;
  }
  else {
    # Expand a normal glob expression (no '**/' present)
    for ( glob( $file ) ) {
      warn "File \"$_\" listed twice (different perms) at $.\n"
        if defined $file_perms{$_} && $file_perms{$_} != $args[0];
      $file_perms{$_} = $args[0] unless defined $file_perms{$_};
    }
  }
}

close PERMS;

# Debugging
#use Data::Dumper;
#$Data::Dumper::Indent = 1;
#print Dumper(\@dirs);
#print Dumper(\%dir_perms);
#print Dumper(\%file_perms);
#exit;

# Given a filename (relative to the users home directory), return the file
# permissions that file is supposed to have.
sub get_perm {
  my ( $file ) = @_;
  $file =~ s/^.\///;
  $file = '.'  unless $file;   # home directory entry

  # Look for a specific file entry and return immediatally
  return $file_perms{$file}  if defined $file_perms{$file};

  # FUTURE: Look for matching specific file regular expersion
  # At the moment RE and pre-expanded into a file list

  #stat($file);   # NOTE this has been done by the calling 'find'!

  # Look for a parent directory entry
  my $dir = $file ;
  $dir =~ s/\/?[^\/]*$// unless -d _;
  $dir = '.'  unless $dir;   # no directory - top level home
  if ( $dir_perms{$dir} ) {
    return $dir_perms{$dir}[0]  if -d _;              # directories
    return $dir_perms{$dir}[2]  unless -d _ || -f _;  # specials
    return $dir_perms{$dir}[1]  if -x _;              # executables
    return $dir_perms{$dir}[2];                       # plain file
  }

  # Look for a higher level 'recursive' directory entry
  while ( $dir ne '.' ) {
    $dir =~ s/\/?[^\/]*$//;    # next higher directory
    $dir = '.'  unless $dir;   # no directory - use the top level home
    if ( $dir_perms{$dir} ) {
      return $dir_perms{$dir}[0]  if -d _;                # directories
      if ( $dir_perms{$dir}[3] eq 'R' ) {
        return $dir_perms{$dir}[2]  unless -d _ || -f _;  # specials / missing
        return $dir_perms{$dir}[1]  if -x _;              # executables
        return $dir_perms{$dir}[2];                       # plain file
      }
    }
  }
  return undef;
}

# -------------------------------------------------------------------
#
print STDERR "-----------------------\n" if $db_list;
print STDERR "Main Loop Processing...\n" if $db_chk;

my $recurse;  # are we to recurse into sub-directories of the given directory?

for my $top (@dirs) {  # for each directory entry (in sequence)
  next unless -d $top;
  print "Checking Directory : $top\n"   if $verbose;
  $recurse = ( $dir_perms{$top}[3] eq 'R' ); # do we recurse this directory?
  find( \&check_file, $top );
}

sub check_file {
  return if -l $_;               # ignore symbolic links
  my $file = $File::Find::name;  # file name relative to home directory
  my $top = $File::Find::topdir;

  # Prune the tree if not recursing, and not the directory we are working in
  $File::Find::prune = 0;  # recurse to do the top level contents
  if ( $file ne $top ) {
    next  if $dir_perms{$top}[3] eq 'I';  # ignore top level contents
    $File::Find::prune = 1;               # Do not recurse deeper by default
    if ( -d _ ) {
      print "  DIR $file  recurse=$recurse",
            ($dir_perms{$file}?"\t\t*** SKIPPING ***":""), "\n" if $db_chk;
      next  if $dir_perms{$file};           # A seperate dir entry does this
      $File::Find::prune = ( ! $recurse );  # recurse deeper into directory?
    }
  }
  my $cur_perm = sprintf("%o", ( stat($_) )[2] & 07777 ); # current mode perms
  my $set_perm = get_perm($file);

  printf "  %-60s %s -> %s\n", $file, $cur_perm, $set_perm   if $db_chk;

  if ( $set_perm =~ /^-+$/ ) {
    #print "$file $cur_perm -- IGNORING\n" if $update;
    return;
  }

  if ( length $set_perm && $cur_perm ne $set_perm ) {
    print "$file $cur_perm -> $set_perm", $update ? " -- FIXING\n" : "\n";
    if ( $update ) {
      chmod( oct $set_perm, $_ ) ||
         warn "$FindBin::Script: chmod $set_perm $file : $!\n";
    }
  }
}