#!/usr/local/bin/perl
#
# ANL passwd program 
#
$Version = "Version 3.0";
#
# Last modified: 2001-Jul-03
#
##################################################
# Mayor changes:
# - program is using libcrack library (by Alec Muffett) for dictionary lookups
# - program is tested on the following architectures: 
#   SunOS, Solaris, Irix-6, AIX-4, linux
# - password changes in local file are not supported any more (only YP)
#   (this is due to differences in /etc/passwd structure on different 
#    UNIX platforms)
# 
#################################################

#############
# Configs

$debug = 0;			# 1 is on 0 is off

#
# Customizable items.
# Change these to reflect your local environment
#
# Legal shells; This is a list of valid login shells
# If you add any new valid shells, this variable should
# be updated. The shells listed here _must_ exist on
# all machines on your network that use YP; otherwise,
# a user may not be able to log in to all of the machines.

@legal_shells = ( '/usr/local/bin/tcsh', '/usr/local/bin/zsh', '/bin/csh', '/bin/sh' );

# location of dictionaries

$dict = "/usr/local/etc/dict";	

# location of ypstuff executable
$ypstuffdir = "/usr/local/adm/bin/";

# End configs
###############


use IPC::Open2;			
use Getopt::Std;		# These two are standard PERL5 libs

#use libcrack;			# Use libcrack module 
use Crypt::Cracklib;			# Use libcrack module 
				# This one has to be installed on your system

# Below used for the prompter
$shell_prompt = join(' ', @legal_shells);

# Security blankets.

$ENV{'IFS'} = '' if $ENV{'IFS'};
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb:/usr/bsd';
umask(022);

chdir '/etc' || die "Can't find /etc.\n";

if ( ! -f "$ypstuffdir/ypstuff" ){
    die "Can't find ", $ypstuffdir, "/ypstuff";
}

# Uncustomizable items.

$| = 1;         # command buffering on STDOUT

chop($host = `hostname`);

########################## ac #1 start
# Get the name of the command the user typed in to call this
# program (either "passwd" or "yppasswd") and chop off the
# path.
($program = $0) =~ s/.*\/(\w*)/\1/;
########################## ac #1 end

# So that messages speak truth about what is being changed.  --mwh
$what = "password";

# Define the usage statement  --mwh 8-26-92
$usage = "Usage: $0 [-f] [-s] [-a] [-r] [name]\n";
$usage .= "\t-f change the gecos information field.\n";
$usage .= "\t-s change the login shell.\n";
$usage .= "\t-a change without resetting password aging.  Unsupported.\n";
$usage .= "\t-r forgo the good password checks.  Root only.\n";
$usage .= "\n$Version\n";

if ( ! getopts( "fsar") ) {
    die "$usage";
}

# Only one option is permitted at a time, so...
$total_opts = $opt_f + $opt_s + $opt_a + $opt_r; # total number of options
if ( $total_opts > 1 ) {
    die "Use only one of -f, -s, -a, -r, at a time.\n$usage\n";
}

# relax the password "goodness" checks?
$relax = 0;
if ( $opt_r ) {
    if ( $< != 0 ) {
	die "\nThe -r (relax) option is for root only.\n$usage";
    }
    $relax = $opt_r;
    print "\nWarning: Not checking if new password is \"good\"!\n.";
}

# changing shells
if ( $opt_s ) {
    $what = "shell";
}

# password aging
if ( $opt_a ) {
    die "\nThe aging option is not supported.\n$usage"
}

# Change the gecos field
if ( $opt_f ) {
    $what = "gcos";
}

# Whose password are we changing, anyway?

# (We use getlogin in preference to getpwuid($<)[0] in case
#  different accounts are sharing uids.)

($me) = @ARGV;
die "You can't change the password for $me.\n" if $me && $<;
$me = getlogin unless $me;
$me = (getpwuid($<))[0] unless $me;

# Trap these signals

$SIG{'INT'} = 'cleanup';
$SIG{'HUP'} = 'cleanup';
$SIG{'QUIT'} = 'cleanup';
$SIG{'PIPE'} = 'cleanup';
$SIG{'ALRM'} = 'cleanup';


# Get passwd entry and remember all logins


#############################
# Program supports only password changes through YP
# starting with version 2.4

($login,$opasswd,$uid,$gid,$ogcos,$home,$shell) =  &getyp($me);
	
if ($login) {
# YP entry exists
    print "Changing $what entry for $me on yp server\n";
}
else {
    die "Error: no entry for $me in YP database\n";
}

# get rid of <cr> wherever it was acquired
chop( $shell );

die "You aren't you! ($< $uid $me $x $login)\n"
    if $< && $< != $uid;      # Just being paranoid...
$salt = substr($opasswd,0,2);
# 
###### # added to save the original gcos
$gcos = $ogcos;
###### #
# Canonicalize name. 
# 
$ogcos =~ s/,.*//;
$mynames = $ogcos;
$mynames =~ s/\W+/ /;
$mynames =~ s/^ //;
$mynames =~ s/ $//;
$mynames =~ s/ . / /g;
$mynames =~ s/ . / /g;
$mynames =~ s/^. //;
$mynames =~ s/ .$//;
$mynames =~ s/ /|/;
$mynames = '^$' if $mynames eq '';

#################################### ac #3 end

# Finally we can begin.

system 'stty', '-echo';

if ($<) {
    print "Old password: ";
    chop($pass0 = <STDIN>);
    print "\n";

   if (length($pass0) > 8) {
            $passa = $pass0;
            $pass0 = substr($passa,0,8);
   }

    # Note: we shouldn't use die while echo is off.
    # Now it deals with "no password" accounts
    # do myexit(1) unless $pass0;

    if ( ! $pass0 ) {
	&myexit(1) if $opasswd;
    }

    if (crypt($pass0,$salt) ne $opasswd) {
	print "Sorry.\n";
	do myexit(1);
    }
}

system 'stty', 'echo';

# This will get changed if in fact we are changing the password
$cryptpass = $opasswd;

# OK, now we believe they know who they are, what are we doing?
if ( $opt_s ) {
    &shell_game;
}

if ( $opt_f ) {
    &gecos_update;
}

if ( ! $opt_s && ! $opt_f ) {
    &get_new_pw;
    $cryptpass = &encrypt_passwd($login,$pass1);
}


####### #
## $login   the login name
## $pass0   the original passwd
## $pass1   the new passwd to be encrypted and installed
## $uid     the old user id
## $gid     the group id
## $gcos    the gcos stuff to be installed
## $home    the home file system
## $shell   the shell the gets installed
######## # 

@pw = ("$login","$cryptpass","$uid","$gid","","",$gcos,"$home","$shell");
				# 
chop($host = `ypwhich -m passwd`);

if ( ! &open2(READ, WRITE, "$ypstuffdir/ypstuff $host"))
{
    die "Open2 failed\n";
}
print "Opening $ypstuffdir/ypstuff $host\n" if $debug;    
print "$pass0\n" if $debug;
print WRITE "$pass0\n";
				 
print WRITE join("\n", @pw, "");
print join("\n", @pw, "") if $debug;
				 
close(WRITE);

$repl = <READ>;

close(READ);

				
if ($repl =~ /^SUCCESS\s*$/)
{
    print "Success\n";
    die "\n Password entry updated on server.\n\n";
}
elsif ($repl =~ /^ERROR:\s+(.*)\s*$/)
{
    die "\nPassword update on server not possible at this time. 
Failure: $1\nTry again later.\n"; 
}
else
{
    print "Unknown reply <$repl>\n";
    die "\nPassword update on server failed. Failure: unknown\nTry again later.\n";
}


###############################################################
#                                                             #
# This subroutine is the whole reason for this program.  It   #
# checks for many different kinds of bad password.  We don't  #
# tell people what kind of pattern they MUST have, because    #
# that would reduce the search space unnecessarily.           #
#                                                             #
# goodenough() returns 1 if password passes muster, else 0.   #
#                                                             #
###############################################################

sub goodenough{
    return 1 if $relax;         # Only root can bypass this.
    $pass = shift(@_);
    $mono = $pass !~ /^.+([A-Z].*[a-z]|[a-z].*[A-Z])/;
    $mono = 0 if $pass =~ /[^a-zA-Z0-9 ]/;

    $now = time;
    ($nsec,$nmin,$nhour,$nmday,$nmon,$nyear) = localtime($now);

    # Embedded null can spoof crypt routine.

    if ($pass =~ /\0/) {
	print "Please don't use the null character in your password.\n";
	return 0;
    }

    if ($pass =~ /:/) {
	print "Please don't use the colon character in your password.  Some vendors have\n";
	print "a problem in changing passwds to something new when the old has a colon.\n";
	return 0;
    }

    # Do a little checking on the passwd for regex characters like * --Gene
    $tstring = $pass;
    $tstring =~ s/[\\()*.|\$^+\[\]]/\\$&/g;
    $tstring =~ s/[\\()?.|\$^+\[\]]/\\$&/g;
    print "$tstring is the new string comprared to $pass\n" if $debug;

    # Same password they just had?
    # This needs modified also to handle accounts that started with 
    # no password.   Without a salt from opasswd, crypt returns null, 
    # so don't test.   --Mark Henderson 8-26-92
    #     if (crypt($pass,$salt) eq $opasswd) {

    if ((crypt($pass,$salt) eq $opasswd) && ($opasswd)) {
	print "Please use a different password than you just had.\n";
	return 0;
    }
    
    # Password is a part of the gecos field?
    if( $gcos =~ /$tstring/i ) {
	print "Please don't use a part of your gcos entry.\n";
	return 0;
    }
	    
    # Password in .plan file?

    if(&checkfile("$home/.plan", $tstring)) {
         print "Please don't use a part of your .plan file!\n";
        return 0;
    }

    # Password in .project file?

    if(&checkfile("$home/.project", $tstring)) {    
	print "Please don't use a part of your .project file!\n";
       return 0;
   }

# Too much like the old password?

    if ($pass0 && length($pass0) == length($pass)) {
	$diff = 0;
	for ($i = length($pass)-1; $i >= 0; --$i) {
	    ++$diff
	      if substr($pass,$i,1) ne substr($pass0,$i,1);
	}
	if ($diff <= 2) {
	    print "That's too close to your old password.  Please try again.\n";
	    return 0;
	}
    }

    # Too short?  Get progressively nastier.

    if (length($pass) < 6) {
	print "I SAID, " if $isaid++;
	print "Please use at least 6 characters.\n";
	print "\nIf you persist I will log you out!\n\n"
	    if $isaid == 3;
	print "\nI mean it!!\n\n"
	    if $isaid == 4;
	print "\nThis is your last warning!!!\n\n"
	    if $isaid == 5;
	if ($isaid == 6) {
	    print "\nGoodbye!\n\n";
	    seek(STDIN,-100,0);  # Induce indigestion in shell.
	    exit 123;
	}
	return 0;
    }
    $isaid = 0;

     # run it through the pattern matcher..

    if ( $pass =~/^[A-Z]*$/ )          { print "Only upper case strings are not allowed.\n"; return 0;}
    if ( $pass =~/^[a-z]*$/ )          { print "Only lower case letters can be easily cracked.\n"; return 0;}
    if ( $pass =~/^[a-zA-Z]*$/ )       { print "Only letters can be easily cracked.\n"; return 0;}
    if ( $pass =~/^\d+$/ )             { print "You need to have more than a random number\n"; return 0;}
    if ( $pass =~/^[a-z]*\d+$/ )       { print "Only lower case letters with a number can be easily cracked.\n"; return 0;}
    if ( $pass =~/^[A-Z]*\d+$/ )       { print "Only upper case letters with a number can be easily cracked.\n"; return 0;}
    if ( $pass =~/^\d+[a-z]*$/ )       { print "Numbers with lower case strings can be easily cracked.\n"; return 0;}
    if ( $pass =~/^\d+[A-Z]*$/ )       { print "Numbers with upper case strings can be easily cracked.\n"; return 0;}
    if ( $pass =~/^\d+[a-zA-Z]*$/ )    { print "Numbers with only letters can be easily cracked.\n"; return 0;}
    if ( $pass =~/^[a-zA-Z]*\d+$/ )    { print "Only letters followed a number can be easily cracked.\n"; return 0;}
    if ( $pass =~/^\d+[a-zA-Z]*\d+$/ ) { print "DOE prohibits use of numbers in the first and/or last location.\n"; return 0;}

    # Call cracklib routine -- Added by EMir();

    $foo =  fascist_check($pass, $dict);

    if ( $foo ne "ok" ) {
        print "$foo!\n";
	return 0;
    }
    endif;


    if ($pass =~ /(ibm|dec|sun|at&t|nasa)/i) {
	print qq#A common substring such as "$1" makes your# .
	    " password too easy to guess.\n";
	return 0;
    }

    # Does it look like a date?

    if ($pass =~ m!^[-\d/]*$!) {
	if ($pass =~ m!^\d{3}-\d{2}-\d{4}$! ||
	    $pass =~ m!^\d\d\d\d\d\d\d\d\d$!) {
	    print "Please don't use a Social Security Number!\n";
	    return 0;
	}
	if ($pass =~ m!^\d*/\d*/\d*$! ||
	    $pass =~ m!^\d*-\d*-\d*$! ||
	    $pass =~ m!$nyear$!) {
	    print "Please don't use dates.\n";
	    return 0;
	}
	if ($pass =~ m!^\d\d\d-?\d\d\d\d$!) {
	    print "Please don't use a phone number.\n";
	    return 0;
	}
	if ($pass =~ m!^\d{6,7}$!) {
	    print "Please don't use a short number.\n";
	    return 0;
	}
    }

# minor cleanup to get matched parens --gene
    if ($mo = ($pass =~ /^[ \d]*([a-zA-Z]{3,5})[ \d]*$/) &&
	($mo =~ /^(jan|feb|mar(ch)?|apr(il)?|may|june?|july?|aug|sept?|oct|nov|dec)$/i) ) {
	print "Please don't use dates.\n";
	return 0;
    }

    # Login id?

    if ($pass =~ /$me/i) {
	print "Please don't use your login id.\n";
	return 0;
    }

    # My own name?

    if ($pass =~ /$mynames/i) {
	print "Please don't use part of your name.\n";
	return 0;
    }

    # My host name?

    if ($pass =~ /$host/i) {
	print "Please don't use your host name.\n";
	return 0;
    }

    # License plate number?

    if ($pass =~ /^\d?[a-zA-Z][a-zA-Z][a-zA-Z]\d\d\d$/ ||
	$pass =~ /^\d\d\d[a-zA-Z][a-zA-Z][a-zA-Z]$/) {
	print "Please don't use a license number.\n";
	return 0;
    }

    # A function key?  (This pattern checks Sun-style fn keys.)

    if ($pass =~ /^\033\[\d+/) {
	print "Please don't use a function key.\n";
	return 0;
    }

    # A sequence of closely related ASCII characters?

    @ary = unpack('C*',$pass);
    $ok = 0;
    for ($i = 0; $i < $#ary; ++$i) {
	$diff = $ary[$i+1] - $ary[$i];
	$ok = 1 if $diff > 1 || $diff < -1;
    }
    if (!$ok) {
	print "Please don't use sequences.\n";
	return 0;
    }

    # A sequence of keyboard keys?

    ($foo = $pass) =~ y/A-Z/a-z/;
    $foo =~ y/qwertyuiop[]asdfghjkl;'zxcvbnm,.\//a-la-ka-j/;
    $foo =~ y/!@#\$%^&*()_+|~/abcdefghijklmn/;
    $foo =~ y/-1234567890=\\`/kabcdefghijlmn/;
    @ary = unpack('C*',$foo);
    $ok = 0;
    for ($i = 0; $i < $#ary; ++$i) {
	$diff = $ary[$i+1] - $ary[$i];
	$ok = 1 if $diff > 1 || $diff < -1;
    }
    if (!$ok) {
	print "Please don't use consecutive keys.\n";
	return 0;
    }

    # Repeated patterns: ababab, abcabc, abcdabcd

    if ( $pass =~ /^(..)\1\1/
      || $pass =~ /^(...)\1/
      || $pass =~ /^(....)\1/ ) {
	print "Please don't use repeated sequences of $1.\n";
	return 0;
    }

    # Reversed patterns: abccba abcddcba

    if ( $pass =~ /^(.)(.)(.)\3\2\1/
      || $pass =~ /^(.)(.)(.)(.)\4\3\2\1/ ) {
	print "Please don't use palindromic sequences of $1$2$3$4.\n";
	return 0;
    }

    # Some other login name?

    if ($isalogin{$pass}) {
	print "Please don't use somebody's login id.\n";
	return 0;
    }

    # A local host name?

    if (-f "/usr/hosts/$pass") {
	print "Please don't use a local host name.\n";
	return 0;
    }

    # Reversed login id?

    $reverse = reverse $me;
    if ($pass =~ /$reverse/i) {
	print "Please don't use your login id spelled backwards.\n";
	return 0;
    }

    1;
}

sub cleanup {
    system 'stty', 'echo';
    print "\n\nAborted.\n";
    exit 1;
}

sub myexit {
    system 'stty', 'echo';
    exit shift(@_);
}


1;


# getyp($user): Accepts a text string (the username) as its argument.
#               Searches the yp database for this name.
#               Returns a list of all the fields of the passwd entry,
#               or null if the entry does not exist.
sub getyp {
	print "Inside getyp.\n" if $debug;
	local($user) = @_;
	print "Getting the user entry for $user.\n";
	$match = `ypcat passwd | grep ${user}:`;
	@ypentry = split(/:/, `ypmatch $user passwd`) if($match);
	print "The returned entry is @ypentry.\n" if $debug;
    return @ypentry;
}
1;


sub get_new_pw {

system 'stty', '-echo';
# Pick a password

for (;;) {
    $goodenough = 0;
    until ($goodenough) {
	print "New password: ";
	chop($pass1 = <STDIN>);
	print "\n";
	do myexit(1) unless $pass1;
	print "(Checking for lousy passwords...)\n";
	$goodenough = &goodenough($pass1);

	if ($goodenough eq 0) {
                print "Password is not acceptable, try again!\n";
        }

	# If longer than 8 chars, check first 8 chars alone.

	if ($goodenough && length($pass1) > 8) {
	    $pass8 = substr($pass1,0,8);
	    print "(Rechecking first 8 characters...)\n";
	    unless ($goodenough = &goodenough($pass8)) {
		    print "(Note that only the first 8 characters count.)\n";
	    }
	}
    };

    print "Retype new passwd: ";
    chop($pass2 = <STDIN>);
    print "\n";
  last if ($pass1 eq $pass2);
    print "Password mismatch--try again.\n";
}

system 'stty', 'echo';
}
1;

sub shell_game {
    # we have the original shell in $shell
    # offer the options ( This takes care of what is legal )
    $result = &im_prompt2("c", "Which shell would you like?", $shell_prompt,
                         $shell, @legal_shells);

    if($shell eq $result){
	print "\nLeaving shell unchanged.\n\n";
	exit(0);
    }

    $shell = $result; #leave here so debugging statement doesn't lie - KMS
    $new_shell = $result; #so that it really changes in non-yp passwd file -KMS
}
1;

sub gecos_update {
    local($name, $where, $office, $home);
    local($ngcos, $nname, $nwhere, $noffice, $nhome, $ok);
    # we have the gcos field from $gcos
    print "Current gcos is: $gcos\n" if $debug;
    ($name, $where, $office, $home) = split (",", $gcos);
    $ok = "no";
    while ( $ok eq 'no' ) {
	# print"NOTICE: To deter silly names, changes to gecos field are logged.\n\n";
	$nname = &im_prompt2("x", "Please enter name:", "", $name);
	$nwhere = &im_prompt2("x", "Please enter Affiliation:", "", $where);
	$noffice = &im_prompt2("x", "Please enter Office phone:", "", $office);
	$nhome = &im_prompt2("x", "Please enter Home phone:", "", $home);
	print "\nName: $nname\nLocation: $nwhere\n";
	print "Office phone: $noffice\nHome phone: $nhome\n";
	$ok = &im_prompt2("i", "\nAre these values ok?", "Yes/no",
			  "Yes", "yes","no" );

	# safety check for ":" and <CR>'s in the password file.
	$ngcos = join(",", $nname, $nwhere, $noffice, $nhome);
	if ( $ngcos =~ /:/ || $ngcos =~ /\n/ ) {
	    $ok = "no";
	    print "Invalid gcos entry!  \":\" and <CR> are not allowed.\n";
	}
    }
    # $subject = "$0: $me changing gecos field\n";
    # $subject .= "Old: $gcos\n";
    # $subject .= "New: $ngcos\n";
    # `/usr/ucb/Mail -s "$subject"  $accounts &`;
    $gcos = $ngcos; #so the debugging statement tells the truth -KMS
    $new_gcos = $ngcos; #so the new value gets written to passwd file -KMS
}
1;

##################################################################
# checkfile(file, string): Searches a file for any occurances
# of the string specified. Matches are done in a case-insensitive
# manner.
# If an occurance exists, returns 1; otherwise, returns 0

sub checkfile {
    local($file, $string) = @_;
    local($line);
    if ( -f $file ) {
	open (FILE, "$file");
	while ($line = <FILE>) {
	    return 1 if( $line =~ /$string/i );
	}
    }
    return 0;
}



# This perl subroutine will encrypt passwords
# The use of the subroutine is:
#	$crypted = &encrypt_passwd( $plaintext, $salt );
#	
#  --Mark Henderson
# 
# Merged it with main anlpasswd program 
# -- EMir();


sub encrypt_passwd {
  local($user,$pass)=@_;
  local($nsalt,$week,$now,$pert1,$pert2);
  local(@salt_set)=('a'..'z','A'..'Z','0'..'9','.','/');
  $now=time;
  ($pert1,$pert2) = unpack("C2",$user);
  $week = $now / (60*60*24*7) + $pert1 + $pert2;
  $nsalt = $salt_set[$week % 64] . $salt_set[$now %64];
  return crypt($pass,$nsalt);
}




# This perl routine will take a prompt, a default response and a list of
# possible responses and deal with the user interface, ( and the user! ),
# by displaying the prompt, showing the default, and checking to be sure
# that the response is one of the legal choices.
# --Mark Henderson
#
# Additional "types" that could be added would be a phone type,
# a social security type, a generic numeric pattern type...

# The usage is the following:
# x = don't care, a = alpha-only, n = numeric-only, i = ignore case
# c = case sensitive, r = ranged by the low and high values
#
# $result = &prompt("x", "text prompt", "help prompt", "default" );
#
# $result = &prompt("a", "text prompt", "help prompt", "default" );
#
# $result = &prompt("n", "text prompt", "help prompt", "default" );
#
# $result = &prompt("i", "text prompt", "help prompt", "default",
#	                 "legal_options-ignore-case-list");
#
# $result = &prompt("c", "text prompt", "help prompt", "default",
#	                 "legal_options-case-sensitive-list");
#
# $result = &prompt("r", "text prompt", "help prompt", "default",
#			"low", "high");
#
# What, you might ask, is the difference between a "text prompt" and a
# "help prompt"?  Think about the case where the "legal_options" look 
# something like: "1-1000".  Now consider what happens when you tell someone
# that "0" is not between 1-1000 and that the possible choices are:  :)
# 1 2 3 4 5 .....
# This is what the "help prompt" is for.

# It will work off of unique parts of "legal_options".

sub im_prompt2 {
    local ($debug) = 0;		# debugging

    local($mopt, $prompt, $prompt_options, $default, @things);
    local($repl, @match, $tmp, $match_options, $case, $low, $high);

    # Figure out just what we are doing here
    ($mopt) = @_;
    print "mopt is: $mopt\n" if $debug;

    # check the size of the match option, it should just have one char.
    die "Illegal call in im_prompt2 prompter."
	if ( length($mopt) > 1 );

    WHAT: {			# What sort of checking are we doing
	$type = 0;
	$legal = 0;
	$range = 0;

	if ( $mopt =~ /x/ || $mopt =~ /a/ || $mopt =~ /n/ ) {
	    ($mopt, $prompt, $prompt_options, $default) = @_;
	    $type = 1;
	    last WHAT;
	}
	if ( $mopt =~ /c/ || $mopt =~ /i/ ) {
	    ($mopt, $prompt, $prompt_options, $default, @things) = @_;
	    $legal = 1;
	    last WHAT;
	}
	if ( $mopt =~ /r/ ) {
	    ($mopt, $prompt, $prompt_options, $default, $low, $high) = @_;
	    $range = 1;
	    last WHAT;
	}
     }				


    $ok = 0;
    while (1) {
        # print out the prompt string in all it's gore
	print "$prompt ";
	if ( $prompt_options ne '' ) {
	    print "($prompt_options) ";
	} 
        print "[default $default] " if $default ne '';

        $_ = scalar<STDIN>;
        chop;			# nuke the <CR>

        s/^\s*//;		# ignore leading white space
        s/\s*$//;		# ignore trailing white space

        $_ = $default if $_ eq '';

        if ($_ eq '') {
            print "Invalid option\n";
            next;
        }

        print "Reply: '$_'\n" if $debug;
        $repl = $_;

	# Now here is where things get real interesting
	
        HOW: {
	    if ( $type ) { &typeit; last HOW; }
	    if ( $legal ) { &legalit; last HOW; }
	    if ( $range ) { &rangeit; last HOW; }
	}
	if ( $ok ) { 
	    return $repl;
	} else {
	    if ( $prompt_options ne '' ) {
		print "Options are:\n$prompt_options\n";
	    } 
	}

    }

sub rangeit {
    # this routine makes sure that the reply is within a given range 

    if ( $low <= $repl && $repl <= $high ) { 
	$ok = 1;
    } else {
	print "Invalid range value.  ";
    }
}

sub legalit {
    # this routine checks to see if a repl is one of a set of "things"
    # it checks case based on c = case check, i = ignore case

    if ( $mopt eq "c" ) {
	@match = grep(/^$repl/, @things); # check w/case
    } else {
	@match = grep(/^$repl/i, @things); # check ignoring case
    }
    # this is to check for unique stings if they aren't at the beginning
    if ( @match == 0 ) {
        if ( $mopt eq "c" ) {
            @match = grep(/$repl/, @things); # check w/case
        } else {
            @match = grep(/$repl/i, @things); # check ignoring case
        }
    }
    print join(":", @match), "\n" if $debug;
    if (@match == 1) {
	$repl = $match[0];
	$ok = 1;
    } elsif (@match == 0) {
	print "Invalid legal match.  ";
    } else {
	foreach $tmp ( @match ) {
	    print "testing $tmp for $repl.\n" if ($debug);
	    $ok = 1 if ($tmp eq $repl);
	}
	if ( ! $ok ) {
	    print "Ambiguous reply.  ";
	}
    }
}

sub typeit {
    # this routine does checks based on the following:
    # x = no checks, a = alpha only, n = numeric only
    print "inside of typeit\n" if $debug;

    if ( $mopt eq "x" ) { $ok = 1; }

    if ( $mopt eq "a" ) {
	if ( $repl =~ /^[a-zA-Z]*$/ ) { 
	    $ok = 1; 
	} else {		
	    print "Invalid type value.  ";
	}
    }

    if ( $mopt eq "n" ) {
	if ( $repl =~/^[0-9]*$/ ) { 
	    $ok = 1; 
	} else {
	    print "Invalid numeric value.  ";
	}
    }
}				
}
