#!/usr/bin/perl
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the Perl Artistic License or the
# GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# If you do not have a copy of the GNU General Public License write to
# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
# MA 02139, USA.

=head1 NAME

wacs - web applications control system

=head1 SYNOPSIS

	wacs (-i|--install -a|--adjust -r|--remove -s|--show) webAppName
		[--vhost serverName] [--webAppRoot path]
		[--define var1=val1 --define var2=val2 ...]
		[-q|--quiet -d|--debug level -v|--version]

	Installation or Upgrading webapp:
		wacs -i webAppName [--webAppRoot path]
			[--define var1=val1 --define var2=val2 ...]

	Adjusting webapp to selected virtual host:
		wacs -a webAppName --vhost serverName [--webAppRoot path]
			[--define var1=val1 --define var2=val2 ...]

	Removing webapp from virtual host(s):
	WARNING!!! If no --vhost option specified, webapp will fully
	uninstalled from all virtual hosts and from wacs database

		wacs -r webAppName [ --vhost serverName ]

	Show detailed info about webapp:
		wacs -s [webAppName] [ --vhost serverName ]

=head1 DESCRIPTION

wacs allow you to share web applications between Virtual Hosts.
You can control installation, upgrading and removing of web applications.

=head1 AUTHOR

Vladimir Lettiev E<lt>F<crux@altlinux.ru>E<gt>

=cut

use strict;
#use warnings;
use Getopt::Long;
use DB_File;
use Config::General;
use Data::Dumper;

my (%opts,%db,$cnf,$db_link);
my $debug = 1;
my $version = "0.10";
my $chroot = "";
my $defConfDir = $chroot . "/etc/httpd/conf";
my $incoming = $chroot . "/var/lib/wacs/incoming";
my $db = $chroot . "/var/lib/wacs/db/wacs.db";
my $webAppsDir = $chroot . "/usr/share/webapps";
my $config;

GetOptions(\%opts,'install|i:s','remove|r:s','adjust|a:s','quiet|q','debug|d:i','define:s%','webAppRoot:s',
'vhost:s','help|h','version|v','show|s:s');

if (exists $opts{'help'}){
	print <<EOF;
WACS - Web Applications Control System.
wacs allow you to share web applications between Virtual Hosts.
You can control installation, upgrading and removing of web applications.

Usage:
	wacs (-i|--install -a|--adjust -r|--remove -s|--show) webAppName
		[--vhost serverName] [--webAppRoot path]
		[--define var1=val1 --define var2=val2 ...]
		[-q|--quiet -d|--debug level -v|--version]

	Installation or Upgrading webapp:
		wacs -i webAppName [--webAppRoot path]
			[--define var1=val1 --define var2=val2 ...]

	Adjusting webapp to selected virtual host:
		wacs -a webAppName --vhost serverName [--webAppRoot path]
			[--define var1=val1 --define var2=val2 ...]

	Removing webapp from virtual host(s):
	WARNING!!! If no --vhost option specified, webapp will fully
		uninstalled from all virtual hosts and from wacs database

		wacs -r webAppName [ --vhost serverName ]

	Show detailed info about webapp:
		wacs -s [webAppName] [ --vhost serverName ]

EOF
	exit;

}

if (exists $opts{"version"}){
	print "wacs version $version\n";
	exit;
}

# Set verbosity
if ( exists $opts{'quiet'} ) {
	$debug = 0;
} elsif ( exists $opts{'debug'} ) {
	$debug = $opts{'debug'};
}

# MAIN CYCLE

# open database
unless ($db_link = tie %db, "DB_File", $db, O_CREAT|O_RDWR, 0600, $DB_BTREE ){
	&DEBUG(0, "Can not open wacs database $db: $!");
	exit(1);
}

# installing .cnf
if (exists $opts{'install'}){

	my $name = $opts{'install'};

	$cnf = $incoming."/".$name.".cnf";
	unless ( -f $cnf ) {
		&DEBUG(0,"$cnf not found\nCan not install webapp");
		goto fail;
	}

	&DEBUG(3, "$cnf succefully founded");
	unless ($config = &checkCnf($cnf)) {
		&DEBUG(0,"Parsing of $cnf failed");
		goto fail;
	}

	if (exists ($opts{"webAppRoot"}) ) {
		$config->{'webAppRoot'} = $opts{"webAppRoot"};
	}
	foreach ( sort keys %{$config->{varDefinitions}}) {
		if (exists $opts{"define"}->{$_}){
			$config->{varDefinitions}->{$_} = $opts{"define"}->{$_};
		}
	}

	if ( exists $db{$name} ){
		&DEBUG(2,"$name already installed.");
		my $configOld = eval $db{$name};
		if (keys %{$configOld->{vhosts}}){
			&DEBUG(3,"$name was adjusted. Performing upgrade...");

			# Here go upgrade process
			foreach my $vhost( sort keys %{$configOld->{vhosts}} ){
				my ($vconf,$docRoot,$include) = &findVhost($vhost,$name);
				unless ($vconf) {
					&DEBUG(0,"Can not upgrade $vhost. Skip...");
					next;
				}
				my $newWebAppConf= $config->{webAppConf};

				my %vhVars = ();
				foreach my $var (keys %{$config->{varDefinitions}}) {
					if (exists $configOld->{vhosts}->{$vhost}->{varDefinitions}->{$var}){
						$config->{vhosts}->{$vhost}->{varDefinitions}->{$var} =
							$configOld->{vhosts}->{$vhost}->{varDefinitions}->{$var};
						$vhVars{$var} = $configOld->{vhosts}->{$vhost}->{varDefinitions}->{$var};
					} else {
						$vhVars{$var} = $config->{varDefinitions}->{$var};
					}
				}

				$vhVars{documentroot} = $docRoot;
				if (exists $configOld->{vhosts}->{$vhost}->{webAppRoot}) {
					$vhVars{webAppRoot} = $configOld->{vhosts}->{$vhost}->{webAppRoot};
					$config->{vhosts}->{$vhost}->{webAppRoot} =
							$configOld->{vhosts}->{$vhost}->{webAppRoot};
				} elsif ($configOld->{webAppRoot} ne $config->{webAppRoot}) {
					$vhVars{webAppRoot} = $configOld->{webAppRoot};
					$config->{vhosts}->{$vhost}->{webAppRoot} = $configOld->{webAppRoot};
				} else {
					$vhVars{webAppRoot} = $configOld->{webAppRoot};
				}

				foreach my $var (keys %vhVars){
					$newWebAppConf =~ s/\$$var/$vhVars{$var}/gi;
				}

				if (open(CONF,">$defConfDir/wacs/$vhost-$name.conf")){
					print CONF $newWebAppConf;
					close CONF;
				} else {
					&DEBUG(0,"Can not create $defConfDir/wacs/$vhost-$name.conf: $!");
					&DEBUG(0,"Can not upgrade $vhost. Skip...");
					next;
				}
				unless ($include) {
					unless (&mkInclude($name,$vhost,$vconf,"add")) {
						next;
					}
				}

				unless (&farmer($webAppsDir."/".$name,
					$chroot.$vhVars{documentroot}.$vhVars{webAppRoot},
					$config->{configFiles},"copy")) {
					DEBUG(0,"Cloning failed. Skip...");
					next;
				}

				$config->{vhosts}->{$vhost}->{status} = "adjusted";
			}

		} else {
			&DEBUG(3,"$name not adjusted. So, just overwrite conf...");
		}
		
	} else {
		&DEBUG(3,"$name is new. Installing...");
	}

	my $d = Data::Dumper->new([$config]);
	$d->Indent(0);
	$d->Terse(1);
	$db{$name} = $d->Dump;

	&DEBUG(3,"Installed succefully");
	rename($cnf,$cnf.".installed");

# show info
} elsif (exists $opts{'show'}) {

	my $name = $opts{'show'};

	# print a list of installed webapps, and also show in what virtual host they are adjusted
	if ($name eq ""){
		my @list =  sort keys %db;
		unless (@list) {
			&DEBUG(1,"No webapps installed");
		}
		foreach my $webapp (sort @list){
			my $curConf = eval $db{$webapp};
			&DEBUG(6,&Dumper($curConf));
			print $webapp . "\t- installed." ;
			if (keys %{$curConf->{vhosts}}){
				print " Adjusted in virtual hosts: ".
					join(", ",sort keys %{$curConf->{vhosts}});
			}
			print "\n";
		}

	# on empty db 
	} elsif (! exists $db{$name}) {
		&DEBUG(1,"Webapp $name not installed");

	# if vhost specified show detailed info about it
	} elsif (exists $opts{"vhost"}) {
		my $curConf = eval $db{$name};

		unless ($curConf->{vhosts}->{$opts{vhost}}->{status} eq "adjusted") {
			&DEBUG(1,"Webapp $name not adjusted for ".$opts{"vhost"});
		} else {
			# show info of adjusted webapp in vhost
			print "Webapp $name configuration for $opts{'vhost'}:\n";
			print "\twebAppRoot = ";
			if (exists $curConf->{vhosts}->{$opts{vhost}}->{webAppRoot}) {
				print $curConf->{vhosts}->{$opts{vhost}}->{webAppRoot};
			} else {
				print $curConf->{webAppRoot};
			}
			print "\n\tconfigFiles: ". join(", ", sort keys
						%{$curConf->{configFiles}}) ."\n";
			print "\tDefined variables:\n " if (keys %{$curConf->{varDefinitions}});
			foreach my $var (sort keys %{$curConf->{varDefinitions}}) {
				print "\t\t".$var." = ";
				if (exists $curConf->{vhosts}->{$opts{vhost}}->{varDefinitions}->{$var}) {
					print
					$curConf->{vhosts}->{$opts{vhost}}->{varDefinitions}->{$var};
				} else {
					print $curConf->{varDefinitions}->{$var};
				}
				print "\n";
			}
		}

	# Show default information of installed webapps
	} else {
		print "Webapp $name installed.\n";
		my $curConf = eval $db{$name};
		if (exists($curConf->{vhosts})) {
			print "Adjusted in virtual hosts: ",
				join(", ",sort keys %{$curConf->{vhosts}}),"\n";
		}

		&DEBUG(5,&Dumper($curConf));
		print "\nDefault configuration:\n";
		print "\twebAppRoot = ". $curConf->{"webAppRoot"};
		print "\n\tconfigFiles: ". join(", ", sort keys %{$curConf->{configFiles}}) ."\n";
		print "\tDefined variables:\n" if (keys %{$curConf->{varDefinitions}});
		foreach my $var (sort keys %{$curConf->{varDefinitions}}) {
			print "\t\t".$var." = ".$curConf->{varDefinitions}->{$var}."\n";
		}
		DEBUG(2,"\twebapp apache configuration:\n" . $curConf->{"webAppConf"});
	}


# adjust
} elsif (exists $opts{'adjust'}) {

	my $name = $opts{'adjust'};

	unless ( exists $db{$name} ) {
		&DEBUG(0, $name ." not installed");
		goto fail;
	}

	unless (exists $opts{"vhost"}){
		&DEBUG(0, "Virtual host not specified. Exiting.");
		goto fail;
	}

	my ($vconf,$docRoot,$include) = &findVhost($opts{"vhost"},$name);
	unless ($vconf) {
		goto fail;
	}

	# create webAppConf for current vhost, and substitute variables

	my $curConf = eval $db{$name};

	my $saveWR = undef;
	if ($curConf->{vhosts}->{$opts{vhost}}->{status} eq "adjusted"){
		if (exists $curConf->{vhosts}->{$opts{vhost}}->{webAppRoot}){
			$saveWR = $curConf->{vhosts}->{$opts{vhost}}->{webAppRoot};
		} else {
			$saveWR = $curConf->{webAppRoot};
		}
	}

	my $newWebAppConf= $curConf->{webAppConf};

	my %vhVars = ();
	foreach my $var (keys %{$curConf->{varDefinitions}}) {
		if (exists $opts{"define"}->{$var}){
			$curConf->{vhosts}->{$opts{vhost}}->{varDefinitions}->{$var} =
							$opts{"define"}->{$var};
			$vhVars{$var} = $opts{"define"}->{$var};
		} else {
			$vhVars{$var} = $curConf->{varDefinitions}->{$var};
		}
	}

	$vhVars{'documentroot'} = $docRoot;
	if (exists $opts{webAppRoot}){
		$curConf->{vhosts}->{$opts{vhost}}->{webAppRoot} = $opts{"webAppRoot"};
		$vhVars{'webAppRoot'} = $opts{"webAppRoot"};
	} else {
		$vhVars{"webAppRoot"} = $curConf->{webAppRoot};
	}
	foreach my $var (keys %vhVars){
			$newWebAppConf =~ s/\$$var/$vhVars{$var}/gi;
	}

	if (open(CONF,">$defConfDir/wacs/$opts{'vhost'}-$name.conf")){
		print CONF $newWebAppConf;
		close CONF;
	} else {
		DEBUG(0,"Can not create $defConfDir/wacs/$opts{'vhost'}-$name.conf: $!");
		goto fail;
	}

	# insert include string in current vhost (if its not exist) 
	unless ($include) {
		unless (&mkInclude($name,$opts{vhost},$vconf,"add")) {
			goto fail;
		}
	}

	if (defined($saveWR) && $saveWR ne $vhVars{'webAppRoot'}){
		&farmer($webAppsDir."/".$name,$chroot.$vhVars{'documentroot'}.$saveWR,
		$curConf->{configFiles},"delete");
	}

	unless (&farmer($webAppsDir."/".$name,
			$chroot.$vhVars{'documentroot'}.$vhVars{'webAppRoot'},
			$curConf->{configFiles},"copy")) {
		DEBUG(0,"Cloning failed");
		goto fail;
	}

	$curConf->{vhosts}->{$opts{vhost}}->{status} = "adjusted";

	&DEBUG(5,Dumper($curConf));

	my $d = Data::Dumper->new([$curConf]);
	$d->Indent(0);
	$d->Terse(1);
	$db{$name} = $d->Dump;

# remove webapp from virtual host(s)
} elsif (exists $opts{remove}){

	my $name = $opts{remove};

	unless ( exists $db{$name} ) {
		&DEBUG(0, $name ." not installed");
		goto fail;
	}

	my @deadList = ();
	my $curConf = eval $db{$name};

	unless (exists $opts{vhost}){
		&DEBUG(1,"Virtual host not specified!");
		&DEBUG(1,"Remove $name from all virtual hosts and uninstall");
		@deadList = sort keys %{$curConf->{vhosts}};
	} elsif ($curConf->{vhosts}->{$opts{vhost}}->{status} eq "adjusted") {
		push @deadList, $opts{vhost};
	} else {
		DEBUG(1,"$name not adjusted in $opts{vhost}");
	}

	foreach my $vhost (@deadList) {
		my ($vconf,$docRoot,$include) = &findVhost($vhost,$name);
		unless ($vconf) {
			&DEBUG(0,"Can not remove $name from $vhost. Skip it..");
			next;
		}

		# delete include string in current vhost (if its exist) 
		if ($include) {
			unless (&mkInclude($name,$vhost,$vconf,"delete")) {
				goto fail;
			}
		}

		unlink "$defConfDir/wacs/$vhost-$name.conf";

		my $war = "";
		if (exists $curConf->{vhosts}->{$vhost}->{webAppRoot}){
			$war = $curConf->{vhosts}->{$vhost}->{webAppRoot};
		} else {
			$war = $curConf->{webAppRoot};
		}

		&farmer($webAppsDir."/".$name,$chroot.$docRoot.$war,
		$curConf->{configFiles},"delete");

		delete $curConf->{vhosts}->{$vhost};

	}

	if (@deadList && exists $opts{vhost}){
		&DEBUG(5,Dumper($curConf));

		my $d = Data::Dumper->new([$curConf]);
		$d->Indent(0);
		$d->Terse(1);
		$db{$name} = $d->Dump;
	} elsif (! exists $opts{vhost}) {
		delete $db{$name};
	}

# No action
} else {
	&DEBUG(1,"Nothing to do");
}

undef $db_link; untie %db;
exit(0);

fail:
	undef $db_link; untie %db;
	exit(1);

# subs
sub DEBUG($$) {
	my $level = shift;
	my $message = shift;
	
	if ($level == 0) {
		print STDERR $message."\n";
	} elsif ($level <= $debug) {
		print $message."\n";
	}
}

sub checkCnf($) {
	my $cnf = shift;
	my $tmp = "";
	unless (open(CNF,$cnf)){
		&DEBUG(0,"Can not open $cnf: $!");
		return undef;
	}
	while (<CNF>){
		$tmp .= $_;
	}
	close(CNF);

	my ($webAppConf) = ( $tmp =~ /<webAppConf>\s*(.+?)<\/webAppConf>/is );

	my $config = new Config::General(
		-String => $tmp,
		-LowerCaseNames => "false",
		-MergeDuplicateBlocks => "on");

	unless (defined($config) && defined($webAppConf)){
		return undef;
	}

	my %config = $config->getall;
	$config{"webAppConf"} = $webAppConf;

	unless ( defined($config{webAppName}) ){
		&DEBUG(0,"not defined webAppName");
		return undef;
	}

	&DEBUG(5, &Dumper(\%config));
	return \%config;
}

sub findVhost($) {
	my $vhost = shift;
	my $name = shift;
	my (@tmp,@vfiles,$founded);

	foreach my $dir ("vhosts", "vhosts.d") {
		if ( opendir(DIR, "$defConfDir/$dir") ){
			@tmp = grep { /\.conf$/ &&
				-f "$defConfDir/$dir/$_" } readdir(DIR);
			foreach (@tmp) {
				$_ = "$defConfDir/$dir/".$_;
			}
		} else {
			&DEBUG(2,"Can not open $defConfDir/$dir: $!");
		}
		@vfiles = (@vfiles,@tmp);
	}

	unless (@vfiles){
		&DEBUG(1, "wacs can not find your Virtual Host configuration files.");
		&DEBUG(2, "Dont ask me to search in httpd.conf - thats not good place for it.");
		return undef;
	}

	foreach my $vconf (@vfiles){
		unless (open(FILE, $vconf)) {
			&DEBUG(2,"can not open $vconf: $!");
			next;
		}
		if ( grep {/^\s*ServerName\s+$vhost\s+/i} <FILE> ){
			$founded = $vconf;
			close(FILE);
			last;
		} else {
			close(FILE);
		}
	}

	unless ($founded) {
		&DEBUG(0,"Virtual Host $vhost not found in apache's configuration files");
		return undef;
	}

	my $apache = new Config::General(
		-ConfigFile => $founded,
		-LowerCaseNames => "on",
		-MergeDuplicateBlocks => "false");

	unless($apache){
		&DEBUG(0,"Error while reading $founded");
		return undef;
	}

	my %apache = $apache->getall;
	&DEBUG(5, &Dumper(\%apache));

	my $docRoot = undef;
	my $include = undef;
	my $fail = undef;
	
	foreach my $ip (keys %{$apache{virtualhost}}){
		if (ref($apache{virtualhost}->{$ip}) eq "ARRAY") {
			foreach my $realm (@{$apache{virtualhost}->{$ip}}){
				next unless ($realm->{servername} eq $vhost);
				unless (exists $realm->{documentroot}) {
					&DEBUG(0,"DocumentRoot not specified in $founded");
					$fail = "true";
					last;
				}
				$docRoot = $realm->{documentroot};
				if (ref($realm->{include}) eq "ARRAY") {
					foreach my $inc (@{$realm->{include}}){
						if ($inc eq
							"conf/wacs/$vhost-$name.conf"){
							$include = "already";
							&DEBUG(2,"Include exist.");
							last;
						}
					}
				} elsif ($realm->{include} eq
					"conf/wacs/$vhost-$name.conf"){
					$include = "already";
					&DEBUG(2,"Include exist.");
				}
				last;
			}
		} elsif (ref($apache{virtualhost}->{$ip}) eq "HASH" &&
				$apache{virtualhost}->{$ip}->{servername} eq $vhost) {
			unless (exists $apache{virtualhost}->{$ip}->{documentroot}) {
				&DEBUG(0,"DocumentRoot not specified in $founded");
				$fail = "true";
			}
			$docRoot = $apache{virtualhost}->{$ip}->{documentroot};
			if (ref($apache{virtualhost}->{$ip}->{include}) eq "ARRAY"){
				foreach my $inc (@{$apache{virtualhost}->{$ip}->{include}}) {
					if ($inc eq "conf/wacs/$vhost-$name.conf") {
						$include = "already";
						&DEBUG(2,"Include exist.");
						last;
					}
				}
			} elsif ( $apache{virtualhost}->{$ip}->{include} eq
				"conf/wacs/$vhost-$name.conf"){
				$include = "already";
				&DEBUG(2,"Include exist.");
			}
			
		}
		last if ($docRoot || $fail);
	}

	unless($docRoot || $fail){
		&DEBUG(0,"Parsing of $founded failed");
		return undef;
	}

	return ($founded,$docRoot,$include);

}

# Sub =farmer= - main clone engine
sub farmer {

	my $from = shift;
	my $to = shift;
	my $confList = shift;
	my $action = shift;
	my %FROM = ();
	
	unless ( -d $from ) {
		&DEBUG(0,$from." not exist or not directory");
		return undef;
	}
	
	if (! -e $to ) {

		return "ok" if ($action eq "delete");
		my @tmp = split(/\//, $to);

		for my $i (0..$#tmp-1){
			unless ( -e "/".join("/",@tmp[0..$i]) ) {
				mkdir "/".join("/",@tmp[0..$i]), 0755;
			}
		}

		unless ($confList) {
			symlink $from,$to;
			return "true";
		} else {
			mkdir $to,0755;
		}
	} elsif (! -d $to) {
		&DEBUG(0,"$to exist but not directory");
		return undef;
	}

	my %confHash = ();

	foreach my $conf (sort keys %{$confList}) {
		my $oldConf = $conf;
		$conf =~ s|\*|[^/]*|g;
		$conf =~ s/(\.|\?)/\\$1/g;
		$conf =~ s|^/||;
		$conf =~ s|/$||;
		$confHash{$conf} = $confList->{$oldConf};
	}

	my $dir = "";
	my %cdir = ();
	my @dirs = ();
	
	do {
		unless ( opendir(DIR,$from."/".$dir) ){
			&DEBUG(0, "Can not open dir $from.$dir: $!");
			return undef;
		}
		foreach ( grep {! /\.{1,2}$/ } readdir(DIR)) {
			if ( -f $from."/".$dir."/".$_ ){
				$FROM{$dir."/".$_} = "f". &checkCf($dir."/".$_,\%cdir,\%confHash);
			} elsif ( -d $from."/".$dir."/".$_ ) {
				$FROM{$dir."/".$_} = "d". &checkCf($dir."/".$_,\%cdir,\%confHash);
				push @dirs,$dir."/".$_;
			} else {
				&DEBUG(1, "$_ not file or directory. Skip it.");
			}
		}
		close(DIR);
		$dir = shift @dirs;
	} while ($dir);

	my @list = sort keys %FROM;

	foreach my $file (@list) {

		if (exists $cdir{$file} || $FROM{$file} =~ /dc/){
			if ( -e $to.$file ) {
				if ( -l $to.$file ) {
					unlink $to.$file;
				} elsif (! -d $to.$file) {
					DEBUG(1,"$file is not a dir. Something wrong. Try to backUp");
					unless (&backUp($to.$file)) {
						return undef;
					};
				}
			}
			my ($mode,$uid,$gid) = (stat($from.$file))[2,4,5];
			if ($FROM{$file} =~ /^dc(\d+)$/){
				$mode = $1;
			} else {
				$mode = sprintf("%04o", $mode & 07777);
			}
			if ($action ne "delete"){
				mkdir $to.$file;
				chmod oct($mode),$to.$file;
				chown $uid,$gid,$to.$file;
			}
		} elsif ($FROM{$file} =~ /fc/) {
			if ( -l $to.$file ) {
				unlink $to.$file;
			} elsif ( -e $to.$file ) {
				next;
			}
			system("cp","-p",$from.$file,$to.$file) if ($action ne "delete");
			if ($FROM{$file} =~ /^fc(\d+)$/){
				chmod oct($1),$to.$file if ($action ne "delete");
			}
		} elsif ($FROM{$file} eq "d") {
			if ( -l $to.$file ) {
				unlink $to.$file;
			} elsif ( -d $to.$file ) {
				DEBUG(1, "$file is a dir. Can not link it. Try to backUp");
				next unless (&backUp($to.$file));
			} elsif (-e $to.$file ) {
				DEBUG(1,"$file not dir. Try to backUp");
				unless (&backUp($to.$file)) {
					return undef;
				}
			}
			symlink($from.$file,$to.$file) if ($action ne "delete");
			foreach my $empty ( grep { /^$file\/.+/ } @list ){
				$FROM{$empty} = "empty";
			}

		} elsif ($FROM{$file} eq "f") {
			if (-l $to.$file) {
				unlink($to.$file);
			} elsif ( -e $to.$file) {
				next unless (&backUp($to.$file));
			}
			symlink($from.$file,$to.$file) if ($action ne "delete");
		}
	}

	return "ok";

}

sub checkCf {
	my $file = shift;
	my $dir = shift;
	my $confList = shift;

	my $ret = undef;
	my @tmp = ();
	foreach my $cnf (keys %{$confList}) {
		next unless ($file =~ m|^/$cnf$|);
		$ret = "c".$confList->{$cnf};
		&DEBUG(6,"$file match $cnf: $ret");
		@tmp = split(/\//, $file);
		for my $i (1..$#tmp-1) {
			next if (exists ${$dir}{join("/",@tmp[0..$i])});
			${$dir}{join("/",@tmp[0..$i])} = "c";
		}
	}
	return $ret;
}

sub backUp {
	my $file = shift;
	my $backup = $file.".wacs-save";
	
	if (-d $backup) {
		system("rm","-rf",$backup);
	} elsif ( -f $backup || -l $backup) {
		unlink $backup;
	} elsif ( -e $backup) {
		return undef;	
	}

	system("mv",$file,$backup);
	return "ok";	
}

sub mkInclude {
	my $name = shift;
	my $vhost = shift;
	my $vconf = shift;
	my $action = shift;
	
	unless (open(VH,"$vconf")){
		DEBUG(0,"Can not open $vconf: $!");
		return undef;;
	}
	my $tmp = "";
	while(<VH>){
		if ($action eq "delete") {
			unless (m|^Include\s+conf/wacs/$vhost-$name\.conf\s+|i){
				$tmp .= $_;
			}
		} else {
			$tmp .= $_;
			if (/^\s*ServerName\s+$vhost\s+/i){
				$tmp .= "Include conf/wacs/$vhost-$name.conf\n";
			}
		}

	}
	close(VH);
	unless(open(VH,">$vconf")){
		DEBUG(0,"Can not write to $vconf: $!");
		undef $tmp;
		return undef;
	}
	print VH $tmp;
	close(VH);

	return "ok";
	
}
