#!/usr/bin/perl -w # $Id$ # Copyright 2002 Katipo Communications # # This file is part of Koha. # # Koha is free software; you can redistribute it and/or modify it under the # terms of the GNU General Public License as published by the Free Software # Foundation; either version 2 of the License, or (at your option) any later # version. # # Koha is distributed in the hope that it will be useful, but WITHOUT ANY # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along with # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA use strict; use vars qw( $answer $missing $status ); use vars '@CLEANUP'; # A stack of references-to-code. When this script # exits, whether normally or abnormally, each # bit of cleanup code is run to clean up. See # also &cleanup, below. use vars '%CACHE'; # Cached values from the previous run, used to # supply defaults when the user runs the installer # a second time. use vars '%PROG'; # This hash maps internal names for programs to # their full pathnames, e.g. # $PROG{"perl"} eq "/usr/local/bin/perl" use vars '@PROG_DEF'; # This contains declarations saying which external # programs the installer needs to find. use vars qw($KOHA_CONF); # Location of koha.conf file use vars qw(%PERL_MODULES); # Installed perl modules. Actually, these are # only the optional modules, since the # installer dies if it can't find one or more # required modules. use vars qw($DB_NAME $DB_HOST $DB_USER $DB_PASSWD); # Database name, host, user, and password for # accessing the Koha database. use vars qw($MYSQL_ADMIN $MYSQL_PASSWD); # MySQL administrator name and password. Used # to create the database and give the Koha # user privileges on the Koha database. use vars qw($USE_VHOSTS); # True iff we'll be using virtual hosts use vars qw($OPAC_HOST @OPAC_REALHOSTS $INTRA_HOST @INTRA_REALHOSTS); # Web hosts: $OPAC_HOST and $INTRA_HOST are # the (virtual) hosts on which the OPAC and # intranet reside. # @OPAC_REALHOSTS and @INTRA_REALHOSTS list # the real hosts on which the $OPAC_HOST and # $INTRA_HOST (virtual) hosts reside. They are # arrays because the user might spread the # load among several real hosts. $SIG{'__DIE__'} = \&sig_DIE; # Clean up after we die $SIG{'INT'} = \&sig_INT; # Clean up if ^C given $| = 1; # Flush output immediately, in case the # user is piping this script or something. # XXX - Log everything that happens ### Phase 1: Gather information # Warn the installer about potential nastiness, and give ver a chance # to abort now. $answer = &y_or_n(< "stty" ], [ "chown" => "chown" ], [ "chmod" => "chmod" ], [ "perl" => "perl", "perl5" ], [ "install" => "ginstall", "install" ], [ "make" => "gmake", "make" ], [ "mysql" => "mysql" ], [ "mysqladmin" => "mysqladmin" ], [ "mysqldump" => "mysqldump" ], ); # First, we try to find the programs automatically on the user's # $PATH. Later, we'll give ver a chance to override any and all of # these paths, but presumably the automatic search will be correct # 90+% of the time, so this reduces erosion on the user's # key. foreach my $prog_def (@PROG_DEF) { my $prog = shift @{$prog_def}; my $fullpath; # Full path to program next if !defined($prog); printf "%-20s: ", $prog; $fullpath = $CACHE{"prog_$prog"} || &find_program(@{$prog_def}); if (!defined($fullpath)) { # Can't find this program $missing = 1; print "** Not found\n"; next; } $CACHE{"prog_$prog"} = $PROG{$prog} = $fullpath; print $fullpath, "\n"; } if ($missing) { # One or more programs were not found. We've already printed # an error message about this above. print < $DB_PASSWD ); # Generate koha.conf # XXX - Ask whether to use the same koha.conf file for the intranet # and OPAC sites. &write_conf("koha.conf.new", "koha.conf.in", "db_passwd" => $DB_PASSWD ); ### XXX - Phase 3: Install files # XXX - Warn the user that the installation will reveal the DBA and # Koha user's passwords (briefly) in the output of 'ps'. That for # greater security, he should do things manually. # XXX - Also perhaps set $ENV{MYSQL_PWD} # XXX - Actually, this should just use 'make ' to do stuff. # XXX - In each case, give user a chance to edit the file first. # XXX - Make sure to convert #! line before installing any scripts # XXX - When overwriting files, make sure to keep a backup # XXX - Installing/upgrading database: # - Get MySQL admin username and password # - Get database hostname # - See if the database exists already. If not, create it. # - See if koha user has rights on the database. If not, add them. # XXX - 'make install-db', if requested $answer = &y_or_n(<; # Slurp in the whole file close F; if (defined(wantarray) && wantarray) { # Array context. Return a list of lines for (@lines) { chomp; } return @lines; } # Void or scalar context. Return the concatenation of the # lines. return join("", @lines); } # load_cache # Read the cache file, and store cached values in %CACHE. # The format of the cache file is: # # Note: there is only one space between the variable and its value. # This allows us to have values with whitespace in them. # # Blank lines are ignored. Any line that begins with "#" is a comment. # The value may contain escape sequences of the form "\xAB", where # "AB" is a pair of hex digits representing the ASCII value of the # real character. sub load_cache { open CACHE, "< installer.cache" or do { warn "Can't open cache file :$!"; return; }; while () { my $var; my $value; chomp; next if /^\#/; # Ignore comments next if /^\s*$/; # Ignore blank lines if (!/^(\w+)\s(.*)/) { warn "Bad line in cache file, line $.:\n$_\n"; } $var = $1; $value = $2; # Unescape special characters $value =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge; $CACHE{$var} = $value; } close CACHE; } # _sanitize # Utility function used by &save_cache: escapes suspicious-looking # characters in a string, and returns the cleaned-up string. sub _sanitize { my $string = shift; $string =~ s{[^-\+\w\d \t.;/\{\}\@]}{sprintf("\\x%02x", ord($&))}ge; return $string; } # save_cache # Save cacheable values to the cache file sub save_cache { my $var; # Variable name my $value; # Variable value open CACHE, "> installer.cache" or do { warn "Can't write to cache file: $!"; return; }; # Write the keys. while (($var, $value) = each %CACHE) { print CACHE "$var\t", &_sanitize($value), "\n"; } close CACHE; } # find_program # Find a program in $ENV{PATH}. Each argument is a variant name of the # program to look for. That is, # &find_program("bison", "yacc"); # will first look for "bison", and if that's not found, will look for # "yacc". # Returns the full pathname if found, or undef otherwise. If the # program appears in multiple path directories, returns the first one. sub find_program { my @path = split /:/, $ENV{"PATH"}; # The $prog loop is on the outside: if the caller calls # &find_program("bison", "yacc"), that means that the caller # would prefer to find "bison", but will settle for "yacc". # Hence, we want to look for "bison" first. foreach my $prog (@_) { foreach my $dir (@path) { # Make sure that what we've found is not only # executable, but also a plain file # (directories are also executable, you know). if ( -f "$dir/$prog" && -x "$dir/$prog") { return "$dir/$prog"; } } } return undef; # Didn't find it } # ask # Ask the user a question, and return the result. # If $default is undef, &ask will keep asking the question until it # gets a nonempty answer. # If $default is the empty string and the user just hits , # &ask will return the empty string. # The remaining arguments, if any, are the list of acceptable answers. # &ask will keep asking the question until it gets one of the # acceptable answers. If the list is empty, any answer will do. # NOTE: the list of acceptable answers is not displayed to the user. # You need to make them part of the question. sub ask { my $question = shift; # The question to ask my $default = shift; # The return value if the user just hits # my @answers = @_; # The list of acceptable responses my $answer; # The user's answer # Prettify whitespace at the end of the question. First, we # remove the trailing newline that will have been left by # <; die "EOF on STDIN" if !defined($answer); $answer =~ s/^\s+//gs; # Trim whitespace $answer =~ s/\s+//gs; if ($answer eq "") { # The user just hit . See if that's okay if (!defined($default)) { print "Sorry, you must give an answer.\n\n"; redo; } # There's a default. Use it. $answer = $default; last; } else { # The user gave an answer. See if it's okay. # If the caller didn't specify a list of # acceptable answers, then all answers are # okay. last if $#answers < 0; # Make sure the answer is on the list for (@answers) { last if $answer eq $_; } print "Sorry, I don't understand that answer.\n\n"; } } return $answer; } # y_or_n # Asks a yes-or-no question. If the user answers yes, returns true, # otherwise returns false. # The second argument, $default, is a boolean value. If not given, it # defaults to true. sub y_or_n { my $question = shift; # The question to ask my $default = shift; # Default answer my $def_prompt; # The "(Y/n)" thingy at the end. my $answer; $default = 1 unless defined($default); # True by default chomp $question; $question .= " " unless $question =~ /\s$/s; if ($default) { $question .= "(Y/n)"; } else { $question .= "(y/N)"; } # Keep asking the question until we get an answer while (1) { $answer = &ask($question, ""); return $default if $answer eq ""; if ($answer =~ /^y(es)?$/i) { return 1; } elsif ($answer =~ /^no?$/) { return 0; } print "Please answer yes or no.\n\n"; } } # read_koha_conf # Reads the specified Koha config file. Returns a reference-to-hash # whose keys are the configuration variables, and whose values are the # configuration values (duh). # Returns undef in case of error. # # Stolen from C4/Context.pm, but I'd like this script to be standalone. sub read_koha_conf { my $fname = shift; # Config file to read my $retval = {}; # Return value: ref-to-hash holding the # configuration open (CONF, $fname) or return undef; while () { my $var; # Variable name my $value; # Variable value chomp; s/#.*//; # Strip comments next if /^\s*$/; # Ignore blank lines # Look for a line of the form # var = value if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/) { # FIXME - Complain about bogus line next; } # Found a variable assignment # FIXME - Ought to complain is this line sets a # variable that was already set. $var = $1; $value = $2; $retval->{$var} = $value; } close CONF; return $retval; } # write_conf # Very similar to what autoconf does with Makefile.in --> Makefile. So # similar, in fact, that it should be trivial to make this work with # autoconf. # # &write_conf takes a file name and an optional template file, and # generates the file by replacing all sequences of the form "@var@" in # the template with $CACHE{var}. # # If the template file name is omitted, it defaults to the output # file, with ".in" appended. sub write_conf { my $fname = shift; # Output file name my $template = shift; # Template file name my %extras = @_; # Additional key=>value pairs push @CLEANUP, sub { unlink $fname }; # If we're interrupted while writing the # output file, don't leave a partial one lying # around # Generate template file name $template = $fname . ".in" unless defined $template; # Generate the output file open TMPL, "< $template" or die "Can't open $template: $!"; open OUT, "> $fname" or die "Can't write to $fname: $!"; chmod 0600, $fname; # Restrictive permissions while () { # Replace strings of the form "@var@" with the # variable's value. Look first in %extras, then in # %CACHE. Use the first one that's defined. If none of # them are, use the empty string. # We can't use # $extras{$1} || $CACHE{$1} # because "0" is a perfectly good substitution value, # but would evaluate as false. And we need the empty # string because if neither one is defined, the "perl # -w" option would complain about us using an # undefined value. s{\@(\w+)\@} { if (defined($extras{$1})) { $extras{$1}; } elsif (defined($CACHE{$1})) { $CACHE{$1}; } else { ""; } }ge; print OUT; } close OUT; close TMPL; pop @CLEANUP; } # cleanup # Clean up after the script when it dies. Pops each bit of cleanup # code from @CLEANUP in turn and executes it. This way, the cleanup # functions are called in the reverse of the order in which they were # added. sub cleanup { my $code; while ($code = pop @CLEANUP) { eval &$code; } } # sig_DIE # This is the $SIG{__DIE__} handler. It gets called when the script # exits abnormally. It calls &cleanup to remove any temporary files # and whatnot that may have been created. sub sig_DIE { my $msg = shift; # die() message. Not currently used return if !defined($^S); # Don't die before parsing is done return if $^S; # Don't clean up if dying inside # an eval &cleanup(); print STDERR "\n", $msg; die <