;# $Id: install.pl,v 3.0.1.4 1998/07/28 17:03:54 ram Exp $
;#
;#  Copyright (c) 1990-1993, Raphael Manfredi
;#  
;#  You may redistribute only under the terms of the Artistic License,
;#  as specified in the README file that comes with the distribution.
;#  You may reuse parts of this distribution only within the terms of
;#  that same Artistic License; a copy of which may be found at the root
;#  of the source tree for mailagent 3.0.
;#
;# $Log: install.pl,v $
;# Revision 3.0.1.4  1998/07/28 17:03:54  ram
;# patch62: was not processing (prefix) indication from setup.cf
;#
;# Revision 3.0.1.3  1997/02/20  11:44:47  ram
;# patch55: missed a '$' in front of a variable in create()
;#
;# Revision 3.0.1.2  1996/12/24  14:54:05  ram
;# patch45: new prefix() routine
;#
;# Revision 3.0.1.1  1995/02/16  14:33:13  ram
;# patch32: created
;#
;#
;# This part of the 'cf' package is responsible for setting up a proper config
;# for mailagent to run correctly.
;#
;# The main entry point is &cf'setup. Little information is available at that
;# time, and of course, we do not have any logging. Therefore, messages are
;# printed on stdout.
;#
;# We start by looking for the ~/.mailagent file. If it exists, then we'll
;# have to merge it with newer variables that may have been introduced.
;# The configuration is then loaded and all mandatory directories or files
;# are created.
;#
;# The configured path is also checked to ensure we can find at least perl
;# and mailagent. NB: when creating a ~/.mailagent from scratch, we only
;# configure the path variable, not the p_host one.
;#
#
# Configuration setup main entry point
#

package cf;

# Setup a decent mailagent environment, and returns a proper exit status,
# i.e. 0 for success and 1 for failure.
sub setup {
	*main'add_log = *main'stdout_log;	# Setup a decent logging routine

	# To allow for automatic -I testing, we set-up the following two
	# variables specially for the test suite when invoked with the
	# undocumented -TEST option.

	local($cfset'home);					# Computed HOME directory
	local($cfset'privlib);				# Installed mailagent libdir
	if ($'test_mode) {
		$cfset'home = $ENV{'HOME'};					# agent/test/out
		$cfset'privlib = "$cfset'home/../../files";	# agent/files
	} else {
		$cfset'home = &'tilda_expand('~');
		$cfset'privlib = &'tilda_expand($'privlib);
	}

	umask(077);							# Default mode: rw for user only!
	$home = $cfset'home;				# Required by &main'tilda...

	# Setup a default configuration
	unless (&cfset'init) {
		&'add_log("trouble initializing configuration -- help required");
		return 1;
	}

	# Now load new configuration and perform sanity checks
	&'get_configuration;
	unless (defined $main'loglvl) {
		&'add_log("trouble getting new configuration -- check it up");
		return 1;
	}

	&cfset'check;		# Check the configuration
	return 0;			# OK
}

#
# Configuration setup routines
#

package cfset;

# Initialize configuration, returning true on success.
sub init {
	unless (-d $home) {
		&'add_log("cannot locate home directory -- all I have is '$home'");
		return 0;	# failed
	}
	unless (-w $home) {
		&'add_log("you lack write permissions in $home");
		return 0;	# failed
	}

	local($pwdhome) = $'test_mode ? $ENV{'HOME'} : (getpwuid($<))[7];
	if (defined $ENV{'HOME'} && $ENV{'HOME'} ne $pwdhome) {
		&'add_log("your HOME environment variable disagrees with /etc/passwd");
		&'add_log("HOME: $ENV{'HOME'}, /etc/passwd: $pwdhome");
	}

	$ENV{'HOME'} = $home;					# This is set by filter normally

	return 0 unless &read_setup;			# Get setup.cf for defaults
	return &merge if -e "$home/.mailagent";	# Merge if already exists

	# Ok, at this point, we need to create a default ~/.mailagent that
	# will enable the user to run mailagent correctly.

	&'add_log("creating ~/.mailagent...");

	unless (open(TEMPLATE, "$privlib/mailagent.cf")) {
		&'add_log("cannot open $privlib/mailagent.cf: $!");
		return 0;	# failed
	}

	unless (open(CONFIG, ">$home/.mailagent")) {
		&'add_log("cannot create $home/.mailagent: $!");
		return 0;	# failed
	}

	# Build up a default configuratiuon from the mailagent.cf template.
	# If some variables have configured defaults in setup.cf, then use that.
	# Otherwise, copy the line, propagating the "commented out" status.

	local($_);
	local($c, $var, $sp1, $sp2, $val, $comment);
	while (<TEMPLATE>) {
		if (
			($c, $var, $sp1, $sp2, $val, $comment) =
			/^(#?)(\w+)(\s*):(\s*)([^#\n]*)(#.*)?/
		) {
			next if $var =~ /^p_/;				# Skip p_host examples
			if (defined $Var{$var}) {			# Has a computable default
				($val) = $val =~ m/(\s+)$/;		# Keep spaces before comment
				print CONFIG "$c$var$sp1:$sp2", &dflt($var), "$val$comment\n";
			} else {
				print CONFIG;		# No computable default, print verbatim
			}
		} else {
			print CONFIG;
		}
	}
	close CONFIG;
	close TEMPLATE;
}

# Merge existing configuration with possible new variables, returning
# true on success. Called from &init, after setup.cf loading when an
# existing ~/.mailagent is detected.
sub merge {
	local($old) = '.mailagent';
	local($new) = "$old.new";
	local($bak) = "$old.bak";

	&'add_log("merging ~/.mailagent...");

	unless (open(OLD, "$home/$old")) {
		&'add_log("cannot open $home/$old: $!");
		return 0;	# failed
	}

	# Fist pass on old file to get at the currently defined variables

	local(%seen);		# Records variables in current configuration
	local($_);
	while (<OLD>) {
		$seen{$1}++ if /^#?(\w+)\s*:/;
	}
	seek(OLD, 0, 0);	# Rewind

	unless (open(TEMPLATE, "$privlib/mailagent.cf")) {
		&'add_log("cannot open $privlib/mailagent.cf: $!");
		return 0;	# failed
	}

	# Now grab all the "known" variables in the mailagent.cf template.
	# Those tell us about the possible new variables that may have been
	# introduced since  the time ~/.mailagent was first created.

	local(%known);
	while (<TEMPLATE>) {
		$known{$1}++ if /^#?(\w+)\s*:/;
	}
	seek(TEMPLATE, 0, 0);	# Rewind

	unless (open(NEW, ">$home/$new")) {
		&'add_log("cannot create $home/$new: $!");
		return 0;	# failed
	}

	# Start duplicating existing configuration
	while (<OLD>) {
		print NEW;			# Print line verbatim
	}
	close OLD;

	local(%missing);
	local($missing) = 0;

	# Look for possible new variables added since last configuration
	foreach $var (keys %known) {
		next if $var =~ /^p_/;				# Skip p_host examples
		$missing{$var}++ unless defined $seen{$var};
		$missing++ unless defined $seen{$var};
	}

	if ($missing) {
		local($s) = $missing == 1 ? '' : 's';
		&'add_log("adding $missing extra variable$s to ~/.mailagent...");
		print NEW <<EOM;

#
# Extra variables added to configuration -- version $'mversion PL$'patchlevel
#

EOM
	} else {
		close NEW;
		close TEMPLATE;
		&'add_log("existing configuration was up-to-date");
		unlink("$home/$new") || &'add_log("WARNING can't unlink $new: $!");
		return 1;	# OK
	}

	# Add all new variables. If they have configured defaults in setup.cf,
	# then use that. Otherwise, copy the line verbatim from the mailagent.cf
	# template. We propagate the "commented out" status as necessary.

	local($c, $var, $sp1, $sp2, $val, $comment);
	while (<TEMPLATE>) {
		if (
			($c, $var, $sp1, $sp2, $val, $comment) =
			/^(#?)(\w+)(\s*):(\s*)([^#\n]*)(#.*)?/
		) {
			next unless defined $missing{$var};
			if (defined $Var{$var}) {			# Has a computable default
				($val) = $val =~ m/(\s+)$/;		# Keep spaces before comment
				print NEW "$c$var$sp1:$sp2", &dflt($var), "$val$comment\n";
			} else {
				print NEW;		# No computable default, print verbatim
			}
		}
	}
	close NEW;
	close TEMPLATE;

	local($status) = 1;

	unless (rename("$home/$old", "$home/$bak")) {
		&'add_log("ERROR unable to rename $old into $bak: $!");
	} else {
		&'add_log("renamed $old into $bak");
	}

	unless (rename("$home/$new", "$home/$old")) {
		&'add_log("ERROR unable to intall new $old: $!");
		$status = 0;
	} else {
		&'add_log("new $old installed");
	}

	return $status;	# OK, unless ~/.mailagent not installed
}

# Check the current loaded configuration.
# We ensure all the required files/directories are there, and that the path
# setting on this machine is good enough to locate perl and mailagent.
sub check {
	&'add_log("checking your configuration...");

	# Check file/directory existence and consistency...
	local($path);		# Computed value for given configuration parameter
	local($type);		# File/directory type
	foreach $var (keys %File) {
		eval '$path = $cf' . "'$var";
		&'add_log("ERROR in &cfset'check: $@") if chop($@);
		next if $@ ne '';
		$type = $File{$var};
		next unless $type;
		next if $path eq '' && $type =~ /^[fd]/;	# Missing, but optional
		$path = &'tilda_expand($path);
		if ($type =~ /^[fd]/) {
			&exists($path, $type, $var);	# Check existing file/dir
		} elsif ($path eq '') {
			&'add_log("ERROR mandatory parameter '$var' not defined");
		} else {
			&create($path, $type, $var);	# Create missing file/dir
		}
	}

	# Check home directory consistency...
	local($pwdhome) = $'test_mode ? $ENV{'HOME'} : (getpwuid($<))[7];
	unless ($pwdhome eq $cf'home) {
		&'add_log("WARNING home config parameter disagrees with /etc/passwd");
		&'add_log("home: $cf'home, /etc/passwd: $pwdhome");
	}

	# Make sure path setting is correct...
	&path_check;
	&path_check('mailagent');
	&path_check('perl');
}

# Get the setup.cf file, and create two data structures:
#   %Var:  indexed by variable name, yielding a perl expression to compute
#          the default value of that variable.
#   %File: indexed by variable name, yields whether it refers to a file
#          or a directory. Used to check-up the configuration.
# Return true on success.
sub read_setup {
	unless (open(SETUP, "$privlib/setup.cf")) {
		&'add_log("cannot open $privlib/setup.cf: $!");
		return 0;	# failed
	}
	local($_);
	while (<SETUP>) {
		next if /^#/;			# Skip comments
		next if /^\s*$/;		# Skip blank lines
		if (/^(\w+)\s*:\s*(.*)/) {			# var: perl-expr
			$Var{$1} = $2;					# specifies a computation for var
		} elsif (/^(\w+)\s*=\s*(.*)/) {		# var= F file
			$File{$1} = $2;					# tells what $var points to
		} else {
			&'add_log("WARNING setup.cf file corrupted at line $.");
		}
	}
	close SETUP;
	return 1;		# OK
}

# Compute a default specified by the setup.cf file.
sub dflt {
	local($var) = @_;
	local($perl) = $Var{$var};
	local($dflt);
	eval '$dflt = ' . $perl;
	&'add_log("ERROR while computing default for $var: $@") if chop($@);
	return $dflt;
}

# Check that a given file/directory is of the correct kind.
# Returns true if file/directory exists.
sub exists {
	local($path, $type, $var) = @_;
	local($what) = $type =~ /^[Dd]/ ? 'directory' : 'file';
	local($prefix) = &prefix($path, $type);
	local($short) = &'tilda("$prefix/$path");
	unless (-e "$prefix/$path") {
		&'add_log("no $prefix/$path for $what '$var' yet") if $cf'level > 14;
		return 0;
	}
	&'add_log("checking $what '$var' at $prefix/$path") if $cf'level > 11;
	if ($type =~ /^[Dd]/) {
		&'add_log("ERROR $short is not a directory (variable $var)")
			unless -d "$prefix/$path";
	} else {
		&'add_log("ERROR $short is not a file (variable $var)")
			if -d "$prefix/$path";
	}
	return 1;		# Exists, but may be of the wrong type
}

# Create file/directory, using type sepcification from the setup.cf file.
sub create {
	local($path, $type, $var) = @_;
	return if &exists($path, $type, $var);
	local($what) = $type =~ /^D/ ? 'directory' : 'file';
	local($file) = $type =~ /^\w\s*(.*)/;
	$file =~ s/\s*\(.*\)\s*//;		# Remove ($spool)-like location hints
	local($from) = $file ? "from default $file" : '(empty)';
	local($prefix) = &prefix($path, $type);
	local($target) = "$prefix/$path";
	$target =~ tr|/||s;				# If $path starts with /, $prefix is ''
	local($short) = &'tilda($target);
	&'add_log("creating mandatory $what $short $from for variable $var");
	if ($type =~ /^D/) {
		&'makedir($target);
	} else {
		local($dir, $base) = $target =~ m|(.*)/(.*)|;
		&'makedir($dir);
		unless (open(BASE, ">$dir/$base")) {
			&'add_log("ERROR cannot create $dir/$base: $!") if $cf'level;
			return;
		}
		if ($file && !open(FILE, "$privlib/$file")) {
			&'add_log("ERROR cannot open $privlib/$file: $!") if $cf'level;
		} else {
			local($_);
			while (<FILE>) {
				print BASE;
			}
			close FILE;
		}
		close BASE;
	}
}

# Compute suitable prefix to put in front of variable value before checking
# for file existence or performing creation. In the absence of specified
# prefix, the file is anchored under the home directory if it does not
# begin with a /.
#
# If a file is spefied as:
#        mailbox = f ($maildrop)
# in the setup.cf file, then it means the optional file is implicitely located
# under another configuration variable or specified path. Use that if necessary.
# Note that if a variable is specified, it is assumed to be a configuration
# variable and is therefore evaluated in the cf package. It is possible to
# fully qualify that name if necessary...
#
# Returns the suitable prefix (with ~ substitution).
sub prefix {
	local($path, $type) = @_;	# Path, file type such as "f ($var)"
	local($prefix) = $type =~ /\((.*)\)/;	# Grab ($var) or (/usr/bin) prefix
	eval "package cf; \$cfset'prefix = \"$cfset'prefix\";" if $prefix;
	$prefix = '~' unless $prefix || $path =~ m|^/|;
	return $prefix ? &'tilda_expand($prefix) : '';
}

# Check path setting.
# Without any argument, simply checks that each path directory is correct.
# Otherwise, try to locate the argument within the path.
sub path_check {
	local($prog) = @_;
	local($host) = &'hostname;
	$host =~ s/^(\w+).*/$1/;		# Trim domain name
	local($lpath);					# Value of local path (p_host)
	eval '$lpath = $cf' . "'p_$host";
	&'add_log("ERROR in cfset'path_check: $@") if chop($@);

	local($direxp);		# Expanded version of the directory
	local($found) = 0;
	foreach $dir (split(/:/, "$lpath:$cf'path")) {
		next if $dir eq '';
		$direxp = &'tilda_expand($dir);
		unless (defined $prog || -d $direxp) {
			&'add_log("WARNING path component '$dir' not found!");
		}
		if (defined $prog && -e "$direxp/$prog" && -x _ && !-d _) {
			$found++;
			last;
		}
	}
	&'add_log("WARNING cannot locate '$prog' in set-up path")
		if defined($prog) && !$found;
}

# Compute a suitable default path and return it. We try to include directories
# under the user home directory, and directories containing some programs
# like 'ls', 'pg', 'perl' and 'mailagent'.
# NB: This routine is not called directly but via setup.cf and &dflt.
sub default_path {
	local($path) = '';		# The build-up path
	local($short);			# Path with tilda substitution
	foreach $dir (split(/:/, $ENV{'PATH'})) {
		next if $dir eq '' || $dir =~ /^\.\.?$/;
		$short = &'tilda($dir);
		if ($short ne $dir) {
			$path .= "$short:";
			next;
		}
		$path .= "$dir:" if &contains($dir, 'ls', 'pg', 'perl', 'mailagent');
	}
	chop($path);			# Remove trailing ':'
	return $path;
}

# Returns true if the specified dir exists, has the x bit set and contains
# one of the specified programs.
sub contains {
	local($dir, @progs) = @_;
	return 0 if !-d $dir || !-x _;
	foreach $prog (@progs) {
		return 1 if -e "$dir/$prog" && -x _;
	}
	return 0;	# Not found
}

package main;

