#!/usr/bin/perl -U
# -U should prevent perl from its "taint" checkings, by which perl tries to secure suid scripts

########## Confixx(R) 3.0 Professional ############
####### Copyright SWsoft, Inc. 2004-2005 ##########
#### http://www.sw-soft.com - info@sw-soft.com ####


##########################################################################
# The utilities provides an ability to manage confixx skins. 
# Requirements:
# 1. it should belong to $confixx_user:$confixx_group 
#    (typically, 'confixx:users');
# 2. it should have 550 permissions (eXecutable by user and group)
# 3. User under which php is running (typically 'apache') should be 
#    included in $confixx_group group (typically 'users').
##########################################################################

# help script to find its local modules
BEGIN {
  use FindBin;
  use lib "$FindBin::Bin";
}
# end

# Configuration variables

$confixx_binDir  = '/var/www/confixx/bin';	# should be replaced when installed
$confixx_sbinDir = '/var/www/confixx/sbin';	# should be replaced when installed
$confixx_htmlDir = '/var/www/confixx/html';	# should be replaced when installed
$confixx_tmpDir  = '/var/www/confixx/tmp';	# should be replaced when installed
$confixx_user    = 'confixx';              	# should be replaced when installed
$confixx_group 	 = 'users';	               	# should be replaced when installed
$confixx_gid	 = '100';                 	# should be replaced when installed

$bin_gzip	= '/bin/gzip';			# should be replaced when installed
$bin_tar	= '/bin/tar';			# should be replaced when installed
$bin_unzip	= '/usr/bin/unzip';		# should be replaced when installed
$bin_find	= '/usr/bin/find';		# should be replaced when installed

# do not use variable in expression below, because 'use' is a compile time directive
use lib '##confixx_sbinDir##';		# should be replaced when installed

use File::Copy;

#my (undef, undef, $confixx_gid, undef) = getgrnam($confixx_group);
use English;	# allow human readable names names of Perl internal variables

#
# confixx's modules
#
use Modules::File;
use Modules::File::Proc;

if (! $ARGV[0]) {
	printf("Use %s --help or %s -h for command line help\n", $0, $0);
	exit 1;
}

# parse arguments

use Getopt::Long;
Getopt::Long::Configure('require_order');

my  @args_config = (
	'new_skin',
	'del_skin',
	'mov_file=s',
	'skin=s',
	'dest=s',
	'use_arc=s',
	'use_dir=s',
	'arc_type=s',
	'debug|d=i',
	'help|h',
	'test|t',
	'force|f'									
);

my %arguments = ();
unless (&GetOptions(\%arguments, @args_config)) {
	&fehler("Errors in command line arguments were found. Please run '$0 --help' for usage information\n");
}

# Getopt leaves unrecognized arguments in @ARGV
warn("Found unrecognized options in the command line near \"@ARGV\"") if (@ARGV);

if (exists ($arguments{'help'})) {
	&print_help;
	exit 0;
}

my $debug_level = exists ($arguments{'debug'}) ? $arguments{'debug'} : 0;

unless(defined $arguments{'skin'}) {
	&fehler("You must specify '--skin'. Please run '$0 --help' for usage information\n");
}

my $skin = $arguments{'skin'} if (exists $arguments{'skin'});
my $skindir =  "$confixx_htmlDir/skins/$skin";
my %targets = (
#	'admin' 	=> "$Modules::Conf::confixx_htmlDir/admin/skins/$main::skin",
#	'reseller' 	=> "$confixx_htmlDir/reseller/skins/$skin",
#	'user' 		=> "$confixx_htmlDir/user/skins/$skin",
);

#print "Real UID :$UID, Eff. UID:$EUID => Suid\n" if ($debug_level);

# Files supplied to the utility are in tmp directory and belong to apache user.
# The code below
# allows the utility to read a file by changing the group it belongs

{
#	($UID, $EUID) = ($EUID, $UID);		

	my $file;
	if (exists($arguments{'use_arc'})) {
		$file = "$confixx_tmpDir/$arguments{'use_arc'}";
	} elsif (exists($arguments{'mov_file'})) {
		$file = "$confixx_tmpDir/$arguments{'mov_file'}";
	}

	if ($file) {
		unless (-e $file) {
			&fehler("File '$file' does not exist");
		}
		my (undef, undef,$mode,undef,$uid,$gid,undef,$size,
        $atime,$mtime,$ctime,undef,undef) = stat($file);

	# user 'apache' should be in 'users' group
#		chown ($uid, $confixx_gid, $file)
#			or &fehler("Unable to change ownership ('$uid:$gid' to '$uid:$confixx_gid') on a temporary file '$file': $!");
#		chmod (0660, $file)
#			or &fehler("Unable to change permissions on a temporary file '$file': $!");
	}

#	($EUID, $UID) = ($UID, $EUID);		
}

#$UID = $EUID;					# make setuid
#$GID = $EGID;					# make setgid

#print "Suid => Real UID:$UID, Eff. UID:$EUID\n" if ($debug_level);

umask 0022;

$main::fs = Modules::File->new();

#adaptors
$main::skin = $skin;
$main::skindir = $skindir;
%main::targets = %targets;

my $t_str_not_found = '';
if ( exists( $arguments{'new_skin'} ) && exists( $arguments{'use_arc'} ) ) {

	my $type = $arguments{'arc_type'};
	$type = 'tgz' unless ($type);
	&new_skin_from_arc("$confixx_tmpDir/$arguments{'use_arc'}", $type);
	
} elsif (exists($arguments{'new_skin'}) && exists($arguments{'use_dir'})) {
	if ( $arguments{'new_skin'} eq $arguments{'use_dir'} ) {
		&fehler("Destination skin is same as source skin ('$arguments{'new_skin'}')".
			" Operation is skiped.");
	} else {
		&new_skin_from_dir("$confixx_htmlDir/skins/$arguments{'use_dir'}");
	}
} elsif (exists $arguments{'del_skin'}) {

	&del_skin();
	
} elsif (exists $arguments{'mov_file'}) {

	unless (exists $arguments{'dest'})  {
		&fehler("You must specify '--dest'.  Please run '$0 --help' for usage information\n");
	}
	&mov_file("$confixx_tmpDir/$arguments{'mov_file'}", "$main::skindir/$arguments{'dest'}");
}

#print "success\n";
exit(0);

sub check_executable($) {
	my ($name) = @_;
	my $var_name = "bin_$name";
	print "VAR $var_name  = $$var_name;\n" if ($debug_level);
	unless ($$var_name) {
		&fehler("Probably '$name' software is not installed on the machine: \$$var_name configuration variable is not set.");
	}
	unless (-x $$var_name) {
		&fehler("Can not find '$name' program executable. File '$$var_name' does not exist or is not executable. Probably, \$bin_gzip configuration variable is not set properly.");
	}
}

sub new_skin_dirs() {

	my $obj_skindir = $main::fs->createDir($main::skindir, 0755, $arguments{'force'});
	unless ( defined $obj_skindir ) {
		&fehler("Unable to create directory '$main::skindir':\n");
	}

	my %obj_links = ();
#	while (my ($key, $dir) = each(%main::targets)) {
#		$obj_links{$key} = $main::fs->createSoftLink($dir, $main::skindir);
#		unless (defined $obj_links{$key}) {
#			&fehler("Unable to create link '$dir': $!\n");
#		}
#	}
	
	return ($obj_skindir, \%obj_links);
}

sub new_skin_from_arc ($$) {
	my ($file, $type) = @_;

	my ($obj_skindir, $href_obj_links) = &new_skin_dirs();

	# Create temp directory for skin unpacking

#	use File::Temp qw/ :mktemp  /;
	my $obj_tmpskindir = $main::fs->createTempDir("$confixx_tmpDir/confixx_skin_XXXXXX");
	&fehler("Unable to create temporary dir") unless (defined $obj_tmpskindir);
	my $tmpskindir = $obj_tmpskindir->name();

#	print `ls -l $file`;	
#	print `id`;

	# unpack a skin archive
	
	if ($type eq 'tar' || $type eq 'tgz') {
		&check_executable('gzip');
		&check_executable('tar');
		system("$bin_gzip -dc '$file'|$bin_tar -x -C '$tmpskindir/'") == 0
			or &fehler("Unable to extract '$file' to '$tmpskindir' ($type): $!\n");			
	} elsif ($type eq 'zip') {
		&check_executable('unzip');
		system("$bin_unzip '$file' -d '$tmpskindir/' 1>/dev/null 2>&1") == 0
			or &fehler("Unable to extract '$file' to '$tmpskindir' ($type): $!\n");		
	}

	# remove not-allowed files 
	# should be before copying to a proper location
	
	# list of allowed file extensions. case insensitive.	
	&check_executable('find');
	my @ext = ('jpg', 'jpeg', 'gif', 'png', 'css');	
	my @find_cond = ();
	foreach my $allowed_ext (@ext) {
		push @find_cond, "-iname '*.$allowed_ext'";
	}
	my $find_cond_str = join ' -or ', @find_cond;
	if ($find_cond_str) {
		system("$bin_find '$tmpskindir/' -type f -and '!' '(' $find_cond_str ')' -exec rm -f '{}' ';'") == 0
			or &fehler("Can not remove not allowed files from skin: $!\n");
	}
	
	# copy skin to a proper location	
	
	&move($tmpskindir, $main::skindir)
		or &fehler("Unable to move skin to a proper location ($main::skindir): $!\n");
	system("chmod -R 0755 $main::skindir") == 0
		or &fehler("Unable to set proper permissions to the skin directory '$main::skindir': $!\n");
#	system("chown -R $confixx_user:$confixx_group $main::skindir") == 0
#		or &fehler("Unable to set proper permissions to the skin directory '$main::skindir': $!\n");

	$obj_skindir->confirm();
#	$$href_obj_links{'reseller'}->confirm();
#	$$href_obj_links{'user'}->confirm();
	
	return 1;
}

sub new_skin_from_dir($) {
	my ($dir) = @_;

	unless (-d $dir) {
		&fehler("Directory '$dir' does not exist\n");
	}

	my ($obj_skindir, $href_obj_links) = &new_skin_dirs();
	
	opendir(DIR, $dir)
		or &fehler("Unable to operate with directory '$dir': $!\n");
	my $file;
	while(defined($file = readdir DIR)) {
		next if $file =~ /^\.\.?$/;			# skip '.' and '..'
		&cnx_copy("$dir/$file", $main::skindir)
			or &fehler("Unable to copy file '$file' to new skin: $!\n");
	}
	closedir(DIR);

	$obj_skindir->confirm() if ref($obj_skindir);  ## skip if $obj_... is not object
#	$$href_obj_links{'reseller'}->confirm();
#	$$href_obj_links{'user'}->confirm();
	
	return 1;
}

sub del_skin(;$) {
	while (my ($key, $dir) = each(%main::targets)) {
		unlink ("$dir") 
			or &fehler("Unable to remove link '$dir': $!\n");
	}
	&removeDir($main::skindir)
		or &fehler("Unable to remove directory '$main::skindir': $!\n");
	return 1;
}

# Potential trouble: 
# the utility does not set permissions to new skins explicitly,
# so we can met once a situation that we can not create file in 
# skin directory

sub mov_file($$) {
	my ($from_file, $to_file) = @_;

 	unless (-e $from_file)	{
		&fehler("File '$from_file' does not exist\n");
	}
 	unless (-f $from_file)	{
		&fehler("File '$from_file' is not a regular file\n");
	}
 	unless (-R $from_file)	{
		&fehler("No permission to read file '$from_file' for <$UID:$GID> user\n");
	}
 	unless (-e $to_file && -W $to_file)	{
		&fehler("No permission to write to file '$to_file' for <$UID:$GID> user\n");
	}

	&copy($from_file, $to_file)
		or &fehler("Unable to copy file '$from_file' to '$to_file' (uid=$UID, gid=$GID): $!\n");
	unlink($from_file)
		or &fehler("Unable to remove file '$from_file': $!\n");
	return 1;
}

sub fehler{
	my ($msg, $err_code) = @_;

	chomp $msg;		# remove '\n' from the end (if any)
	print $msg . "\n";	# add '\n'
	$err_code = 1 unless (defined $err_code);
	exit $err_code;
}

sub system2($;@) {
	my (@args) = @_;
	system @args;
	if ($? == -1) {
		warn $!;
		return 0;
	};
	my $exit_value = $? >> 8;
	return 1 if ($exit_value == 0);
	warn($!);
	return 0;
}

sub print_help {
	print << "EOF";
Usage:

skinmng	--skin <skin_dir>  action

Actions:

--new_skin --use_arc <file> --arc_type <archive_type>
	create new skin directory and fill it with an archive content 
	(<archive type> is 'tgz', 'zip', ...)
--new_skin --use_dir <skindir>
	create new skin directory and fill it with another skin content
--del_skin   
	delete skin directory

--mov_file <source> --dest <result> 
	move file to skin directory. 
	<source> - is file (in temp dir) to move to skin.
	<result> - is relative (from skin) path to file, which you want 
		to replace in skin.

Options:

--force - rewrite the existing dir/file

--debug - print debug messages
--help  - print the help message

EOF
};
