# FILE: adm-upd.pl
# DESCRIPTION: Automatic Update of your Discus Board
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### UPDATE_admin
###
### Controls all Update functions
###

sub UPDATE_admin {
	my ($FORMref) = @_;
	if ($FORMref->{action} eq "update_savepref") {
		my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
		bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
		bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
		my $u = {};
		$u->{auto_upgrade} = ($FORMref->{toggle} == 1 ? 1 : 0);
		$u->{auto_upgrade_key} = ($FORMref->{auto_upgrade_key} eq "" ? "" : $FORMref->{auto_upgrade_key});
		$u->{auto_upgrade_account} = ($FORMref->{auto_upgrade_account} eq "" ? "" : $FORMref->{auto_upgrade_account});
		$u->{discusware_ip_address} = ($FORMref->{discusware_ip_address} eq "" ? "" : $FORMref->{discusware_ip_address});
		dreq("adm-opts");
		options_save($u);
		hash_merge($GLOBAL_OPTIONS, $u, 1);
		my $subst = {};
		$subst->{general}->{username} = $result->[0]->{user};
		$FORMref->{menu} = 3;
		$subst->{general}->{screen} = 0;
		dreq("adm-misc");
		version_manager($FORMref, $subst, $result);
	}
	if ($FORMref->{action} eq "update_signup") {
		my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
		bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
		bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
		undef my $subst;
		$subst->{general}->{username} = $result->[0]->{user};
		$subst->{general}->{screen} = 1;
		if (! -d "$DCONF->{admin_dir}/data/updates") {
			if (mkdir("$DCONF->{admin_dir}/data/updates", oct($DCONF->{perms0777}))) {
				chmod (oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/data/updates");
				$subst->{tests}->{t1} = "";
			} else {
				$subst->{tests}->{t1} = "Error creating directory: $!";
			}
		} else {
			$subst->{tests}->{t1} = "";
		}
		chmod (oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/data/updates");
		($subst->{tests}->{t2}, $subst->{tests}->{t3}) = update_test_dir("$DCONF->{admin_dir}/data/updates");
		($subst->{tests}->{t4}, $subst->{tests}->{t5}) = update_test_dir("$DCONF->{admin_dir}/source");
		($subst->{tests}->{t6}, $subst->{tests}->{t7}) = update_test_dir("$DCONF->{admin_dir}/source/$PARAMS->{pro_fileid}");
		($subst->{tests}->{t8}, $subst->{tests}->{t9}) = update_test_dir("$DCONF->{admin_dir}/template/admin");
		($subst->{tests}->{t10}, $subst->{tests}->{t11}) = update_test_dir("$DCONF->{admin_dir}/template/ui");
		($subst->{tests}->{t12}, $subst->{tests}->{t13}) = update_test_dir("$DCONF->{admin_dir}/template/pro");
		($subst->{tests}->{t14}, $subst->{tests}->{t15}) = update_test_dir("$DCONF->{admin_dir}/skins");
		($subst->{tests}->{t16}, $subst->{tests}->{t17}) = update_test_dir("$DCONF->{admin_dir}");
		($subst->{tests}->{t19}, $subst->{tests}->{t20}) = update_test_dir("$DCONF->{admin_dir}/template/mailmesg");
		my $u = "";
		foreach my $key (keys(%{ $subst->{tests} })) {
			$u .= $subst->{tests}->{$key};
		}
		$subst->{general}->{ok} = ($u eq "" ? 1 : 0);
		$subst->{general}->{menu} = 3;
		$subst->{'general'}->{'username'} = $result->[0]->{'user'};
		$subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=version_mgr&username=$result->[0]->{user}";
		screen_out("version", $subst);
	}
	if ($FORMref->{action} eq "update_now") {
		my $i = crypt($FORMref->{sk}, $GLOBAL_OPTIONS->{auto_upgrade_key});
		update_die(2002) if $GLOBAL_OPTIONS->{auto_upgrade_key} ne $i;
		update_die(2002) if $GLOBAL_OPTIONS->{discusware_ip_address} ne $ENV{REMOTE_ADDR};
		update_die(2000) if $GLOBAL_OPTIONS->{auto_upgrade} == 0;
		update_die(2003) if $GLOBAL_OPTIONS->{auto_upgrade_key} eq "";
		update_die(2004) if ! $FORMref->{sa};
		update_die(2006) if ($FORMref->{sa} eq "gv" && ! update_give_version_info());
		my $checksum = calculate_key();
		update_die(2018) if $FORMref->{key} ne $checksum;
		update_die(2005) if ($FORMref->{sa} eq "ip" && ! update_set_trusted_ip($FORMref->{ip}));
		if ($FORMref->{sa} eq "fi") {
			my $x = update_receive_file($FORMref);
			update_die(2006+$x) if $x >= 1;
			my $filename = $FORMref->{filename}; $filename =~ s/[^\w\-\.]//g;
			my $y = update_verify_file($filename);
			update_die(2009+$y) if $y >= 1;
			update_die(0);
		}
		if ($FORMref->{sa} eq "rf") {
			my ($success, $failure) = update_replace_files();
			update_die(0);
		}
		update_make_dir($FORMref) if $FORMref->{sa} eq "md";
		update_remove_file($FORMref) if $FORMref->{sa} eq "rm";
		update_remove_dir($FORMref) if $FORMref->{sa} eq "rd";
	}
}

###
### update_set_trusted_ip
###
### Sets the entry for DiscusWare's IP address.  If we change servers, our
### old one will tell your server to update itself.
###

sub update_set_trusted_ip {
	my ($ip_addr) = @_;
	$ip_addr =~ s/[^\d\.]//g;
	return 0 if $ip_addr !~ m|^(\d+)\.(\d+)\.(\d+)\.(\d+)$|;
	dreq("adm-opts");
	update_die(0) if options_save({ discusware_ip_address => $ip_addr });
	return 0;
}

###
### update_die
###
### Kills update process with a status code
###

sub update_die {
	my ($code) = @_;
	header();
	print $code;
	program_exit(0);
}

###
### update_test_dir
###
### Tests a directory to be sure you can add, remove, and delete files there
###

sub update_test_dir {
	my ($dir) = @_;
	my $o = undef;
	my $t = undef;
	if (open(TEST, "> $dir/testfile")) {
		print TEST "test\n";
		close (TEST);
		if (open(TEST, "< $dir/testfile")) {
			my @test = <TEST>;
			close (TEST);
			chomp $test[0];
			$o = 1 if $test[0] ne "test";
		} else {
			$o = 2;
		}
	} else {
		$o = 3;
	}
	chmod(oct(0000), "$dir/testfile");
	$t = $! if ! unlink "$dir/testfile";
	return ($o, $t);
}

###
### calculate_key
###
### Key is used to ensure that your board has contacted DiscusWare server
###

sub calculate_key {
	my $checksum = 0;
	foreach my $key (keys %{$DCONF}) {
		$checksum += unpack("%16C*", $DCONF->{$key});
	}
	return $checksum;	
}


###
### update_give_version_info
###
### This gives your board's version information to DiscusWare's update agent.
###

sub update_give_version_info {
	header();
	my $checksum = calculate_key();
	print <<EOF;
serial=$PARAMS->{serial}
pro_license=$DCONF->{pro_license}
pro_fileid=$DCONF->{pro_fileid}
language=$DCONF->{language}
html_url=$DCONF->{html_url}
account_number=$GLOBAL_OPTIONS->{auto_upgrade_account}
feature_on=$GLOBAL_OPTIONS->{auto_upgrade}
discusware_ip=$GLOBAL_OPTIONS->{discusware_ip_address}
key=$checksum
EOF
	program_exit(0);
}

###
### update_remove_dir
###
### Removes a directory
###

sub update_remove_dir {
	my ($FORMref) = @_;
	my $dirname = $FORMref->{dirname};
	$dirname =~ s%/PRO_##/%/PRO_$DCONF->{pro_fileid}/%;
	$dirname =~ s/[^\/\.\w]//g;
	$dirname =~ s/\.+/./g;
	$dirname =~ s%^\./discus_admin/%$DCONF->{admin_dir}/%;
	$dirname =~ s%^\./public_html/%$DCONF->{html_dir}/%;
	$dirname =~ s%^\./cgi-bin/%$DCONF->{script_dir}/%;
	update_die(2025) if ! -e $dirname;
	update_die(2026) if -f $dirname;
	if (opendir(DIR, $dirname)) {
		my @dir = grep { ! /^\.+$/ } readdir(DIR);
		closedir(DIR);
		update_die(2027) if scalar @dir;
	}
	update_die(2028) if ! rmdir $dirname;
	update_die(0);
}


###
### update_remove_file
###
### Creates a directory
###

sub update_remove_file {
	my ($FORMref) = @_;
	my $filename = $FORMref->{filename};
	$filename =~ s%/PRO_##/%/PRO_$DCONF->{pro_fileid}/%;
	$filename =~ s/[^\/\.\w]//g;
	$filename =~ s/\.+/./g;
	$filename =~ s%^\./discus_admin/%$DCONF->{admin_dir}/%;
	$filename =~ s%^\./public_html/%$DCONF->{html_dir}/%;
	$filename =~ s%^\./cgi-bin/%$DCONF->{script_dir}/%;
	update_die(2022) if ! -e $filename;
	update_die(2023) if ! -f $filename;
	update_die(2024) if ! unlink $filename;
	update_die(0);
}

###
### update_make_dir
###
### Creates a directory
###

sub update_make_dir {
	my ($FORMref) = @_;
	my $dirname = $FORMref->{dirname};
	$dirname =~ s%/PRO_##/%/PRO_$DCONF->{pro_fileid}/%;
	$dirname =~ s/[^\/\.\w]//g;
	$dirname =~ s/\.+/./g;
	$dirname =~ s%^\./discus_admin/%$DCONF->{admin_dir}/%;
	$dirname =~ s%^\./public_html/%$DCONF->{html_dir}/%;
	$dirname =~ s%^\./cgi-bin/%$DCONF->{script_dir}/%;
	if (! -e $dirname) {
		my $k = mkdir($dirname, oct($DCONF->{perms0777}));
		if (! $k) {
			update_die(2020) if -f $dirname;
			update_die(2021) if -d $dirname;
			update_die(2019);
		}
		chmod(oct($DCONF->{perms0777}), $dirname);
		update_die(0);
	}
	update_die(2020) if -f $dirname;
	update_die(2021);
}

###
### update_replace_files
###
### Replaces files with those in your "updates" directory
###

sub update_replace_files {
	my @success = ();
	my @failure = ();
	my $s = $PARAMS->{'serial'}; $s =~ s/\./_/g;
	if (! -e "$DCONF->{admin_dir}/backups/$s") {
		mkdir("$DCONF->{admin_dir}/backups/$s", oct($DCONF->{perms0777})) || update_die(2017); ## 2017
		chmod(oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/backups/$s");
	}
	my $budir = "$DCONF->{admin_dir}/backups/$s";
	opendir(DIR, "$DCONF->{admin_dir}/data/updates") || update_die(2016);			## 2016
	my @dir = grep { /\.prg$/ } readdir(DIR);
	closedir(DIR);
	foreach my $file (@dir) {
		my $filename = $1 if $file =~ /(.*)\./;
		my $p = {};
		open (FILE, "< $DCONF->{admin_dir}/data/updates/$filename.dat");
		while (<FILE>) {
			chomp;
			if (m|^(\w+)=(.*)|) {
				$p->{$1} = $2;
			}
		}
		close (FILE);
		my $destfile = $p->{destfile};
		$destfile =~ m|^.*/(.*)|;
		$p->{discus_filename} = $1 if ! $p->{discus_filename};
		$destfile =~ s%^\./discus_admin/%$DCONF->{admin_dir}/%;
		$destfile =~ s%/PRO_##/%/PRO_$DCONF->{pro_fileid}/%;
		$destfile =~ s%^\./public_html/%$DCONF->{html_dir}/%;
		next if $destfile =~ m%^\./cgi-bin/%;
		if (open(FILE, "< $destfile")) {
			binmode(FILE);
			open (DEST, "> $budir/$p->{discus_filename}");
			binmode(DEST);
			while (<FILE>) {
				print DEST;
			}
			close (DEST);
			close (FILE);
		}
		if (open(FILE, "< $DCONF->{admin_dir}/data/updates/$file")) {
			binmode(FILE);
			unlink $destfile;
			if ($p->{converted} == 1) {
				my $content = "";
				while (my $data = <FILE>) {
					while (	$data =~ /^([0-9a-f][0-9a-f])/ ) {
						$data = $';
						$content .= pack("C", hex($1));
					}
				}
				if (open (DEST, "> $destfile")) {
					binmode(DEST);
					print DEST $content;
					close (DEST);
					unlink("$DCONF->{admin_dir}/data/updates/$file");
					unlink("$DCONF->{admin_dir}/data/updates/$filename.dat");
					chmod (oct($DCONF->{perms0666}), $destfile);
					push (@success, $filename);
				} else {
					push (@failure, { filename => $filename, reason => 1, text => $! });
				}
			} else {	
				if (open(DEST, "> $destfile")) {
					binmode(DEST);
					while (<FILE>) {
						print DEST;
					}
					close (DEST);
					unlink("$DCONF->{admin_dir}/data/updates/$file");
					unlink("$DCONF->{admin_dir}/data/updates/$filename.dat");
					chmod (oct($DCONF->{perms0666}), $destfile);
					push (@success, $filename);
				} else {
					push (@failure, { filename => $filename, reason => 1, text => $! });
				}
			}
		} else {
			push (@failure, { filename => $filename, reason => 0, text => $! });
		}
	}
	return (\@success, \@failure);
}

###
### update_receive_file
###
### This receives a file and saves it to your "updates" directory
###

sub update_receive_file {
	my ($FORMref) = @_;
	my $filename = $FORMref->{filename}; $filename =~ s/[^\w\-\.]//g;
	return 1 if $filename eq "";													## 2007
	my $destfile = $FORMref->{destfile};
	my $checksum = $FORMref->{checksum};
	my $content = $FORMref->{content};
	my $version = $FORMref->{version};
	my $converted = 0 + $FORMref->{converted};
	if (open(FILE, "> $DCONF->{admin_dir}/data/updates/$filename.prg")) {
		binmode FILE;
		print FILE $content;
		close (FILE);
	} else {
		return 2;																	## 2008
	}
	if (open(FILE, "> $DCONF->{admin_dir}/data/updates/$filename.dat")) {
		print FILE "destfile=$destfile\n";
		print FILE "checksum=$checksum\n";
		print FILE "version=$version\n";
		print FILE "converted=$converted\n";
		close (FILE);
	} else {
		return 3;																	## 2009
	}
	return 0;
}

###
### update_verify_file
###
### Makes sure that your file got here properly
###

sub update_verify_file {
	my ($filename) = @_;
	return 1 if ! -d "$DCONF->{admin_dir}/data/updates";							## 2010
	return 2 if ! -e "$DCONF->{admin_dir}/data/updates/$filename.prg";				## 2011
	return 3 if ! -e "$DCONF->{admin_dir}/data/updates/$filename.dat";				## 2012
	open (FILE, "< $DCONF->{admin_dir}/data/updates/$filename.dat") || return 4;	## 2013
	my @file = <FILE>;
	close (FILE);
	undef my $p;
	foreach my $x (@file) {
		chomp $x;
		if ($x =~ m|^(\w+)=(.*)|) {
			$p->{$1} = $2;
		}
	}
	open (FILE, "< $DCONF->{admin_dir}/data/updates/$filename.prg") || return 5;	## 2014
	close (FILE);
	my $checksum = checksum("$DCONF->{admin_dir}/data/updates/$filename.prg");
	return 6 if $checksum ne $p->{checksum};										## 2015
	return 0;
}

###
### checksum
###
### Calculates a checksum for a file
###

sub checksum {
	my ($filename) = @_;
	my $R = readfile_binary($filename);
	return unpack("%16C*", $R);
}

1;

