home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
adm-upd.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
14KB
|
450 lines
# 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;