home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / cgi-bin / discus4_00 / 1st_install.pl next >
Perl Script  |  2009-11-06  |  14KB  |  434 lines
  1. #!/usr/bin/perl
  2.  
  3. my $discus_version = "4.00";
  4. my $pro_version = -e "./source/fcn-prfl.pl";
  5.  
  6. # FIRST-TIME SETUP SCRIPT FOR DISCUS ON UNIX or WINDOWS PLATFORMS
  7. # Copyright (c) 1998-2002, DiscusWare, LLC, all rights reserved.
  8. # This script may not be redistributed or used except as provided
  9. # in the Discus license agreement.
  10.  
  11. my $platform = "";
  12. my $unix = 0; my $windows = 0;        # Comment this line to disable auto-detect
  13. #my $unix = 1; my $windows = 0;        # Uncomment this line if you have unix
  14. #my $windows = 1; my $unix = 0;        # Uncomment this line if you have Windows
  15.  
  16. if ($unix == 0 && $windows == 0) {
  17.     if ($^O eq "MSWin32") {
  18.         $windows = 1;
  19.         $platform = "WINDOWS";
  20.     } elsif (-e "/etc/passwd") {
  21.         $unix = 1;
  22.         $platform = "UNIX";
  23.     } else {
  24.         $unix = 1;
  25.         $platform = "UNKNOWN PLATFORM";
  26.     }
  27. }
  28. my $q = quotemeta(sprintf("%02d.%02d", $discus_version));
  29.  
  30. # ---------------------------------------------------------------------------------
  31.  
  32. if ($unix) {
  33.     $SIG{'CONT'} = 'continuation_handler';
  34. }
  35.  
  36. sub continuation_handler {
  37.     print "\n" x 25;
  38.     print "Congratulations, you have successfully reactivated this script\n";
  39.     print "with the 'fg' command.\n\n";
  40.     if (-s "./discus.conf" <= 1) {
  41.         print "If you have not already done so, access the 'dconfig' script in\n";
  42.         print "your web browser.  Fill out the form as instructed.\n\n";
  43.     }
  44.     print "Press ENTER to continue...\n\n";    
  45. }
  46.  
  47. my $passes = 0;
  48. my $path_perl = "";
  49.  
  50. while (1) {
  51.     $passes++;
  52.  
  53.     opendir(DIR, ".");
  54.     my @dir = grep { /^dconfig\./ } readdir(DIR);
  55.     closedir(DIR);
  56.     if (-e "./discus.conf" && -s "./discus.conf" > 0 && ! -e "install.txt" && scalar @dir) {
  57.         print "\n\n";
  58.         print "-" x 60, "\n";
  59.         print "DISCUS.CONF FILE DETECTED\n\n";
  60.         print "Setup has detected that you have created a discus.conf file\n";
  61.         print "for this installation.  Do you want to use this discus.conf\n";
  62.         print "data to install your board at this time?\n\n";
  63.         print "Your answer (y/n):  ";
  64.         my $yn5 = <STDIN>;
  65.         if ($yn5 =~ /^y/i) {
  66.             if ($path_perl eq "") {
  67.                 open (FTPDIAG, "./$dir[0]");
  68.                 my @dconfig = <FTPDIAG>;
  69.                 close (FTPDIAG);
  70.                 $path_perl = $dconfig[0];
  71.                 $path_perl =~ s/\s+$//;
  72.                 $path_perl =~ s/^#!//;
  73.             }
  74.             require "./instsubs.pl";
  75.             my $DC = read_discus_conf();
  76.             install_discus(0, undef, $DC, $path_perl);
  77.             install_complete($DC);
  78.             last;
  79.         }
  80.     }
  81.     
  82.     unlink "./install.txt";
  83.     open (FILE, "> ./discus.conf"); close (FILE);
  84.     chmod(oct(666), "./discus.conf");
  85.  
  86.     if (scalar @dir) {
  87.         print "\n\n";
  88.         print "-" x 60, "\n";
  89.         print "PASTE IN DISCUS.CONF FILE\n\n";
  90.         print "Setup has detected that you may have just recently generated a\n";
  91.         print "discus.conf file with the on-line setup form.  Do you want to\n";
  92.         print "paste in discus.conf data now?\n\n";
  93.         print "Your answer (y/n):  ";
  94.         my $yn4 = <STDIN>;
  95.         if ($yn4 =~ /^y/i) {
  96.             print "\nUsing the paste function of your telnet client or this window,\n";
  97.             print "paste in the discus.conf data that you copied from your web\n";
  98.             print "browser.  If setup does not automatically continue after doing this,\n";
  99.             print "hit the ENTER key.\n\n";
  100.             print "Paste in discus.conf data now...\n";
  101.             my @dcd = ();
  102.             while (my $x = <STDIN>) {
  103.                 push @dcd, $x if $x =~ /^\w+=/;
  104.                 last if $x !~ /\S/ || $x =~ /^contact=/;
  105.             }
  106.             open (DISCUS, "> discus.conf");
  107.             print DISCUS map { chomp $_; join("", $_, "\n") } @dcd;
  108.             close (DISCUS);
  109.             my %dc = undef;
  110.             foreach my $line (@dcd) {
  111.                 $dc{$1} = $2 if $line =~ /^(\w+)=(.*?)\s*$/;
  112.             }
  113.             print "\n" x 25;
  114.             print "-" x 60, "\n";
  115.             print "Congratulations!  Your discus.conf file has been generated.  Please\n";
  116.             print "wait while I finish setting up your Discus board...\n\n";
  117.             if ($path_perl eq "") {
  118.                 open (FTPDIAG, "./$dir[0]");
  119.                 my @dconfig = <FTPDIAG>;
  120.                 close (FTPDIAG);
  121.                 $path_perl = $dconfig[0];
  122.                 $path_perl =~ s/\s+$//;
  123.                 $path_perl =~ s/^#!//;
  124.             }
  125.             require "./instsubs.pl";
  126.             install_discus(0, undef, \%dc, $path_perl);
  127.             install_complete(\%dc);
  128.             last;
  129.         }
  130.     }
  131.     
  132.     if ($passes >= 2) {
  133.         print "\n" x 25;
  134.         print "-" x 60, "\n";
  135.         print "DISCUS SETUP - LOOP WARNING\n\n";
  136.         print "Setup has detected that you have generated your discus.conf file,\n";
  137.         print "but you have chosen not to install the software using this data.\n";
  138.         print "\n";
  139.         print "Please choose from among the following choices:\n\n";
  140.         print "1) Generate a new dconfig.cgi file by answering the normal questions\n";
  141.         print "   (path to Perl, CGI extension, etc.)\n\n";
  142.         print "2) Ask you again if you would like to use your discus.conf data to\n";
  143.         print "   install Discus.\n\n";
  144.         print "3) Exit setup\n\n";
  145.         print "Your choice (1-3):  ";
  146.         my $ync = <STDIN>;
  147.         last if $ync < 1 || $ync > 2;
  148.         next if $ync == 2;
  149.     }
  150.  
  151.     print "\n" x 25;
  152.     print "-" x 60, "\n";
  153.     print "WELCOME TO DISCUS $discus_version ";
  154.     print "PRO " if $pro_version;
  155.     print "SETUP FOR $platform\n\n";
  156.     print "\n\n";
  157.     print "Please wait while I check your distribution...\n";
  158.     print " - Checking [source] directory: ";
  159.     if (! -d "./source") {
  160.         print "{failed}\n";
  161.         print "\nBe sure that you have followed the setup instructions\n";
  162.         print "completely, including the ones to 'cd' to the discus4_00\n";
  163.         print "subdirectory, and to preserve subdirectory structure when\n";
  164.         print "extracting the distribution archive.\n\n";
  165.         press_key();
  166.         exit(0);
  167.     }
  168.     print "{passed}\n";
  169.     print " - Checking [common.pl] file: ";
  170.     if (! open(FILE, "< ./source/common.pl")) {
  171.         print "{failed} $!\n";
  172.         print "\nBe sure that you have followed the setup instructions\n";
  173.         print "completely, including the ones to 'cd' to the discus4_00\n";
  174.         print "subdirectory, and to preserve subdirectory structure when\n";
  175.         print "extracting the distribution archive.\n\n";
  176.         press_key();
  177.         exit(0);
  178.     }
  179.     my @c = <FILE>;
  180.     close (FILE);
  181.     print "{passed}\n";
  182.     print " - Checking serial number: ";
  183.     my @ps = grep(/^\s*\$PARAMS->\{'serial'\}/, @c);
  184.     my $serial = "";
  185. IL:    foreach my $i (@ps) {
  186.         if ($i =~ m|"\.$q\.(\d+)"|) {
  187.             $serial = $1;
  188.             last IL;
  189.         }
  190.     }
  191.     if ($serial eq "") {
  192.         print "{failed}\n";
  193.         press_key();
  194.         exit(0);
  195.     }
  196.     print "{passed}\n";
  197.     press_key();
  198.  
  199.     print "\n" x 25;
  200.     print "-" x 60, "\n";
  201.     print "IMPORTANT INSTALLATION NOTICE\n\n";
  202.     print "This script is used only to install Discus for the FIRST TIME\n";
  203.     print "on a server.  This script MUST NOT be used to upgrade an existing\n";
  204.     print "Discus board.\n\n";
  205.     print "Please confirm that you wish to perform a FIRST TIME INSTALLATION\n";
  206.     print "on this server by typing 'Y' here and pressing ENTER:\n\n";
  207.     print "  Proceed with FIRST TIME INSTALLATION? (Y/N):  ";
  208.     my $yn1 = <STDIN>;
  209.     exit(0) if $yn1 !~ /^y/i;
  210.  
  211.     my $pro_license = "";
  212.     if ($pro_version == 1) {
  213.         print "\n" x 25;
  214.         print "-" x 60, "\n";
  215.         print "DISCUS PRO LICENSE NUMBER\n\n";
  216.         print "You have chosen to install Discus Pro.  Please enter your Discus\n";
  217.         print "Pro license number here:\n\n";
  218.         until ($pro_license =~ /^(\d)(\d)(\d)(\d)\-(\d)(\d)(\d)(\d)\-(\d)(\d)(\d)(\d)$/ && ($1 + $5) % 10 == $9 && ($2 + $6) % 10 == $10 &&($3 + $7) % 10 == $11 &&($4 + $8) % 10 == $12) {
  219.             print "  Discus Pro License Number:  ";
  220.             $pro_license = <STDIN>;
  221.             $pro_license =~ s/[^\d\-]//g;
  222.             exit(0) if $pro_license eq "";
  223.         }
  224.     }    
  225.  
  226.     print "\n" x 25;
  227.     print "-" x 60, "\n";
  228.     print "CHOOSE PATH TO PERL\n\n";
  229.     print "This screen allows you to enter the path to Perl.  Discus 4.0 requires\n";
  230.     print "Perl 5.005 or higher.\n\n";
  231.     if ($] >= 5.005 && -f $^X && -x $^X) {
  232.         print "The Perl interpreter used to execute this script can be found\n";
  233.         print "at $^X.  Unless you know a very good reason not\n";
  234.         print "to do so, you should use this Perl interpreter.\n\n";
  235.         print "Use $^X?  (Y/n):  ";
  236.         my $yn2 = <STDIN>;
  237.         $path_perl = $^X if $yn2 !~ /^n/i;
  238.     }
  239.     my $perl = {};
  240. PP:    while ($path_perl eq "") {
  241.         if ($unix) {
  242.             my $whereis = `whereis perl`;
  243.             if ($whereis =~ m|perl: (.*)|) {
  244.                 my @perls = split(/\s+/, $1);
  245.                 foreach my $perl_s (@perls) {
  246.                     my $tp = test_perl($perl_s);
  247.                     $perl->{$perl_s} = $tp if $tp >= 5;
  248.                 }
  249.             }    
  250.             my $which = `which perl`; chomp $which;
  251.             if ($which =~ m|perl|) {
  252.                 my $tp = test_perl($which);
  253.                 $perl->{$which} = $tp if $tp >= 5;
  254.             }
  255.             my $tries = "/usr/bin/perl /usr/bin/perl5 /usr/local/bin/perl /usr/local/bin/perl5 /usr/sbin/perl /usr/local/sbin/perl /usr/contrib/bin/perl";    
  256.             foreach my $try (split(/\s/, $tries)) {
  257.                 my $tp = test_perl($try);
  258.                 $perl->{$try} = $tp if $tp >= 5;
  259.             }
  260.         }
  261.         if (keys %{$perl}) {
  262.             print "\nThe following Perl interpreters were located on your system.\n";
  263.             print "Choose one of these interpreters, or just hit ENTER to type in\n";
  264.             print "the path manually.\n\n";
  265.             print "##  Path to Perl                                Version\n";
  266.             print "--  ------------------------------------------- -------\n";
  267.             my $i = 0;
  268.             my @pl = ();
  269.             foreach my $k (keys %{$perl}) {
  270.                 printf "%2d", ++$i;
  271.                 print "  ";
  272.                 print substr(join("", $k, " " x 60), 0, 43);
  273.                 print " ";
  274.                 print substr($perl->{$k}, 0, 7), "\n";
  275.                 push @pl, $k;
  276.             }
  277.             print "    (Just hit ENTER to choose your own path)\n";
  278.             print "\nPath to Perl choice:  ";
  279.             my $ppc = <STDIN>; chomp $ppc;
  280.             if ($ppc >= 1 && $ppc <= scalar(@pl)) {
  281.                 $path_perl = $pl[$ppc-1];
  282.             }
  283.             $perl = {};    
  284.         }
  285.         if ($path_perl eq "") {
  286.             print "\nEnter full path to Perl:  ";
  287.             my $fpp = <STDIN>; chomp $fpp;
  288.             if (! -f $fpp || ! -x $fpp) {
  289.                 print "\nWARNING: That path to Perl does not appear to be valid.\n";
  290.                 print "Press Y to accept this path anyway, or any other key to try again:  ";
  291.                 my $yn3 = <STDIN>;
  292.                 next PP if $yn3 !~ /^y/i;
  293.                 $path_perl = $fpp;
  294.             }
  295.         }
  296.     }
  297.  
  298.     my $cgi_extension = "";
  299.     print "\n" x 25;
  300.     print "-" x 60, "\n";
  301.     print "CHOOSE YOUR CGI EXTENSION\n\n";
  302.     print "Here, you need to enter the extension that will cause your server\n";
  303.     print "to execute files as CGI scripts.  Generally this is .cgi, but sometimes\n";
  304.     print "it is .pl.  Rarely is it something else.\n\n";
  305.     print "##  Extension\n";
  306.     print "--  ---------\n";
  307.     print " 1  .cgi\n";
  308.     print " 2  .pl\n";
  309.     print "    (Just hit ENTER to choose your own extension)\n\n";
  310.     print "\nCGI extension choice:  ";
  311.     my $cgc = <STDIN>; chomp $cgc;
  312.     $cgi_extension = $cgc; $cgi_extension =~ s/\W//g;
  313.     $cgi_extension = 'cgi' if $cgc == 1;
  314.     $cgi_extension = 'pl' if $cgc == 2;
  315.     exit(0) if $cgc !~ /\S/;
  316.  
  317.     my $dconfig_name = "dconfig.$cgi_extension";
  318.     if (open (FILE, "./source/dconfig.txt")) {
  319.         my $pwd = eval '
  320.             use Cwd;
  321.                my $dir = cwd;
  322.             $dir;
  323.         ';
  324.         open (FTPDIAG, "> ./$dconfig_name");
  325.         print FTPDIAG "#!$path_perl\n";
  326.         while (<FILE>) {
  327.             if (/^my \$pro_license/) {
  328.                 print FTPDIAG "my \$pro_license = '$pro_license';\n";
  329.             } elsif (/^my \$language_list/ && -e "./source/languages") {
  330.                 opendir(DIR, "./source/languages");
  331.                 my @lang = grep { /^\w+$/ } readdir(DIR);
  332.                 closedir(DIR);
  333.                 my @ll = map { join("", "<option value=$_>", "\u$_", "</option>") } @lang;
  334.                 my $str = join("", @ll);
  335.                 print FTPDIAG "my \$language_list = '$str';\n";
  336.             } elsif (/^my \$get_discus_pro/ && $pro_version) {
  337.                 print FTPDIAG "my \$get_discus_pro = 1;\n";
  338.             } elsif (/^my \$discusware_url/) {
  339.                 print FTPDIAG "my \$discusware_url = \"$dconfig_name\";\n";
  340.             } elsif (/^(\s*)my \$discus_conf_generate_dir/) {
  341.                 print FTPDIAG "$1my \$discus_conf_generate_dir = '$pwd';\n";
  342.             } else {
  343.                 print FTPDIAG $_;
  344.             }
  345.         }
  346.         close (FILE);
  347.         close (FTPDIAG);
  348.         chmod (oct(755), "./$dconfig_name");
  349.     } else {
  350.         print "ERROR: Could not open dconfig.txt\n";
  351.         exit(0);
  352.     }
  353.     print "\n" x 25;
  354.     print "-" x 60, "\n";
  355.     print "INTERACTIVE SETUP FORM INSTRUCTIONS\n\n";
  356.     print "This script has generated a file named 'dconfig.$cgi_extension' in this\n";
  357.     print "directory.\n\n";
  358.     print "1) Copy this file to a directory on your server where CGI scripts can\n";
  359.     print "   be executed (generally 'cgi-bin').\n\n";
  360.     if ($unix) {
  361.         print "   On most unix systems, you can press CTRL-Z now to return to the\n";
  362.         print "   command prompt.  Then use the 'cp' command as in this example:\n";
  363.         print "      cp -p $dconfig_name /path/to/your/cgi-bin\n\n";
  364.         print "   When the file has been copied, type 'fg' to return to the script.\n";
  365.         print "   Press ENTER to continue with setup.\n\n";
  366.     } else {
  367.         print "   You can use Windows explorer to copy the $dconfig_name file.  Then\n";
  368.         print "   paste (copy) the file to your server's CGI directory (usually called\n";
  369.         print "   'cgi-bin' or 'scripts').\n\n";
  370.     }    
  371.     print "2) Access the dconfig script in your web browser by typing in the URL into\n";
  372.     print "   the browser's location bar (e.g., http://your.server.com/cgi-bin/dconfig.$cgi_extension).\n\n";
  373.     print "3) Fill out the form, answering all questions that are presented.  This\n";
  374.     print "   allows you to customize your installation of Discus using your browser.\n\n";
  375.     print "4) If needed, press ENTER to receive further instructions.\n\n";
  376.     press_key(1);
  377. }
  378.  
  379. exit(0);
  380.  
  381.  
  382. ###################################################################
  383. # Miscellaneous Subroutines
  384.  
  385. sub press_key {
  386.     if ($_[0] == 0) {
  387.         print "\n";
  388.         print "-" x 60, "\n";
  389.         print "   Please press ENTER to continue with setup\n";
  390.         print "-" x 60, "\n";
  391.     }
  392.     my $f = <STDIN>;
  393.     print "\n";
  394. }
  395.  
  396. sub test_perl {
  397.     my ($perlin) = @_;
  398.     return 0 if ! $unix;
  399.     return 0 if $perl->{$perlin};
  400.     my $cmd = "$perlin -e 'print \"pv:$]\";'";
  401.     if (-x $perlin) {
  402.         my $result = `$cmd`; chomp $result;
  403.         return $' if $result =~ /^pv:/;
  404.     }
  405.     return 0;
  406. }
  407.  
  408. sub divider {
  409.     print "\n" x 20;
  410.     print ">", "=" x 58, "<", "\n";
  411.     print "\n";
  412. }
  413.  
  414. sub install_complete {
  415.     my ($DC) = @_;
  416.     print "\n" x 25;
  417.     print "-" x 60, "\n";
  418.     print "DISCUS INSTALLATION -- COMPLETE\n\n";
  419.     print "Congratulations!  Your discussion board has been successfully\n";
  420.     print "installed.  To begin using your board, please do the following:\n\n";
  421.     print "1) Go to your board.  It is found at:\n";
  422.     print "   $DC->{script_url}/discus.$DC->{cgi_extension}\n\n";
  423.     print "2) Click on the administration link.  Enter your username ('$DC->{superuser}')\n";
  424.     print "   and leave the password blank.  You will be prompted to set up\n";
  425.     print "   your password and register Discus.\n\n";
  426.     print "3) Return to administration with username '$DC->{superuser}' and the\n";
  427.     print "   password you just set up.  Go to the administration instructions\n";
  428.     print "   and read through the superuser getting started tutorial.\n\n";
  429.     print "Thank you for choosing Discus!\n\n";
  430.     print "Press any key to continue...\n";
  431.     my $iii = <STDIN>;
  432.     exit(0);
  433. }
  434.