#!/usr/bin/perl -w

# ================================================================================
# Functions used by perl scripts to set and check permissions
# ================================================================================

use strict;
use warnings;

use Clone 'clone'; # yum install perl-Clone

# --------------------------------
# permissions flags from man page stat(2)
# --------------------------------

my $S_IFMT    = 0170000;  # bitmask for the file type bitfields
my $S_IFSOCK  = 0140000;    # socket
my $S_IFLNK   = 0120000;    # symbolic link
my $S_IFREG   = 0100000;    # regular file
my $S_IFBLK   = 0060000;    # block device
my $S_IFDIR   = 0040000;    # directory
my $S_IFCHR   = 0020000;    # character device
my $S_IFIFO   = 0010000;    # FIFO
my $S_ISUID   = 0004000;  # set UID bit
my $S_ISGID   = 0002000;  # set-group-ID bit 
my $S_ISVTX   = 0001000;  # sticky bit 
my $S_IRWXU   = 00700;    # mask for file owner permissions
my $S_IRUSR   = 00400;      # owner has read permission
my $S_IWUSR   = 00200;      # owner has write permission
my $S_IXUSR   = 00100;      # owner has execute permission
my $S_IRWXG   = 00070;    # mask for group permissions
my $S_IRGRP   = 00040;      # group has read permission
my $S_IWGRP   = 00020;      # group has write permission
my $S_IXGRP   = 00010;      # group has execute permission
my $S_IRWXO   = 00007;    # mask for permissions for others (not in group)
my $S_IROTH   = 00004;      # others have read permission
my $S_IWOTH   = 00002;      # others have write permission
my $S_IXOTH   = 00001;      # others have execute permission

# -----------------------------
# Key used in the passed maps. Maps are used to make sure the passed parameters are applied correctly
# -----------------------------

our $USER     = "_user_";
our $GROUP    = "_group_";
our $DIRPERM  = "_dirperm_";
our $FILEPERM = "_fileperm_";

# -------
# Helper
# -------

sub collect {
    my($collected,$path,$nodeType,$settingsMapRef) = @_;
    if (exists $$collected{$path}) {
       my $oldList           = $$collected{$path};
       my $oldNodeType       = $$oldList[0];
       my $oldSettingsMapRef = $$oldList[1];
       die "For '$path': old node type is $oldNodeType, new node type is $nodeType\n" if ($oldNodeType ne $oldNodeType);
       # fuse maps (the target map is a private copy)
       for my $key (keys %$settingsMapRef) { 
          $$oldSettingsMapRef{$key} = $$settingsMapRef{$key}
       }
    }
    else {
       $$collected{$path} = [ $nodeType , clone($settingsMapRef) ]
    }
}

# ------
# Helper
# ------

sub slurpDirEntries {
   my($dir) = @_;
   if (! -e $dir) {
      print STDERR "Directory '$dir' does not exist\n";
      return undef 
   }
   if (-l $dir) {
      print STDERR "This is not a directory but a symlink: '$dir'\n";
      return undef
   }
   if (! -d $dir) {
      print STDERR "This is not a directory: '$dir'\n";
      return undef
   }
   opendir(my $dirh,$dir) or die "Could not open directory '$dir': $! -- exiting\n";
   my @entries = readdir($dirh);
   closedir($dirh);
   return \@entries
}

# Concerning the "settingsMapRef":
#
# -- "user" and "group" may be undefined meaning "leave them as is" or
#    may be symbolic names (not numeric representations)
# -- "permissions" may undefined meaning "leave them as is" or be the octal 
#    representation of "rwxrwxrwx" (TODO: extend this to the symbolic
#    representation as used in chmod)

# -----------------------------
# Adjust a directory (only the directory itself, nothing underneath)
# If "createDir" is set and the path does not exist, this is considered
# a creation command for later!
# -----------------------------

sub adjustDirectory {
   my($collected,$path,$settingsMapRef,$createDir) = @_;
   if (! -e $path && $createDir) {
      collect($collected,$path,'CREATE_DIRECTORY',$settingsMapRef)
   }
   else {
      collect($collected,$path,'DIRECTORY',$settingsMapRef)
   }
}  

# -----------------------------
# Adjust a file 
# -----------------------------

sub adjustFile {
   my($collected,$path,$settingsMapRef) = @_;
   collect($collected,$path,'FILE',$settingsMapRef)
}

# -----------------------------
# Adjust any file one level below a given directory, but not the directory itself
# -----------------------------

sub adjustAnyFileUnder {
   my($collected,$path,$settingsMapRef) = @_;
   my $arrayRef = slurpDirEntries($path);
   if ($arrayRef) {
      my @files = ();
      for my $entry (@$arrayRef) {
         if ($entry eq '.' || $entry eq '..') { next }
         if (-f "$path/$entry") { push(@files,$entry) } # else { print "--- $dir/$entry is not a file -- skipping\n" }
      }
      for my $file (@files) {
         adjustFile($collected,"$path/$file",$settingsMapRef)
      }
   }
}

# -----------------------------
# Adjust any directory one level below a directory, but not the directory itself
# -----------------------------

sub adjustAnyDirUnder {
   my($collected,$path,$settingsMapRef) = @_;
   my $arrayRef = slurpDirEntries($path);
   if ($arrayRef) {
      my @subdirs = ();
      for my $entry (@$arrayRef) {
         if ($entry eq '.' || $entry eq '..') { next; }
         if (-d "$path/$entry" && ! -l "$path/$entry") { push(@subdirs,$entry) } # else { print "$dir/$entry is not a directory -- skipping\n" }
      }
      for my $subdir (@subdirs) {
         adjustDirectory($collected,"$path/$subdir",$settingsMapRef)
      }
   }
}

# -----------------------------
# Recursively adjust a tree, including the root
# -----------------------------
# "path" may actually be a file, in which case the function only adjusts the file.
#
# $USER,$GROUP,$DIRPERM,$FILEPERM may be unset in the "$settingsMapRef", in which
# case the corresponding settings will not be changed on "apply"

sub adjustTree {
   my($collected,$path,$settingsMapRef) = @_;
   # print "adjustTree($path)\n";
   if (! $path) {
      print STDERR "An empty 'path' has been passed to adjustTree()\n";
   }
   elsif (-l $path ) {
      # Just a symlink; leave it alone
   }
   elsif (!-e $path) {
      # Path does not exist; we can't assume it is a directory that shall be created, so do nothing
   }
   elsif (-f $path ) {
      adjustFile($collected,$path,$settingsMapRef)
   }
   elsif (-d $path) {
      adjustDirectory($collected,$path,$settingsMapRef);
      opendir(my $dirh,$path) or die "Could not open directory '$path': $! -- exiting\n";
      my @entries = readdir($dirh);
      closedir($dirh);
      for my $entry (@entries) {
         if ($entry eq '.' || $entry eq '..') { 
            next
         }
         adjustTree($collected,"$path/$entry",$settingsMapRef);
      }
   }
   else {
      print STDERR "Unhandled type of file at '$path'"
   }
}

# -------
# Helper
# -------

sub settingsMapToText {
   my($settingsMapRef) = @_;
   my $txt = "";
   foreach my $key (sort keys %$settingsMapRef) {
     if ($txt) {
        $txt .= ", "
     }
     $txt .= $key;
     $txt .= "=";
     $txt .= $$settingsMapRef{$key};
   }
   return "($txt)"
}

# ----------------------------------------
# Apply an earlier "collected", which is a map : path -> [ expected type, settings map ]
# ----------------------------------------

sub applyCollected {
   my ($collected,$debugFlag) = @_;
   my $counter = 0;
   for my $path (sort keys %$collected) {      
      my $listRef        = $$collected{$path};
      my $nodeType       = $$listRef[0];
      my $settingsMapRef = $$listRef[1];
      # print "$path --> " . $nodeType . " + " . settingsMapToText($settingsMapRef) . "\n";
      $counter += applyDescToPath($path,$nodeType,$settingsMapRef,$debugFlag)
   }
   return $counter
}

# -----
# Helper
# -----

sub applyDescToPath {
   my ($path,$nodeType,$settingsMapRef,$debugFlag) = @_;
   my $user     = $$settingsMapRef{$USER};
   my $group    = $$settingsMapRef{$GROUP};
   my $dirPerm  = $$settingsMapRef{$DIRPERM};
   my $filePerm = $$settingsMapRef{$FILEPERM};
   my $permissions;
   #
   # Check user and group if required; these are supposed to by names (if defined), not numbers
   # TODO: This should be buffered
   #
   if (defined $user) {
      my $uid = getpwnam($user);         
      if (!defined $uid) {
         die "Given user '$user' for '$path' cannot be resolved to a UID\n";
      }
   }
   if (defined $group) {
      my $gid = getgrnam($group);
      if (!defined $gid) {
         die "Given group '$group' for '$path' cannot be resolved to a GID\n";
      }
   }
   #
   # pre-handle by type
   #
   if ($nodeType eq 'FILE') {
      if (! -e $path) {
         print STDERR "File '$path' does not exist -- skipping this\n";
         return 0
      }
      else {
         if (!-f $path || -l $path) {
            print STDERR "Expected file, but this is not a file: '$path' -- skipping this\n";
            return 0  
         }
         else {
            $permissions = $filePerm
         }
      }
   }
   elsif ($nodeType eq 'CREATE_DIRECTORY') {
      if (! -e $path) {
         print "Directory '$path' does not exist and create demanded -- creating it\n";
         my @args = ("/usr/bin/install", "--directory");
         if (defined $group) {
            push(@args,"--group");
            push(@args,"$group")
         }
         if (defined $user) {
            push(@args,"--owner");
            push(@args,"$user")
         }
         if (defined $dirPerm) {
            push(@args,"--mode");
            push(@args,"$dirPerm")
         }
         push(@args,$path);
         my $cmd = join(" ",@args);
         my $retval = system(@args);
         if ($retval != 0) { 
            die "While running '$cmd': $! -- exiting\n";
         }
         return 1
      }
      else {
         print "An entry for '$path' actually exists, although creation as a directory was demanded -- skipping this\n";
         return 0
      }
   }
   elsif ($nodeType eq 'DIRECTORY') {
      if (! -e $path) {
         print "Directory '$path' does not exist and create not demanded -- skipping this\n";
         return 0
      }
      else {
         if (!-d $path || -l $path) {
            print STDERR "Expected directory, but this is not a directory: '$path' -- skipping this\n";
            return 0
         }
         else {
            $permissions = $dirPerm
         }
      }
   }
   else {
      die "Unknown node type passed: '$nodeType'\n"
   }
   #
   # Now "adjust" 
   #
   my @stat = stat($path);
   if (!@stat) {
      die "Stat on '$path' failed: $! -- exiting\n";
   }
   my ($dev,$ino,$mode,$nlink,$uidfile,$gidfile,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = @stat;
   if ($debugFlag) {
      print "File     : $path\n";
      print " DEV     : $dev\n";
      print " INO     : $ino\n";
      print " MODE    : " . permtxt($mode) . "\n";
      print " NLINK   : $nlink\n";
      print " UID     : $uidfile\n";
      print " GID     : $gidfile\n";
      print " RDEV    : $rdev\n";
      print " SIZE    : $size\n";
      print " ATIME   : $atime\n";
      print " MTIME   : $mtime\n";
      print " CTIME   : $ctime\n";
      print " BLKSIZE : $blksize\n";
      print " BLOCKS  : $blocks\n";
   }
   #
   # actually adjust user/group
   #
   my $counter = 0;
   if (defined $user || defined $group) {
      my ($uadj,$gadj,$ufile,$gfile);
      if (defined $user) {
         $ufile = getpwuid($uidfile);
         if ($ufile ne $user) { $uadj = $user }
      }
      if (defined $group) {
         $gfile = getgrgid($gidfile);
         if ($gfile ne $group) { $gadj = $group }
      }
      if (defined $uadj && defined $gadj) {
         print "Adjusting ownership of '$path': user $ufile -> $user, group $gfile -> $group\n"
      }
      elsif (defined $gadj) {
         print "Adjusting ownership of '$path': group $gfile -> $group\n"
      }
      elsif (defined $uadj) {
         print "Adjusting ownership of '$path': user $ufile -> $user\n"
      }   
      $counter += _chown($path,$uadj,$gadj)
   }
   if (defined $permissions) {
      my $maskedmode = $mode & ($S_IRWXU | $S_IRWXG | $S_IRWXO);
      if ($maskedmode != oct($permissions)) {
         print "Adjusting mode of '$path': " . permtxt($mode) . " -> " . permtxt(oct($permissions)) . "\n";
         $counter += _chmod($path,$permissions);
      }
   }
   if ($counter) { return 1 } else { return 0 }
}

# ----------------------------------
# changing modus
# ----------------------------------

sub _chmod {
   my($path,$permissions) = @_;
   my @args;
   if (defined $permissions) {
      @args = ("/bin/chmod","$permissions",$path)
   }
   my $retval = system(@args);
   if ($retval != 0) { 
      my $cmd = join(" ",@args);
      die "While running '$cmd': $! -- exiting\n";
   }
   return 1
}

# ----------------------------------
# changing owner
# ----------------------------------

sub _chown {
   my($path,$user,$group) = @_;
   my @args;
   if (defined $user && defined $group) {
      @args = ("/bin/chown","$user:$group")
   }
   elsif (defined $user) {
      @args = ("/bin/chown","$user")
   }
   elsif (defined $group) {
      @args = ("/bin/chgrp","$group")
   }
   else {
      return 0
   }
   push(@args,$path);
   my $retval = system(@args);
   if ($retval != 0) { 
      my $cmd = join(" ",@args);
      die "While running '$cmd': $! -- exiting\n";
   }
   return 1
}

# ----------------------------------
# Transform numeric permission to string
# ----------------------------------

sub permtxt {
   my($num) = @_;
   $num = $num*1;
   my $res = "";
   my $addComma = 0;
   if (($num & $S_IFMT) == $S_IFSOCK) {
      $res .= "," unless !$addComma;
      $res .= "sok";
      $addComma = 1
   }
   if (($num & $S_IFMT) == $S_IFLNK) {
      $res .= "," unless !$addComma;
      $res .= "sym";
      $addComma = 1
   }
   if (($num & $S_IFMT) == $S_IFREG) {
      $res .= "," unless !$addComma;
      $res .= "fil";
      $addComma = 1
   }
   if (($num & $S_IFMT) == $S_IFBLK) {
      $res .= "," unless !$addComma;
      $res .= "blk";
      $addComma = 1
   }
   if (($num & $S_IFMT) == $S_IFDIR) {
      $res .= "," unless !$addComma;
      $res .= "dir";
      $addComma = 1
   }
   if (($num & $S_IFMT) == $S_IFCHR) {
      $res .= "," unless !$addComma;
      $res .= "chr";
      $addComma = 1
   }
   if (($num & $S_IFMT) == $S_IFIFO) {
      $res .= "," unless !$addComma;
      $res .= "pip";
      $addComma = 1
   }
   if ($num & $S_ISVTX) {
      $res .= "," unless !$addComma;
      $res .= "STCK";
      $addComma = 1
   }   
   if ($num & $S_ISUID) {
      $res .= "," unless !$addComma;
      $res .= "SUID";
      $addComma = 1
   }
   if ($num & $S_ISGID) {
      $res .= "," unless !$addComma;
      $res .= "SGID";
      $addComma = 1
   }
   $res = $res . "[u:";
   my $add;
   if ($num & $S_IRUSR) { $add = "r" } else { $add = "." }
   $res .= $add;
   if ($num & $S_IWUSR) { $add = "w" } else { $add = "." }
   $res .= $add;
   if ($num & $S_IXUSR) { $add = "x" } else { $add = "." }
   $res .= $add . "][g:";
   if ($num & $S_IRGRP) { $add = "r" } else { $add = "." }
   $res .= $add;
   if ($num & $S_IWGRP) { $add = "w" } else { $add = "." }
   $res .= $add;
   if ($num & $S_IXGRP) { $add = "x" } else { $add = "." }
   $res .= $add . "][o:";
   if ($num & $S_IROTH) { $add = "r" } else { $add = "." }
   $res .= $add;
   if ($num & $S_IWOTH) { $add = "w" } else { $add = "." }
   $res .= $add;
   if ($num & $S_IXOTH) { $add = "x" } else { $add = "." }
   $res .= $add . "]";
   return $res
}