waipconfig.pl 19.3 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file 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 Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
23 24 25 26 27 28 29 30 31 32
#

#
# This file goes in /usr/site/sbin on the CDROM.
#
use English;
use Getopt::Std;
use Fcntl;
use IO::Handle;

33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
#
# Disk related parameters
#

# where to find kernel config output
my $dmesgcmd = "/sbin/dmesg";
my $dmesgfile = "/var/run/dmesg.boot";

# preferred ordering of disks to use
my @preferred = ("ar", "aacd", "amrd", "mlxd", "twed", "ad", "da");

# ordered list of disks found and hash of sizes
my @disklist;
my %disksize;

# min disk size we can use (in MB)
my $MINDISKSIZE = 8000;

51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
#
# Boot configuration for the CDROM. Determine the IP configuration, either
# from the floopy or from the user interactively.
#
# This is run from /etc/rc.network on the cdrom. It will write a new
# file of shell variables resembling what goes in /etc/rc.conf so that
# network configuration can proceed normally. Also write the new values
# to the file floopy data file for next time.
#
sub usage()
{
    print("Usage: waipconfig\n");
    exit(-1);
}
my  $optlist = "";

#
# Turn off line buffering on output
#
STDOUT->autoflush(1);
STDERR->autoflush(1);

#
# Untaint the environment.
# 
$ENV{'PATH'} = "/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/sbin:".
77
    "/usr/local/bin:/usr/site/bin:/usr/site/sbin";
78 79 80 81 82
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# The raw disk device. 
#
83
my $defrawdisk	= "/dev/ad0";
84 85 86 87
my $rawbootdisk;
my $etcdir	= "/etc";
my $rcconflocal	= "$etcdir/rc.conf.local";
my $resolveconf = "$etcdir/resolv.conf";
88
my $localhostrev= "$etcdir/namedb/localhost.rev";
89 90 91
my $hardconfig	= "$etcdir/emulab-hard.txt";
my $softconfig	= "$etcdir/emulab-soft.txt";
my $tbboot	= "tbbootconfig";
92 93 94
my $dodhcp	= 0;
my $DHCPTAG	= "DHCP";
my $INADDR_ANY	= "0.0.0.0";
95 96 97 98 99 100
    
#
# This is our configuration.
#
my %config = ( interface  => undef,
	       hostname   => undef,
101
	       domain     => undef,
102 103 104 105
	       IP         => undef,
	       netmask    => undef,
	       nameserver => undef,
	       gateway    => undef,
106
	       bootdisk   => undef,
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
	     );

# Must be root
if ($UID != 0) {
    die("*** $0:\n".
	"    Must be root to run this script!\n");
}

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV != 0) {
    usage();
}

127 128 129 130 131 132 133 134 135
#
# Catch ^C and exit with special status. See exit(13) below.
# The wrapper script looks these exits!
# 
sub handler () {
    $SIG{INT} = 'IGNORE';
    exit(12);
}
$SIG{INT}  = \&handler;
136

137 138
sub BootFromCD();

139 140
# Do it.
BootFromCD();
141 142 143 144 145
exit(0);

sub BootFromCD()
{
    #
146 147 148
    # Always check for a hardwired config. However, it takes precedence
    # only when the disk is raw. The config block overrides the config
    # file, except for bootdisk of course. 
149
    #
150 151 152 153
    my $hardwired = (CheckConfigFile() == 0 ? 1 : 0);

    # Either no config file, or bootdisk unspecified. Must figure it out.
    if (!defined($config{'bootdisk'})) {
154
	#
155 156 157 158 159 160 161 162 163 164 165
	# Give them multiple tries to find a disk with an existing
	# configuration block.
	#
	while (1) {
	    $rawbootdisk = WhichRawDisk();
	    if (CheckConfigBlock() == 0) {
		last;
	    }
	    print "No existing configuration was found on $rawbootdisk\n";
	    if (Prompt("Try another disk for existing configuration?",
		       "No", 10) =~ /no/i) {
166 167 168 169 170 171 172 173
		if (! $hardwired) {
		    #
		    # Don't want to try another disk,
		    # consider this a first time install.
		    #
		    GetNewConfig();
		    $rawbootdisk = $config{'bootdisk'};
		}
174 175 176
		last;
	    }
	}
177
    }
178 179 180 181 182 183 184 185 186 187
    else {
	#
	# A hardwired config with a disk spec. Allow for overriding by
	# the config block. If the disk is raw (no config block) then
	# nothing will have be changed.
	#
	$rawbootdisk = $config{'bootdisk'};

	CheckConfigBlock();
    }
188

189 190 191 192 193 194 195 196
    #
    # See if a config block/file specifed DHCP. Will already be set if
    # we got the config from the user, but the duplicate check is fine.
    #
    if (defined($config{'hostname'}) && $config{'hostname'} eq $DHCPTAG) {
	$dodhcp = 1;
    }

197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
    #
    # Give the user a chance to override the normal operation, and specify
    # alternate parameters.
    #
    while (1) {
	PrintConfig();

	#
	# Everything must be defined or its a big problem! Keep looping
	# until we have everything. 
	#
	foreach my $key (keys(%config)) {
	    if (!defined($config{$key})) {
		print "Some configuration parameters are missing!\n";
		GetUserConfig();
		next;
	    }
	}

	#
	# Otherwise, one last chance to override.
	#
	if (Prompt("Specify Alternate Configuration?", "No", 10) =~ /no/i) {
	    last;
	}
	GetUserConfig();
    }

    #
    # Generate the rc files.
    #
    if (WriteRCFiles() < 0) {
	print "Could not write rc files.\n";
230
	exit(-1);
231 232 233 234 235 236 237 238
    }
    
    #
    # Text version of the latest config. Used later for checking registration
    # and the disk update.
    # 
    if (WriteConfigFile($softconfig) < 0) {
	print "Could not write soft config file.\n";
239
	exit(-1);
240 241 242 243
    }
    return 0;
}

244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
sub GetNewConfig()
{
    #
    # First, an intimidating disclaimer
    #
    print "\n";
    print "****************************************************************\n";
    print "*                                                              *\n";
    print "* Netbed installation CD (version 0.1).                        *\n";
    print "*                                                              *\n";
    print "* THIS PROGRAM WILL WIPE YOUR YOUR HARD DISK!                  *\n";
    print "* It will then install a fresh Netbed image.                   *\n";
    print "*                                                              *\n";
    print "* If this is NOT what you intended, please type 'no' to the    *\n";
    print "* prompt below and the machine will reboot (don't forget to    *\n";
    print "* remove the CD).                                              *\n";
    print "*                                                              *\n";
    print "* Before you can install this CD, you must first go to         *\n";
    print "* www.emulab.net/cdromnewkey.php for a password.               *\n";
    print "*                                                              *\n";
    print "* You must also know some basic characteristics of the machine *\n";
    print "* you are installing on (disk device and network interface) as *\n";
    print "* well as configuration of the local network (host and domain  *\n";
    print "* name, IP address for machine, nameserver and gateway).       *\n";
    print "*                                                              *\n";
    print "****************************************************************\n";
    print "\n";

    if (Prompt("Continue with installation?", "No") =~ /no/i) {
273
	exit(13);
274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293
    }

    #
    # All right, we gave them a chance.
    # Here we should explain what the possible disk/network options are,
    # preferably by going out and discovering what exists.
    #

    print "****************************************************************\n";
    print "*                                                              *\n";
    print "* The installation script attempts to intuit default values    *\n";
    print "* for much of installation information.  In the process it may *\n";
    print "* generate error messages from the kernel which may be safely  *\n";
    print "* ignored.                                                     *\n";
    print "*                                                              *\n";
    print "****************************************************************\n";

    GetUserConfig();
}

294 295 296 297 298 299 300 301
#
# Prompt for the configuration from the user. Return -1 if something goes
# wrong.
#
sub GetUserConfig()
{
    print "Please enter the system configuration by hand\n";
    
302
    $config{'bootdisk'}  = Prompt("System boot disk", $rawbootdisk);
303
    $config{'interface'} = Prompt("Network Interface", WhichInterface());
304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343

    #
    # Ask if they want to use DHCP. If so, we skip all the other stuff.
    # If not, must prompt for the goo.
    #
    if (Prompt("Use DHCP?", ($dodhcp ? "Yes" : "No")) =~ /yes/i) {
	$dodhcp = 1;

	#
	# Give the rest of the config strings a phony tag (DHCP) so they
	# are not undefined, and values are written to the config file
	# and to the boot block. We look for the tags when the config block
	# or file is read back in.
	#
	# I am considering changing the bootblock to just use a boolean
	# value, which would be fine since we use an entire sector, so
	# backwards compatability with existing records is not an issue.
	#
	$config{'domain'}    = $DHCPTAG;
	$config{'hostname'}  = $DHCPTAG;
	$config{'IP'}        = $INADDR_ANY;
	$config{'netmask'}   = $INADDR_ANY;
	$config{'gateway'}   = $INADDR_ANY;
	$config{'nameserver'}= $INADDR_ANY;
    	return 0;
    }
    $dodhcp = 0;
    #
    # In case the user changed his mind, we do not want to prompt with
    # the silly DHCP/INADDR_ANY strings as the default!
    #
    foreach my $key (keys(%config)) {
	my $val = $config{$key};

	if (defined($val) &&
	    ($val eq $DHCPTAG || $val eq $INADDR_ANY)) {
	    $config{$key} = undef;
	}
    }
    
344
    $config{'domain'}    = Prompt("Domain", $config{'domain'});
345 346
    $config{'hostname'}  = Prompt("Hostname (without the domain!)",
				  $config{'hostname'});
347
    $config{'IP'}        = Prompt("IP Address", $config{'IP'});
348
    $config{'netmask'}   = Prompt("Netmask", WhichNetMask());
349
    $config{'gateway'}   = Prompt("Gateway IP", WhichGateway());
350
    $config{'nameserver'}= Prompt("Nameserver IP", $config{'nameserver'});
351

352 353 354
    # XXX
    $rawbootdisk = $config{'bootdisk'};

355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405
    return 0;
}

#
# Check for hardwired configuration file. We do this on both the CDROM boot
# and the disk boot.
#
sub CheckConfigFile(;$)
{
    my ($path) = @_;

    if (!defined($path)) {
	$path = "$hardconfig";
    }
	
    if (! -e $path) {
	return -1;
    }
    if (! open(CONFIG, $path)) {
	print("$path could not be opened for reading: $!\n");
	return -1;
    }
    while (<CONFIG>) {
	chomp();
	ParseConfigLine($_);
    }
    close(CONFIG);
    return 0;
}

#
# Check Config block.
#
sub CheckConfigBlock()
{
    #
    # See if a valid header block.
    #
    system("$tbboot -v $rawbootdisk");
    if ($?) {
	return -1;
    }

    #
    # Valid block, so read the configuration out to a temp file
    # and then parse it normally.
    # 
    system("$tbboot -r /tmp/config.$$ $rawbootdisk");
    if ($?) {
	return -1;
    }
406 407 408 409 410 411
    if (CheckConfigFile("/tmp/config.$$") == 0) {
	# XXX bootdisk is not part of the on disk info
	$config{'bootdisk'} = $rawbootdisk;
	return 0;
    }
    return -1;
412 413 414 415 416 417 418 419 420
}

#
# Which network interface. Just come up with a guess, and let the caller
# spit that out in a prompt for verification.
#
sub WhichInterface()
{
    # XXX
421 422
    if (defined($config{'interface'})) {
	return $config{'interface'};
423 424 425
    }
    my @allifaces = split(" ", `ifconfig -l`);
		       
426 427 428 429 430
    #
    # Prefer the first interface found that is not "lo".
    #
    foreach my $iface (@allifaces) {
	if ($iface =~ /([a-zA-z]+)(\d+)/) {
431
	    if ($1 eq "lo" || $1 eq "faith" || $1 eq "gif" || $1 eq "tun") {
432 433 434 435 436 437
		next;
	    }

	    # XXX check to make sure it has carrier
	    if (`ifconfig $iface` =~ /.*no carrier/) {
		next;
438
	    }
439 440

	    return $iface;
441 442
	}
    }
443

444
    return undef;
445 446
}

447
#
448
# Which network mask.  Default based on the network number.
449 450 451 452 453 454 455 456
#
sub WhichNetMask()
{
    # XXX
    if (defined($config{'netmask'})) {
	return $config{'netmask'};
    }

457 458 459 460 461 462 463 464 465 466
    #
    # XXX this is a nice idea, but will likely be wrong for large
    # institutions that subdivide class B's (e.g., us!)
    #
    if (0 && defined($config{'IP'})) {
	my ($net) = split(/\./, $config{'IP'});
	return "255.0.0.0" if $net < 128;
	return "255.255.0.0" if $net < 192;
    }

467 468 469
    return "255.255.255.0";
}

470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497
#
# Which gateway IP.  Use the more or less traditional .1 for the network
# indicated by (IP & netmask).
#
sub WhichGateway()
{
    # XXX
    if (defined($config{'gateway'})) {
	return $config{'gateway'};
    }

    #
    # Grab IP and netmask, combine em, stick 1 in the low quad,
    # make sure the result isn't the IP, and return that.
    # Parsing tricks from the IPv4Addr package.
    #
    if (defined($config{'IP'}) && defined($config{'netmask'})) {
	my $addr = unpack("N", pack("CCCC", split(/\./, $config{'IP'})));
	my $mask = unpack("N", pack("CCCC", split(/\./, $config{'netmask'})));
	my $gw = ($addr & $mask) | 1;
	if ($gw != $addr) {
	    return join(".", unpack("CCCC", pack("N", $gw)));
	}
    }

    return undef;
}

498 499
#
# Which raw disk. Prompt if we cannot come up with a good guess.
500
# Note: raw and block devices are one in the same now.
501 502 503 504
#
sub WhichRawDisk()
{
    #
505 506 507 508 509 510
    # Find the list of configured disks
    #
    my @list = DiskList();

    #
    # Search the drives looking for one with a valid header.
511
    # 
512 513
    foreach my $disk (@list) {
	my $guess = "/dev/${disk}";
514

515 516 517 518 519 520 521 522
	system("$tbboot -v $guess");
	if (! $?) {
	    #
	    # Allow for overiding the guess, with short timeout.
	    #
	    $rawbootdisk = Prompt("Which Disk Device is the boot device?",
				  "$guess", 10);
	    goto gotone;
523 524 525 526
	}
    }

    #
527 528
    # None with configuration info, just use the first existing disk
    # which is large enough and is actually accessible.
529
    #
530
    foreach my $disk (@list) {
531 532
	my $guess = "/dev/${disk}";

533
	if (DiskSize($disk) >= $MINDISKSIZE && DiskReadable($disk)) {
534 535 536
	    #
	    # Allow for overiding the guess, with short timeout.
	    #
537 538
	    $rawbootdisk = Prompt("Which Disk Device is the boot device?",
				  "$guess", 10);
539 540 541 542 543 544 545 546 547
	    goto gotone;
	}
    }
  gotone:
    
    #
    # If still not defined, then loop forever.
    # 
    while (!defined($rawbootdisk) || ! -e $rawbootdisk) {
548 549
	$rawbootdisk = Prompt("Which Disk Device is the boot device?",
			      $defrawdisk);
550 551 552 553
    }
    return $rawbootdisk;
}

554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619
#
# Create a list of all disks and their sizes.
#
sub DiskList()
{
    if (-x $dmesgcmd) {
	GetDisks($dmesgcmd);
    }

    # if we didn't grab anything there, try the /var/run file
    if (@disklist == 0 && -r $dmesgfile) {
	GetDisks("cat $dmesgfile");
    }

    return @disklist;
}

sub DiskSize($)
{
    my ($name) = @_;

    if (defined($disksize{$name})) {
	return $disksize{$name};
    }
    return 0;
}

sub DiskReadable($)
{
    my ($disk) = @_;
    my $dev = "/dev/$disk";

    if (!system("dd if=$dev of=/dev/null bs=512 count=32 >/dev/null 2>&1")) {
	return(1);
    }
    return(0);
}

sub GetDisks($)
{
    my ($cmd) = @_;
    my @units = (0, 1, 2, 3);
    my @cmdout = `$cmd`;

    #
    # Arbitrary: we prefer disk type over unit number;
    # e.g. ad1 is better than da0.
    #
    foreach my $disk (@preferred) {
	foreach my $unit (@units) {
	    my $dmesgpat = "^($disk$unit):.* (\\d+)MB.*\$";
	    foreach my $line (@cmdout) {
		if ($line =~ /$dmesgpat/) {
		    my $name = $1;
		    my $size = $2;
		    if (!defined($disksize{$name})) {
			push(@disklist, $name);
		    }
		    $disksize{$name} = $size;
		}
	    }
	}
    }
}


620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643
#
# Write a config file suitable for input to the testbed boot header program.
#
sub WriteConfigFile($)
{
    my ($path) = @_;

    print "Writing $path\n";
    if (! open(CONFIG, "> $path")) {
	print("$path could not be opened for writing: $!\n");
	return -1;
    }
    foreach my $key (keys(%config)) {
	my $val = $config{$key};

	print CONFIG "$key=$val\n";
    }
    close(CONFIG);
    return 0;
}

sub PrintConfig()
{
    print "\nCurrent Configuration:\n";
644 645 646 647 648 649 650 651

    if ($dodhcp) {
	print "  bootdisk=" . $config{'bootdisk'} . "\n";
	print "  interface=" . $config{'interface'} . "\n";
	print "  DHCP=Yes\n";
	return;
    }
    
652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681
    foreach my $key (keys(%config)) {
	my $val = $config{$key};

	if (!defined($val)) {
	    $val = "*** undefined ***";
	}

	print "  $key=$val\n";
    }
    print "\n";
    return 0;
}

#
# Write an rc.conf style file which can be included by sh. This is based
# on the info we get. We also write a resolve.conf
#
sub WriteRCFiles()
{
    my $path = "$rcconflocal";

    if (! open(CONFIG, "> $path")) {
	print("$path could not be opened for writing: $!\n");
	return -1;
    }

    print "Writing $path\n";
    print CONFIG "#\n";
    print CONFIG "# DO NOT EDIT! This file is autogenerated at reboot.\n";
    print CONFIG "#\n";
682
    print CONFIG "network_interfaces=\"lo0 $config{'interface'}\"\n";
683 684 685 686 687 688 689
    print CONFIG "# Netbed info\n";
    print CONFIG "netbed_disk=\"$rawbootdisk\"\n";

    #
    # Its very simple if using DHCP!
    #
    if ($dodhcp) {
690 691
	print CONFIG "netbed_IP=\"$DHCPTAG\"\n";
	print CONFIG "ifconfig_$config{interface}=\"$DHCPTAG\"\n";
692 693 694 695 696 697
	close(CONFIG);
	return 0;
    }

    print CONFIG "netbed_IP=\"$config{IP}\"\n";
    print CONFIG "#\n";
698 699 700 701
    print CONFIG "hostname=\"$config{hostname}.$config{domain}\"\n";
    print CONFIG "ifconfig_$config{interface}=\"".
	         "inet $config{IP} netmask $config{netmask}\"\n";
    print CONFIG "defaultrouter=\"$config{gateway}\"\n";
702
    print CONFIG "named_enable=\"YES\"\n";
703 704 705 706 707 708 709 710 711 712
    print CONFIG "# EOF\n";
    close(CONFIG);

    $path = $resolveconf;
    print "Writing $path\n";
    if (! open(CONFIG, "> $path")) {
	print("$path could not be opened for writing: $!\n");
	return -1;
    }
    print CONFIG "search $config{domain}\n";
713
    print CONFIG "nameserver 127.0.0.1\n";
714 715
    print CONFIG "nameserver $config{nameserver}\n";
    close(CONFIG);
716 717 718 719 720 721 722 723 724

    $path = $localhostrev;
    my $myhost = "$config{hostname}.$config{domain}";
    my $mydom  = "$config{domain}";
    print "Writing $path\n";
    if (! open(CONFIG, "> $path")) {
	print("$path could not be opened for writing: $!\n");
	return -1;
    }
725
    print CONFIG "\$TTL	3600\n\n";
726 727 728 729 730 731 732 733 734 735
    print CONFIG "@	IN	SOA	${myhost}. root.${myhost}.  (\n";
    print CONFIG "				20020927  ; Serial\n";
    print CONFIG "				3600      ; Refresh\n";
    print CONFIG "				900       ; Retry\n";
    print CONFIG "				3600000   ; Expire\n";
    print CONFIG "				3600 )    ; Minimum\n";
    print CONFIG "	IN	NS	${myhost}.\n";
    print CONFIG "1	IN	PTR	localhost.${mydom}.\n\n";
    close(CONFIG);
    
736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798
    return 0;
}

#
# Parse config lines. Kinda silly.
#
sub ParseConfigLine($)
{
    my($line) = @_;

    if ($line =~ /(.*)="(.+)"/ ||
	$line =~ /^(.*)=(.+)$/) {
	print "$1 $2\n";
	exists($config{$1}) and
	    $config{$1} = $2;
    }
}

#
# Spit out a prompt and a default answer. If optional timeout supplied,
# then wait that long before returning the default. Otherwise, wait forever.
#
sub Prompt($$;$)
{
    my ($prompt, $default, $timeout) = @_;

    if (!defined($timeout)) {
	$timeout = 10000000;
    }

    print "$prompt";
    if (defined($default)) {
	print " [$default]";
    }
    print ": ";

    eval {
	local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
	
	alarm $timeout;
	$_ = <STDIN>;
	alarm 0;
    };
    if ($@) {
	if ($@ ne "alarm\n") {
	    die("Unexpected interrupt in prompt\n");
	}
	#
	# Timed out.
	#
	print "\n";
	return $default;
    }
    return undef
	if (!defined($_));
	
    chomp();
    if ($_ eq "") {
	return $default;
    }

    return $_;
}