home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / cgi-bin / discus4_00 / instsubs.pl < prev    next >
Perl Script  |  2009-11-06  |  7KB  |  257 lines
  1. #!/usr/bin/perl
  2.  
  3. my $discus_version = "4.00";
  4.  
  5. ###
  6. ### instsubs.pl - Subroutines to install Discus
  7. ###
  8.  
  9. if ($0 =~ /instsubs/) {
  10.     print "To install or upgrade Discus by telnet, use:\n";
  11.     print "   1st_install.pl -- first time installation\n";
  12.     print "   upgrade.pl     -- all subsequent upgrades\n";
  13.     print "\n";
  14.     print "This script, instsubs.pl, supports those scripts, but has\n";
  15.     print "no function when run by itself.\n\n";
  16.     my $foo = <STDIN>;
  17.     exit(0);
  18. }
  19.  
  20. my $interactive = 1;
  21.  
  22. ###
  23. ### install_discus
  24. ###
  25.  
  26. sub install_discus {
  27.     my ($upgrade, $d, $DC, $pathperl) = @_;
  28.     $DC->{language} = $DC->{language_chosen} if defined $DC->{language_chosen} && ! defined $DC->{language};
  29.     $DC->{language} =~ tr/A-Z/a-z/; $DC->{language} =~ s/\W//g;
  30.     my @filelist = ();
  31.     my $pro_fileid = "";
  32.     foreach my $k (keys %{$DC}) {
  33.         $DC->{$k} =~ s/\\/\//g if $k =~ /_dir$/;
  34.     }
  35.     if ($pathperl eq "") {
  36.         open (FILE, "< $DC->{script_dir}/board-admin.$DC->{cgi_extension}") || die "Open Error: Could not determine path to perl: $!\n";
  37.         my @file = <FILE>;
  38.         close (FILE);
  39.         $pathperl = $file[0];
  40.         $pathperl =~ s/^\s*#!\s*//;
  41.     }    
  42.     if (-e "$DC->{admin_dir}/source") {
  43.         opendir(DIR, "$DC->{admin_dir}/source");
  44.         my @dir = grep { /^PRO_/ } readdir(DIR);
  45.         closedir(DIR);
  46.         if ($dir[0] =~ /^PRO_(\d+)/) {
  47.             $pro_fileid = $1;
  48.         }        
  49.     }
  50.     if ($pro_fileid == 0) {
  51.         srand time;
  52.         $pro_fileid = "";
  53.         for (my $i = 1; $i <= 12; $i++) {
  54.             $pro_fileid .= int(rand(10));
  55.         }
  56.     }
  57.     if (open (FILELIST, "< ./source/filelist.txt")) {    
  58.         while (<FILELIST>) {
  59.             my ($perms, $filename, $flags) = split(/\s+/, $_);
  60.             my $is_dir = $perms =~ /^d/;
  61.             my $perm = "777";
  62.             $perm = "777" if $perms =~ /rwxrwxrwx$/;
  63.             $perm = "666" if $perms =~ /rw-rw-rw-$/;
  64.             $perm = "755" if $perms =~ /rwxr-xr-x$/;
  65.             $perm = "644" if $perms =~ /rw-r--r--$/;
  66.             $perm = $DC->{perms0666} if $perms =~ /rw-rw-rw-$/ && $DC->{perms0666};
  67.             $perm = $DC->{perms0777} if $perms =~ /rwxrwxrwx$/ && $DC->{perms0777};
  68.             $perm = $DC->{perms0755} if $perms =~ /rwxr-xr-x$/ && $DC->{perms0755};
  69.             $flags = $1 if $flags =~ /^\[(.*)\]$/;
  70.             $filename = join("", $`, "PRO_$pro_fileid", $') if $filename =~ /PRO_##/;
  71.             my $filepath = $filename;
  72.             $filepath =~ s%^\./discus_admin%$DC->{admin_dir}%g;
  73.             if ($DC->{icon_dir} ne "" && $DC->{icon_dir} ne "icons") {
  74.                 $filepath =~ s%^\./public_html/icons%$DC->{html_dir}/$DC->{icon_dir}%g;
  75.             }    
  76.             $filepath =~ s%^\./public_html%$DC->{html_dir}%g;
  77.             $filepath =~ s%^\./cgi-bin%$DC->{script_dir}%g;
  78.             $filepath =~ s%\.cgi$%.$DC->{cgi_extension}% if $DC->{cgi_extension} ne "cgi" && $flags =~ /C/;
  79.             chmod (oct($perm), $filepath);
  80.             next if $flags =~ /\*/ && -e $filepath && $upgrade;
  81.             next if $DC->{pro} == 0 && $flags =~ /\%/;
  82.             if (-e $filepath && $flags =~ /^(\d+)/) {
  83.                 $flags = $';
  84.                 if ($d->{$1} eq "0" || ($d->{$1} ne "1" && $flags =~ /N/)) {
  85.                     if ($flags =~ /<([\d\.]+)>/) {
  86.                         $flags = join("", $`, $');
  87.                         next if $DC->{version} >= $1;
  88.                     } else {
  89.                         next;
  90.                     }
  91.                 }
  92.             }
  93.             my $sourcefile = $' if $filename =~ /.*\//;
  94.             my $forcecode = "";
  95.             $forcecode = htaccess_source() if $flags =~ /~/;
  96.             $forcecode = nsconfig_source() if $flags =~ /`/;
  97.             $forcecode = "#\n" if $flags =~ /\*/ && $flags !~ /O/;
  98.             $forcecode = "\n" if $flags =~ /X/;
  99.             $forcecode = passwd_source($DC) if $flags =~ /P/;
  100.             push @filelist, {
  101.                 filename => $sourcefile,
  102.                 destfile => $filepath,
  103.                 is_dir => $is_dir,
  104.                 perm => $perm,
  105.                 forcecode => $forcecode,
  106.                 flags => $flags,
  107.             };
  108.         }
  109.     } else {
  110.         print "Error: could not open file list: $!\n";
  111.         exit(0);
  112.     }
  113.     process_entry($pathperl, $DC, @filelist);
  114.     $DC->{version} = $discus_version;
  115.     open (DCONF, "> $DC->{admin_dir}/discus.conf");
  116.     open (DCONF_LOCAL, "> ./discus.conf");
  117.     foreach my $k (keys %{$DC}) {
  118.         print DCONF "$k=$DC->{$k}\n";
  119.         print DCONF_LOCAL "$k=$DC->{$k}\n";
  120.     }
  121.     close (DCONF);    
  122.     close (DCONF_LOCAL);    
  123.     chmod (oct(777), "$DC->{admin_dir}/discus.conf");
  124.     open (FILE, ">> install.txt");
  125.     print FILE "Upgrade of $DC->{html_url} at ", scalar(localtime(time)), "\n" if $upgrade;
  126.     print FILE "Install of $DC->{html_url} at ", scalar(localtime(time)), "\n" if ! $upgrade;
  127.     close (FILE);
  128. }
  129.  
  130. ###
  131. ### process_entry
  132. ###
  133.  
  134. sub process_entry {
  135.     my $pathperl = shift;
  136.     my $DC = shift;
  137.     while (my $entry = shift) {
  138.         if ($entry->{is_dir}) {
  139.             next if -d $entry->{destfile};
  140.             if (-f $entry->{destfile}) {    
  141.                 if ($interactive) {
  142.                     print "$entry->{destfile} is a file -- should be a directory\n";
  143.                     print "Delete file to create directory?  (y/n): ";
  144.                     my $ch1 = <STDIN>;
  145.                     exit(0) if $ch1 =~ /^n/i;                    
  146.                 }
  147.                 unlink $entry->{destfile};
  148.             }    
  149.             mkdir($entry->{destfile}, oct($entry->{perm})) || die "Directory creation error for $entry->{destfile}: $!";
  150.             chmod(oct($entry->{perm}), $entry->{destfile});
  151.         } else {
  152.             next if $entry->{filename} eq "";
  153.             $entry->{filename} = "index.html" if $entry->{flags} =~ /i/;
  154.             if ($entry->{forcecode} ne "") {
  155.                 open (FILE, "> $entry->{destfile}") || die "File write error for $entry->{destfile}: $!";
  156.                 print FILE $entry->{forcecode};
  157.                 close (FILE);
  158.                 chmod (oct($entry->{perm}), $entry->{destfile});
  159.             } else {
  160.                 open (FILE, "> $entry->{destfile}") || die "File write error for $entry->{destfile}: $!";
  161.                 binmode FILE;
  162.                 my @src = ();
  163.                 if (open (SRC, "< ./source/languages/$DC->{language}/$entry->{filename}")) {
  164.                     binmode SRC;
  165.                     @src = <SRC>;
  166.                     close (SRC);
  167.                 } elsif (open (SRC, "< ./source/$entry->{filename}")) {
  168.                     binmode SRC;
  169.                     @src = <SRC>;
  170.                     close (SRC);
  171.                 } else {
  172.                     die "File read error for $entry->{filename}: $!";
  173.                 }
  174.                 print FILE "#!$pathperl\n" if $entry->{flags} =~ /C/;
  175.                 foreach $_ (@src) {
  176.                     if ($entry->{flags} =~ /H/) {
  177.                         s/\$html_url/$DC->{html_url}/g;
  178.                         s/\$script_url/$DC->{script_url}/g;
  179.                         s/\$cgi_extension/$DC->{cgi_extension}/g;
  180.                         s%<!--TITLE-->(.*?)<!--/TITLE-->%<!--TITLE--><TITLE>$DC->{title}</TITLE><!--/TITLE-->%g;
  181.                         s%<!--\*-->(.*?)<!--/\*-->%<!--\*-->$DC->{title}<!--/\*-->%g;
  182.                     } elsif ($entry->{flags} =~ /C/) {
  183.                         s/my \$DISCUS_CONF_DEFINITION = '(.*?)';/my \$DISCUS_CONF_DEFINITION = '$DC->{admin_dir}\/discus.conf';/g;
  184.                         s/\$DCONF->\{script_dir\} = ".*?";/\$DCONF->\{script_dir\} = "$DC->{script_dir}";/g;
  185.                     }
  186.                     print FILE $_;
  187.                 }
  188.                 close (FILE);
  189.                 chmod (oct($entry->{perm}), $entry->{destfile});
  190.             }
  191.         }        
  192.     }    
  193. }
  194.  
  195. ###
  196. ### htaccess_source
  197. ###
  198.  
  199. sub htaccess_source {
  200.     return "Order deny,allow\nDeny from all\nAllow from none\n";
  201. }
  202.  
  203. ###
  204. ### nsconfig_source
  205. ###
  206.  
  207. sub nsconfig_source {
  208.     return "<FILES *>\nRestrictAccess type=deny ip=*\n</FILES>\n";
  209. }
  210.  
  211. ###
  212. ### passwd_source
  213. ###
  214.  
  215. sub passwd_source {
  216.     my $DC = shift;
  217.     return "$DC->{superuser}::email:fullname:1::" . time . ":0:0:/\n";
  218. }
  219.  
  220. ###
  221. ### upgrade_or_not
  222. ###
  223.  
  224. sub upgrade_or_not {
  225.     my $z = shift;
  226.     print substr(join("", $z, " " x 60), 0, 60);
  227.     if ($_[0] eq "y") {
  228.         print "[Y/n]: ";
  229.     } else {
  230.         print "[y/N]: ";
  231.     }
  232.     my $uon = <STDIN>;
  233.     return 1 if $uon =~ /^y/i;
  234.     return 0 if $uon =~ /^n/i;
  235.     return 1 if $_[0] eq "y";
  236.     return 0;
  237. }
  238.  
  239. ###
  240. ### read_discus_conf
  241. ###
  242.  
  243. sub read_discus_conf {
  244.     my $file = -f $_[0] ? $_[0]    : "./discus.conf";
  245.     open (FILE, "< $file") || die "Could not open discus.conf at [$file]: $!";
  246.     my $dc = {};
  247.     while (<FILE>) {
  248.         if (/^(\w+)=(.*?)\s*$/) {
  249.             $dc->{$1} = $2;
  250.         }
  251.     }
  252.     close (FILE);
  253.     return $dc;    
  254. }
  255.     
  256. 1;
  257.