#!/usr/bin/perl -CA
# acme_cert v1.0.3  (c) 1.4.2019 by Andreas Ley  (u) 22.11.2021
# Request or renew ACME certificate from Let's Encrypt

use strict;
#no strict 'vars';
use warnings;
no warnings 'uninitialized';
use sigtrap;
#use diagnostics;

# The script itself may use utf-8 encoded identifiers and literals
use utf8;
# Latin-1 codepoints are considered characters
use feature 'unicode_strings';
#use locale;
# Enable UTF-8 encoding for all files (but not already open handles)
use open ':encoding(utf8)';

use Getopt::Long;
use File::Path;
use File::Basename;
use File::Spec::Functions;
use Net::DNS;
use NetAddr::IP ':lower';

use NET::WebAPI;

use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Deepcopy = 1;
#warn Data::Dumper->Dump([\%hash],['*']) if (defined($debug{'file'}));
#warn Data::Dumper->new([\%hash],['*'])->Indent(0)->Dump if (defined($debug{'file'}));

my $dehydrated = '/usr/bin/dehydrated';

my $root = '/var/www';

my $home = defined($ENV{'SUDO_USER'}) ? (getpwnam($ENV{'SUDO_USER'}))[7] : defined($ENV{'HOME'}) ? $ENV{'HOME'} : (getpwuid($<))[7];
my $config = catfile($home,'.config','netdb_client.ini');

sub usage
{
	my ($message) = @_;

	my $image = $0;
	$image =~ s!.*/!!;

	print  STDERR  "$message\n" if (defined($message));
	print  STDERR  "Usage: $image [options] FQDN [...]\n";
	print  STDERR  "-v, --verbose	Verbose mode\n";
	print  STDERR  "-C, --config	Specify NetVS token config (use - for stdin)\n";
	print  STDERR  "-f, --force	Force renewal even though current certificate is valid for more than a month\n";
	print  STDERR  "-d, --force-dns	Skip checking DNS servers\n";
	print  STDERR  "Your NetVS-Token must be readable from $config\n" unless ($config eq '-' || -r $config);
	exit(1);
}

my %opt;
@_ = @ARGV unless (defined($Devel::Trace::TRACE));
$Getopt::Long::ignorecase = 0;
GetOptions (\%opt,'debug|D:s','help|h','trace|x','verbose|v+','dry-run|n',
	'config|C=s','force|f','force-dns|d',
	);
exec($^X,'-CA','-d:Trace',$0,@_) if (defined($opt{'trace'}) && !defined($Devel::Trace::TRACE));

$config = $opt{'config'} if (defined($opt{'config'}));

&usage() if (defined($opt{'help'}) || !@ARGV);
&usage("Your NetVS-Token must be readable from $config") unless ($config eq '-' || -r $config);

if (defined($opt{'verbose'}) || defined($opt{'debug'})) {
	$|=1;
	select((select(STDERR),$|=1)[0]);
}

my (%debug,$on,$off);

sub debug
{
	my $file = shift;
	my $line = shift;
	my $prefix = defined($debug{'path'})?$file:defined($debug{'file'})?basename($file):'';
	if (defined($debug{'line'})) {
		$prefix .= ':' if (length($prefix));
		$prefix .= $line;
	}
	$prefix .= '  ' if (length($prefix));
	warn $prefix.(@_>1 ? join(', ',map("\"$_\"",@_))."\n" : "@_\n");
	if (defined($debug{'stacktrace'})) {
		use Carp 'longmess';
		{	no warnings 'once';
			$Carp::MaxArgLen = 0;
			$Carp::MaxArgNum = 0;
		}
		warn longmess('debug called');
	}
}
$debug{undef} = \&debug;

if (defined($opt{'debug'})) {
	for (split(',',$opt{'debug'})) {
		if (/=/) {
			$debug{$`} = $';
		}
		else {
			$debug{$_} = 1;
		}
	}
	&debug(__FILE__,__LINE__,'%debug = '.Data::Dumper->Dump([\%debug],['*debug'])) if (defined($debug{'debug'}));
	&debug(__FILE__,__LINE__,'%opt = '.Data::Dumper->Dump([\%opt],['*opt'])) if (defined($debug{'opt'}));
	if (defined($ENV{'TERM'})) {
		use Term::Cap;
		my $term = Tgetent Term::Cap { 'OSPEED'=>9600 };
		$on = $term->Tputs('md');
		$off = $term->Tputs('me');
	}
}

# Enable UTF-8 encoding for already open handles
# ":utf8" would enable perl native coding which happens to be UTF-8 only on ASCII platforms
binmode(STDIN,':encoding(utf8)');
binmode(STDOUT,':encoding(utf8)');
# Triggers "syswrite() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at /usr/share/perl/5.28/sigtrap.pm line 86." when a signal is received
#binmode(STDERR,':encoding(utf8)') unless (defined($Devel::Trace::TRACE));

umask(022);

################################################################################

#dehydrated -c -n -d www.fm.kit.edu -d fm.kit.edu

my $opt = NET::WebAPI->read_config($config);
$opt->{'debug'} = \%debug;
$opt->{'url'} = 'test' if (defined($opt{'dry-run'}));

my $webapi = NET::WebAPI->new($opt) or die "Can't connect to WebAPI\n";

for my $fqdn (@ARGV) {
	&debug(__FILE__,__LINE__,$fqdn) if (defined($debug{'fqdn'}));

	my (@alias,$type);

	my ($err,@dns_a) = &dns_a($fqdn);
	&debug(__FILE__,__LINE__,'@dns_a',@dns_a) if (defined($debug{'dns'}));

	my $conf = catfile($root,$fqdn,'conf','ssl','dehydrated','type');
	if (open(CONF,'<',$conf)) {
		$type = <CONF>;
		chomp $type;
		close(CONF);
	}
	else {

	# FQDN is resolvable in DNS
	if (@dns_a) {
		my @public = grep(!&is_private($_),@dns_a);
		&debug(__FILE__,__LINE__,'@public',@public) if (defined($debug{'dns'}));
		# FQDN resolves to a public IP address
		if (@public) {
			$type = 'http-01';
		}
		# FQDN resolves to a private IP address
		else {
			my ($err,@cname) = &dns_cname($fqdn);
			# FQDN is a CNAME (to a private IP address)
			if (@cname) {
				die "$fqdn: CNAME to private IP address (no usable ACME challenge)\n";
			}
			# FQDN is a private IP address
			else {
				my @a = $webapi->list_a($fqdn);
				&debug(__FILE__,__LINE__,'@a',@a) if (defined($debug{'dnsvs'}));
				# FQDN is defined within DNSVS so a TXT can be set
				if (@a) {
					$type = 'dns-01';
				}
				# FQDN is not defined within DNSVS so a TXT can't be set
				else {
					die "$fqdn: Private IP address but not defined within DNSVS (no method to define TXT)\n";
				}
			}
		}
	}
	else {
		# FQDN not resolvable in DNS â perhaps DNSVS hasn't updated DNS yet? So use the source, Luke â¦
		my $cname = &resolve_cname($fqdn);
		&debug(__FILE__,__LINE__,'$cname',$cname) if (defined($debug{'dnsvs'}));
		my @a = $webapi->list_a($cname);
		&debug(__FILE__,__LINE__,'@a',@a) if (defined($debug{'dnsvs'}));
		# FQDN is address defined within DNSVS
		if (@a) {
			my $odd = 0;
			my @public = grep(!&is_private($_),grep($odd++%2,@a));
			# FQDN will resolve to a public IP address
			if (@public) {
				$type = 'http-01';
				die "$fqdn: IP address defined within DNSVS but not yet visible in DNS (just wait for it)\n";
			}
			elsif ($cname eq $fqdn) {
				$type = 'dns-01';
			}
			else {
				die "$fqdn: CNAME to private IP address (no usable ACME challenge)\n";
			}
		}
		else {
			die "Internal error? $fqdn is a CNAME defined within DNSVS, but the canonical name $cname has no address defined within DNSVS\n" if ($cname ne $fqdn);
			die "$fqdn: Unresolvable\n";
		}
	}

	}
	&debug(__FILE__,__LINE__,'type',$type) if (defined($debug{'type'}));

	# Add all aliases to this FQDN from DNSVS
	# This will fail for delegated domains or domains not defined within DNSVS, but since it does no harm, we don't check these conditions
	push(@alias,$webapi->list_cname_target($fqdn));
	&debug(__FILE__,__LINE__,@alias) if (defined($debug{'alias'}) && $debug{'alias'}>1);

	# Add all explicitly specified aliases to this FQDN
	my $aliases = catfile($root,$fqdn,'conf','aliases');
	if (open(ALIASES,'<',$aliases)) {
		while (<ALIASES>) {
			chomp;
			s/\s*#.*//;
			next if (/^\s*$/);
			push(@alias,split);
		}
		&debug(__FILE__,__LINE__,@alias) if (defined($debug{'alias'}) && $debug{'alias'}>1);
	}

	# If the FQDN was resolvable in DNS, check that all nameservers give consistent answers
	if (@dns_a && !defined($opt{'force-dns'})) {
		# If we host servers for delegated domains, the FQDN should be an alias to a hostname in our realm, so resolve CNAMEs first
		my $name = &resolve_cname($fqdn);
		# This is the set of nameservers for the server's canonical name
		my ($err,@ns) = &dns_ns($name);
		die "No nameservers found for $name: $err\n" unless (@ns);
		# To check all these nameservers for consistency, choose one as the canonical nameserver and it's A and AAAA RRs as the canonical records
		my ($canonical_ns,$canonical_err,@canonical_a);
		do {
			$canonical_ns = shift(@ns);
			($canonical_err,@canonical_a) = &dns_a($name,$canonical_ns);
		} until ($err ne 'query timed out');
		# Now check all the other nameservers for distributing the same set of A and AAAA RRs
		for my $ns (@ns) {
			my ($err,@a) = &dns_a($name,$ns);
			next if ($err eq 'query timed out');
			if (&compare(\@a,\@canonical_a)) {
				die "$fqdn: addresses for $name on $canonical_ns and $ns differ!\n$canonical_ns: ".join(', ',@canonical_a?@canonical_a:$canonical_err)."\n$ns: ".join(', ',@a?@a:$err)."\n";
			}
		}
		# Even if all nameservers agree on an error, this is not what we want
		die "$fqdn: DNS error for $name: $canonical_err\n" unless (@canonical_a);

		# For every alias defined, check that all authoritative nameservers for this alias return a CNAME to or the same set of A/AAAA RRs as the canonical name
		if (@alias) {
			&debug(__FILE__,__LINE__,@alias) if (defined($debug{'alias'}));

			for my $alias (@alias) {
				&debug(__FILE__,__LINE__,$alias) if (defined($debug{'check'}));
				my $aname = &resolve_cname($alias);
				&debug(__FILE__,__LINE__,"&resolve_cname($alias) = ",$aname) if (defined($debug{'check'}) && $debug{'check'}>1);
				my ($err,@ns) = &dns_ns($aname);
				&debug(__FILE__,__LINE__,"&dns_ns($aname) = ",@ns) if (defined($debug{'check'}) && $debug{'check'}>1);
				die "No nameservers found for $aname: $err\n" unless (@ns);
				for my $ns (@ns) {
					my ($err,$cname) = &dns_cname($aname,$ns);
					next if ($err eq 'query timed out');
					&debug(__FILE__,__LINE__,"&dns_cname($aname,$ns) = ",$cname) if (defined($debug{'check'}) && $debug{'check'}>1);
					if (defined($cname)) {
						if ($cname ne $fqdn) {
							die "$fqdn: $alias: CNAME for $aname on $ns is not $fqdn!\n";
						}
					}
					else {
						my ($err,@a) = &dns_a($aname,$ns);
						next if ($err eq 'query timed out');
						&debug(__FILE__,__LINE__,"&dns_a($aname,$ns) = ",@a) if (defined($debug{'check'}) && $debug{'check'}>1);
						if (&compare(\@a,\@canonical_a)) {
							die "$fqdn: $alias: addresses for $name on $canonical_ns and $aname on $ns differ!\n$canonical_ns: $name: ".join(', ',@canonical_a?@canonical_a:$canonical_err)."\n$ns: $aname: ".join(', ',@a?@a:$err)."\n";
						}
					}
				}
			}
		}

	}

	# Now that nameservers seem to deliver correct (or, at least, consistent) addresses, it's time to request a certificate
	if (defined($type)) {
		# If conflicting other instances become a problem: use a lockf or kill old instances like with
		# ps faxww|grep 'dehydrated.* stage\.fm\.kit\.edu'
		my $ssl = catdir($root,$fqdn,'conf','ssl');
		my $deh = catdir($ssl,'dehydrated');
		my $log = catdir($root,$fqdn,'log','dehydrated');
		mkpath([$deh,$log]);
		symlink(catdir('..','..','..','log','dehydrated'),catdir($deh,'log'));
		if (-e '/etc/cluster') {
			my $deploy_cert_d = catdir($deh,'deploy_cert.d');
			my $deploy_cert = catfile($deploy_cert_d,'apache2');
			mkpath($deploy_cert_d);
			unless (-e $deploy_cert) {
				open(DEPLOY_CERT,'>',$deploy_cert) or die "Can't write to $deploy_cert: $!\n";
				print DEPLOY_CERT "#!/bin/sh\n";
				#print DEPLOY_CERT "dist -v -s all '$deh' && clcmd -vf -s all 'sc reload-or-restart httpd@$fqdn'\n";
				# Will be loaded with the nightly logrotate
				print DEPLOY_CERT "exec dist -q -s all '$deh'\n";
				close(DEPLOY_CERT);
				chmod(0755,$deploy_cert);
			}
		}
		my @trace = ('/bin/bash','-x') if (defined($debug{'dehydrated'}));
		# Well, it's not an alias but a subdirectory, but this is the only practicable way to get this path down to dehydrated :-/
		my @opts = ('--config','/etc/apache2/dehydrated/config','--out',$ssl,'--alias','dehydrated');
		push(@opts,'--force') if (defined($opt{'force'}));
		# Don't use '--lock-suffix',$fqdn - dehydrated doesn't employ lockf, so crashes lead to leftover lockfiles :(
		# FIXME: We mitigate this by placing locks in /run, but we should probably do something like find "/var/lock/dehydrated-$fqdn" -mtime +7 -delete
		# FIXME: Does $dehydrated give a return code on error, e.g. if the staging CA is still configured? Should we propagate this error code to, say, vhost?
		my @log;
		push(@log,{'stdout'=>catfile($log,'log-'.time()),'stderr'=>['stdout']}) unless (defined($opt{'verbose'}));
		&shell(@log,@trace,$dehydrated,@opts,'--cron','--lock-suffix',$fqdn,'--challenge',$type,map(('--domain',$_),$fqdn,@alias));
	}
}

sub resolve_cname
{
	&debug(__FILE__,__LINE__,'+ &resolve_cname('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'resolve_cname'}) || defined($debug{'dns'}));
	my ($fqdn) = @_;

	while (1) {
		my ($err,$cname) = &dns_cname($fqdn);
		last unless (defined($cname));
		$fqdn = $cname;
	}

	&debug(__FILE__,__LINE__,'+ &resolve_cname = '.$fqdn) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'resolve_cname'}) && $debug{'resolve_cname'}>1 || defined($debug{'dns'}) && $debug{'dns'}>1);
	return($fqdn);
}

sub dns_ns
{
	&debug(__FILE__,__LINE__,'+ &dns_ns('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'dns_ns'}) || defined($debug{'dns'}));
	my ($fqdn) = @_;
	$fqdn .= '.';

	my $resolver = new Net::DNS::Resolver();
	$resolver->debug(1) if (defined($debug{'dns_ns'}) && $debug{'dns_ns'}>4 || defined($debug{'dns'}) && $debug{'dns'}>4);

	my @ns;
	while (length($fqdn)) {
		&debug(__FILE__,__LINE__,'+ &dns_ns: NS '.$fqdn) if (defined($debug{'dns_ns'}) && $debug{'dns_ns'}>2 || defined($debug{'dns'}) && $debug{'dns'}>2);
		my $reply = $resolver->query($fqdn,'NS');
		&debug(__FILE__,__LINE__,'+ &dns_ns: '.Data::Dumper->new([$reply],['*'])->Indent(1)->Dump) if (defined($debug{'dns_ns'}) && $debug{'dns_ns'}>3 || defined($debug{'dns'}) && $debug{'dns'}>3);
		&debug(__FILE__,__LINE__,'+ errorstring: '.$resolver->errorstring()) if (!defined($reply) && (defined($debug{'dns_ns'}) && $debug{'dns_ns'}>3 || defined($debug{'dns'}) && $debug{'dns'}>3));
		if (defined($reply)) {
			my @cname = map($_->cname,rrsort('CNAME','',$reply->answer));
			if (@cname) {
				$fqdn = pop(@cname);
				next;
			}
			@ns = map($_->nsdname,rrsort('NS','',$reply->answer));
			last if (@ns);
		}
		$fqdn =~ s/^[^.]+\.//;
	}

	&debug(__FILE__,__LINE__,"+ &dns_ns $fqdn = ".join(', ',@ns)) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'dns_ns'}) && $debug{'dns_ns'}>1 || defined($debug{'dns'}) && $debug{'dns'}>1);
	return ($resolver->errorstring(),@ns);
}

sub dns_a
{
	&debug(__FILE__,__LINE__,'+ &dns_a('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'dns_a'}) || defined($debug{'dns'}));
	my ($fqdn,$ns) = @_;
	
	my $resolver = new Net::DNS::Resolver();
	$resolver->nameservers($ns) if (defined($ns));
	$resolver->debug(1) if (defined($debug{'dns_a'}) && $debug{'dns_a'}>4 || defined($debug{'dns'}) && $debug{'dns'}>4);

	my @a;
	for my $type ('A','AAAA') {
		&debug(__FILE__,__LINE__,'+ &dns_a: '.$type.' '.$fqdn) if (defined($debug{'dns_a'}) && $debug{'dns_a'}>2 || defined($debug{'dns'}) && $debug{'dns'}>2);
		my $reply = $resolver->query($fqdn,$type);
		&debug(__FILE__,__LINE__,'+ &dns_a: '.Data::Dumper->new([$reply],['*'])->Indent(1)->Dump) if (defined($debug{'dns_a'}) && $debug{'dns_a'}>3 || defined($debug{'dns'}) && $debug{'dns'}>3);
		&debug(__FILE__,__LINE__,'+ errorstring: '.$resolver->errorstring()) if (!defined($reply) && (defined($debug{'dns_a'}) && $debug{'dns_a'}>3 || defined($debug{'dns'}) && $debug{'dns'}>3));
		push(@a,map($_->address,rrsort($type,'',$reply->answer))) if (defined($reply));
		&debug(__FILE__,__LINE__,'+ &dns_a: ',@a) if (defined($debug{'dns_a'}) && $debug{'dns_a'}>2 || defined($debug{'dns'}) && $debug{'dns'}>2);
	}

	&debug(__FILE__,__LINE__,'+ &dns_a = '.join(', ',$resolver->errorstring(),@a)) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'dns_a'}) && $debug{'dns_a'}>1 || defined($debug{'dns'}) && $debug{'dns'}>1);
	return($resolver->errorstring(),@a);
}

sub dns_cname
{
	&debug(__FILE__,__LINE__,'+ &dns_cname('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'dns_cname'}) || defined($debug{'dns'}));
	my ($fqdn,$ns) = @_;
	
	my $resolver = new Net::DNS::Resolver();
	$resolver->nameservers($ns) if (defined($ns));
	$resolver->debug(1) if (defined($debug{'dns_cname'}) && $debug{'dns_cname'}>4 || defined($debug{'dns'}) && $debug{'dns'}>4);

	my $reply = $resolver->query($fqdn,'CNAME');
	&debug(__FILE__,__LINE__,'+ &dns_cname: '.Data::Dumper->new([$reply],['*'])->Indent(1)->Dump) if (defined($debug{'dns_cname'}) && $debug{'dns_cname'}>3 || defined($debug{'dns'}) && $debug{'dns'}>3);
	&debug(__FILE__,__LINE__,'+ errorstring: '.$resolver->errorstring()) if (!defined($reply) && (defined($debug{'dns_cname'}) && $debug{'dns_cname'}>3 || defined($debug{'dns'}) && $debug{'dns'}>3));
	my @cname = map($_->cname,rrsort('CNAME','',$reply->answer)) if (defined($reply));
	die "WTF?!" if (@cname>1);

	&debug(__FILE__,__LINE__,'+ &dns_cname = '.join(', ',@cname)) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'dns_cname'}) && $debug{'dns_cname'}>1 || defined($debug{'dns'}) && $debug{'dns'}>1);
	return($resolver->errorstring(),@cname);
}

sub is_private
{
	&debug(__FILE__,__LINE__,'+ &is_private('.join(',',map("'$_'",@_)).')') if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'is_private'}));
	my ($addr) = @_;

	&debug(__FILE__,__LINE__,'addr',$addr) if (defined($debug{'is_private'}) && $debug{'is_private'}>2);
	my $ip = NetAddr::IP->new($addr);
	&debug(__FILE__,__LINE__,'ip',$ip->canon) if (defined($debug{'is_private'}) && $debug{'is_private'}>2);
	# This is UGLY but there seems to be no method to do bit operations on a NetAddr::IP
	$ip = NetAddr::IP->new($ip->short=~s/^.*::/::/r) if ($ip->bits>32);
	&debug(__FILE__,__LINE__,'ip',$ip->canon) if (defined($debug{'is_private'}) && $debug{'is_private'}>2);

	&debug(__FILE__,__LINE__,'+ &is_private = '.$ip->is_rfc1918) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'is_private'}) && $debug{'is_private'}>1);
	return($ip->is_rfc1918);
}

sub compare
{
	&debug(__FILE__,__LINE__,'+ &compare'.Data::Dumper->new([\@_],['*'])->Indent(0)->Dump) if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'compare'}));
	my @a = @{$_[0]};
	my @b = @{$_[1]};

	while (@a) {
		return(1) if (pop(@a) ne pop(@b));
	}
	return(@b?1:0);
}

################################################################################
#
# Run shell command
#
sub shell
{
	&debug(__FILE__,__LINE__,'+ &shell'.Data::Dumper->new([\@_],['*'])->Indent(0)->Dump) if (defined($debug{'call'}) && $debug{'call'}>1 || defined($debug{'shell'}));
	my $param = shift if (ref($_[0]) eq 'HASH');
	my %param = %{$param} if (defined($param));
	my (@cmd) = @_;

	if ($opt{'dry-run'} >= ($param{'dry-level'} // 1)) {
		print join(' ','+',@cmd)."\n";
		return;
	}

	if (defined($param{'stdin'})) {
		open(OLDIN,'<&',\*STDIN) or die "Can't dup STDIN: $!";
		open(STDIN,'<',$param{'stdin'}) or die "Can't redirect STDIN from $param{'stdin'}: $!";
	}
	if (defined($param{'stdout'})) {
		open(OLDOUT,'>&',\*STDOUT) or die "Can't dup STDOUT: $!";
		open(STDOUT,'>',$param{'stdout'}) or die "Can't redirect STDOUT to $param{'stdout'}: $!";
	}
	if (defined($param{'stderr'})) {
		open(OLDERR,'>&',\*STDERR) or die "Can't dup STDERR: $!";
		if (ref($param{'stderr'})) {
			open(STDERR,'>&',\*STDOUT) or die "Can't redirect STDERR to STDOUT: $!";
		}
		else {
			open(STDERR,'>',$param{'stderr'}) or die "Can't redirect STDERR to $param{'stderr'}: $!";
		}
	}

	my $retval = system(@cmd);

	open(STDIN,'<&',\*OLDIN) or die "Can't re-dup STDIN: $!\n" if (defined($param{'stdin'}));
	open(STDOUT,'>&',\*OLDOUT) or die "Can't re-dup STDOUT: $!\n" if (defined($param{'stdout'}));
	open(STDERR,'>&',\*OLDERR) or die "Can't re-dup STDERR: $!\n" if (defined($param{'stderr'}));

	&debug(__FILE__,__LINE__,'+ &shell = '.$retval) if (defined($debug{'return'}) && $debug{'return'}>1 || defined($debug{'shell'}) && $debug{'shell'}>1);
	return($retval);
}
