#!/usr/bin/perl

my $discus_version = "4.00";

###
### instsubs.pl - Subroutines to install Discus
###

if ($0 =~ /instsubs/) {
	print "To install or upgrade Discus by telnet, use:\n";
	print "   1st_install.pl -- first time installation\n";
	print "   upgrade.pl     -- all subsequent upgrades\n";
	print "\n";
	print "This script, instsubs.pl, supports those scripts, but has\n";
	print "no function when run by itself.\n\n";
	my $foo = <STDIN>;
	exit(0);
}

my $interactive = 1;

###
### install_discus
###

sub install_discus {
	my ($upgrade, $d, $DC, $pathperl) = @_;
	$DC->{language} = $DC->{language_chosen} if defined $DC->{language_chosen} && ! defined $DC->{language};
	$DC->{language} =~ tr/A-Z/a-z/; $DC->{language} =~ s/\W//g;
	my @filelist = ();
	my $pro_fileid = "";
	foreach my $k (keys %{$DC}) {
		$DC->{$k} =~ s/\\/\//g if $k =~ /_dir$/;
	}
	if ($pathperl eq "") {
		open (FILE, "< $DC->{script_dir}/board-admin.$DC->{cgi_extension}") || die "Open Error: Could not determine path to perl: $!\n";
		my @file = <FILE>;
		close (FILE);
		$pathperl = $file[0];
		$pathperl =~ s/^\s*#!\s*//;
	}	
	if (-e "$DC->{admin_dir}/source") {
		opendir(DIR, "$DC->{admin_dir}/source");
		my @dir = grep { /^PRO_/ } readdir(DIR);
		closedir(DIR);
		if ($dir[0] =~ /^PRO_(\d+)/) {
			$pro_fileid = $1;
		}		
	}
	if ($pro_fileid == 0) {
		srand time;
		$pro_fileid = "";
		for (my $i = 1; $i <= 12; $i++) {
			$pro_fileid .= int(rand(10));
		}
	}
	if (open (FILELIST, "< ./source/filelist.txt")) {	
		while (<FILELIST>) {
			my ($perms, $filename, $flags) = split(/\s+/, $_);
			my $is_dir = $perms =~ /^d/;
			my $perm = "777";
			$perm = "777" if $perms =~ /rwxrwxrwx$/;
			$perm = "666" if $perms =~ /rw-rw-rw-$/;
			$perm = "755" if $perms =~ /rwxr-xr-x$/;
			$perm = "644" if $perms =~ /rw-r--r--$/;
			$perm = $DC->{perms0666} if $perms =~ /rw-rw-rw-$/ && $DC->{perms0666};
			$perm = $DC->{perms0777} if $perms =~ /rwxrwxrwx$/ && $DC->{perms0777};
			$perm = $DC->{perms0755} if $perms =~ /rwxr-xr-x$/ && $DC->{perms0755};
			$flags = $1 if $flags =~ /^\[(.*)\]$/;
			$filename = join("", $`, "PRO_$pro_fileid", $') if $filename =~ /PRO_##/;
			my $filepath = $filename;
			$filepath =~ s%^\./discus_admin%$DC->{admin_dir}%g;
			if ($DC->{icon_dir} ne "" && $DC->{icon_dir} ne "icons") {
				$filepath =~ s%^\./public_html/icons%$DC->{html_dir}/$DC->{icon_dir}%g;
			}	
			$filepath =~ s%^\./public_html%$DC->{html_dir}%g;
			$filepath =~ s%^\./cgi-bin%$DC->{script_dir}%g;
			$filepath =~ s%\.cgi$%.$DC->{cgi_extension}% if $DC->{cgi_extension} ne "cgi" && $flags =~ /C/;
			chmod (oct($perm), $filepath);
			next if $flags =~ /\*/ && -e $filepath && $upgrade;
			next if $DC->{pro} == 0 && $flags =~ /\%/;
			if (-e $filepath && $flags =~ /^(\d+)/) {
				$flags = $';
				if ($d->{$1} eq "0" || ($d->{$1} ne "1" && $flags =~ /N/)) {
					if ($flags =~ /<([\d\.]+)>/) {
						$flags = join("", $`, $');
						next if $DC->{version} >= $1;
					} else {
						next;
					}
				}
			}
			my $sourcefile = $' if $filename =~ /.*\//;
			my $forcecode = "";
			$forcecode = htaccess_source() if $flags =~ /~/;
			$forcecode = nsconfig_source() if $flags =~ /`/;
			$forcecode = "#\n" if $flags =~ /\*/ && $flags !~ /O/;
			$forcecode = "\n" if $flags =~ /X/;
			$forcecode = passwd_source($DC) if $flags =~ /P/;
			push @filelist, {
				filename => $sourcefile,
				destfile => $filepath,
				is_dir => $is_dir,
				perm => $perm,
				forcecode => $forcecode,
				flags => $flags,
			};
		}
	} else {
		print "Error: could not open file list: $!\n";
		exit(0);
	}
	process_entry($pathperl, $DC, @filelist);
	$DC->{version} = $discus_version;
	open (DCONF, "> $DC->{admin_dir}/discus.conf");
	open (DCONF_LOCAL, "> ./discus.conf");
	foreach my $k (keys %{$DC}) {
		print DCONF "$k=$DC->{$k}\n";
		print DCONF_LOCAL "$k=$DC->{$k}\n";
	}
	close (DCONF);	
	close (DCONF_LOCAL);	
	chmod (oct(777), "$DC->{admin_dir}/discus.conf");
	open (FILE, ">> install.txt");
	print FILE "Upgrade of $DC->{html_url} at ", scalar(localtime(time)), "\n" if $upgrade;
	print FILE "Install of $DC->{html_url} at ", scalar(localtime(time)), "\n" if ! $upgrade;
	close (FILE);
}

###
### process_entry
###

sub process_entry {
	my $pathperl = shift;
	my $DC = shift;
	while (my $entry = shift) {
		if ($entry->{is_dir}) {
			next if -d $entry->{destfile};
			if (-f $entry->{destfile}) {	
				if ($interactive) {
					print "$entry->{destfile} is a file -- should be a directory\n";
					print "Delete file to create directory?  (y/n): ";
					my $ch1 = <STDIN>;
					exit(0) if $ch1 =~ /^n/i;					
				}
				unlink $entry->{destfile};
			}	
			mkdir($entry->{destfile}, oct($entry->{perm})) || die "Directory creation error for $entry->{destfile}: $!";
			chmod(oct($entry->{perm}), $entry->{destfile});
		} else {
			next if $entry->{filename} eq "";
			$entry->{filename} = "index.html" if $entry->{flags} =~ /i/;
			if ($entry->{forcecode} ne "") {
				open (FILE, "> $entry->{destfile}") || die "File write error for $entry->{destfile}: $!";
				print FILE $entry->{forcecode};
				close (FILE);
				chmod (oct($entry->{perm}), $entry->{destfile});
			} else {
				open (FILE, "> $entry->{destfile}") || die "File write error for $entry->{destfile}: $!";
				binmode FILE;
				my @src = ();
				if (open (SRC, "< ./source/languages/$DC->{language}/$entry->{filename}")) {
					binmode SRC;
					@src = <SRC>;
					close (SRC);
				} elsif (open (SRC, "< ./source/$entry->{filename}")) {
					binmode SRC;
					@src = <SRC>;
					close (SRC);
				} else {
					die "File read error for $entry->{filename}: $!";
				}
				print FILE "#!$pathperl\n" if $entry->{flags} =~ /C/;
				foreach $_ (@src) {
					if ($entry->{flags} =~ /H/) {
						s/\$html_url/$DC->{html_url}/g;
						s/\$script_url/$DC->{script_url}/g;
						s/\$cgi_extension/$DC->{cgi_extension}/g;
						s%<!--TITLE-->(.*?)<!--/TITLE-->%<!--TITLE--><TITLE>$DC->{title}</TITLE><!--/TITLE-->%g;
						s%<!--\*-->(.*?)<!--/\*-->%<!--\*-->$DC->{title}<!--/\*-->%g;
					} elsif ($entry->{flags} =~ /C/) {
						s/my \$DISCUS_CONF_DEFINITION = '(.*?)';/my \$DISCUS_CONF_DEFINITION = '$DC->{admin_dir}\/discus.conf';/g;
						s/\$DCONF->\{script_dir\} = ".*?";/\$DCONF->\{script_dir\} = "$DC->{script_dir}";/g;
					}
					print FILE $_;
				}
				close (FILE);
				chmod (oct($entry->{perm}), $entry->{destfile});
			}
		}		
	}	
}

###
### htaccess_source
###

sub htaccess_source {
	return "Order deny,allow\nDeny from all\nAllow from none\n";
}

###
### nsconfig_source
###

sub nsconfig_source {
	return "<FILES *>\nRestrictAccess type=deny ip=*\n</FILES>\n";
}

###
### passwd_source
###

sub passwd_source {
	my $DC = shift;
	return "$DC->{superuser}::email:fullname:1::" . time . ":0:0:/\n";
}

###
### upgrade_or_not
###

sub upgrade_or_not {
	my $z = shift;
	print substr(join("", $z, " " x 60), 0, 60);
	if ($_[0] eq "y") {
		print "[Y/n]: ";
	} else {
		print "[y/N]: ";
	}
	my $uon = <STDIN>;
	return 1 if $uon =~ /^y/i;
	return 0 if $uon =~ /^n/i;
	return 1 if $_[0] eq "y";
	return 0;
}

###
### read_discus_conf
###

sub read_discus_conf {
	my $file = -f $_[0] ? $_[0]	: "./discus.conf";
	open (FILE, "< $file") || die "Could not open discus.conf at [$file]: $!";
	my $dc = {};
	while (<FILE>) {
		if (/^(\w+)=(.*?)\s*$/) {
			$dc->{$1} = $2;
		}
	}
	close (FILE);
	return $dc;	
}
	
1;
