# FILE: swupdate.pl
# DESCRIPTION: Functions to use the automatic update of Discus
# $COPYRIGHT$

use strict;
use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);
use Digest::MD5 qw(md5_hex);
use File::Basename;
use File::Copy;
my $null = chr(0);

###
### update_handler
###
### Form handler for update actions
###

sub update_handler {
	my ($FORMref) = @_;
	my $action;
	$action = $1 if $FORMref->{'action'} =~ /^version_swupdate_(\w+)$/;
	error_message('update_handler error', 'Invalid form action specified', 0, 1) if ! defined $action;
	my $result = [];
	if ($action eq 'background_submit') {
		update_background_writemsg(1) if $GLOBAL_OPTIONS->{'swupdate_background'} == 0;
		update_background_writemsg(2) if $GLOBAL_OPTIONS->{'swupdate_password'} eq '';
		update_background_writemsg(3) if $GLOBAL_OPTIONS->{'swupdate_password'} ne $FORMref->{'swupdate_password'};
	} else {
		$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 ! is_superuser($result->[0]->{'user'});
	}	
	my %actions = (
		'browser_submit' => sub { return update_receiver($FORMref, $result, 0) },
		'background_submit' => sub { return update_receiver($FORMref, $result, 1) },
		'browser_confirm' => sub { return update_applicator($FORMref, $result) },
		'choose' => sub { return update_chooser($FORMref, $result) },
	);
	error_message('update_handler error', 'Unrecognized form action specified', 0, 1) if ! defined $actions{$action};
	return &{$actions{$action}}();
}

###
### swupdate_applicator_form_array
###
### Prepare array of files to overwrite or not overwrite
###

sub swupdate_applicator_form_array {
	my $x = $_[0];
	my $i = 1;
	my @files = ();
	while (exists $x->{'hash'}->{$i}) {
		my %z = %{ $x->{'hash'}->{$i} };
		$z{'internal'} = $i;
		my $destfile = "$z{'actual_dir'}/$z{'file'}";
		if (defined $x->{'hash'}->{$i}->{'delete'}) {
			if (-f $destfile) {
				$z{'destfile_exists'} = 1;
				$z{'destfile_mtime'} = (stat $destfile)[9];
				$z{'checkbox_checked'} = 1;
				$z{'checkbox_disabled'} = 0;
			} else {
				$z{'destfile_exists'} = 0;
				$z{'checkbox_checked'} = 0;
				$z{'checkbox_disabled'} = 1;
			}	
		} elsif (-f $destfile) {
			$z{'destfile_exists'} = 1;
			$z{'destfile_mtime'} = (stat $destfile)[9];
			if ($z{'destfile_mtime'} > $x->{'hash'}->{'0'}->{'time'}) {
				$z{'checkbox_checked'} = 0;
				$z{'checkbox_disabled'} = 1;
			} else {
				if ($z{'force_overwrite'}) {
					$z{'checkbox_checked'} = 1;
					$z{'checkbox_disabled'} = 1;
				} elsif ($z{'no_overwrite'}) {
					$z{'checkbox_checked'} = 0;
					$z{'checkbox_disabled'} = 1;
				} elsif ($z{'dont_overwrite'}) {
					$z{'checkbox_checked'} = 0;
					$z{'checkbox_disabled'} = 0;
				} else {
					$z{'checkbox_checked'} = 1;
					$z{'checkbox_disabled'} = 0;
				}			
			}	
		} else {
			$z{'checkbox_checked'} = 1;
			$z{'checkbox_disabled'} = 1;
			$z{'destfile_exists'} = 0;
		}		
		push @files, \%z;
		$i += 1;
	}
	return \@files;
}

###
### update_test
###
### Make sure each directory we plan to write can actually be written to
###

sub update_test {
	my $h = $_[0];
	my %dir = ();
	my @fail = ();
	foreach my $key (keys %{$h->{'hash'}}) {
		my $dirname = $h->{'hash'}->{$key}->{'actual_dir'};
		next if defined $dir{$dirname};
		next if ! -d $dirname;
		$dir{$dirname} = 1;
		push @fail, $dirname if update_test_dir($dirname);
	}
	if (defined $h->{'hash'}->{'0'}->{'install_license'}) {
		if (! defined $dir{$DCONF->{'admin_dir'}}) {
			push @fail, $DCONF->{'admin_dir'} if update_test_dir($DCONF->{'admin_dir'});
		}
	}
	return \@fail;	
}

###
### update_test_dir
###
### Actually test writability of a directory
###

sub update_test_dir {
	my $dirname = $_[0];
	my $tftest = 0;
	while (-e "$dirname/testfile.$tftest") {
		$tftest += int(rand(100));
	}
	if (open(FILE, "> $dirname/testfile.$tftest")) {
		close (FILE);
		if (unlink("$dirname/testfile.$tftest")) {
			return undef;
		} else {
			log_error('swupdate.pl', 'update_test_dir',"Could not remove a test file (testfile.$tftest): $!");
			return 1;
		}
	} else {
		log_error('swupdate.pl', 'update_test_dir',"Could not create a test file (testfile.$tftest): $!");
		return 1;
	}
}
	

###
### update_applicator
###
### Receive the final confirmation from the browser to apply an update
###

sub update_applicator {
	my ($FORMref, $result) = @_;
	my @files = ();
	my ($dir, $file) = validate_temp($FORMref->{'update'}, 1);
	my $x = update_action_prepare($dir);
	
	if ($FORMref->{'apply'} ne '') {
		my $t = update_test($x);
		if (ref $t eq 'ARRAY' && scalar @{$t} > 0) {
			my $subst = {};
			$subst->{'general'}->{'screen'} = 4;
			$subst->{'general'}->{'username'} = $result->[0]->{'user'};
			$subst->{'general'}->{'selected_update'} = $FORMref->{'update'};
			$subst->{'general'}->{'url'} = "$PARAMS->{'cgiurl'}?action=version_mgr&username=$result->[0]->{'user'}";
			$subst->{'general'}->{'menu'} = 1;
			my @d = map {{ dirname => $_ }} @{$t};
			$subst->{'dirs'} = \@d;
			screen_out('swupdate', $subst);
		}
		my $h = update_apply($file);
		my $subst = {};
		my @files = ();
		foreach my $key (sort { $a <=> $b } keys %{$h->{'hash'}}) {
			next if $key < 1;
			my %u = %{ $h->{'hash'}->{$key} };
			push @files, \%u;
		}
		$subst->{'ok'} = $h->{'ok'};
		$subst->{'fail'} = $h->{'fail'};
		$subst->{'general'}->{'menu'} = 1;
		$subst->{'general'}->{'username'} = $result->[0]->{'user'};
		$subst->{'general'}->{'screen'} = 3;
		$subst->{'general'}->{'selected_update_descr'} = $h->{'hash'}->{'0'}->{'description'};
		$subst->{'general'}->{'url'} = "$PARAMS->{'cgiurl'}?action=version_mgr&username=$result->[0]->{'user'}";
		$subst->{'general'}->{'files_fail'} = scalar keys %{$h->{'fail'}};
		$subst->{'details'} = $h->{'details'};
		screen_out('swupdate', $subst);
	} else {
		my $subst = {};
		$subst->{'general'}->{'menu'} = 1;
		$subst->{'general'}->{'username'} = $result->[0]->{'user'};
		$subst->{'general'}->{'screen'} = 1;
		$subst->{'general'}->{'selected_update_descr'} = $x->{'hash'}->{'0'}->{'description'};
		$subst->{'general'}->{'selected_update'} = $FORMref->{'update'};
		$subst->{'general'}->{'selected_update_time'} = $x->{'hash'}->{'0'}->{'time'};
		$subst->{'general'}->{'url'} = "$PARAMS->{'cgiurl'}?action=version_mgr&username=$result->[0]->{'user'}";
		$subst->{'files'} = swupdate_applicator_form_array($x);
		screen_out('swupdate', $subst);
	}
}

###
### update_chooser
###
### Choose which update you wish to apply.
###

sub update_chooser {
	my ($FORMref, $result) = @_;
	
	my @updates = ();
	my $tmpdir = ifdef($DCONF->{'tempdir'}, "$DCONF->{'admin_dir'}/data/temp");
	if (opendir(DIR, $tmpdir)) {
		while (my $dir = readdir(DIR)) {
			next if $dir !~ /^update(\w+)$/;
			if (-f "$tmpdir/$dir/control") {
				my %hash = ();
				$hash{'mtime'} = (stat "$tmpdir/$dir/control")[9];
				$hash{'update'} = $1;
				if (open (FILE, "< $tmpdir/$dir/control")) {
					while (my $x = <FILE>) {
						if ($x =~ m|^0:(\w+):(.*?)\s*$|) {
							$hash{$1} = $2;
						} else {
							last;
						}
					}
					close (FILE);				
				}				
				push @updates, \%hash;
			}
		}
	}	
	@updates = sort { $a->{'mtime'} <=> $b->{'mtime'} } @updates;
	my $subst = {};
	$subst->{'general'}->{'username'} = $result->[0]->{'user'};
	$subst->{'updates'} = \@updates;
	$subst->{'general'}->{'screen'} = 0;
	$subst->{'general'}->{'menu'} = 1;
	$subst->{'general'}->{'url'} = "$PARAMS->{'cgiurl'}?action=version_mgr&username=$result->[0]->{'user'}";
	screen_out('swupdate', $subst);
}


###
### update_action_prepare
###
### Parse a control file, get a list of directories to create, and so on
###

sub update_action_prepare {
	my $dir = $_[0];
	my $skip = ifdef($_[1], {});
	my %hash = ();
	my %ok = ();
	my %fail = ();
	error_message('update_action_prepare error', 'Temporary directory lacks control file', 0, 1) if ! -f "$dir/control";
	open (FILE, "< $dir/control") or error_message('update_action_prepare error', 'Could not read control file');
	while (<FILE>) {
		next if ! /^(\d+):(\w+):(.*?)\s*$/;
		$hash{$1}{$2} = $3;
	}
	close (FILE);
	my %dn = ( 'a' => $DCONF->{'admin_dir'}, 'h' => $DCONF->{'html_dir'}, 's' => $DCONF->{'script_dir'} );
K:	foreach my $key (keys %hash) {
		next if $key == 0;
		my $basedir = $hash{$key}{'basedir'};
		my $subdir = $hash{$key}{'subdir'};
		my $destdir = '';
		my $nicedir = '';
		if (! -f "$dir/$key.dat" && ! defined $hash{$key}{'delete'}) {
			log_error('swupdate.pl', 'update_action_prepare', "Source file $key.dat does not exist, file=$hash{$key}{'file'}");
			$fail{$key} = 1;
			next K;
		}
		if ($basedir eq '' || ! defined $dn{$basedir}) {
			log_error('swupdate.pl', 'update_action_prepare', "Base directory for $key.dat is invalid, file=$hash{$key}{'file'}");
			$fail{$key} = 1;
			next K;
		}
		if ($basedir eq 'h' && $subdir =~ m|^/icons/(.*)|) {
			$destdir = join("/", $DCONF->{'icon_dir'}, $1);
			$nicedir = join("/", 'icon_dir', $1);
		} elsif ($basedir eq 'h' && $subdir =~ m|^/messages/(.*)|) {
			$nicedir = join("/", 'message_dir', $1);
			$destdir = join("/", $DCONF->{'message_dir'}, $1);
		} elsif ($basedir eq 'h' && $subdir eq '/icons') {
			$destdir = $DCONF->{'icon_dir'};
			$nicedir = 'icon_dir';
		} elsif ($basedir eq 'h' && $subdir eq '/messages') {
			$destdir = $DCONF->{'message_dir'};
			$nicedir = 'message_dir';
		} elsif ($basedir eq 'a' && $hash{$key}{'pro_src'} == 1) {
			if ($DCONF->{'pro'} == 0 && $DCONF->{'pro_fileid'} == 0) {
				if (opendir(DIR, "$DCONF->{'admin_dir'}/source")) {
					while (my $dir = readdir(DIR)) {
						next if $dir !~ /^PRO_(\d+)$/;
						$DCONF->{'pro_fileid'} = $1;
						last;
					}
					closedir(DIR);
				}
				if ($DCONF->{'pro_fileid'} == 0) {
					srand(time);
					my $z = join("", int(rand(1000000)), $$, time); $z =~ s/\D//g;
					$DCONF->{'pro_fileid'} = $1 if $z =~ /^(\d+)$/;
				}
			}
			$destdir = join("/", $DCONF->{'admin_dir'}, 'source', "PRO_$DCONF->{'pro_fileid'}");
			$nicedir = 'admin_dir/source/PRO_xxxxx';
		} elsif ($basedir eq 's' && $subdir ne '') {
			log_error('swupdate.pl', 'update_apply', "Subdirectories of script directory are not supported (file=$hash{$key}{'file'})");
			$skip->{$hash{$key}{'file'}} = $hash{$key}{'md5sum'};
			next;
		} else {
			$destdir = join("", $dn{$basedir}, $subdir);
			$nicedir = join("", 'admin_dir', $subdir) if $basedir eq 'a';
			$nicedir = join("", 'html_dir', $subdir) if $basedir eq 'h';
			$nicedir = join("", 'script_dir', $subdir) if $basedir eq 'h';
		}
		if (defined $skip->{$hash{$key}{'file'}}) {
			if ($skip->{$hash{$key}{'file'}} eq $hash{$key}{'md5sum'}) {
				log_error('swupdate.pl', 'update_apply', "Skipped file $hash{$key}{'file'} as per user request");
				$hash{$key}{'force_skip'} = 1;
			} else {
				log_error('swupdate.pl', 'update_apply', "Bad MD5 checksum on $hash{$key}{'file'} in skip list... replacing file anyway");
				delete $skip->{$hash{$key}{'file'}};
				$hash{$key}{'force_skip'} = 0;
			}
		}
		$hash{$key}{'actual_dir'} = $destdir if ! defined $hash{$key}{'actual_dir'};
		$hash{$key}{'nice_dir'} = $nicedir if ! defined $hash{$key}{'nice_dir'};;
	}
	return { hash => \%hash, ok => \%ok, fail => \%fail, skip => \$skip };
}

###
### update_apply
###
### Apply a recently received update
###

sub update_apply {
	my ($dir) = validate_temp($_[0], 1);
	
	#
	# Pre-process the control file
	#
	
	my $h = update_action_prepare($dir, $_[1]);
	my %hash = %{ $h->{'hash'} };
	my %ok = %{ $h->{'ok'} };
	my %fail = %{ $h->{'fail'} };
	my $skip = $h->{'skip'};
	my $tm = ifdef($hash{'0'}{'time'}, time);
	my @details = ();
	
	#
	# Actually put the replaced files into place
	#

K:	foreach my $key (sort { $a <=> $b } keys %hash) {
		next if $key == 0;
		my $destdir = $hash{$key}{'actual_dir'};
		my $filename = join("/", $destdir, $hash{$key}{'file'});
		if (defined $hash{$key}{'delete'}) {
			if (-f $filename) {
				if (move($filename, "$dir/$hash{$key}{'file'}.$hash{$key}{'md5sum'}")) {
					$ok{$key} = 1;
					push @details, { ok => 2, error => '', dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
				} else {
					$fail{$key} = 1; my $err = $!;
					log_error('swupdate.pl', 'update_apply', "Move of $filename (old) -> $dir/$hash{$key}{'file'}.$hash{$key}{'md5sum'} failed: $err");
					push @details, { ok => 0, error => "Removal of file failed: $err", dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
				}
			}			
		} elsif (-f $filename) {
			if (move($filename, "$dir/$hash{$key}{'file'}.$hash{$key}{'md5sum'}")) {
				if (move("$dir/$key.dat", $filename)) {
					$ok{$key} = 1;
					utime $tm, $tm, $filename;
					my $perm = ifdef($DCONF->{"perms0$hash{$key}{'perms'}"}, $hash{$key}{'perms'}, 777);
					chmod oct($perm), $filename;
					push @details, { ok => 1, error => '', dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
				} else {
					$fail{$key} = 1; my $err = $!;
					log_error('swupdate.pl', 'update_apply', "Move of $key.dat -> $filename failed: $err");
					push @details, { ok => 0, error => "Replacement of file failed: $err", dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
				}
			} else {
				$fail{$key} = 1; my $err = $!;
				log_error('swupdate.pl', 'update_apply', "Move of $filename (old) -> $dir/$hash{$key}{'file'}.$hash{$key}{'md5sum'} failed: $err");
				push @details, { ok => 0, error => "Removal of file failed: $err", dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
			}				
		} else {
			my $d = dirname($filename);
			my @mkdir = ();
			while (! -d $d) {
				push @mkdir, $d;
				$d = dirname($d);
				if ($d eq $destdir || $d eq '/' || $d eq '') {
					log_error('swupdate.pl', 'update_apply', "Invalid directory path in $filename, skipping");
					$fail{$key} = 1;
					push @details, { ok => 0, error => "Invalid directory path", dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
					next K;
				}
			}
			foreach my $mkd (reverse @mkdir) {
				if (mkdir $mkd, oct(0)) {
					chmod oct($DCONF->{'perms0777'}), $mkd;
				} else {
					my $err = $!;
					log_error('swupdate.pl', 'update_apply', "Mailed to mkdir $mkd for $filename: $err");
					$fail{$key} = 1;
					push @details, { ok => 0, error => "Create directory $mkd failed: $err", dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
					next K;
				}
			}
			if (move("$dir/$key.dat", $filename)) {
				$ok{$key} = 1;
				utime $tm, $tm, $filename;
				my $perm = ifdef($DCONF->{"perms0$hash{$key}{'perms'}"}, $hash{$key}{'perms'}, 777);
				chmod oct($perm), $filename;
				push @details, { ok => 1, error => "", dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
			} else {
				$fail{$key} = 1; my $err = $!;
				log_error('swupdate.pl', 'update_apply', "Move of $key.dat -> $filename failed: $err");
				push @details, { ok => 0, error => "Replacement of file failed: $err", dir => $hash{$key}{'nice_dir'}, file => $hash{$key}{'file'} };
			}
		}		
	}
	
	if (scalar keys %fail == 0) {
		move("$dir/control", "$dir/control.done");
		if (defined $hash{'0'}{'install_license'}) {
			copy("$DCONF->{'admin_dir'}/discus.conf", "$dir/discus.conf");
			if (open(FILE, "< $dir/discus.conf")) {
				if (open (OUT, "> $dir/discus.conf.new")) {
					while (<FILE>) {
						next if /^pro=/;
						next if /^pro_license=/;
						print OUT $_;
					}
					print OUT "pro=1\n";
					print OUT "pro_license=$hash{'0'}{'install_license'}\n";
					close (OUT);
					if (unlink "$DCONF->{'admin_dir'}/discus.conf") {
						move("$dir/discus.conf.new", "$DCONF->{'admin_dir'}/discus.conf");
						chmod oct($DCONF->{'perms0666'}), "$DCONF->{'admin_dir'}/discus.conf";
					}
				}
			}			
		}
	}

	#
	# Report what happened in the appropriate format
	#
	
	return { ok => \%ok, fail => \%fail, skip => $skip, hash => \%hash, details => \@details };
}

###
### update_filestructure
###
### Compare the serial number of the existing board to the current version being installed,
### and if there are file structure updates to be performed, do them now
###

sub update_filestructure {
	
	
	
	
}

###
### update_receiver
###
### Receive the update file data from the DiscusWare website, or via the client browser.
###

sub update_receiver {
	my ($FORMref, $result, $background) = @_;
	my @file_in = grep { /^u(\d+)$/ } keys %{$FORMref};
	my ($tempdir, $dirfile) = create_temp("updateXXXXXXXX", 1);
	my $counter = 0;
	my $time = time;
	my @control = ();	
	push @control, "0:description:$1\n" if $FORMref->{'description'} =~ m|^\s*(.*?)\s*$|;
	push @control, "0:time:$time\n";
	push @control, "0:install_license:$1\n" if $FORMref->{'install_license'} =~ m|^(\d{4}-\d{4}-\d{4})$|;
	my @del = grep { /^d(\d+)$/ } keys %{$FORMref};
	foreach my $key (@del) {
		$counter += 1;
		my $filename = basename($FORMref->{$key});
		my $dirname = dirname($FORMref->{$key});
		my $bd = "";
		if ($dirname =~ m|^(\w+)(\/.*)|) {
			$dirname = $2;
			$bd = substr($1, 0, 1);
			$bd = 's' if $bd eq 'c';
		}
		push @control, "$counter:delete:1\n";
		push @control, "$counter:file:$filename\n";
		push @control, "$counter:subdir:$dirname\n";
		push @control, "$counter:basedir:$bd\n";
		push @control, "$counter:nice_dir:html_dir$dirname\n" if $bd eq 'h';
		push @control, "$counter:nice_dir:admin_dir$dirname\n" if $bd eq 'a';
		push @control, "$counter:nice_dir:script_dir$dirname\n" if $bd eq 's';
		push @control, "$counter:actual_dir:$DCONF->{'html_dir'}$dirname\n" if $bd eq 'h';
		push @control, "$counter:actual_dir:$DCONF->{'admin_dir'}$dirname\n" if $bd eq 'a';
		push @control, "$counter:actual_dir:$DCONF->{'script_dir'}$dirname\n" if $bd eq 's';
	}
	
	#
	# Receive the incoming control data
	#
	
	foreach my $file (@file_in) {
		$counter += 1;
		my @data;
		@data = update_decoder(swupdate_decode($FORMref->{$file})) if ! defined $FORMref->{'is_compressed'};
		@data = update_decoder(swupdate_decompress(swupdate_decode($FORMref->{$file}))) if defined $FORMref->{'is_compressed'};
		if ($background == 0) {
			error_message('update_receiver error', 'Did not receive valid header data in file', 0, 1) if ref $data[0]->{'header'} ne 'HASH';
		} else {
			update_background_writemsg(4);
		}
		my $header = $data[0]->{'header'};
		my $content = $data[0]->{'content'};
		if (open (FILE, "> $tempdir/$counter.dat")) {
			binmode(FILE);
			print FILE $content;
			close (FILE);
			if (open(FILE, "< $tempdir/$counter.dat")) {
				binmode(FILE);
				my $content2;
				while (<FILE>) {
					$content2 .= $_;
				}
				close (FILE);
				$content =~ s/[\r\n]//g;
				$content2 =~ s/[\r\n]//g;
				if ($content ne $content2) {
					if ($background == 0) {
						error_message('update_receiver error', join('', 'File ', $counter, '.dat was not correctly written to disk'));
					} else {
						update_background_writemsg(5, $header->{'filesize'},-s "$tempdir/$counter.dat");
					}
				}
			} else {
				if ($background == 0) {
					error_message('update_receiver error', join('', 'File ', $counter, '.dat was not readable from disk'));
				} else {
					update_background_writemsg(6,$!);
				}
			}
		} else {
			if ($background == 0) {
				error_message('update_receiver error', 'Failed to write to data file');
			} else {
				update_background_writemsg(6,$!);
			}
		}
		foreach my $key (keys %{$header}) {
			push @control, join("", $counter, ":", $key, ":", $header->{$key}, "\n");
		}
	}
	if (open (FILE, "> $tempdir/control")) {
		print FILE @control;
		close (FILE);
		if (-s "$tempdir/control" != length(join("", @control))) {
			my $content = join("", @control);
			my $content2;
			if (open(FILE, "< $tempdir/control")) {
				while (<FILE>) {
					$content2 .= $_;
				}
				close (FILE);
				$content =~ s/[\r\n]//g;
				$content2 =~ s/[\r\n]//g;
				if ($content ne $content2) {
					if ($background == 0) {
						error_message('update_receiver error', join('', 'File control was not correctly written to disk'));
					} else {
						update_background_writemsg(7,length(join("", @control)),-s "$tempdir/control");
					}
				}
			} else {
				if ($background == 0) {
					error_message('update_receiver error', join('', 'File control was not readable from disk'));
				} else {
					update_background_writemsg(8,$!);
				}
			}
		}
	} else {
		if ($background == 0) {
			error_message('update_receiver error', 'Failed to write control file');
		} else {
			update_background_writemsg(8,$!);
		}
	}
	
	update_background_writemsg(0) if $background == 1;
	
	#
	# Generate the output suitable for the browser
	#
	
	my $x = update_action_prepare($tempdir);
	my $subst = {};
	if ($tempdir =~ m|.*[\\/](update\w+)$|) {
		$subst->{'general'}->{'selected_update'} = $1;
	} else {
		log_error('swupdate.pl', 'update_receiver', "Failed to parse requested directory name ($tempdir)");
		error_message('update_receiver error', 'Failed to parse directory name', 0, 1);
	}
	if ($FORMref->{'toggle_version_warning'} == 1) {
		dreq('adm-opts');
		options_save({hide_version_manager_disclaimer => 1 });			
	}
	$subst->{'general'}->{'menu'} = 1;
	$subst->{'general'}->{'username'} = $result->[0]->{'user'};
	$subst->{'general'}->{'screen'} = 2;
	$subst->{'general'}->{'selected_update_descr'} = $x->{'hash'}->{'0'}->{'description'};
	$subst->{'general'}->{'selected_update_time'} = $x->{'hash'}->{'0'}->{'time'};
	$subst->{'files'} = swupdate_applicator_form_array($x);
	$subst->{'general'}->{'url'} = "$PARAMS->{'cgiurl'}?action=version_mgr&username=$result->[0]->{'user'}";
	screen_out('swupdate', $subst);
}

###
### update_decoder
###
### This is the format in which the updated files are supplied.  The specification for this
### format is as follows:
###
### Header section
###   Bytes 0 - 49: Name of file
###   Byte 50: Base directory within Discus (a=admin, h=html, s=script)
###   Byte 51: Does this go into (source/PRO_#####)? (1=yes, 0=no)
###   Bytes 52 - 99: Subdirectory structure where this file goes
###   Bytes 100 - 102: Permissions (octal format)
###   Bytes 103 - 110: Size of file (bytes)
###   Bytes 111 - 142: MD5 checksum of the file (hex format)
###   Byte 143: Overwrite flag - force overwrite (1=yes, 0=no)
###   Byte 144: No-overwrite flag - never overwrite (1=yes, 0=no)
###   Byte 145: Prompt flag - prompt user to overwrite (1=yes, 0=no)
###   Byte 146: Is a file with wide characters, use UTF-8 (1=yes, 0=no)
###   Bytes 147 - 400: Reserved for future use
###   Bytes 401 - 510: Description of file
###   Byte 511: Null character (\0)

sub update_decoder {
	my @data = ();
	my %header = ();
	my $content = "";
	while (my $input = shift @_) {
		while (length($input) > 0) {
			my $this = substr($input, 0, 512);
			substr($input, 0, 512) = "";
			if (! exists $header{'file'}) {
				error_message('update_decoder error', join('', 'No header information determined after ', scalar(@data), ' files'), 0, 1) if length($this) != 512;
				$header{'file'} = swupdate_nullremove(substr($this, 0, 50));
				$header{'basedir'} = swupdate_nullremove(substr($this, 50, 1));
				$header{'pro_src'} = swupdate_nullremove(substr($this, 51, 1));
				$header{'subdir'} = swupdate_nullremove(substr($this, 52, 48));
				$header{'perms'} = swupdate_nullremove(substr($this, 100, 3));
				$header{'filesize'} = swupdate_nullremove(substr($this, 103, 8));
				$header{'md5sum'} = swupdate_nullremove(substr($this, 111, 32));
				$header{'force_overwrite'} = swupdate_nullremove(substr($this, 143, 1));
				$header{'no_overwrite'} = swupdate_nullremove(substr($this, 144, 1));
				$header{'dont_overwrite'} = swupdate_nullremove(substr($this, 145, 1));
				$header{'utf8'} = swupdate_nullremove(substr($this, 146, 1));
				$header{'description'} = swupdate_nullremove(substr($this, 401, 110));
				$header{'nullbyte'} = swupdate_nullremove(substr($this, 511, 1));
				if (ord($header{'nullbyte'}) != 0) {
					error_message('update_decoder error', join('', 'Header for file ', $header{'file'}, ' was not complete'), 0, 1);
				}
			} else {
				if ($this =~ /$null+$/) {
					$content .= $`;
					$content =~ s/$null+$//o;
					if (length($content) != $header{'filesize'}) {
						error_message('update_decoder error', join('', 'File ', $header{'file'}, ' has the wrong size (expected=', $header{'filesize'}, ", actual=", length($content), ")"), 0, 1);
					}
					my $md5 = "";
					if ($header{'utf8'} == 1) {
						eval 'use Encode qw(encode_utf8)';
						$md5 = md5_hex(encode_utf8($content));
					} else {
						$md5 = md5_hex($content);
					}
					if ($md5 ne $header{'md5sum'}) {
						error_message('update_decoder error', join('', 'File ', $header{'file'}, ' has the wrong MD5 checksum'), 0, 1);
					}
					my %header_deref = %header;
					push @data, { header => \%header_deref, content => $content };
					%header = ();
					$content = "";
				} else {
					$content .= $this;
				}
			}
		}
	}
	return @data;
}

###
### swupdate_nullremove
###
### Remove null padding
###

sub swupdate_nullremove {
	my $inp = $_[0];
	$inp =~ s/$null//go;
	return $inp;
}

###
### swupdate_decompress
###
### Decompresses (using Compress::Zlib) incoming information
###

sub swupdate_decompress {
	my @output = ();
	eval 'use Compress::Zlib qw(uncompress)';
	error_message('swupdate_decompress error', "Compression not supported on this host, as there was a problem loading Compress::Zlib", 0, 1) if $@ ne '';
	while (my $data = shift @_) {
		push @output, uncompress($data);
	}
	return @output;
}

###
### swupdate_decode
###
### Decode (using MIME::Base64) incoming information
###

sub swupdate_decode {
	my @output = ();
	eval 'use MIME::Base64 qw(decode_base64)';
	return swupdate_decode_pp(@_) if $@ ne '';
	while (my $data = shift @_) {
		push @output, decode_base64($data);
	}
	return @output;
}

###
### swupdate_decode_pp
###
### Pure perl MIME Base64 parser.  This is based on the package
### MIME::Base64::Perl, modified to format error messages as Discus
### expects, and to handle multiple incoming arguments.  The following
### copyright notice appears on this package:
###
### Copyright 1995-1999, 2001-2004 Gisle Aas.
### 
### This library is free software; you can redistribute it and/or
### modify it under the same terms as Perl itself.
### 
### Distantly based on LWP::Base64 written by Martijn Koster
### <m.koster@nexor.co.uk> and Joerg Reichelt <j.reichelt@nexor.co.uk> and
### code posted to comp.lang.perl <3pd2lp$6gf@wsinti07.win.tue.nl> by Hans
### Mulder <hansm@wsinti07.win.tue.nl>
###

sub swupdate_decode_pp {
	my @output = ();
	while (my $str = shift) {
		$str =~ tr|A-Za-z0-9+=/||cd;
		if (length($str) % 4 != 0) { push @output, ''; next }
		$str =~ s/=+$//;
		$str =~ tr|A-Za-z0-9+/| -_|;
		if (length($str) == 0) { push @output, ''; next }
		my $uustr = '';
		my $l = length($str) - 60;
		my $i;
		for ($i = 0; $i <= $l; $i += 60) {
			$uustr .= "M" . substr($str, $i, 60);
		}
		$str = substr($str, $i);
		if ($str ne "") {
			$uustr .= chr(32 + length($str)*3/4) . $str;
		}
		push @output, unpack ("u", $uustr);
	}
	return @output;
}

###
### update_background_writemsg
###
### Write out a message appropriate for parsing by a background uploader
###

sub update_background_writemsg {
	header();
	print join(":", @_);
	program_exit(0);
}

1;