#!/usr/bin/perl

my $discus_version = "4.00";
my $pro_version = -e "./source/fcn-prfl.pl";

# FIRST-TIME SETUP SCRIPT FOR DISCUS ON UNIX or WINDOWS PLATFORMS
# Copyright (c) 1998-2002, DiscusWare, LLC, all rights reserved.
# This script may not be redistributed or used except as provided
# in the Discus license agreement.

my $platform = "";
my $unix = 0; my $windows = 0;		# Comment this line to disable auto-detect
#my $unix = 1; my $windows = 0;		# Uncomment this line if you have unix
#my $windows = 1; my $unix = 0;		# Uncomment this line if you have Windows

if ($unix == 0 && $windows == 0) {
	if ($^O eq "MSWin32") {
		$windows = 1;
		$platform = "WINDOWS";
	} elsif (-e "/etc/passwd") {
		$unix = 1;
		$platform = "UNIX";
	} else {
		$unix = 1;
		$platform = "UNKNOWN PLATFORM";
	}
}
my $q = quotemeta(sprintf("%02d.%02d", $discus_version));

# ---------------------------------------------------------------------------------

if ($unix) {
	$SIG{'CONT'} = 'continuation_handler';
}

sub continuation_handler {
	print "\n" x 25;
	print "Congratulations, you have successfully reactivated this script\n";
	print "with the 'fg' command.\n\n";
	if (-s "./discus.conf" <= 1) {
		print "If you have not already done so, access the 'dconfig' script in\n";
		print "your web browser.  Fill out the form as instructed.\n\n";
	}
	print "Press ENTER to continue...\n\n";	
}

my $passes = 0;
my $path_perl = "";

while (1) {
	$passes++;

	opendir(DIR, ".");
	my @dir = grep { /^dconfig\./ } readdir(DIR);
	closedir(DIR);
	if (-e "./discus.conf" && -s "./discus.conf" > 0 && ! -e "install.txt" && scalar @dir) {
		print "\n\n";
		print "-" x 60, "\n";
		print "DISCUS.CONF FILE DETECTED\n\n";
		print "Setup has detected that you have created a discus.conf file\n";
		print "for this installation.  Do you want to use this discus.conf\n";
		print "data to install your board at this time?\n\n";
		print "Your answer (y/n):  ";
		my $yn5 = <STDIN>;
		if ($yn5 =~ /^y/i) {
			if ($path_perl eq "") {
				open (FTPDIAG, "./$dir[0]");
				my @dconfig = <FTPDIAG>;
				close (FTPDIAG);
				$path_perl = $dconfig[0];
				$path_perl =~ s/\s+$//;
				$path_perl =~ s/^#!//;
			}
			require "./instsubs.pl";
			my $DC = read_discus_conf();
			install_discus(0, undef, $DC, $path_perl);
			install_complete($DC);
			last;
		}
	}
	
	unlink "./install.txt";
	open (FILE, "> ./discus.conf"); close (FILE);
	chmod(oct(666), "./discus.conf");

	if (scalar @dir) {
		print "\n\n";
		print "-" x 60, "\n";
		print "PASTE IN DISCUS.CONF FILE\n\n";
		print "Setup has detected that you may have just recently generated a\n";
		print "discus.conf file with the on-line setup form.  Do you want to\n";
		print "paste in discus.conf data now?\n\n";
		print "Your answer (y/n):  ";
		my $yn4 = <STDIN>;
		if ($yn4 =~ /^y/i) {
			print "\nUsing the paste function of your telnet client or this window,\n";
			print "paste in the discus.conf data that you copied from your web\n";
			print "browser.  If setup does not automatically continue after doing this,\n";
			print "hit the ENTER key.\n\n";
			print "Paste in discus.conf data now...\n";
			my @dcd = ();
			while (my $x = <STDIN>) {
				push @dcd, $x if $x =~ /^\w+=/;
				last if $x !~ /\S/ || $x =~ /^contact=/;
			}
			open (DISCUS, "> discus.conf");
			print DISCUS map { chomp $_; join("", $_, "\n") } @dcd;
			close (DISCUS);
			my %dc = undef;
			foreach my $line (@dcd) {
				$dc{$1} = $2 if $line =~ /^(\w+)=(.*?)\s*$/;
			}
			print "\n" x 25;
			print "-" x 60, "\n";
			print "Congratulations!  Your discus.conf file has been generated.  Please\n";
			print "wait while I finish setting up your Discus board...\n\n";
			if ($path_perl eq "") {
				open (FTPDIAG, "./$dir[0]");
				my @dconfig = <FTPDIAG>;
				close (FTPDIAG);
				$path_perl = $dconfig[0];
				$path_perl =~ s/\s+$//;
				$path_perl =~ s/^#!//;
			}
			require "./instsubs.pl";
			install_discus(0, undef, \%dc, $path_perl);
			install_complete(\%dc);
			last;
		}
	}
	
	if ($passes >= 2) {
		print "\n" x 25;
		print "-" x 60, "\n";
		print "DISCUS SETUP - LOOP WARNING\n\n";
		print "Setup has detected that you have generated your discus.conf file,\n";
		print "but you have chosen not to install the software using this data.\n";
		print "\n";
		print "Please choose from among the following choices:\n\n";
		print "1) Generate a new dconfig.cgi file by answering the normal questions\n";
		print "   (path to Perl, CGI extension, etc.)\n\n";
		print "2) Ask you again if you would like to use your discus.conf data to\n";
		print "   install Discus.\n\n";
		print "3) Exit setup\n\n";
		print "Your choice (1-3):  ";
		my $ync = <STDIN>;
		last if $ync < 1 || $ync > 2;
		next if $ync == 2;
	}

	print "\n" x 25;
	print "-" x 60, "\n";
	print "WELCOME TO DISCUS $discus_version ";
	print "PRO " if $pro_version;
	print "SETUP FOR $platform\n\n";
	print "\n\n";
	print "Please wait while I check your distribution...\n";
	print " - Checking [source] directory: ";
	if (! -d "./source") {
		print "{failed}\n";
		print "\nBe sure that you have followed the setup instructions\n";
		print "completely, including the ones to 'cd' to the discus4_00\n";
		print "subdirectory, and to preserve subdirectory structure when\n";
		print "extracting the distribution archive.\n\n";
		press_key();
		exit(0);
	}
	print "{passed}\n";
	print " - Checking [common.pl] file: ";
	if (! open(FILE, "< ./source/common.pl")) {
		print "{failed} $!\n";
		print "\nBe sure that you have followed the setup instructions\n";
		print "completely, including the ones to 'cd' to the discus4_00\n";
		print "subdirectory, and to preserve subdirectory structure when\n";
		print "extracting the distribution archive.\n\n";
		press_key();
		exit(0);
	}
	my @c = <FILE>;
	close (FILE);
	print "{passed}\n";
	print " - Checking serial number: ";
	my @ps = grep(/^\s*\$PARAMS->\{'serial'\}/, @c);
	my $serial = "";
IL:	foreach my $i (@ps) {
		if ($i =~ m|"\.$q\.(\d+)"|) {
			$serial = $1;
			last IL;
		}
	}
	if ($serial eq "") {
		print "{failed}\n";
		press_key();
		exit(0);
	}
	print "{passed}\n";
	press_key();

	print "\n" x 25;
	print "-" x 60, "\n";
	print "IMPORTANT INSTALLATION NOTICE\n\n";
	print "This script is used only to install Discus for the FIRST TIME\n";
	print "on a server.  This script MUST NOT be used to upgrade an existing\n";
	print "Discus board.\n\n";
	print "Please confirm that you wish to perform a FIRST TIME INSTALLATION\n";
	print "on this server by typing 'Y' here and pressing ENTER:\n\n";
	print "  Proceed with FIRST TIME INSTALLATION? (Y/N):  ";
	my $yn1 = <STDIN>;
	exit(0) if $yn1 !~ /^y/i;

	my $pro_license = "";
	if ($pro_version == 1) {
		print "\n" x 25;
		print "-" x 60, "\n";
		print "DISCUS PRO LICENSE NUMBER\n\n";
		print "You have chosen to install Discus Pro.  Please enter your Discus\n";
		print "Pro license number here:\n\n";
		until ($pro_license =~ /^(\d)(\d)(\d)(\d)\-(\d)(\d)(\d)(\d)\-(\d)(\d)(\d)(\d)$/ && ($1 + $5) % 10 == $9 && ($2 + $6) % 10 == $10 &&($3 + $7) % 10 == $11 &&($4 + $8) % 10 == $12) {
			print "  Discus Pro License Number:  ";
			$pro_license = <STDIN>;
			$pro_license =~ s/[^\d\-]//g;
			exit(0) if $pro_license eq "";
		}
	}	

	print "\n" x 25;
	print "-" x 60, "\n";
	print "CHOOSE PATH TO PERL\n\n";
	print "This screen allows you to enter the path to Perl.  Discus 4.0 requires\n";
	print "Perl 5.005 or higher.\n\n";
	if ($] >= 5.005 && -f $^X && -x $^X) {
		print "The Perl interpreter used to execute this script can be found\n";
		print "at $^X.  Unless you know a very good reason not\n";
		print "to do so, you should use this Perl interpreter.\n\n";
		print "Use $^X?  (Y/n):  ";
		my $yn2 = <STDIN>;
		$path_perl = $^X if $yn2 !~ /^n/i;
	}
	my $perl = {};
PP:	while ($path_perl eq "") {
		if ($unix) {
			my $whereis = `whereis perl`;
			if ($whereis =~ m|perl: (.*)|) {
				my @perls = split(/\s+/, $1);
				foreach my $perl_s (@perls) {
					my $tp = test_perl($perl_s);
					$perl->{$perl_s} = $tp if $tp >= 5;
				}
			}    
			my $which = `which perl`; chomp $which;
			if ($which =~ m|perl|) {
				my $tp = test_perl($which);
				$perl->{$which} = $tp if $tp >= 5;
			}
			my $tries = "/usr/bin/perl /usr/bin/perl5 /usr/local/bin/perl /usr/local/bin/perl5 /usr/sbin/perl /usr/local/sbin/perl /usr/contrib/bin/perl";    
			foreach my $try (split(/\s/, $tries)) {
				my $tp = test_perl($try);
				$perl->{$try} = $tp if $tp >= 5;
			}
		}
		if (keys %{$perl}) {
			print "\nThe following Perl interpreters were located on your system.\n";
			print "Choose one of these interpreters, or just hit ENTER to type in\n";
			print "the path manually.\n\n";
			print "##  Path to Perl                                Version\n";
			print "--  ------------------------------------------- -------\n";
			my $i = 0;
			my @pl = ();
			foreach my $k (keys %{$perl}) {
				printf "%2d", ++$i;
				print "  ";
				print substr(join("", $k, " " x 60), 0, 43);
				print " ";
				print substr($perl->{$k}, 0, 7), "\n";
				push @pl, $k;
			}
			print "    (Just hit ENTER to choose your own path)\n";
			print "\nPath to Perl choice:  ";
			my $ppc = <STDIN>; chomp $ppc;
			if ($ppc >= 1 && $ppc <= scalar(@pl)) {
				$path_perl = $pl[$ppc-1];
			}
			$perl = {};	
		}
		if ($path_perl eq "") {
			print "\nEnter full path to Perl:  ";
			my $fpp = <STDIN>; chomp $fpp;
			if (! -f $fpp || ! -x $fpp) {
				print "\nWARNING: That path to Perl does not appear to be valid.\n";
				print "Press Y to accept this path anyway, or any other key to try again:  ";
				my $yn3 = <STDIN>;
				next PP if $yn3 !~ /^y/i;
				$path_perl = $fpp;
			}
		}
	}

	my $cgi_extension = "";
	print "\n" x 25;
	print "-" x 60, "\n";
	print "CHOOSE YOUR CGI EXTENSION\n\n";
	print "Here, you need to enter the extension that will cause your server\n";
	print "to execute files as CGI scripts.  Generally this is .cgi, but sometimes\n";
	print "it is .pl.  Rarely is it something else.\n\n";
	print "##  Extension\n";
	print "--  ---------\n";
	print " 1  .cgi\n";
	print " 2  .pl\n";
	print "    (Just hit ENTER to choose your own extension)\n\n";
	print "\nCGI extension choice:  ";
	my $cgc = <STDIN>; chomp $cgc;
	$cgi_extension = $cgc; $cgi_extension =~ s/\W//g;
	$cgi_extension = 'cgi' if $cgc == 1;
	$cgi_extension = 'pl' if $cgc == 2;
	exit(0) if $cgc !~ /\S/;

	my $dconfig_name = "dconfig.$cgi_extension";
	if (open (FILE, "./source/dconfig.txt")) {
		my $pwd = eval '
			use Cwd;
           	my $dir = cwd;
			$dir;
		';
		open (FTPDIAG, "> ./$dconfig_name");
		print FTPDIAG "#!$path_perl\n";
		while (<FILE>) {
			if (/^my \$pro_license/) {
				print FTPDIAG "my \$pro_license = '$pro_license';\n";
			} elsif (/^my \$language_list/ && -e "./source/languages") {
				opendir(DIR, "./source/languages");
				my @lang = grep { /^\w+$/ } readdir(DIR);
				closedir(DIR);
				my @ll = map { join("", "<option value=$_>", "\u$_", "</option>") } @lang;
				my $str = join("", @ll);
				print FTPDIAG "my \$language_list = '$str';\n";
			} elsif (/^my \$get_discus_pro/ && $pro_version) {
				print FTPDIAG "my \$get_discus_pro = 1;\n";
			} elsif (/^my \$discusware_url/) {
				print FTPDIAG "my \$discusware_url = \"$dconfig_name\";\n";
			} elsif (/^(\s*)my \$discus_conf_generate_dir/) {
				print FTPDIAG "$1my \$discus_conf_generate_dir = '$pwd';\n";
			} else {
				print FTPDIAG $_;
			}
		}
		close (FILE);
		close (FTPDIAG);
		chmod (oct(755), "./$dconfig_name");
	} else {
		print "ERROR: Could not open dconfig.txt\n";
		exit(0);
	}
	print "\n" x 25;
	print "-" x 60, "\n";
	print "INTERACTIVE SETUP FORM INSTRUCTIONS\n\n";
	print "This script has generated a file named 'dconfig.$cgi_extension' in this\n";
	print "directory.\n\n";
	print "1) Copy this file to a directory on your server where CGI scripts can\n";
	print "   be executed (generally 'cgi-bin').\n\n";
	if ($unix) {
		print "   On most unix systems, you can press CTRL-Z now to return to the\n";
		print "   command prompt.  Then use the 'cp' command as in this example:\n";
		print "      cp -p $dconfig_name /path/to/your/cgi-bin\n\n";
		print "   When the file has been copied, type 'fg' to return to the script.\n";
		print "   Press ENTER to continue with setup.\n\n";
	} else {
		print "   You can use Windows explorer to copy the $dconfig_name file.  Then\n";
		print "   paste (copy) the file to your server's CGI directory (usually called\n";
		print "   'cgi-bin' or 'scripts').\n\n";
	}	
	print "2) Access the dconfig script in your web browser by typing in the URL into\n";
	print "   the browser's location bar (e.g., http://your.server.com/cgi-bin/dconfig.$cgi_extension).\n\n";
	print "3) Fill out the form, answering all questions that are presented.  This\n";
	print "   allows you to customize your installation of Discus using your browser.\n\n";
	print "4) If needed, press ENTER to receive further instructions.\n\n";
	press_key(1);
}

exit(0);


###################################################################
# Miscellaneous Subroutines

sub press_key {
	if ($_[0] == 0) {
		print "\n";
		print "-" x 60, "\n";
		print "   Please press ENTER to continue with setup\n";
		print "-" x 60, "\n";
	}
	my $f = <STDIN>;
	print "\n";
}

sub test_perl {
	my ($perlin) = @_;
	return 0 if ! $unix;
	return 0 if $perl->{$perlin};
	my $cmd = "$perlin -e 'print \"pv:$]\";'";
	if (-x $perlin) {
		my $result = `$cmd`; chomp $result;
		return $' if $result =~ /^pv:/;
	}
	return 0;
}

sub divider {
	print "\n" x 20;
	print ">", "=" x 58, "<", "\n";
	print "\n";
}

sub install_complete {
	my ($DC) = @_;
	print "\n" x 25;
	print "-" x 60, "\n";
	print "DISCUS INSTALLATION -- COMPLETE\n\n";
	print "Congratulations!  Your discussion board has been successfully\n";
	print "installed.  To begin using your board, please do the following:\n\n";
	print "1) Go to your board.  It is found at:\n";
	print "   $DC->{script_url}/discus.$DC->{cgi_extension}\n\n";
	print "2) Click on the administration link.  Enter your username ('$DC->{superuser}')\n";
	print "   and leave the password blank.  You will be prompted to set up\n";
	print "   your password and register Discus.\n\n";
	print "3) Return to administration with username '$DC->{superuser}' and the\n";
	print "   password you just set up.  Go to the administration instructions\n";
	print "   and read through the superuser getting started tutorial.\n\n";
	print "Thank you for choosing Discus!\n\n";
	print "Press any key to continue...\n";
	my $iii = <STDIN>;
	exit(0);
}
