home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / adm-upd.pl < prev    next >
Text File  |  2009-11-06  |  14KB  |  450 lines
  1. # FILE: adm-upd.pl
  2. # DESCRIPTION: Automatic Update of your Discus Board
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### UPDATE_admin
  20. ###
  21. ### Controls all Update functions
  22. ###
  23.  
  24. sub UPDATE_admin {
  25.     my ($FORMref) = @_;
  26.     if ($FORMref->{action} eq "update_savepref") {
  27.         my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  28.         bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  29.         bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  30.         my $u = {};
  31.         $u->{auto_upgrade} = ($FORMref->{toggle} == 1 ? 1 : 0);
  32.         $u->{auto_upgrade_key} = ($FORMref->{auto_upgrade_key} eq "" ? "" : $FORMref->{auto_upgrade_key});
  33.         $u->{auto_upgrade_account} = ($FORMref->{auto_upgrade_account} eq "" ? "" : $FORMref->{auto_upgrade_account});
  34.         $u->{discusware_ip_address} = ($FORMref->{discusware_ip_address} eq "" ? "" : $FORMref->{discusware_ip_address});
  35.         dreq("adm-opts");
  36.         options_save($u);
  37.         hash_merge($GLOBAL_OPTIONS, $u, 1);
  38.         my $subst = {};
  39.         $subst->{general}->{username} = $result->[0]->{user};
  40.         $FORMref->{menu} = 3;
  41.         $subst->{general}->{screen} = 0;
  42.         dreq("adm-misc");
  43.         version_manager($FORMref, $subst, $result);
  44.     }
  45.     if ($FORMref->{action} eq "update_signup") {
  46.         my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  47.         bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  48.         bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  49.         undef my $subst;
  50.         $subst->{general}->{username} = $result->[0]->{user};
  51.         $subst->{general}->{screen} = 1;
  52.         if (! -d "$DCONF->{admin_dir}/data/updates") {
  53.             if (mkdir("$DCONF->{admin_dir}/data/updates", oct($DCONF->{perms0777}))) {
  54.                 chmod (oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/data/updates");
  55.                 $subst->{tests}->{t1} = "";
  56.             } else {
  57.                 $subst->{tests}->{t1} = "Error creating directory: $!";
  58.             }
  59.         } else {
  60.             $subst->{tests}->{t1} = "";
  61.         }
  62.         chmod (oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/data/updates");
  63.         ($subst->{tests}->{t2}, $subst->{tests}->{t3}) = update_test_dir("$DCONF->{admin_dir}/data/updates");
  64.         ($subst->{tests}->{t4}, $subst->{tests}->{t5}) = update_test_dir("$DCONF->{admin_dir}/source");
  65.         ($subst->{tests}->{t6}, $subst->{tests}->{t7}) = update_test_dir("$DCONF->{admin_dir}/source/$PARAMS->{pro_fileid}");
  66.         ($subst->{tests}->{t8}, $subst->{tests}->{t9}) = update_test_dir("$DCONF->{admin_dir}/template/admin");
  67.         ($subst->{tests}->{t10}, $subst->{tests}->{t11}) = update_test_dir("$DCONF->{admin_dir}/template/ui");
  68.         ($subst->{tests}->{t12}, $subst->{tests}->{t13}) = update_test_dir("$DCONF->{admin_dir}/template/pro");
  69.         ($subst->{tests}->{t14}, $subst->{tests}->{t15}) = update_test_dir("$DCONF->{admin_dir}/skins");
  70.         ($subst->{tests}->{t16}, $subst->{tests}->{t17}) = update_test_dir("$DCONF->{admin_dir}");
  71.         ($subst->{tests}->{t19}, $subst->{tests}->{t20}) = update_test_dir("$DCONF->{admin_dir}/template/mailmesg");
  72.         my $u = "";
  73.         foreach my $key (keys(%{ $subst->{tests} })) {
  74.             $u .= $subst->{tests}->{$key};
  75.         }
  76.         $subst->{general}->{ok} = ($u eq "" ? 1 : 0);
  77.         $subst->{general}->{menu} = 3;
  78.         $subst->{'general'}->{'username'} = $result->[0]->{'user'};
  79.         $subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=version_mgr&username=$result->[0]->{user}";
  80.         screen_out("version", $subst);
  81.     }
  82.     if ($FORMref->{action} eq "update_now") {
  83.         my $i = crypt($FORMref->{sk}, $GLOBAL_OPTIONS->{auto_upgrade_key});
  84.         update_die(2002) if $GLOBAL_OPTIONS->{auto_upgrade_key} ne $i;
  85.         update_die(2002) if $GLOBAL_OPTIONS->{discusware_ip_address} ne $ENV{REMOTE_ADDR};
  86.         update_die(2000) if $GLOBAL_OPTIONS->{auto_upgrade} == 0;
  87.         update_die(2003) if $GLOBAL_OPTIONS->{auto_upgrade_key} eq "";
  88.         update_die(2004) if ! $FORMref->{sa};
  89.         update_die(2006) if ($FORMref->{sa} eq "gv" && ! update_give_version_info());
  90.         my $checksum = calculate_key();
  91.         update_die(2018) if $FORMref->{key} ne $checksum;
  92.         update_die(2005) if ($FORMref->{sa} eq "ip" && ! update_set_trusted_ip($FORMref->{ip}));
  93.         if ($FORMref->{sa} eq "fi") {
  94.             my $x = update_receive_file($FORMref);
  95.             update_die(2006+$x) if $x >= 1;
  96.             my $filename = $FORMref->{filename}; $filename =~ s/[^\w\-\.]//g;
  97.             my $y = update_verify_file($filename);
  98.             update_die(2009+$y) if $y >= 1;
  99.             update_die(0);
  100.         }
  101.         if ($FORMref->{sa} eq "rf") {
  102.             my ($success, $failure) = update_replace_files();
  103.             update_die(0);
  104.         }
  105.         update_make_dir($FORMref) if $FORMref->{sa} eq "md";
  106.         update_remove_file($FORMref) if $FORMref->{sa} eq "rm";
  107.         update_remove_dir($FORMref) if $FORMref->{sa} eq "rd";
  108.     }
  109. }
  110.  
  111. ###
  112. ### update_set_trusted_ip
  113. ###
  114. ### Sets the entry for DiscusWare's IP address.  If we change servers, our
  115. ### old one will tell your server to update itself.
  116. ###
  117.  
  118. sub update_set_trusted_ip {
  119.     my ($ip_addr) = @_;
  120.     $ip_addr =~ s/[^\d\.]//g;
  121.     return 0 if $ip_addr !~ m|^(\d+)\.(\d+)\.(\d+)\.(\d+)$|;
  122.     dreq("adm-opts");
  123.     update_die(0) if options_save({ discusware_ip_address => $ip_addr });
  124.     return 0;
  125. }
  126.  
  127. ###
  128. ### update_die
  129. ###
  130. ### Kills update process with a status code
  131. ###
  132.  
  133. sub update_die {
  134.     my ($code) = @_;
  135.     header();
  136.     print $code;
  137.     program_exit(0);
  138. }
  139.  
  140. ###
  141. ### update_test_dir
  142. ###
  143. ### Tests a directory to be sure you can add, remove, and delete files there
  144. ###
  145.  
  146. sub update_test_dir {
  147.     my ($dir) = @_;
  148.     my $o = undef;
  149.     my $t = undef;
  150.     if (open(TEST, "> $dir/testfile")) {
  151.         print TEST "test\n";
  152.         close (TEST);
  153.         if (open(TEST, "< $dir/testfile")) {
  154.             my @test = <TEST>;
  155.             close (TEST);
  156.             chomp $test[0];
  157.             $o = 1 if $test[0] ne "test";
  158.         } else {
  159.             $o = 2;
  160.         }
  161.     } else {
  162.         $o = 3;
  163.     }
  164.     chmod(oct(0000), "$dir/testfile");
  165.     $t = $! if ! unlink "$dir/testfile";
  166.     return ($o, $t);
  167. }
  168.  
  169. ###
  170. ### calculate_key
  171. ###
  172. ### Key is used to ensure that your board has contacted DiscusWare server
  173. ###
  174.  
  175. sub calculate_key {
  176.     my $checksum = 0;
  177.     foreach my $key (keys %{$DCONF}) {
  178.         $checksum += unpack("%16C*", $DCONF->{$key});
  179.     }
  180.     return $checksum;    
  181. }
  182.  
  183.  
  184. ###
  185. ### update_give_version_info
  186. ###
  187. ### This gives your board's version information to DiscusWare's update agent.
  188. ###
  189.  
  190. sub update_give_version_info {
  191.     header();
  192.     my $checksum = calculate_key();
  193.     print <<EOF;
  194. serial=$PARAMS->{serial}
  195. pro_license=$DCONF->{pro_license}
  196. pro_fileid=$DCONF->{pro_fileid}
  197. language=$DCONF->{language}
  198. html_url=$DCONF->{html_url}
  199. account_number=$GLOBAL_OPTIONS->{auto_upgrade_account}
  200. feature_on=$GLOBAL_OPTIONS->{auto_upgrade}
  201. discusware_ip=$GLOBAL_OPTIONS->{discusware_ip_address}
  202. key=$checksum
  203. EOF
  204.     program_exit(0);
  205. }
  206.  
  207. ###
  208. ### update_remove_dir
  209. ###
  210. ### Removes a directory
  211. ###
  212.  
  213. sub update_remove_dir {
  214.     my ($FORMref) = @_;
  215.     my $dirname = $FORMref->{dirname};
  216.     $dirname =~ s%/PRO_##/%/PRO_$DCONF->{pro_fileid}/%;
  217.     $dirname =~ s/[^\/\.\w]//g;
  218.     $dirname =~ s/\.+/./g;
  219.     $dirname =~ s%^\./discus_admin/%$DCONF->{admin_dir}/%;
  220.     $dirname =~ s%^\./public_html/%$DCONF->{html_dir}/%;
  221.     $dirname =~ s%^\./cgi-bin/%$DCONF->{script_dir}/%;
  222.     update_die(2025) if ! -e $dirname;
  223.     update_die(2026) if -f $dirname;
  224.     if (opendir(DIR, $dirname)) {
  225.         my @dir = grep { ! /^\.+$/ } readdir(DIR);
  226.         closedir(DIR);
  227.         update_die(2027) if scalar @dir;
  228.     }
  229.     update_die(2028) if ! rmdir $dirname;
  230.     update_die(0);
  231. }
  232.  
  233.  
  234. ###
  235. ### update_remove_file
  236. ###
  237. ### Creates a directory
  238. ###
  239.  
  240. sub update_remove_file {
  241.     my ($FORMref) = @_;
  242.     my $filename = $FORMref->{filename};
  243.     $filename =~ s%/PRO_##/%/PRO_$DCONF->{pro_fileid}/%;
  244.     $filename =~ s/[^\/\.\w]//g;
  245.     $filename =~ s/\.+/./g;
  246.     $filename =~ s%^\./discus_admin/%$DCONF->{admin_dir}/%;
  247.     $filename =~ s%^\./public_html/%$DCONF->{html_dir}/%;
  248.     $filename =~ s%^\./cgi-bin/%$DCONF->{script_dir}/%;
  249.     update_die(2022) if ! -e $filename;
  250.     update_die(2023) if ! -f $filename;
  251.     update_die(2024) if ! unlink $filename;
  252.     update_die(0);
  253. }
  254.  
  255. ###
  256. ### update_make_dir
  257. ###
  258. ### Creates a directory
  259. ###
  260.  
  261. sub update_make_dir {
  262.     my ($FORMref) = @_;
  263.     my $dirname = $FORMref->{dirname};
  264.     $dirname =~ s%/PRO_##/%/PRO_$DCONF->{pro_fileid}/%;
  265.     $dirname =~ s/[^\/\.\w]//g;
  266.     $dirname =~ s/\.+/./g;
  267.     $dirname =~ s%^\./discus_admin/%$DCONF->{admin_dir}/%;
  268.     $dirname =~ s%^\./public_html/%$DCONF->{html_dir}/%;
  269.     $dirname =~ s%^\./cgi-bin/%$DCONF->{script_dir}/%;
  270.     if (! -e $dirname) {
  271.         my $k = mkdir($dirname, oct($DCONF->{perms0777}));
  272.         if (! $k) {
  273.             update_die(2020) if -f $dirname;
  274.             update_die(2021) if -d $dirname;
  275.             update_die(2019);
  276.         }
  277.         chmod(oct($DCONF->{perms0777}), $dirname);
  278.         update_die(0);
  279.     }
  280.     update_die(2020) if -f $dirname;
  281.     update_die(2021);
  282. }
  283.  
  284. ###
  285. ### update_replace_files
  286. ###
  287. ### Replaces files with those in your "updates" directory
  288. ###
  289.  
  290. sub update_replace_files {
  291.     my @success = ();
  292.     my @failure = ();
  293.     my $s = $PARAMS->{'serial'}; $s =~ s/\./_/g;
  294.     if (! -e "$DCONF->{admin_dir}/backups/$s") {
  295.         mkdir("$DCONF->{admin_dir}/backups/$s", oct($DCONF->{perms0777})) || update_die(2017); ## 2017
  296.         chmod(oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/backups/$s");
  297.     }
  298.     my $budir = "$DCONF->{admin_dir}/backups/$s";
  299.     opendir(DIR, "$DCONF->{admin_dir}/data/updates") || update_die(2016);            ## 2016
  300.     my @dir = grep { /\.prg$/ } readdir(DIR);
  301.     closedir(DIR);
  302.     foreach my $file (@dir) {
  303.         my $filename = $1 if $file =~ /(.*)\./;
  304.         my $p = {};
  305.         open (FILE, "< $DCONF->{admin_dir}/data/updates/$filename.dat");
  306.         while (<FILE>) {
  307.             chomp;
  308.             if (m|^(\w+)=(.*)|) {
  309.                 $p->{$1} = $2;
  310.             }
  311.         }
  312.         close (FILE);
  313.         my $destfile = $p->{destfile};
  314.         $destfile =~ m|^.*/(.*)|;
  315.         $p->{discus_filename} = $1 if ! $p->{discus_filename};
  316.         $destfile =~ s%^\./discus_admin/%$DCONF->{admin_dir}/%;
  317.         $destfile =~ s%/PRO_##/%/PRO_$DCONF->{pro_fileid}/%;
  318.         $destfile =~ s%^\./public_html/%$DCONF->{html_dir}/%;
  319.         next if $destfile =~ m%^\./cgi-bin/%;
  320.         if (open(FILE, "< $destfile")) {
  321.             binmode(FILE);
  322.             open (DEST, "> $budir/$p->{discus_filename}");
  323.             binmode(DEST);
  324.             while (<FILE>) {
  325.                 print DEST;
  326.             }
  327.             close (DEST);
  328.             close (FILE);
  329.         }
  330.         if (open(FILE, "< $DCONF->{admin_dir}/data/updates/$file")) {
  331.             binmode(FILE);
  332.             unlink $destfile;
  333.             if ($p->{converted} == 1) {
  334.                 my $content = "";
  335.                 while (my $data = <FILE>) {
  336.                     while (    $data =~ /^([0-9a-f][0-9a-f])/ ) {
  337.                         $data = $';
  338.                         $content .= pack("C", hex($1));
  339.                     }
  340.                 }
  341.                 if (open (DEST, "> $destfile")) {
  342.                     binmode(DEST);
  343.                     print DEST $content;
  344.                     close (DEST);
  345.                     unlink("$DCONF->{admin_dir}/data/updates/$file");
  346.                     unlink("$DCONF->{admin_dir}/data/updates/$filename.dat");
  347.                     chmod (oct($DCONF->{perms0666}), $destfile);
  348.                     push (@success, $filename);
  349.                 } else {
  350.                     push (@failure, { filename => $filename, reason => 1, text => $! });
  351.                 }
  352.             } else {    
  353.                 if (open(DEST, "> $destfile")) {
  354.                     binmode(DEST);
  355.                     while (<FILE>) {
  356.                         print DEST;
  357.                     }
  358.                     close (DEST);
  359.                     unlink("$DCONF->{admin_dir}/data/updates/$file");
  360.                     unlink("$DCONF->{admin_dir}/data/updates/$filename.dat");
  361.                     chmod (oct($DCONF->{perms0666}), $destfile);
  362.                     push (@success, $filename);
  363.                 } else {
  364.                     push (@failure, { filename => $filename, reason => 1, text => $! });
  365.                 }
  366.             }
  367.         } else {
  368.             push (@failure, { filename => $filename, reason => 0, text => $! });
  369.         }
  370.     }
  371.     return (\@success, \@failure);
  372. }
  373.  
  374. ###
  375. ### update_receive_file
  376. ###
  377. ### This receives a file and saves it to your "updates" directory
  378. ###
  379.  
  380. sub update_receive_file {
  381.     my ($FORMref) = @_;
  382.     my $filename = $FORMref->{filename}; $filename =~ s/[^\w\-\.]//g;
  383.     return 1 if $filename eq "";                                                    ## 2007
  384.     my $destfile = $FORMref->{destfile};
  385.     my $checksum = $FORMref->{checksum};
  386.     my $content = $FORMref->{content};
  387.     my $version = $FORMref->{version};
  388.     my $converted = 0 + $FORMref->{converted};
  389.     if (open(FILE, "> $DCONF->{admin_dir}/data/updates/$filename.prg")) {
  390.         binmode FILE;
  391.         print FILE $content;
  392.         close (FILE);
  393.     } else {
  394.         return 2;                                                                    ## 2008
  395.     }
  396.     if (open(FILE, "> $DCONF->{admin_dir}/data/updates/$filename.dat")) {
  397.         print FILE "destfile=$destfile\n";
  398.         print FILE "checksum=$checksum\n";
  399.         print FILE "version=$version\n";
  400.         print FILE "converted=$converted\n";
  401.         close (FILE);
  402.     } else {
  403.         return 3;                                                                    ## 2009
  404.     }
  405.     return 0;
  406. }
  407.  
  408. ###
  409. ### update_verify_file
  410. ###
  411. ### Makes sure that your file got here properly
  412. ###
  413.  
  414. sub update_verify_file {
  415.     my ($filename) = @_;
  416.     return 1 if ! -d "$DCONF->{admin_dir}/data/updates";                            ## 2010
  417.     return 2 if ! -e "$DCONF->{admin_dir}/data/updates/$filename.prg";                ## 2011
  418.     return 3 if ! -e "$DCONF->{admin_dir}/data/updates/$filename.dat";                ## 2012
  419.     open (FILE, "< $DCONF->{admin_dir}/data/updates/$filename.dat") || return 4;    ## 2013
  420.     my @file = <FILE>;
  421.     close (FILE);
  422.     undef my $p;
  423.     foreach my $x (@file) {
  424.         chomp $x;
  425.         if ($x =~ m|^(\w+)=(.*)|) {
  426.             $p->{$1} = $2;
  427.         }
  428.     }
  429.     open (FILE, "< $DCONF->{admin_dir}/data/updates/$filename.prg") || return 5;    ## 2014
  430.     close (FILE);
  431.     my $checksum = checksum("$DCONF->{admin_dir}/data/updates/$filename.prg");
  432.     return 6 if $checksum ne $p->{checksum};                                        ## 2015
  433.     return 0;
  434. }
  435.  
  436. ###
  437. ### checksum
  438. ###
  439. ### Calculates a checksum for a file
  440. ###
  441.  
  442. sub checksum {
  443.     my ($filename) = @_;
  444.     my $R = readfile_binary($filename);
  445.     return unpack("%16C*", $R);
  446. }
  447.  
  448. 1;
  449.  
  450.