#!/usr/bin/perl
############################################################################################
# Shell utility to set properly file permissions for the current part of this software.
# Usage: perl set-permissions.pl
# Usage (Verbose Mode): perl set-permissions.pl -v
# Author: Daniel Dinev; All rights reserved (c) 2001; http://www.chatologica.com/
############################################################################################

use strict;                                             # make Perl more strict to code
$^W = 1;                                                # enable warnings
$| = 1;                                                 # do not buffer the script output
BEGIN {
    # Now making the current working directory to be the directory where this script resides.
    # This is needed usually if the web server is IIS on Windows platform!
    my $path = $0;                                      # $0 is the full path to this script
    if($path =~ m{^(.*)[/\\][^/\\]+$}) {                # remove script filename from the path
        $path = $1;
        if(!chdir($path)){
            print "Can't navigate to '$path' directory: $!";
            exit;
        };
    };
};
BEGIN {
    use vars qw($ChmodWin $SkipChmodReason $MASK);
    $ChmodWin = 0;
    $SkipChmodReason = 0;
    if($^O =~ m{win(16|32|dows)}i){ # windows platform detected
        local $SIG{__DIE__} = sub {};
        eval("use Win32::FileSecurity qw(MakeMask Get Set)");
        if(!$@){
            $ChmodWin = 1;
            $MASK = Win32::FileSecurity::MakeMask(qw(FULL GENERIC_ALL));
        } else {
            $SkipChmodReason = $@;
        }
    }
}
umask 0000;                                             # do not mask file permissions
use IO::File;
&do;



sub do                                                  # THE MAIN WORK OF THIS SCRIPT
{
    my $verbose = $ARGV[0];
    if($SkipChmodReason){
        print "\nSKIPPING FILE PERMISSIONS SETTING FOR THIS PLATFORM BECAUSE:\n\n$SkipChmodReason\n";
    } else {
        my $rules = &read_hash('chatologica.txt');              # read chmod rules
        if(%$rules){
            print "Please wait while working ...\n";
            my $error = &chmod_tree('./',$rules,$verbose);      # chmod recursively
            if(!$verbose){
                print $error;                                   # show only errors happened in silent mode
            };
            print "Setting permissions finished.\n";
        } else {
            print "Error parsing file: chatologica.txt\n";
        };
    };
};



sub chmod_tree                                          # CHMOD ALL FILES/DIRECTORIES IN THIS TREE
{
    my($path,$rules,$verbose,$rel_path) = @_;
    my $error = '';
    return if !$path;
    $rel_path = $rel_path || '';
    $rules = {} if !defined $rules;
    $path = &end_path($path);
    $rel_path = &end_path($rel_path);
    my $file;
    my $D = new IO::File;                               # new file handle
    if(opendir($D,"$path$rel_path")){
        while(defined($file = readdir($D))) {           # read this directory
            chomp $file;
            $file =~ /^(.*)$/; $file = $1;
            if($file !~ m/^\.\.?$/) {                   # skip the . and .. files
                if (-d "$path$rel_path$file") {         # it's a directory
                    my $new_rel_path = $rel_path . $file;
                    $new_rel_path = &end_path($new_rel_path);
                    $error .= &chmod_tree($path,$rules,$verbose,$new_rel_path);
                } else {
                    $error .= &chmod_by_hint("$path$rel_path$file","$rel_path$file",1,$rules,$verbose);
                };
            };
        };
        closedir $D;
        $error .= &chmod_by_hint("$path$rel_path",$rel_path,0,$rules,$verbose);
    } else {
        $error = " Can't read directory '$path$rel_path': $!";
        print $error if $verbose;
    };
    return $error;
}



sub my_chmod                                             # THE UNIVERSAL CHMOD FUNCTION
{
    my($path,$mode) = @_;                               # $mode is decimal 666, 777, .....
    if($SkipChmodReason){ return ''};                   # if useless chmod
    my $error = '';                                       # $path is full or relative path
    if(!$ChmodWin){ # unix-like chmod
        if(!(chmod oct($mode),$path)){
            $error = " Can't chmod $mode $path $!\n";
        }
    } else { # chmod for windows
        my $hash = {};
        local $SIG{__DIE__} = sub {};
        if(eval{Win32::FileSecurity::Get($path,$hash)}){
            $$hash{'Everyone'} = $MASK;
            if(!eval{&Win32::FileSecurity::Set($path,$hash)}) {
                $error .= " Can't set full permissions for '$path': $!";
            }
        }
    }
    return $error;
}



sub chmod_by_hint                               # CHMOD A FILE OR DIRECTORY BY HINT
{
    my($file_path,$rel_path,$is_file,$rules,$verbose) = @_;
    my $error = '';
    my $mode = chmod_hint($rel_path,$is_file,$rules);
    print "chmod $mode $file_path - " if $verbose;
    if($error = &my_chmod($file_path,$mode)){
        print "Failed!\n" if $verbose;
    } else {
        print "OK\n" if $verbose;
    };
    return $error;
}



sub chmod_hint                                  # SUGGEST A FILE MODE ACCORDING TO PRODUCT REQUIREMENTS
{
    my($path,$is_file,$rules)=@_;
    my $mode;
    if($is_file){                                       # it's a file
        $mode = '644';                                  # default file mode
        if($path =~ m{\.(pl|fcgi|cgi|mpl)$}i) {         # checking for default chmods
            $mode = '755';
        };
        if((defined $$rules{'666file'}) && ($$rules{'666file'} ne '')){
            if($path =~ m{$$rules{'666file'}}){
                $mode = '666';
            };
        };
        if((defined $$rules{'755file'}) && ($$rules{'755file'} ne '')){
            if($path =~ m{$$rules{'755file'}}){
                $mode = '755';
            };
        };
        if((defined $$rules{'6755file'}) && ($$rules{'6755file'} ne '')){
            if($path =~ m{$$rules{'6755file'}}){
                $mode = '6755';
            };
        };
        if((defined $$rules{'4755file'}) && ($$rules{'4755file'} ne '')){
            if($path =~ m{$$rules{'4755file'}}){
                $mode = '4755';
            };
        };
    } else {                                            # is directory
        $mode = '755';                                  # default mode for directories
        if((defined $$rules{'777dir'}) && ($$rules{'777dir'} ne '')){
            if($path =~ m{$$rules{'777dir'}}){
                $mode = '777';
            };
        };
    };
    return $mode;
};



sub read_hash                                           # READ A HASH ARRAY STORED IN FILE
{
    my ($file,$expected)=@_;
    my %hash = ();
    my ($row,%arr) = ();
    my $error = '';
    my $FILE = new IO::File;
    if(open($FILE,"<$file")){                           # opening the file
        while(defined($row = <$FILE>)) {                # reading
            %arr = &StrArr($row,[qw(key value)]);       # parsing records
            $arr{value} =~ s/[\r\n]+$//s;
            $hash{$arr{key}} = $arr{value};             # restore the hash (value,key) from this record
        };
        close $FILE;
    } else {
        $error = " Can't read file '$file': $!";
    };
    if(wantarray){                                      # depends on context return array or scalar
        return (\%hash,$error);
    } else {
        return \%hash;
    };
};



sub StrArr                                      # PARSE A $str RECORD READ FROM A FLAT DB FILE TO %arr
{
    my ($str, $keys,$separator) = @_;           # $keys is a reference to a list of keys names
    $separator = '|' if !$separator;
    my ($i, %arr, $key, $regexp) = ();          # $str is the db record string
    $regexp = "\\$separator";
    chomp $str;                                 # remove new line signs in the end of this string
    $str =~ s{\01|\02}{}g;                      # remove some important hidden chars (if any)
    $str =~ s{\\\\}{\01}g;                      # translate escaped \ to \01
    $str =~ s{\\$regexp}{\02}g;                 # translate escaped separator to \02
    my @values = split(/$regexp/,$str);         # split by field separator
    foreach $i (0..$#$keys) {
        $key = $$keys[$i];
        if($i <= $#values){                     # build the hash
            $arr{$key} = $values[$i];
        } else {
            $arr{$key} = '';                    # if values array is too short, set empty values
        };
        $arr{$key} =~ s{\01}{\\}g;              # recover \
        $arr{$key} =~ s{\02}{$separator}g;      # recover separators
    };
    return %arr;
};



sub end_path                                    # SMART ADDING OF A SLASH AT PATH END
{
    my ($path)=@_;
    $path = '' if !defined $path;
    if(($path =~ m{\\}) && ($path !~ m{/})){
        $path =~ s{([^\\])$}{$1\\};
    } else {
        $path =~ s{([^/])$}{$1/};
    };
    return $path;
}



