misc/safe-installer

   1 #!/usr/bin/perl -w
   2
   3 # $Id$
   4
   5 # Copyright 2002 Katipo Communications
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 2 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along with
  19 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  20 # Suite 330, Boston, MA  02111-1307 USA
  21
  22 use strict;
  23
  24 use vars qw( $answer $missing $status );
  25 use vars '@CLEANUP';    # A stack of references-to-code. When this script
  26                         # exits, whether normally or abnormally, each
  27                         # bit of cleanup code is run to clean up. See
  28                         # also &cleanup, below.
  29 use vars '%CACHE';      # Cached values from the previous run, used to
  30                         # supply defaults when the user runs the installer
  31                         # a second time.
  32 use vars '%PROG';       # This hash maps internal names for programs to
  33                         # their full pathnames, e.g.
  34                         # $PROG{"perl"} eq "/usr/local/bin/perl"
  35 use vars '@PROG_DEF';   # This contains declarations saying which external
  36                         # programs the installer needs to find.
  37 use vars qw($KOHA_CONF);
  38                         # Location of koha.conf file
  39 use vars qw(%PERL_MODULES);
  40                         # Installed perl modules. Actually, these are
  41                         # only the optional modules, since the
  42                         # installer dies if it can't find one or more
  43                         # required modules.
  44 use vars qw($DB_NAME $DB_HOST $DB_USER $DB_PASSWD);
  45                         # Database name, host, user, and password for
  46                         # accessing the Koha database.
  47 use vars qw($MYSQL_ADMIN $MYSQL_PASSWD);
  48                         # MySQL administrator name and password. Used
  49                         # to create the database and give the Koha
  50                         # user privileges on the Koha database.
  51 use vars qw($USE_VHOSTS);
  52                         # True iff we'll be using virtual hosts
  53 use vars qw($OPAC_HOST @OPAC_REALHOSTS $INTRA_HOST @INTRA_REALHOSTS);
  54                         # Web hosts: $OPAC_HOST and $INTRA_HOST are
  55                         # the (virtual) hosts on which the OPAC and
  56                         # intranet reside.
  57                         # @OPAC_REALHOSTS and @INTRA_REALHOSTS list
  58                         # the real hosts on which the $OPAC_HOST and
  59                         # $INTRA_HOST (virtual) hosts reside. They are
  60                         # arrays because the user might spread the
  61                         # load among several real hosts.
  62
  63 $SIG{'__DIE__'} = \&sig_DIE;    # Clean up after we die
  64 $SIG{'INT'} = \&sig_INT;        # Clean up if ^C given
  65
  66 $| = 1;                         # Flush output immediately, in case the
  67                                 # user is piping this script or something.
  68
  69 # XXX - Log everything that happens
  70
  71 ### Phase 1: Gather information
  72
  73 # Warn the installer about potential nastiness, and give ver a chance
  74 # to abort now.
  75 $answer = &y_or_n(<<EOT, 1);
  76                    WARNING WARNING WARNING WARNING
  77
  78 This is an unstable version of Koha, blah blah blah unhappiness
  79 blah blah nuclear war blah blah spouse will leave you blah blah
  80
  81 Are you sure you want to continue?
  82 EOT
  83 if (!$answer)
  84 {
  85         exit 0;
  86 }
  87
  88 # XXX - Make sure we're in the right directory. Look for a few
  89 # required files ("koha.mysql" seems like a good candidate). If they
  90 # don't exist, try 'cd `dirname $0`' and try again.
  91
  92 # See if there's a cache file, and load it if the user'll allow us
  93 if ( -f "installer.cache" )
  94 {
  95         $answer = &y_or_n(<<EOT, 1);
  96 There appears to be a cache file left over from a previous
  97 run of $0. Do you wish to reuse this information?
  98 EOT
  99         &load_cache if $answer;
 100 }
 101
 102 # Figure out a default location for koha.conf. First, try the location
 103 # specified in the previous run, then the value of the $KOHA_CONF
 104 # environment variable (hey, it might be set), and finally
 105 # /etc/koha.conf.
 106 $KOHA_CONF =    $CACHE{"koha_conf"} ||
 107                 $ENV{"KOHA_CONF"} ||
 108                 "/etc/koha.conf";
 109 $CACHE{"koha_conf"} = $KOHA_CONF;
 110
 111 # If there's a /etc/koha.conf, ask whether the user wants installer to
 112 # read it for hints.
 113 if ( -r $KOHA_CONF)
 114 {
 115         $answer = &y_or_n(<<EOT, defined($CACHE{"hints_from_old_koha_conf"}) ? $CACHE{"hints_from_old_koha_conf"} : 1);
 116
 117 You already have a $KOHA_CONF file.
 118 Shall I read it to get hints as to where to install Koha?
 119 EOT
 120         $CACHE{"hints_from_old_koha_conf"} = $answer;
 121         if ($answer)
 122         {
 123                 my $old_koha_conf;
 124
 125                 $old_koha_conf = &read_koha_conf($CACHE{"koha_conf"});
 126                                 # Read the existing config file
 127
 128                 # Slurp the old config values into %CACHE, with a
 129                 # "conf_" prefix.
 130                 while (my ($key, $value) = each %{$old_koha_conf})
 131                 {
 132                         $CACHE{"conf_$key"} = $value;
 133                 }
 134         }
 135         # XXX - Ask whether the user wants a backup of the existing
 136         # database.
 137 }
 138 delete $CACHE{"conf_pass"};     # Don't cache any passwords
 139
 140 print "\n* Looking for common programs.\n\n";
 141
 142 # Define the list of external programs we need to find
 143 @PROG_DEF = (
 144         # The bit on the left is the program as we'll refer to it
 145         # internally, usually something like $PROG{"perl"}. On the
 146         # right is the list of names under which it might be
 147         # installed.
 148         [ "stty"        => "stty" ],
 149         [ "chown"       => "chown" ],
 150         [ "chmod"       => "chmod" ],
 151         [ "perl"        => "perl", "perl5" ],
 152         [ "install"     => "ginstall", "install" ],
 153         [ "make"        => "gmake", "make" ],
 154         [ "mysql"       => "mysql" ],
 155         [ "mysqladmin"  => "mysqladmin" ],
 156         [ "mysqldump"   => "mysqldump" ],
 157 );
 158
 159 # First, we try to find the programs automatically on the user's
 160 # $PATH. Later, we'll give ver a chance to override any and all of
 161 # these paths, but presumably the automatic search will be correct
 162 # 90+% of the time, so this reduces erosion on the user's <return>
 163 # key.
 164 foreach my $prog_def (@PROG_DEF)
 165 {
 166         my $prog = shift @{$prog_def};
 167         my $fullpath;           # Full path to program
 168
 169         next if !defined($prog);
 170
 171         printf "%-20s: ", $prog;
 172         $fullpath = $CACHE{"prog_$prog"} || &find_program(@{$prog_def});
 173         if (!defined($fullpath))
 174         {
 175                 # Can't find this program
 176                 $missing = 1;
 177                 print "** Not found\n";
 178                 next;
 179         }
 180
 181         $CACHE{"prog_$prog"} =
 182         $PROG{$prog}         = $fullpath;
 183         print $fullpath, "\n";
 184 }
 185
 186 if ($missing)
 187 {
 188         # One or more programs were not found. We've already printed
 189         # an error message about this above.
 190         print <<EOT;
 191
 192 WARNING:
 193 Some programs could not be found.
 194
 195 EOT
 196 } else {
 197         # Ask the user
 198         $answer = &y_or_n("Does this look okay?", 1);
 199         $missing = 1 if !$answer;
 200 }
 201
 202 if ($missing)
 203 {
 204         # Either some program could not be found, or else the user
 205         # didn't like the paths. Either way, go through the list and
 206         # ask.
 207         foreach my $prog_def (@PROG_DEF)
 208         {
 209                 my $prog = shift @{$prog_def};
 210                 my $fullpath;           # Full path to program
 211
 212                 $fullpath = &ask(<<EOT, $PROG{$prog});
 213 Please enter the full pathname to $prog:
 214 EOT
 215                 $CACHE{"prog_$prog"} = $fullpath;
 216         }
 217 }
 218
 219 # Check for required Perl modules
 220 # XXX - Perhaps should cache $PERL5LIB as well
 221 print "\nChecking for required Perl modules.\n";
 222 $missing = 0;
 223
 224 # DBI
 225 printf "%-20s: ", "DBI...";
 226 if (eval { require DBI; })
 227 {
 228         print "Found\n";
 229 } else {
 230         print "Not found\n";
 231         $missing = 1;
 232 }
 233
 234 # DBD::mysql
 235 printf "%-20s: ", "DBD::mysql...";
 236 if (eval { require DBD::mysql; })
 237 {
 238         print "Found\n";
 239 } else {
 240         print "Not found\n";
 241         $missing = 1;
 242 }
 243
 244 # Date::Manip
 245 printf "%-20s: ", "Date::Manip...";
 246 if (eval { require Date::Manip; })
 247 {
 248         print "Found\n";
 249 } else {
 250         print "Not found\n";
 251         $missing = 1;
 252 }
 253
 254 if ($missing)
 255 {
 256         print <<EOT;
 257
 258 One or more required Perl modules appear to be missing. Please install
 259 them, then run $0 again.
 260
 261 EOT
 262         exit 1;
 263 }
 264
 265 print "\nChecking for optional Perl modules.\n";
 266 $missing = 0;
 267
 268 # Net::Z3950
 269 printf "%-20s: ", "Net::Z3950...";
 270 if (eval { require Net::Z3950; })
 271 {
 272         print "Found\n";
 273         $PERL_MODULES{"Net::Z3950"} = 1;
 274 } else {
 275         print "Not found\n";
 276         $missing = 1;
 277 }
 278
 279 if ($missing)
 280 {
 281         print <<EOT;
 282
 283 One or more optional Perl modules appear to be missing. Koha may still
 284 be installed, but some optional features may not be enabled.
 285
 286 EOT
 287         $answer = &y_or_n(<<EOT, 0);
 288 Do you wish to abort the installation?
 289 EOT
 290 }
 291
 292 print "\n* Configuring database\n";
 293
 294 # Get the database administrator's name
 295 $MYSQL_ADMIN = &ask(<<EOT, $CACHE{"dba_user"});
 296
 297 Please enter the MySQL database administrator's name:
 298 EOT
 299 #'
 300 $CACHE{"dba_user"} = $MYSQL_ADMIN;
 301
 302 # Get the database administrator's password
 303 # This is NOT cached
 304 push @CLEANUP, sub { system $PROG{"stty"}, "echo"; };
 305                         # Restore screen echo if we get interrupted
 306 system $PROG{"stty"}, "-echo";          # Turn off screen echo
 307 $MYSQL_PASSWD = &ask(<<EOT, "");
 308
 309 Please enter the MySQL database administrator's password. This will
 310 not be written to any file, and is optional. If you leave this blank,
 311 you will be prompted for it every time it is needed, in the
 312 installation phase.
 313
 314 Database administrator password:
 315 EOT
 316 #'
 317 system $PROG{"stty"}, "echo";           # Turn screen echo back on
 318 print "\n";             # The user's \n, which wasn't displayed
 319
 320 # Get the database name
 321 $DB_NAME = &ask(<<EOT, $CACHE{"db_name"} || $CACHE{"conf_database"});
 322
 323 Please enter the name of the Koha database:
 324 EOT
 325 $CACHE{"db_name"} = $DB_NAME;
 326
 327 # Get database host
 328 $DB_HOST = &ask(<<EOT, $CACHE{"db_host"} || $CACHE{"conf_hostname"});
 329
 330 Please enter the hostname or IP address of the host on which the
 331 database should be installed:
 332 EOT
 333 $CACHE{"db_host"} = $DB_HOST;
 334
 335 # Get the name of the Koha (database) user
 336 $DB_USER = &ask(<<EOT, $CACHE{"db_user"} || $CACHE{"conf_user"});
 337 Please enter the name of the Koha user:
 338 EOT
 339 $CACHE{"db_user"} = $DB_USER;
 340
 341 # Get the Koha database password
 342 # The Koha password is not cached, since the installer cache file is
 343 # world-readable (unless the user has an unusually restrictive umask,
 344 # but we can't assume that).
 345
 346 # XXX - Actually, we might need up to three passwords: one for the
 347 # intranet, one for the OPAC, and one for the database server. Or
 348 # perhaps we need two or three Koha users; the point is to minimize
 349 # the amount of damage that can be wrought if someone breaks in to a
 350 # web or database server.
 351 #
 352 # The OPAC Koha user should be allowed to read anything, and update a
 353 # few limited tables, like session IDs and suchlike, but should on no
 354 # account be permitted to modify the catalogue.
 355 #
 356 # The intranet Koha user should have permission to read everything and
 357 # write all sorts of things, including the catalogue, but should not
 358 # be allowed to drop tables or do anything destructive to the database
 359 # itself.
 360 #
 361 # The maintenance user should be allowed to do everything. Then again,
 362 # perhaps the maintenance user can be installed manually by a clueful
 363 # DBA.
 364 system $PROG{"stty"}, "-echo";          # Turn off screen echo
 365 $DB_PASSWD = &ask(<<EOT, $CACHE{"conf_pass"});
 366 Please enter the Koha user's password:
 367 EOT
 368 #'
 369 system $PROG{"stty"}, "echo";           # Turn screen echo back on
 370 print "\n";             # The user's \n, which wasn't displayed
 371
 372 # XXX - Ask whether to install sample data. Default to no, especially
 373 # if the user requested a backup, earlier.
 374
 375 # XXX - Ask whether to restore the database from a backup. Should take
 376 # a glob pattern, and read each file in turn. Should default to the
 377 # backup we made earlier.
 378
 379 print "\n* Web site configuration.\n";
 380
 381 # XXX - Get information about how to set up the web servers.
 382 # Specifically:
 383 #       - Will you be using virtual hosts?
 384 #       - OPAC virtual host name?
 385 #       - OPAC real host name?
 386 #               Need to grant read-only authorization to Koha user
 387 #               from the real OPAC host. Perhaps have different
 388 #               passwords for intranet and OPAC access.
 389 #       - Intranet virtual host name?
 390 #       - Intranet real host name?
 391 #               Need to grant all access to Koha user from the real
 392 #               intranet host. Perhaps have different passwords for
 393 #               intranet and OPAC access.
 394 #       - Is the database server also running a web server?
 395 #               If so, then need to grant OPAC or intranet access to
 396 #               the database from "localhost".
 397 # XXX - Try to guess this from $CACHE{conf_*}
 398
 399 # XXX - Ask whether one machine will be both the only OPAC server and
 400 # the only intranet server. If yes, then a) we need to use virtual
 401 # hosts (for now), and b) we probably want to use the same koha.conf
 402 # file for both.
 403
 404 $USE_VHOSTS = &y_or_n(<<EOT, $CACHE{"use_vhosts"} || 1);
 405
 406 Will you be using virtual hosts for either the OPAC or intranet
 407 site?
 408 EOT
 409 $CACHE{"use_vhosts"} = $USE_VHOSTS;
 410
 411 $OPAC_HOST = &ask(<<EOT, $CACHE{"opac_host"});
 412
 413 What is the externally-visible name of the host on which the OPAC web
 414 site will reside?
 415 EOT
 416 $CACHE{"opac_host"} = $OPAC_HOST;
 417
 418 if ($USE_VHOSTS)
 419 {
 420         # XXX - Prompt for list of real hosts
 421         @OPAC_REALHOSTS = ($OPAC_HOST); # XXX - Just temporary
 422 } else {
 423         @OPAC_REALHOSTS = ($OPAC_HOST);
 424 }
 425 $CACHE{"opac_realhosts"} = join(" ", @OPAC_REALHOSTS);
 426
 427 #$INSTALL_OPAC = &y_or_n("Do you wish to install the OPAC web site?", 1);
 428 ## XXX - Gather OPAC information
 429 #$INSTALL_INTRANET = &y_or_n("Do you wish to install the intranet web site?",
 430 #       1);
 431 ## XXX - Gather intranet information
 432
 433 # XXX - Get apache.conf file
 434
 435 # XXX - Find out where to install
 436 #       - OPAC HTML files
 437 #       - OPAC cgi-bin files
 438 #       - Intranet HTML files
 439 #       - Intranet cgi-bin files
 440 # XXX - Try to guess this from $CACHE{conf_*}
 441
 442 # XXX - Get the user and group that should own these files. Try to
 443 # guess this from the "User" and "Group" lines in apache.conf. If the
 444 # user is found but the group isn't, use getgr*() and use the first
 445 # group found there. In any case, ask the user to confirm.
 446
 447 # XXX - Get root URLs:
 448 #       - OPAC HTML
 449 #       - OPAC cgi-bin
 450 #       - Intranet HTML
 451 #       - Intranet cgi-bin
 452 # XXX - Try to guess this from $CACHE{conf_*}
 453
 454 &save_cache;                    # Write the cache file for future use
 455
 456 ### XXX - Phase 2: Generate config files
 457
 458 # XXX - Generate sample apache.conf section for OPAC and internal
 459 # virtual hosts.
 460
 461 # Generate the configuration file that will be used by 'make'
 462 &write_conf("Make.conf", undef,
 463         "db_passwd"     => $DB_PASSWD
 464         );
 465
 466 # Generate koha.conf
 467 # XXX - Ask whether to use the same koha.conf file for the intranet
 468 # and OPAC sites.
 469 &write_conf("koha.conf.new", "koha.conf.in",
 470         "db_passwd"     => $DB_PASSWD
 471         );
 472
 473 ### XXX - Phase 3: Install files
 474
 475 # XXX - Warn the user that the installation will reveal the DBA and
 476 # Koha user's passwords (briefly) in the output of 'ps'. That for
 477 # greater security, he should do things manually.
 478 # XXX - Also perhaps set $ENV{MYSQL_PWD}
 479
 480 # XXX - Actually, this should just use 'make <whatever>' to do stuff.
 481
 482 # XXX - In each case, give user a chance to edit the file first.
 483
 484 # XXX - Make sure to convert #! line before installing any scripts
 485
 486 # XXX - When overwriting files, make sure to keep a backup
 487
 488 # XXX - Installing/upgrading database:
 489 # - Get MySQL admin username and password
 490 # - Get database hostname
 491 # - See if the database exists already. If not, create it.
 492 # - See if koha user has rights on the database. If not, add them.
 493
 494 # XXX - 'make install-db', if requested
 495
 496 $answer = &y_or_n(<<EOT, 1);
 497
 498 Would you like to create the Koha database now?
 499 EOT
 500 if ($answer)
 501 {
 502         $status = system $PROG{"make"}, "install-db";
 503         if ($status != 0)
 504         {
 505                 print <<EOT;
 506
 507 *** Error
 508 The database installation appears to have failed. Please read any
 509 error messages that may have been reported above, correct them, and
 510 try again.
 511
 512 EOT
 513                 if (&y_or_n(<<EOT, 1))
 514 Do you wish to abort the installation?
 515 EOT
 516                 {
 517                         print "Exiting.\n";
 518                         &cleanup;
 519                         exit 1;
 520                 }
 521         }
 522 } else {
 523         print <<EOT;
 524
 525 When you are ready, you can install the database by running
 526         make install-db
 527 EOT
 528 }
 529
 530 &cleanup;                       # Clean up before exiting
 531
 532 ########################################
 533 # Utility functions
 534
 535 # readfile
 536 # Read the contents of a file and return them. This is basically
 537 # /bin/cat.
 538 # In a scalar context, returns a string with the contents of the file.
 539 # In array context, returns an array containing the chomp()ed strings
 540 # comprising the file.
 541 #
 542 # Thus, if you just want to read the chomp()ed first line of a file,
 543 # you can
 544 #       ($line) = &readfile("/my/file");
 545 sub readfile
 546 {
 547         my $fname = shift;
 548         my @lines;
 549
 550         open F, "< $fname" or die "Can't open $fname: $!";
 551         @lines = <F>;           # Slurp in the whole file
 552         close F;
 553
 554         if (defined(wantarray) && wantarray)
 555         {
 556                 # Array context. Return a list of lines
 557                 for (@lines)
 558                 {
 559                         chomp;
 560                 }
 561                 return @lines;
 562         }
 563
 564         # Void or scalar context. Return the concatenation of the
 565         # lines.
 566         return join("", @lines);
 567 }
 568
 569 # load_cache
 570 # Read the cache file, and store cached values in %CACHE.
 571 # The format of the cache file is:
 572 #       <variable><space><value>
 573 # Note: there is only one space between the variable and its value.
 574 # This allows us to have values with whitespace in them.
 575 #
 576 # Blank lines are ignored. Any line that begins with "#" is a comment.
 577 # The value may contain escape sequences of the form "\xAB", where
 578 # "AB" is a pair of hex digits representing the ASCII value of the
 579 # real character.
 580 sub load_cache
 581 {
 582         open CACHE, "< installer.cache" or do {
 583                 warn "Can't open cache file :$!";
 584                 return;
 585                 };
 586         while (<CACHE>)
 587         {
 588                 my $var;
 589                 my $value;
 590
 591                 chomp;
 592                 next if /^\#/;          # Ignore comments
 593                 next if /^\s*$/;        # Ignore blank lines
 594
 595                 if (!/^(\w+)\s(.*)/)
 596                 {
 597                         warn "Bad line in cache file, line $.:\n$_\n";
 598                 }
 599                 $var = $1;
 600                 $value = $2;
 601
 602                 # Unescape special characters
 603                 $value =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge;
 604
 605                 $CACHE{$var} = $value;
 606         }
 607         close CACHE;
 608 }
 609
 610 # _sanitize
 611 # Utility function used by &save_cache: escapes suspicious-looking
 612 # characters in a string, and returns the cleaned-up string.
 613 sub _sanitize
 614 {
 615         my $string = shift;
 616
 617         $string =~ s{[^-\+\w\d \t.;/\{\}\@]}{sprintf("\\x%02x", ord($&))}ge;
 618         return $string;
 619 }
 620
 621 # save_cache
 622 # Save cacheable values to the cache file
 623 sub save_cache
 624 {
 625         my $var;                # Variable name
 626         my $value;              # Variable value
 627
 628         open CACHE, "> installer.cache" or do {
 629                 warn "Can't write to cache file: $!";
 630                 return;
 631                 };
 632         # Write the keys.
 633         while (($var, $value) = each %CACHE)
 634         {
 635                 print CACHE "$var\t", &_sanitize($value), "\n";
 636         }
 637         close CACHE;
 638 }
 639
 640 # find_program
 641 # Find a program in $ENV{PATH}. Each argument is a variant name of the
 642 # program to look for. That is,
 643 #       &find_program("bison", "yacc");
 644 # will first look for "bison", and if that's not found, will look for
 645 # "yacc".
 646 # Returns the full pathname if found, or undef otherwise. If the
 647 # program appears in multiple path directories, returns the first one.
 648 sub find_program
 649 {
 650         my @path = split /:/, $ENV{"PATH"};
 651
 652         # The $prog loop is on the outside: if the caller calls
 653         # &find_program("bison", "yacc"), that means that the caller
 654         # would prefer to find "bison", but will settle for "yacc".
 655         # Hence, we want to look for "bison" first.
 656         foreach my $prog (@_)
 657         {
 658                 foreach my $dir (@path)
 659                 {
 660                         # Make sure that what we've found is not only
 661                         # executable, but also a plain file
 662                         # (directories are also executable, you know).
 663                         if ( -f "$dir/$prog" && -x "$dir/$prog")
 664                         {
 665                                 return "$dir/$prog";
 666                         }
 667                 }
 668         }
 669         return undef;           # Didn't find it
 670 }
 671
 672 # ask
 673 # Ask the user a question, and return the result.
 674 # If $default is undef, &ask will keep asking the question until it
 675 # gets a nonempty answer.
 676 # If $default is the empty string and the user just hits <return>,
 677 # &ask will return the empty string.
 678 # The remaining arguments, if any, are the list of acceptable answers.
 679 # &ask will keep asking the question until it gets one of the
 680 # acceptable answers. If the list is empty, any answer will do.
 681 # NOTE: the list of acceptable answers is not displayed to the user.
 682 # You need to make them part of the question.
 683 sub ask
 684 {
 685         my $question = shift;   # The question to ask
 686         my $default  = shift;   # The return value if the user just hits
 687                                 # <return>
 688         my @answers  = @_;      # The list of acceptable responses
 689         my $answer;             # The user's answer
 690
 691         # Prettify whitespace at the end of the question. First, we
 692         # remove the trailing newline that will have been left by
 693         # <<EOT. Then we add a blank if there isn't any whitespace at
 694         # the end of the question, simply because it looks prettier
 695         # that way.
 696         chomp $question;
 697         $question .= " " unless $question =~ /\s$/;
 698
 699         while (1)
 700         {
 701                 # Print the question and the default answer, if any
 702                 print $question;
 703                 if (defined($default) && $default ne "")
 704                 {
 705                         print "[$default] ";
 706                 }
 707
 708                 # Read the answer
 709                 $answer = <STDIN>;
 710                 die "EOF on STDIN" if !defined($answer);
 711                 $answer =~ s/^\s+//gs;  # Trim whitespace
 712                 $answer =~ s/\s+//gs;
 713
 714                 if ($answer eq "")
 715                 {
 716                         # The user just hit <return>. See if that's okay
 717                         if (!defined($default))
 718                         {
 719                                 print "Sorry, you must give an answer.\n\n";
 720                                 redo;
 721                         }
 722
 723                         # There's a default. Use it.
 724                         $answer = $default;
 725                         last;
 726                 } else {
 727                         # The user gave an answer. See if it's okay.
 728
 729                         # If the caller didn't specify a list of
 730                         # acceptable answers, then all answers are
 731                         # okay.
 732                         last if $#answers < 0;
 733
 734                         # Make sure the answer is on the list
 735                         for (@answers)
 736                         {
 737                                 last if $answer eq $_;
 738                         }
 739
 740                         print "Sorry, I don't understand that answer.\n\n";
 741                 }
 742         }
 743         return $answer;
 744 }
 745
 746 # y_or_n
 747 # Asks a yes-or-no question. If the user answers yes, returns true,
 748 # otherwise returns false.
 749 # The second argument, $default, is a boolean value. If not given, it
 750 # defaults to true.
 751 sub y_or_n
 752 {
 753         my $question = shift;   # The question to ask
 754         my $default  = shift;   # Default answer
 755         my $def_prompt;         # The "(Y/n)" thingy at the end.
 756         my $answer;
 757
 758         $default = 1 unless defined($default);  # True by default
 759
 760         chomp $question;
 761         $question .= " " unless $question =~ /\s$/s;
 762         if ($default)
 763         {
 764                 $question .= "(Y/n)";
 765         } else {
 766                 $question .= "(y/N)";
 767         }
 768
 769         # Keep asking the question until we get an answer
 770         while (1)
 771         {
 772                 $answer = &ask($question, "");
 773
 774                 return $default if $answer eq "";
 775
 776                 if ($answer =~ /^y(es)?$/i)
 777                 {
 778                         return 1;
 779                 } elsif ($answer =~ /^no?$/) {
 780                         return 0;
 781                 }
 782
 783                 print "Please answer yes or no.\n\n";
 784         }
 785 }
 786
 787 # read_koha_conf
 788 # Reads the specified Koha config file. Returns a reference-to-hash
 789 # whose keys are the configuration variables, and whose values are the
 790 # configuration values (duh).
 791 # Returns undef in case of error.
 792 #
 793 # Stolen from C4/Context.pm, but I'd like this script to be standalone.
 794 sub read_koha_conf
 795 {
 796         my $fname = shift;      # Config file to read
 797         my $retval = {};        # Return value: ref-to-hash holding the
 798                                 # configuration
 799
 800         open (CONF, $fname) or return undef;
 801
 802         while (<CONF>)
 803         {
 804                 my $var;                # Variable name
 805                 my $value;              # Variable value
 806
 807                 chomp;
 808                 s/#.*//;                # Strip comments
 809                 next if /^\s*$/;        # Ignore blank lines
 810
 811                 # Look for a line of the form
 812                 #       var = value
 813                 if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/)
 814                 {
 815                         # FIXME - Complain about bogus line
 816                         next;
 817                 }
 818
 819                 # Found a variable assignment
 820                 # FIXME - Ought to complain is this line sets a
 821                 # variable that was already set.
 822                 $var = $1;
 823                 $value = $2;
 824                 $retval->{$var} = $value;
 825         }
 826         close CONF;
 827
 828         return $retval;
 829 }
 830
 831 # write_conf
 832 # Very similar to what autoconf does with Makefile.in --> Makefile. So
 833 # similar, in fact, that it should be trivial to make this work with
 834 # autoconf.
 835 #
 836 # &write_conf takes a file name and an optional template file, and
 837 # generates the file by replacing all sequences of the form "@var@" in
 838 # the template with $CACHE{var}.
 839 #
 840 # If the template file name is omitted, it defaults to the output
 841 # file, with ".in" appended.
 842 sub write_conf
 843 {
 844         my $fname = shift;              # Output file name
 845         my $template = shift;           # Template file name
 846         my %extras = @_;                # Additional key=>value pairs
 847
 848         push @CLEANUP, sub { unlink $fname };
 849                         # If we're interrupted while writing the
 850                         # output file, don't leave a partial one lying
 851                         # around
 852         # Generate template file name
 853         $template = $fname . ".in" unless defined $template;
 854
 855         # Generate the output file
 856         open TMPL, "< $template" or die "Can't open $template: $!";
 857         open OUT, "> $fname" or die "Can't write to $fname: $!";
 858         chmod 0600, $fname;             # Restrictive permissions
 859         while (<TMPL>)
 860         {
 861                 # Replace strings of the form "@var@" with the
 862                 # variable's value. Look first in %extras, then in
 863                 # %CACHE. Use the first one that's defined. If none of
 864                 # them are, use the empty string.
 865                 # We can't use
 866                 #       $extras{$1} || $CACHE{$1}
 867                 # because "0" is a perfectly good substitution value,
 868                 # but would evaluate as false. And we need the empty
 869                 # string because if neither one is defined, the "perl
 870                 # -w" option would complain about us using an
 871                 # undefined value.
 872                 s{\@(\w+)\@}
 873                  {
 874                         if (defined($extras{$1}))
 875                         {
 876                                 $extras{$1};
 877                         } elsif (defined($CACHE{$1}))
 878                         {
 879                                 $CACHE{$1};
 880                         } else {
 881                                 "";
 882                         }
 883                  }ge;
 884                 print OUT;
 885         }
 886         close OUT;
 887         close TMPL;
 888
 889         pop @CLEANUP;
 890 }
 891
 892 # cleanup
 893 # Clean up after the script when it dies. Pops each bit of cleanup
 894 # code from @CLEANUP in turn and executes it. This way, the cleanup
 895 # functions are called in the reverse of the order in which they were
 896 # added.
 897 sub cleanup
 898 {
 899         my $code;
 900
 901         while ($code = pop @CLEANUP)
 902         {
 903                 eval &$code;
 904         }
 905 }
 906
 907 # sig_DIE
 908 # This is the $SIG{__DIE__} handler. It gets called when the script
 909 # exits abnormally. It calls &cleanup to remove any temporary files
 910 # and whatnot that may have been created.
 911 sub sig_DIE
 912 {
 913         my $msg = shift;        # die() message. Not currently used
 914
 915         return if !defined($^S);        # Don't die before parsing is done
 916         return if $^S;                  # Don't clean up if dying inside
 917                                         # an eval
 918
 919         &cleanup();
 920
 921         print STDERR "\n", $msg;
 922         die <<EOT;
 923
 924 *** FAILURE ***
 925
 926         The installer has failed. Please check any error messages that
 927 may have been printed above, correct the problem(s), and try again.
 928
 929 EOT
 930 }
 931
 932 # sig_INT
 933 # SIGINT handler. Clean up and exit if the user cancels with ^C.
 934 sub sig_INT
 935 {
 936         &cleanup();
 937
 938         print STDERR <<EOT;
 939
 940 *** CANCELLED ***
 941
 942         Configuration cancelled.
 943
 944 EOT
 945
 946         exit 1;
 947 }
 948