#!/usr/bin/perl --

############################################################################
# Soupermail Install Helper
#
# Internal build version:
# $Id: souperinstall.pl,v 1.19 2001/02/07 08:31:30 aithalv Exp $
#
# Something to take the pain out of installing Soupermail
# Copyright (C) 2000, 2001 
#			Vittal Aithal <[email protected]>
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of 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. You should have received 
# a copy of the GNU General Public License along with this program; if not,
# write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
# MA 02139, USA.
#
############################################################################

use CGI qw(:standard);
use CGI::Carp qw(); #fatalsToBrowser);
use FileHandle;
use Config;
use Socket;
use strict;

my $site = "http://soupermail.sourceforge.net/";
my $faq = "${site}faq.html";
my $targ = ' target="faq"';

my $make = param('make') ? 1 : 0;
my $scrName = "soupermail.pl";
$| = 1;
print ($make ? 
	header(-Content_type =>"text/plain;name=$scrName",
			-Content_disposition=>"file;filename=$scrName") 
	: header());

my @dirList = ();		# where to look for the finder file
my $dirCount = 0;		# how many directories we've looked in
my $cf = {};			# things to look for
$cf->{'perl'} = $Config{'perlpath'};  # perl binary
my $maxDirs = 100;		# the maximum number of directories to look in
my $maxBinDirs = 400;	# the maximum number of bin directories to look in
my @path = ();			# common paths for binaries
my $srv = "";			# web server type
my $os = "";			# operating system
my $fhBug = "0";		# file handle bug
my @tmpList = ();		# common temp directories
my $dirCmd = "";		# how to find out the current directory
my $srvRoot = "";		# the $serverRoot
my $pvtRoot = "";		# the $privateRoot
my $cgiPath = "";		# Where the CGI program is installed
my $mimeOk = 0;			# is MIME::Lite available
my $dbiOk = 0;			# is DBI available
my $binFiles = {};		# what binaries to look for
my $findfile = param('findfile') ? param('findfile') : "souperfinder.htm";
my $findFilePath = "";	# if the find file is in a sub directory
if ($findfile =~ s#^(.*/)([^/]+)$#$2#) {
	$findFilePath = $1;
}
my $forkable = $Config{'d_fork'} eq "define";   # whether we can fork
my $mailUser = "";
my $paranoid = param('paranoid') ? 1 : 0;

if ($make) {
	$cgiPath = param('cgi');
	my $sr = param('srvroot');
	my $pr = param('pvtroot');
	$cf->{'mprog'} = param('mailprog');
	$cf->{'mhost'} = param('mailserver');
	$cf->{'gpg'} = param('gpg');
	$cf->{'pgp5'} = param('pgp5');
	$cf->{'pgp2'} = param('pgp2');
	$cf->{'lout'} = param('lout');
	$cf->{'ps2pdf'} = param('ps2pdf');
	$cf->{'tmp'} = param('temp');
	$cf->{'email'} = param('email');
	$cf->{'perl'} = param('perl');
	$forkable = param('forkable');
	$fhBug = param('fhbug');
	my $soupermail = "";
	if (-f "${cgiPath}/$scrName" && -r "${cgiPath}/$scrName") {
		$soupermail = "${cgiPath}/$scrName";
	} elsif (!-f "${cgiPath}/$scrName") {
		die "Couldn't find $scrName in $cgiPath";
	} elsif (!-r "${cgiPath}/$scrName") {
		die "Couldn't read $scrName in $cgiPath";
	}

	$| = 1;
	my $line = 0;
	my $done = 0;
	open (SOUP, "<$soupermail") || die "Couldn't open $soupermail: $!";
	while (<SOUP>) { 
		if (!$line && $os eq "unix") {
			s/#!.*/#!$cf->{perl} --/;
		}
		unless ($done) {
			s/^\s*use\s+lib\s+qw\(\.\)/use lib qw\(\. $cgiPath\)/;
			s/^\s*\$serverRoot\s*=.*/\$serverRoot = '${sr}';/;
			s/^\s*\$privateRoot\s*=.*/\$privateRoot = '${pr}';/;
			s/^\s*\$mailprog\s*=.*/\$mailprog = '$cf->{mprog}';/;
			s/^\s*\$mailhost\s*=.*/\$mailhost = '$cf->{mhost}';/;
			s/^\s*'gpg'\s*=>.*/'gpg' => '$cf->{gpg}',/;
			s/^\s*'pgp2'\s*=>.*/'pgp2' => '$cf->{pgp2}',/;
			s/^\s*'pgp5'\s*=>.*/'pgp5' => '$cf->{pgp5}',/;
			s/^\s*\$lout\s*=.*/\$lout = '$cf->{lout}';/;
			s/^\s*\$ps2pdf\s*=.*/\$ps2pdf = '$cf->{ps2pdf}';/;
			s/^\s*\$tempDir\s*=.*/\$tempDir = '$cf->{tmp}\/';/;
			s/^\s*\$fhBug\s*=.*/\$fhBug = '$fhBug';/;
			s/^\s*\$forkable\s*=.*/\$forkable = '$forkable';/;
			s/^\s*\$soupermailAdmin\s*=.*/\$soupermailAdmin = '$cf->{email}';/;
			s/^\s*\$paranoid\s*=.*/\$paranoid = $paranoid;/;
			(/#\s+Other\s+global/) && ($done = 1);
		}
		print;
	}
	close(SOUP);
	exit;
}
# Try and determine the server software
$_ = $ENV{"SERVER_SOFTWARE"};

unless ($make) {
	print<<"END_OF_HEADER";
<html>
<head>
<title>Soupermail Installer Results</title>
<style type="text/css">
<!--
body, td, p {
  font-family: Verdana, arial, helvetica, sans-serif;
  font-size: 10pt;
  background: white;
  color: #666666;
}

b { font-weight: bold; }
h2, h3, h4, h5, h6 { color: #666666; font-size: 10pt; }

.info {
  color: blue;
  font-weight: bold;
}

h1.info {
  font-size: 22pt;
  color: black;
  width: 100%;
  background-color: #e2c058;
}

input, .critical {
  color: red;
  font-weight: bold;
  font-family: Verdana, arial, helvetica, sans-serif;
  font-size: 10pt;
}

td p, td, td b {
  background-color: #e2c058;
}
-->
</style>
</head>

<body bgcolor="#ffffff" text="#000000">
<h1 class="info" style="width: 100%">Soupermail Installer Helper</h1>
<p class="info">Below is some diagnostic information that can be used to help install
Soupermail.</p>

<table border="1" cellpadding="5" cellspacing="0" width="100%">
<tr valign="top">
<td>
<p>
Text displayed in GREY is diagnostic information, which you can ignore (even
if it says software error).
</p>

<p class="info">Text written in BLUE contains information messages that you
should read. However they are NOT critical.
</p>

<p class="critical">Text written in RED is critical, and contains information
you MUST act on.
</p>
</td>
</tr>
</table>
<br>
END_OF_HEADER

	print "<b>Webserver</b> $_\n";
}

if (/\bapache\b/i) {
	$srv = "apache";
} elsif (/\biis\d/i) {
	$srv = "iis";
} elsif (/\b(netscape|iplanet)\d/i) {
	$srv = "ns";
}

# try and determine the OS
$_ =$^O;
if (/\bmswin/i) {
	$os = "win";
} elsif (/bsd/i) {
	$os = "unix";
	$fhBug = 1;
} elsif (/\b(.in.x|\w+ix|sunos|solaris)/i) {
	$os = "unix";
}


(!$make) && print "<br><b>Perl</b> $]\n";
if ($os eq "unix") {
	(!$make) && print "<br><b>Operating system</b> UNIX ($^O)\n";
	@path = qw(/usr/local/bin /usr/bin /bin /usr/local/share/bin);
	@tmpList = qw(/var/tmp /tmp /usr/tmp);
	$dirCmd = "/bin/pwd";
	$mailUser = "root";

	my @smDirs = qw(/usr/lib /var/lib /usr/local/lib /usr/local/bin /usr/sbin /sbin);
	while (!$cf->{'mprog'} && ($_ = shift (@smDirs))) {
		if (-f "$_/sendmail" && -x "$_/sendmail") {
			$cf->{'mprog'} = "$_/sendmail";
		}
	}
	$binFiles = { 
					'pgp' => 'pgp2',
					'pgpe' => 'pgp5',
					'gpg' => 'gpg',
					'ps2pdf' => 'ps2pdf',
					'lout' => 'lout'
				};
} elsif ($os eq "win") {
	(!$make) && print "<br><b>Operating system</b> Windows ($^O)\n";
	@path = ("c:/program files", "d:/program files", "c:/", "d:/", "e:/", "f:/");
	@tmpList = qw(c:/temp d:/temp c:/tmp d:/tmp c:/winnt/temp 
					c:/windows/temp c:/winnt40/temp);
	$dirCmd = "cd";
	$mailUser = "administrator";
	$binFiles = { 
					'pgp.exe' => 'pgp2',
					'pgpe.exe' => 'pgp5',
					'gpg.exe' => 'gpg',
					'ps2pdf.bat' => 'ps2pdf',
					'lout.exe' => 'lout'
				};
}


# find the temp directory
while ($_ = shift @tmpList) {
	if (-d $_ && -w $_) {
		$cf->{'tmp'} = $_;
		last;
	}
}

# try and figure out where we're being called from
if ($0) {
	my $cgi = $0;
	(!$make) && print "<br><b>Found</b> \$0 $cgi\n";
	$cgi =~ s#\\#/#g;
	if ($cgi =~ m#/#) {
		$cgi =~ s#/([^/]*)$##;
		$cgiPath = $cgi;
		my @cgi = split(m#/#, $cgi);
		my $buildPath = "";
		$buildPath = shift(@cgi);
		if ($os ne "win") {
			$buildPath .= "/" . shift(@cgi);
		}
		while (my $p = shift(@cgi)) {
			$buildPath .= "/$p";
			unshift(@dirList, $buildPath);
		}
	}
} else {
	(!$make) && print "<br>Didn't find \$0\n";
}

# see if we can find the document root
if ($dirCmd) {
	my $startDir = "";
	open(DC, "$dirCmd |");
	$_ = <DC>;
	chomp;
	$startDir = $_;
	close (DC);
	$startDir =~ s#\\#/#g;
	(!$make) && print "<br><b>Found</b> starting directory $startDir\n";
	my $startPath = $startDir;
	my @cgi = split(m#/#, $startDir);
	my $depth = ($startDir =~ tr#/#/#);
	my $buildPath = "";
	if ($depth > 2) {
		$buildPath = shift(@cgi);
		$buildPath .= "/" . shift(@cgi);
	}
	my $p;
	foreach $p (@cgi) {
		$buildPath .= "/$p";
		$buildPath =~ s#/+#/#g;
		(!$make) && print "<br><b>paths...</b> $buildPath\n";
		unshift(@dirList, $buildPath);
	}
	
	(!$make) && print "<br><b>Environment DOCUMENT_ROOT</b> is: $ENV{DOCUMENT_ROOT}\n";
	push(@dirList, $ENV{'DOCUMENT_ROOT'});
	(!$make) && print "<br><b>Installer searching these paths...</b> " . join(", ", @dirList);
	searchForPage();
	if ($srvRoot) {
		$srvRoot =~ /^(.*[\/\\])/;
		$pvtRoot = "${1}private";
	}
}

my $soupermail = "$cgiPath/$scrName";
if (-f "$soupermail") {
	(!$make) && print "<br><b>Found $scrName</b> $soupermail\n";
}

# Stop local errors being sent to the browser (???)
$SIG{__WARN__} = sub {  };

# Look for MIME::Lite
(!$make) && print "<br><b>Looking for the required perl module MIME::Lite</b>\n";
eval("use lib qw(. $cgiPath);\nuse MIME::Lite;");
if ($@) {
	print<<"EOT";
<br>
<br><b style="color:red">Trouble, the MIME::Lite module doesn't seem to be installed. 
Install it on the webserver before proceeding. See the MIME::Lite section of 
<a href="${site}install.txt" $targ>install.txt</a> included with Soupermail and read 
<a href="${faq}#mimelite" $targ>${faq}#mimelite</a>, the MIME::Lite section of the FAQ, for 
instructions.</b>
<br>
EOT
} else {
	(!$make) && print "<br><b>Found the MIME::Lite module</b>\n";
	$mimeOk = 1;
}

# Look for DBI
(!$make) && print "<br><b>Looking for the optional perl module DBI</b>\n";
eval("use lib qw(. $cgiPath);\nuse DBI;");
if ($@) {
print<<"EOT";
<br>
<br><b style="color:red">It doesn't look like DBI is available on your server.
This means that you won't be able to use Soupermail's database features.
Please read <a href="${faq}#dbi" $targ>${faq}#dbi</a>, the DBI section of the FAQ, 
for more information. If you are not going to use Soupermail's database features,
you can safely ignore this message.
</b>
<br>
EOT
} else {
	(!$make) && print "<br><b>Found the DBI module</b>\n";
	$dbiOk = 1;
}


(!$make) && print "<br><b>Looking for a mailserver</b>\n";
eval("use lib qw(. $cgiPath);\nuse Net::SMTP;");
if ($@ && !$cf->{'mprog'}) {
	print<<"EOT";
<br><b style="color:red">Trouble, the Net::SMTP module doesn't seem to be installed. 
Install it on the webserver before proceeding. See the last section of 
<a href="${site}install.txt" $targ>install.txt</a> included with Soupermail and read 
<a href="${faq}#libnet" $targ>${faq}#libnet</a>, the Net::SMTP section of the FAQ,
for instructions.</b>
EOT
} elsif (!$@) {
	(!$make) && print "<br><b>Found the Net::SMTP module</b>\n";
	my @hosts = qw(localhost mail-fwd relay smtp mail mailhost relay1 smtp-relay 
					mail-relay imap);
	(param('mailserver')) && unshift(@hosts, param('mailserver'));
	(!$make) && print "<br><b>Looking through these mailservers</b> " .
		join(", ", @hosts) . "\n";

	while (my $mhost = shift(@hosts)) {
		if ($mhost =~ /^[\w\d\-]+(\.[\w\d\-]+)*$/) {
			if (checkMailHost($mhost)) {
				$cf->{mhost} = $mhost;
				(!$make) && print "<br><b>Found mail server</b> $mhost\n";
				last;
			}
		} else {
			$mhost =~ s/</&lt;/g;
			$mhost =~ s/>/&gt;/g;
			print "<br><b style=\"color:red\">Trouble, the mail server name $mhost doesn't look valid.</b>\n";
		}
	}
}

(!$make && $cf->{'mprog'}) && print "<br><b> Found mail program</b>  $cf->{mprog}\n";


searchForBins();
my $fh = new FileHandle;
if ($soupermail && -f $soupermail && -r $soupermail) {
	if ($fh->open("< $soupermail")) {
		$fhBug = ! (eval("-T \$fh"));
	}
	$fh->close();
} elsif ($cf->{'tmp'}) {
	my $tmpFile = "$cf->{tmp}/itmp$$" . time;
	$fh->open("> $tmpFile");
	$fhBug = ! (eval("-T \$fh"));
	$fh->close();
	unlink $tmpFile;
} else {
	print "<br><b>Cannot determine \$fhBug</b>: setting to 1 for safety\n";
	$fhBug = 1;
}

if (param('email')) {
	my $e = param('email');
	my $goodCh = '\w\d\-\.\,\/\xc0-\xd6\xd8-\xf6\xf8-\xff';
	if ($e =~ /^[${goodCh}]+\@[$goodCh]+(\.[${goodCh}]+)*$/) {
		$cf->{'email'} = $e;
	} else {
		if (server_name()) {
			makeMail();
		}
	}
} elsif (server_name()) {
	makeMail();
}

unless ($make) {
	print "<br><b>Server name</b> " . server_name() . "\n";
	print "<br><b>Server IP</b> $ENV{SERVER_ADDR}\n";
	print "<br><b>Server Port</b> $ENV{SERVER_PORT}\n";
	print "<br><b>Called From</b> $ENV{HTTP_REFERER}\n";
	print "<br><b>Path Info</b> $ENV{PATH_INFO}\n";
	print "<br><b>Path Translated</b> $ENV{PATH_TRANSLATED}\n";
	print "<br><b>Install Script</b> $0\n";
	print "<br><b>Postscript to PDF</b> " . $cf->{'ps2pdf'} . "\n";
	print "<br><b>Lout</b> " . $cf->{'lout'} . "\n";
	print "<br><b>Temp area</b> " . $cf->{'tmp'} . "\n";
	print "<br><b>Perl</b> " . $cf->{'perl'} . "\n";
	print "<br><b>GPG</b> " . $cf->{'gpg'} . "\n";
	print "<br><b>PGP2</b> " . $cf->{'pgp2'} . "\n";
	print "<br><b>PGP5</b> " . $cf->{'pgp5'} . "\n";
	print "<br><b>Server Root</b> $srvRoot\n";
	print "<br><b>Expanded Server Root</b> " . expandSymlinks($srvRoot) . "\n";
	print "<br><b>Assumed Private Root</b> $pvtRoot\n";
	print "<br><b>FileHandle bug</b> $fhBug\n";
	print "<br><b>Admin email</b> $cf->{email}\n";

	print "\n<p>Done\n";

	if ($srvRoot && $soupermail && $cf->{'tmp'} && $mimeOk &&
		($os eq "win" ||($os eq "unix" && $cf->{'perl'})) &&
		($cf->{'mprog'} || $cf->{'mhost'})) {

		if (-f "${cgiPath}/$scrName" && -r "${cgiPath}/$scrName") { 
			print "<p><hr><b class=critical>Excellent! Your settings are OK to make a custom install. " .
				"Press the button below to generate a copy of Soupermail for " .
				"your server. The customised script will be returned to your " .
				"browser and you should Save it to file once its downloaded.</b> " .
				"<form method=\"post\" action=\"" . script_name . "\">\n" .
				"<input type=\"hidden\" name=\"make\" value=\"1\">\n" .
				"<input type=\"hidden\" name=\"srvroot\" value=\"${srvRoot}\">\n" .
				"<input type=\"hidden\" name=\"pvtroot\" value=\"${pvtRoot}\">\n" .
				"<input type=\"hidden\" name=\"mailserver\" value=\"$cf->{mhost}\">\n" .
				"<input type=\"hidden\" name=\"mailprog\" value=\"$cf->{mprog}\">\n" .
				"<input type=\"hidden\" name=\"email\" value=\"$cf->{email}\">\n" .
				"<input type=\"hidden\" name=\"perl\" value=\"$cf->{perl}\">\n" .
				"<input type=\"hidden\" name=\"gpg\" value=\"$cf->{gpg}\">\n" .
				"<input type=\"hidden\" name=\"pgp2\" value=\"$cf->{pgp2}\">\n" .
				"<input type=\"hidden\" name=\"pgp5\" value=\"$cf->{pgp5}\">\n" .
				"<input type=\"hidden\" name=\"fhbug\" value=\"$fhBug\">\n" .
				"<input type=\"hidden\" name=\"temp\" value=\"$cf->{tmp}\">\n" .
				"<input type=\"hidden\" name=\"ps2pdf\" value=\"$cf->{ps2pdf}\">\n" .
				"<input type=\"hidden\" name=\"lout\" value=\"$cf->{lout}\">\n" .
				"<input type=\"hidden\" name=\"cgi\" value=\"$cgiPath\">\n" .
				"<input type=\"hidden\" name=\"forkable\" value=\"$forkable\">\n" .
				"<input type=\"hidden\" name=\"paranoid\" value=\"${paranoid}\">\n" .
				"<input type=\"submit\" value=\"Generate custom Soupermail\">\n" .
				"</form>\n" .
				"<span class=info>If you would like to edit $scrName yourself, these are the " .
				"values to use:<br><br></span>";
		} else {
			print "<p><hr><b class=critical>The installer cannot fully read the copy " .
				"of $scrName installed on your server, so use the " .
				"values below to finish your installation.</b><p>\n";
		}
		printValues();
		print "<p class=critical>Once you have successfully installed " .
				"soupermail, remove the installer files (script and HTML file). ".
				"THIS IS IMPORTANT as it will stop people from seeing " .
				"your server configuration and you won't interfere with other " .
				"people installing Soupermail.</p>\n";
	} else {
		print <<"END_OF_WARNING";
<p><hr class=critical>There was not enough information to make a custom
installation of Soupermail. See if there are any errors
reported above and try and correct them.</p>

<p class=critical>However, I did determine the following information:</p><p>
END_OF_WARNING
		printValues();
			   
	}
	print "<hr>\n<table width=\"99%\" cellpadding=\"2\" cellspacing=\"0\">\n" .
			"<tr valign=\"top\"><td>(c) Vittal Aithal &lt;" .
			"<a href=\"mailto:vittal.aithal\@bigfoot.com\">" .
			"vittal.aithal\@bigfoot.com</a>&gt; 2000, 2001\n" .
			"</td><td align=\"right\">" .
			"<a href=\"${site}\" $targ>" .
			"${site}</a><br>\n" .
			"<b class=critical>In case of trouble, you MUST read this -&gt;</b> " .
			"<a href=\"${faq}\" $targ>".
			"${faq}</a></td></tr></table>";
}
exit;

sub searchForPage() {
	my $d;
	my %dirCache;
	OUTER:
	while ($d = shift(@dirList)) {
		next if $dirCache{$d};
		last if ($dirCount > $maxDirs);
		$dirCache{$d} = 1;
		opendir (D, $d);
		$dirCount++;
		my @dirs = ();
		if ($os eq "win") {
			@dirs = grep { /^[^\.]/ && 
						  ((-f "$d/$_" && /^${findfile}$/i) ||
						   (-d "$d/$_")) } readdir(D);
		} else {
			@dirs = grep { /^[^\.]/ && 
						  ((-f "$d/$_" && /^${findfile}$/) ||
						   (-d "$d/$_")) } readdir(D);
		}
		while ($_ = shift(@dirs)) {
			if (-f "$d/$_") {
				$srvRoot = "$d";
				if (open (F, "$d/$_")) {
					(!$make) && print "<br><b>Can open</b> $d/$_";
					close(F);
					if ($findFilePath) {
						$srvRoot =~ s#${findFilePath}$##;
					}
				} else {
					(!$make) && print "<br><b>Can not open</b> $d/$_, checking for symlinks...";
					my $sd = expandSymlinks("$d/$_");
					(!$make) && print "<br><b>Expanded symlinks to</b> $sd";
					if (open (F, "$sd")) {
						(!$make) && print "<br><b>Can open</b> $sd";
						close(F);
						if ($findFilePath) {
							$srvRoot =~ s#${findFilePath}$##;
							$srvRoot = expandSymlinks($srvRoot);
						}
					}
				}
				last OUTER;
			} elsif (!$dirCache{"$d/$_"} && -r "$d/$_") {
				push(@dirList, "$d/$_");
			}
		}
	}
}

# Some systems don't like us reading down symlinks, so should expand them
sub expandSymlinks {
	my $origPath = shift;
	return $origPath if ($os ne "unix");
	my @pathList = split(m!/!, $origPath);
	my $newPath = "";
	while (@pathList) {
		my $part = shift(@pathList);
		$newPath .= "/" . $part;
		# See if the path we're now at is a symlink
		if (my $lnk = readlink($newPath)) {
			if ($lnk =~ m!^/!) {
				$newPath = $lnk;
			} else {
				$newPath .= "/../$lnk";
			}
		}
	}
	$newPath =~ s!/+!/!g;
	while ($newPath =~ s![^/]+/\.\./!!) {}
	return $newPath;
}

sub searchForBins() {
	$| = 1;
	my $d;
	my %dirCache;
	my %fileCache = ();
	my $bins = join("|", keys %$binFiles);
	my $binCnt = 0;
	my $maxBin = scalar(keys %$binFiles);
	$bins =~ s/([\.\[\]\(\)\-\?\*\+])/\\$1/g;
	$dirCount = 0;
	OUTER:
	while ($d = shift(@path)) {
		next if $dirCache{$d};
		last if ($dirCount > $maxBinDirs);
		$dirCache{$d} = 1;
		opendir (D, $d);
		$dirCount++;
		my @dirs = ();
		if ($os eq "win") {
			@dirs = grep { /^[^\.]/ && 
						  ((-f "$d/$_" && /^${bins}$/i) ||
						   (-d "$d/$_")) } readdir(D);
		} else {
			@dirs = grep { /^[^\.]/ && 
						  ((-f "$d/$_" && /^${bins}$/) ||
						   (-d "$d/$_")) } readdir(D);
		}
		while ($_ = shift(@dirs) ) {
			if (-f "$d/$_" && !$fileCache{$_}) {
				$fileCache{$_} = 1;
				$cf->{$binFiles->{$_}} = "$d/$_";
				$binCnt++;
				if ($binCnt >= $maxBin) { last OUTER; }
			} elsif (!$dirCache{"$d/$_"} && -r "$d/$_") {
				push(@path, "$d/$_");
			}
		}
	}
}

sub checkMailHost {
	my $mhost = shift;
	my $proto = getprotobyname('tcp');
	socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto);
	my $port = getservbyname('smtp', 'tcp');
	my $iaddr = $mhost;
	if ($iaddr =~ /[^\d\.]/) {
		my @iaddrs = gethostbyname($mhost);
		$iaddr = join(".", unpack("CCCC", $iaddrs[4]));
	} elsif ($iaddr !~ /^\d+\.\d+\.\d+\.\d+$/) {
		return 0;
	}
	return 0 unless ($iaddr);
	print "\n<br>Got address $iaddr\n";
	my $sin = sockaddr_in($port,inet_aton($iaddr));
	my $smtpCon = new Net::SMTP($iaddr, Debug=>10);
	if ($smtpCon) {
		print "<br>Made SMTP connection to $iaddr" . $smtpCon->banner() . "\n";
		$smtpCon->quit();
		return 1;
	} else {
		return 0;
	}
}

sub makeMail {
	if ($ENV{'SERVER_ADMIN'} && $ENV{'SERVER_ADMIN'} !~ /\@localhost$/i) {
		$cf->{'email'} = $ENV{'SERVER_ADMIN'};
		return 1;
	}
	my $domain = server_name();
	if ($domain =~ s/^w+(\d*)\.//i) {
		 $cf->{'email'} = "postmaster\@$domain";
	} else {
		 $cf->{'email'} = "${mailUser}\@$domain";
	}
	return 1;
}

sub printValues {
	if ($cf->{'perl'} && $os eq "unix") {
		print "<span class=info>Your script should start with <b>#!$cf->{perl} --</b></span><br>\n";
	}
	if ($cf->{'email'}) {
		print "<span class=info>\$soupermailAdmin = '<b>$cf->{email}</b>';</span><br>\n";
	}
	if ($srvRoot) {
		print "<span class=info>\$serverRoot = '<b>$srvRoot</b>';</span><br>\n";
	} else {
		print "<span class=critical>You need to find out what \$serverRoot is</span><br>\n";
	}
	if ($pvtRoot) {
		print "<span class=critical>\$privateRoot is assumed to be <b>'$pvtRoot'</b> but please check</span><br>\n";
	}
	if ($cf->{'mprog'} && $os eq "unix") {
		print "<span class=info>\$mailprog = '<b>$cf->{mprog}</b>';</span><br>\n";
	}
	if ($cf->{'mhost'}) {
		print "<span class=info>\$mailhost = '<b>$cf->{mhost}</b>';</span><br>\n";
	}
	if ($cf->{'gpg'}) {
		print "<span class=info> 'gpg' =&gt; '<b>$cf->{gpg}</b>',</span><br>\n";
	}
	if ($cf->{'pgp2'}) {
		print "<span class=info>You should set 'pgp2' =&gt; '<b>$cf->{pgp2}</b>',</span><br>\n";
	}
	if ($cf->{'pgp5'}) {
		print "<span class=info>'pgp5' =&gt; '<b>$cf->{pgp5}</b>',</span><br>\n";
	}
	if ($cf->{'lout'} && $cf->{'ps2pdf'}) {
		print "<span class=info>\$lout = '<b>$cf->{lout}</b>';<br>\n";
		print "\$ps2pdf = '<b>$cf->{ps2pdf}</b>';</span><br>\n";
	}
	if ($cf->{'tmp'}) {
		print "<span class=info>\$tempDir = '<b>$cf->{tmp}/</b>';</span><br>\n";
	} else {
		print "<span class=critical>You need to find out what \$tempDir is</span><br>\n";
	}
	if ($forkable) {
		print "<span class=info>\$forkable = <b>1</b>;</span><br>\n";
	} else {
		print "<span class=info>You should set \$forkable to <b>0</b></span><br>\n";
	}
	if ($fhBug) {
		print "<span class=info>\$fhBug = <b>1</b>;</span><br>\n";
	} else {
		print "<span class=info>You should set \$fhBug to <b>0</b></span><br>\n";
	}
	print "<span class=info>\$paranoid = <b>$paranoid</b>;</span><br>\n";
	print "</p><p class=critical>Support requests to the <a href=\"http://sourceorge.net/forum/forum.php?forum_id=342\">Help Forum</a> " .
			"<b>MUST</b> include <b>ALL</b> the information on this " .
			"page and <b>YOU MUST HAVE READ</b> the <b><a href=\"${faq}\" $targ>FAQ</a></b>.</p>";
}

# vim: ts=4