# Basic expect script for Kerberos tests.
# This is a DejaGnu test script.
# Written by Ian Lance Taylor, Cygnus Support, <ian@cygnus.com>.
# This script is automatically run by DejaGnu before running any of
# the Kerberos test scripts.

# This file provides several functions which deal with a local
# Kerberos database.  We have to do this such that we don't interfere
# with any existing Kerberos database.  We will create all the files
# in the directory $tmppwd, which will have been created by the
# testsuite default script.  We will use $REALMNAME as our Kerberos
# realm name, defaulting to KRBTEST.COM.

set timeout 100
set stty_init {erase \^h kill \^u}
set env(TERM) dumb

set des3_krbtgt 0
set tgt_support_desmd5 0
set supported_enctypes "des-cbc-crc:normal"
set kdc_supported_enctypes "des-cbc-crc:normal"

# The names of the individual passes must be unique; lots of things
# depend on it.  The PASSES variable may not contain comments; only
# small pieces get evaluated, so comments will do strange things.

# Most of the purpose of using multiple passes is to exercise the
# dependency of various bugs on configuration file settings,
# particularly with regards to encryption types.

# The des.no-kdc-md5 pass will fail if the KDC does not constrain
# session key enctypes to those in its permitted_enctypes list.  It
# works by assuming enctype similarity, thus allowing the client to
# request a des-cbc-md4 session key.  Since only des-cbc-crc is in the
# KDC's permitted_enctypes list, the TGT will be unusable.

# KLUDGE for tracking down leaking ptys
if 0 {
    rename spawn oldspawn
    rename wait oldwait
    proc spawn { args } {
	upvar 1 spawn_id spawn_id
	verbose "spawn: args=$args"
	set pid [eval oldspawn $args]
	verbose "spawn: pid=$pid spawn_id=$spawn_id"
	return $pid
    }
    proc wait { args } {
	upvar 1 spawn_id spawn_id
	verbose "wait: args=$args"
	set ret [eval oldwait $args]
	verbose "wait: $ret"
	return $ret
    }
}

if { [string length $VALGRIND] } {
    rename spawn valgrind_aux_spawn
    proc spawn { args } {
	global VALGRIND
	upvar 1 spawn_id spawn_id
	set newargs {}
	set inflags 1
	set eatnext 0
	foreach arg $args {
	    if { $arg == "-ignore" \
		     || $arg == "-open" \
		     || $arg == "-leaveopen" } {
		lappend newargs $arg
		set eatnext 1
		continue
	    }
	    if [string match "-*" $arg] {
		lappend newargs $arg
		continue
	    }
	    if { $eatnext } {
		set eatnext 0
		lappend newargs $arg
		continue
	    }
	    if { $inflags } {
		set inflags 0
		# Only run valgrind for local programs, not
		# system ones.
		if [string match "/" [string index $arg 0]]&&![string match "/bin/sh" $arg]&&![string match "/bin/ls" $arg]&&![regexp {/kshd$} $arg] {
		    set newargs [concat $newargs $VALGRIND]
		}
	    }
	    lappend newargs $arg
	}
	set pid [eval valgrind_aux_spawn $newargs]
	return $pid
    }
}

# Hack around Solaris 9 kernel race condition that causes last output
# from a pty to get dropped.
if { $PRIOCNTL_HACK } {
    catch {exec priocntl -s -c FX -m 30 -p 30 -i pid [getpid]}
    rename spawn oldspawn
    proc spawn { args } {
	upvar 1 spawn_id spawn_id
	set newargs {}
	set inflags 1
	set eatnext 0
	foreach arg $args {
	    if { $arg == "-ignore" \
		     || $arg == "-open" \
		     || $arg == "-leaveopen" } {
		lappend newargs $arg
		set eatnext 1
		continue
	    }
	    if [string match "-*" $arg] {
		lappend newargs $arg
		continue
	    }
	    if { $eatnext } {
		set eatnext 0
		lappend newargs $arg
		continue
	    }
	    if { $inflags } {
		set inflags 0
		set newargs [concat $newargs {priocntl -e -c FX -p 0}]
	    }
	    lappend newargs $arg
	}
	set pid [eval oldspawn $newargs]
	return $pid
    }
}

# The des.des3-tgt.no-kdc-des3 pass will fail if the KDC doesn't
# constrain ticket key enctypes to those in permitted_enctypes.  It
# does this by not putting des3 in the permitted_enctypes, while
# creating a TGT princpal that has a des3 key as well as a des key.

# XXX -- master_key_type is fragile w.r.t. permitted_enctypes; it is
# possible to configure things such that you have a master_key_type
# that is not permitted, and the error message used to be cryptic.

set passes {
    {
	des
	mode=udp
	des3_krbtgt=0
	{supported_enctypes=des-cbc-crc:normal}
	{kdc_supported_enctypes=des-cbc-crc:normal}
	{dummy=[verbose -log "DES TGT, DES enctype"]}
    }
    {
	des.des3tgt
	mode=udp
	des3_krbtgt=1
	{supported_enctypes=des-cbc-crc:normal}
	{kdc_supported_enctypes=des3-cbc-sha1:normal des-cbc-crc:normal}
	{dummy=[verbose -log "DES3 TGT, DES enctype"]}
    }
    {
	des3
	mode=udp
	des3_krbtgt=1
	{supported_enctypes=des3-cbc-sha1:normal des-cbc-crc:normal}
	{kdc_supported_enctypes=des3-cbc-sha1:normal des-cbc-crc:normal}
	{dummy=[verbose -log "DES3 TGT, DES3 + DES enctypes"]}
    }
    {
	aes
	mode=udp
	des3_krbtgt=0
	{supported_enctypes=aes256-cts-hmac-sha1-96:normal des-cbc-crc:normal}
	{kdc_supported_enctypes=aes256-cts-hmac-sha1-96:normal des-cbc-crc:normal}
	{permitted_enctypes(kdc)=aes256-cts-hmac-sha1-96 des-cbc-crc}
	{permitted_enctypes(client)=aes256-cts-hmac-sha1-96 des-cbc-crc}
	{permitted_enctypes(server)=aes256-cts-hmac-sha1-96 des-cbc-crc}
	{master_key_type=aes256-cts-hmac-sha1-96}
	{dummy=[verbose -log "AES + DES enctypes"]}
    }
    {
	aesonly
	mode=udp
	des3_krbtgt=0
	{supported_enctypes=aes256-cts-hmac-sha1-96:normal}
	{kdc_supported_enctypes=aes256-cts-hmac-sha1-96:normal}
	{permitted_enctypes(kdc)=aes256-cts-hmac-sha1-96}
	{permitted_enctypes(client)=aes256-cts-hmac-sha1-96}
	{permitted_enctypes(server)=aes256-cts-hmac-sha1-96}
	{master_key_type=aes256-cts-hmac-sha1-96}
	{dummy=[verbose -log "AES enctypes"]}
    }
    {
	aes-tcp
	mode=tcp
	des3_krbtgt=0
	{supported_enctypes=aes256-cts-hmac-sha1-96:normal}
	{kdc_supported_enctypes=aes256-cts-hmac-sha1-96:normal}
	{permitted_enctypes(kdc)=aes256-cts-hmac-sha1-96}
	{permitted_enctypes(client)=aes256-cts-hmac-sha1-96}
	{permitted_enctypes(server)=aes256-cts-hmac-sha1-96}
	{master_key_type=aes256-cts-hmac-sha1-96}
	{dummy=[verbose -log "AES via TCP"]}
    }
    {
	aes-des3
	mode=udp
	des3_krbtgt=0
	{supported_enctypes=aes256-cts-hmac-sha1-96:normal des3-cbc-sha1:normal des-cbc-crc:normal}
	{kdc_supported_enctypes=aes256-cts-hmac-sha1-96:normal des3-cbc-sha1:normal des-cbc-crc:normal}
	{permitted_enctypes(kdc)=aes256-cts-hmac-sha1-96 des3-cbc-sha1 des-cbc-crc}
	{permitted_enctypes(client)=aes256-cts-hmac-sha1-96 des3-cbc-sha1 des-cbc-crc}
	{permitted_enctypes(server)=aes256-cts-hmac-sha1-96 des3-cbc-sha1 des-cbc-crc}
	{master_key_type=aes256-cts-hmac-sha1-96}
	{dummy=[verbose -log "AES + DES enctypes"]}
    }
    {
	des3-aes
	mode=udp
	des3_krbtgt=1
	{supported_enctypes=aes256-cts-hmac-sha1-96:normal des3-cbc-sha1:normal des-cbc-crc:normal}
	{kdc_supported_enctypes=aes256-cts-hmac-sha1-96:normal des3-cbc-sha1:normal des-cbc-crc:normal}
	{permitted_enctypes(kdc)=aes256-cts-hmac-sha1-96 des3-cbc-sha1 des-cbc-crc}
	{permitted_enctypes(client)=aes256-cts-hmac-sha1-96 des3-cbc-sha1 des-cbc-crc}
	{permitted_enctypes(server)=aes256-cts-hmac-sha1-96 des3-cbc-sha1 des-cbc-crc}
	{master_key_type=aes256-cts-hmac-sha1-96}
	{dummy=[verbose -log "AES + DES enctypes, DES3 TGT"]}
    }
    {
	des-v4
	mode=udp
	des3_krbtgt=0
	{supported_enctypes=des-cbc-crc:v4}
	{kdc_supported_enctypes=des-cbc-crc:v4}
	{default_tkt_enctypes(client)=des-cbc-crc}
	{dummy=[verbose -log "DES TGT, DES-CRC enctype, V4 salt"]}
    }
    {
	des-md5-v4
	mode=udp
	des3_krbtgt=0
	{supported_enctypes=des-cbc-md5:v4 des-cbc-crc:v4}
	{kdc_supported_enctypes=des-cbc-md5:v4 des-cbc-crc:v4}
	{default_tkt_enctypes(client)=des-cbc-md5 des-cbc-crc}
	{dummy=[verbose -log "DES TGT, DES-MD5 and -CRC enctypes, V4 salt"]}
    }
    {
	all-des-des3-enctypes
	mode=udp
	des3_krbtgt=1
	{supported_enctypes=des3-cbc-sha1:normal des-cbc-crc:normal \
		des-cbc-md5:normal des-cbc-crc:v4 des-cbc-md5:norealm \
		des-cbc-md4:normal}
	{kdc_supported_enctypes=des3-cbc-sha1:normal des-cbc-crc:normal \
		des-cbc-md5:normal des-cbc-crc:v4 des-cbc-md5:norealm \
		des-cbc-md4:normal}
	{dummy=[verbose -log "DES3 TGT, many DES3 + DES enctypes"]}
    }
    {
	des.no-kdc-md5
	mode=udp
	des3_krbtgt=0
	tgt_support_desmd5=0
	{permitted_enctypes(kdc)=des-cbc-crc}
	{default_tgs_enctypes(client)=des-cbc-md5 des-cbc-md4 des-cbc-crc}
	{default_tkt_enctypes(client)=des-cbc-md5 des-cbc-md4 des-cbc-crc}
	{supported_enctypes=des-cbc-crc:normal}
	{kdc_supported_enctypes=des-cbc-crc:normal}
	{master_key_type=des-cbc-crc}
	{dummy=[verbose -log \
		"DES TGT, KDC permitting only des-cbc-crc"]}
    }
    {
	des.des3-tgt.no-kdc-des3
	mode=udp
	tgt_support_desmd5=0
	{permitted_enctypes(kdc)=des-cbc-crc}
	{default_tgs_enctypes(client)=des-cbc-crc}
	{default_tkt_enctypes(client)=des-cbc-crc}
	{supported_enctypes=des3-cbc-sha1:normal des-cbc-crc:normal}
	{kdc_supported_enctypes=des3-cbc-sha1:normal des-cbc-crc:normal}
	{master_key_type=des-cbc-crc}
	{dummy=[verbose -log \
		"DES3 TGT, KDC permitting only des-cbc-crc"]}
    }
}

# des.md5-tgt is set as unused, since it won't trigger the error case
# if SUPPORT_DESMD5 isn't honored.

# The des.md5-tgt pass will fail if enctype similarity is inconsisent;
# between 1.0.x and 1.1, the decrypt functions became more strict
# about matching enctypes, while the KDB retrieval functions didn't
# coerce the enctype to match what was requested.  It works by setting
# SUPPORT_DESMD5 on the TGT principal, forcing an enctype of
# des-cbc-md5 on the TGT key.  Since the database only contains a
# des-cbc-crc key, the decrypt will fail if enctypes are not coerced.

# des.no-kdc-md5.client-md4-skey is retained in unsed_passes, even
# though des.no-kdc-md5 is roughly equivalent, since the associated
# comment needs additional investigation at some point re the kadmin
# client.

# The des.no-kdc-md5.client-md4-skey will fail on TGS requests due to
# the KDC issuing session keys that it won't accept.  It will also
# fail for a kadmin client, but for different reasons, since the kadm5
# library does some curious filtering of enctypes, and also uses
# get_in_tkt() rather than get_init_creds(); the former does an
# intersection of the enctypes provided by the caller and those listed
# in the config file!

set unused_passes {
    {
	des.md5-tgt
	des3_krbtgt=0
	tgt_support_desmd5=1
	supported_enctypes=des-cbc-crc:normal
	kdc_supported_enctypes=des-cbc-crc:normal
	{permitted_enctypes(kdc)=des-cbc-md5 des-cbc-md4 des-cbc-crc}
	{permitted_enctypes(client)=des-cbc-md5 des-cbc-md4 des-cbc-crc}
	{dummy=[verbose -log "DES TGT, SUPPORTS_DESMD5"]}
    }
    {
	des.md5-tgt.no-kdc-md5
	des3_krbtgt=0
	tgt_support_desmd5=1
	{permitted_enctypes(kdc)=des-cbc-crc}
	{default_tgs_enctypes(client)=des-cbc-crc}
	{default_tkt_enctypes(client)=des-cbc-crc}
	{supported_enctypes=des-cbc-crc:normal}
	{kdc_supported_enctypes=des-cbc-crc:normal}
	{master_key_type=des-cbc-crc}
	{dummy=[verbose -log \
		"DES TGT, SUPPORTS_DESMD5, KDC permitting only des-cbc-crc"]}
    }
    {
	des.no-kdc-md5.client-md4-skey
	des3_krbtgt=0
	{permitted_enctypes(kdc)=des-cbc-crc}
	{permitted_enctypes(client)=des-cbc-crc des-cbc-md4}
	{default_tgs_enctypes(client)=des-cbc-crc des-cbc-md4}
	{default_tkt_enctypes(client)=des-cbc-md4}
	{supported_enctypes=des-cbc-crc:normal}
	{kdc_supported_enctypes=des-cbc-crc:normal}
	{dummy=[verbose -log \
		"DES TGT, DES enctype, KDC permitting only des-cbc-crc, client requests des-cbc-md4 session key"]}
    }
    {
	all-enctypes
	des3_krbtgt=1
	{supported_enctypes=\
	aes256-cts-hmac-sha1-96:normal aes256-cts-hmac-sha1-96:norealm \
	aes128-cts-hmac-sha1-96:normal aes128-cts-hmac-sha1-96:norealm \
	des3-cbc-sha1:normal des3-cbc-sha1:none \
	des-cbc-md5:normal des-cbc-md4:normal des-cbc-crc:normal \
	des-cbc-md5:v4 des-cbc-md4:v4 des-cbc-crc:v4 \
	}
	{kdc_supported_enctypes=\
	des3-cbc-sha1:normal des3-cbc-sha1:none \
	des-cbc-md5:normal des-cbc-md4:normal des-cbc-crc:normal \
	des-cbc-md5:v4 des-cbc-md4:v4 des-cbc-crc:v4 \
	}
	{dummy=[verbose -log "DES3 TGT, default enctypes"]}
    }
    # This won't work for anything using GSSAPI until it gets AES support.
    {
	aes-only
	des3_krbtgt=0
	{supported_enctypes=aes256-cts-hmac-sha1-96:normal}
	{kdc_supported_enctypes=aes256-cts-hmac-sha1-96:normal}
	{permitted_enctypes(kdc)=aes256-cts-hmac-sha1-96}
	{permitted_enctypes(client)=aes256-cts-hmac-sha1-96}
	{permitted_enctypes(server)=aes256-cts-hmac-sha1-96}
	{master_key_type=aes256-cts-hmac-sha1-96}
	{dummy=[verbose -log "AES only, no DES or DES3 support"]}
    }
}
#	{supported_enctypes=des-cbc-md5:normal des-cbc-crc:normal twofish256-hmac-sha1:normal }
#	{kdc_supported_enctypes= des-cbc-md5:normal des-cbc-crc:normal twofish256-hmac-sha1:normal}

# This shouldn't be necessary on dejagnu-1.4 and later, but 1.3 seems
# to need it because its runtest.exp doesn't deal with PASS at all.
if [info exists PASS] {
    foreach pass $passes {
	if { [lsearch -exact $PASS [lindex $pass 0]] >= 0 } {
	    lappend MULTIPASS $pass
	}
    }
} else {
    set MULTIPASS $passes
}

set last_passname_conf ""
set last_passname_db ""

# We do everything in a temporary directory.
if ![info exists TMPDIR] {
    set tmppwd "[pwd]/tmpdir"
    if ![file isdirectory $tmppwd] {
	catch "exec mkdir $tmppwd" status
    }
} else {
    set tmppwd $TMPDIR
}
verbose "tmppwd=$tmppwd"

# On Ultrix, use /bin/sh5 in preference to /bin/sh.
if ![info exists BINSH] {
    if [file exists /bin/sh5] {
	set BINSH /bin/sh5
    } else {
	set BINSH /bin/sh
    }
}

# For security, we must not use generally known passwords.  This is
# because some of the tests may be run as root.  If the passwords were
# generally know, then somebody could work out the appropriate
# Kerberos ticket to use, and come in when, say, the telnetd daemon
# was being tested by root.  The window for doing this is very very
# small, so the password does not have to be perfect, it just can't be
# constant.
if ![info exists KEY] {
    catch {exec $BINSH -c "echo $$"} KEY
    verbose "KEY is $KEY"
    set keyfile [open $tmppwd/KEY w]
    puts $keyfile "$KEY"
    close $keyfile
}

# Clear away any files left over from a previous run.
# We can't use them now because we don't know the right KEY.
# krb5.conf might change if running tests on another host
catch "exec rm -f $tmppwd/db.ok $tmppwd/srvtab $tmppwd/krb5.conf $tmppwd/kdc.conf $tmppwd/cpw_srvtab $tmppwd/krb.realms $tmppwd/krb.conf"

# Put the installed kerberos directories on PATH.
# This needs to be fixed for V5.
# set env(PATH) $env(PATH):/usr/kerberos/bin:/usr/kerberos/etc
# verbose "PATH=$env(PATH)"

# Some of the tests expect $env(USER) to be set.
if ![info exists env(USER)] {
    if [info exists env(LOGNAME)] {
	set env(USER) $env(LOGNAME)
    } else {
	if [info exists logname] {
	    set env(USER) $logname
	} else {
	    catch "exec whoami" env(USER)
	}
    }
}

# set the realm. The user can override this on the runtest line.
if ![info exists REALMNAME] {
    set REALMNAME "KRBTEST.COM"
}
verbose "Test realm is $REALMNAME"

# Find some programs we need.  We use the binaries from the build tree
# if they exist.  If they do not, then they must be in PATH.  We
# expect $objdir to be ...tests/dejagnu.

foreach i {
    {KDB5_UTIL $objdir/../../kadmin/dbutil/kdb5_util}
    {KRB5KDC $objdir/../../kdc/krb5kdc}
    {KADMIND $objdir/../../kadmin/server/kadmind}
    {KADMIN $objdir/../../kadmin/cli/kadmin}
    {KADMIN_LOCAL $objdir/../../kadmin/cli/kadmin.local}
    {KINIT $objdir/../../clients/kinit/kinit}
    {KTUTIL $objdir/../../kadmin/ktutil/ktutil}
    {KLIST $objdir/../../clients/klist/klist}
    {KDESTROY $objdir/../../clients/kdestroy/kdestroy}
    {RESOLVE $objdir/../resolve/resolve}
    {T_INETD $objdir/t_inetd}
} {
    set varname [lindex $i 0]
    if ![info exists $varname] {
	eval set varval [lindex $i 1]
	set varval [findfile $varval]
	set $varname $varval
	verbose "$varname=$varval"
    } {
	eval set varval \$$varname
	verbose "$varname already set to $varval"
    }
}

if ![info exists RLOGIN] {
    set RLOGIN rlogin
}

if ![info exists RLOGIN_FLAGS] {
    set RLOGIN_FLAGS "-x"
}

# We use a couple of variables to hold shell prompts which may be
# overridden by the user.

if ![info exists ROOT_PROMPT] {
    set ROOT_PROMPT "(%|#|>|\\$) $"
}

if ![info exists SHELL_PROMPT] {
    set SHELL_PROMPT "(%|#|>|\\$) $"
}

verbose "setting up onexit handler (old handler=[exit -onexit])"
exit -onexit [concat {
    verbose "calling stop_kerberos_daemons (onexit handler)"
    stop_kerberos_daemons;
} [exit -onexit]]

# check_k5login

# Most of the tests won't work if the user has a .k5login file, unless
# the user's name appears with $REALMNAME in .k5login

# This procedure returns 1 if the .k5login file appears to be OK, 0
# otherwise.  This check is not foolproof.

# Note that this previously checked for a username with no realm; this
# works for krb4's kuserok() but not for krb5_kuserok(), due to some
# implementation details.  *sigh*

proc check_k5login { testname } {
    global env
    global REALMNAME

    if {![file exists ~/.k5login]} {
	if {$env(USER) == "root"} {
	    return 0
	} else {
	    return 1
	}
    }

    verbose "looking for $env(USER)@$REALMNAME in ~/.k5login" 2
    set file [open ~/.k5login r]
    while { [gets $file principal] != -1 } {
	verbose " found $principal" 2
	if { $principal == "$env(USER)@$REALMNAME" } {
	    close $file
	    return 1
	}
    }
    close $file

    note "$testname test requires that your name appear in your ~/.k5login"
    note "file in the form $env(USER)@$REALMNAME"
    unsupported "$testname"

    return 0
}

proc check_klogin { testname } {
    global env
    global REALMNAME

    if {![file exists ~/.klogin]} {
	if {$env(USER) == "root"} {
	    return 0
	} else {
	    return 1
	}
    }

    verbose "looking for $env(USER) in ~/.klogin" 2
    set file [open ~/.klogin r]
    while { [gets $file principal] != -1 } {
	verbose " found $principal" 2
	if { $principal == "$env(USER)" \
		|| $principal == "$env(USER)@$REALMNAME" } {
	    close $file
	    return 1
	}
    }
    close $file

    note "$testname test requires that your name appear in your ~/.klogin"
    note "file without a realm."
    unsupported "$testname"

    return 0
}

# check_exit_status
# Check the exit status of a spawned program.  Returns 1 if the
# program succeeded, 0 if it failed.

proc check_exit_status { testname } {
    global spawn_id

    verbose "about to wait ($testname)"
    set status_list [wait -i $spawn_id]
    verbose "wait -i $spawn_id returned $status_list ($testname)"
    catch "close -i $spawn_id"
    if { [lindex $status_list 2] != 0 || [lindex $status_list 3] != 0 } {
	verbose -log "exit status: $status_list"
	fail "$testname"
	return 0
    } else {
	return 1
    }
}

#
# ENVSTACK
#

# These procedures implement an environment variable stack.  They use
# the global variable $envvars_tosave for the purpose of identifying
# which environment variables to save.  They also track which ones are
# unset at any particular point.  The stack pointer is $envstackp,
# which is an integer.  The arrays $envstack$envstackp and
# $unenvstack$envstackp store respectively the set of old environment
# variables/values pushed onto the stack and the set of old unset
# environment variables for a given value of $envstackp.

# Changing the value of $envvars_tosave after performing the first
# push operation may result in strangeness.

#
# envstack_push
#
# Push set of current environment variables.
#
proc envstack_push { } {
    global env
    global envvars_tosave
    global envstackp
    global envstack$envstackp
    global unenvstack$envstackp

    verbose "envstack_push: starting, sp=$envstackp"
    foreach i $envvars_tosave {
	if [info exists env($i)] {
	    verbose "envstack_push: saving $i=$env($i)"
	    set envstack${envstackp}($i) $env($i)
	} {
	    verbose "envstack_push: marking $i as unset"
	    set unenvstack${envstackp}($i) unset
	}
    }
    incr envstackp
    verbose "envstack_push: exiting, sp=$envstackp"
}

#
# envstack_pop
#
# Pop set of current environment variables.
#
proc envstack_pop { } {
    global env
    global envstackp

    verbose "envstack_pop: starting, sp=$envstackp"
    incr envstackp -1
    global envstack$envstackp	# YUCK!!! no obvious better way though...
    global unenvstack$envstackp
    if {$envstackp < 0} {
	perror "envstack_pop: stack underflow!"
	return
    }
    if [info exists envstack$envstackp] {
	foreach i [array names envstack$envstackp] {
	    if [info exists env($i)] {
		verbose "envstack_pop: $i was $env($i)"
	    }
	    eval set env($i) \$envstack${envstackp}($i)
	    verbose "envstack_pop: restored $i to $env($i)"
	}
	unset envstack$envstackp
    }
    if [info exists unenvstack$envstackp] {
	foreach i [array names unenvstack$envstackp] {
	    if [info exists env($i)] {
		verbose "envstack_pop: $i was $env($i)"
		unset env($i)
		verbose "envstack_pop: $i unset"
	    } {
		verbose "envstack_pop: ignoring already unset $i"
	    }
	}
	unset unenvstack$envstackp
    }
    verbose "envstack_pop: exiting, sp=$envstackp"
}

#
# Initialize the envstack
#
set envvars_tosave {
    KRB5_CONFIG KRB5CCNAME KRBTKFILE KRB5RCACHEDIR
    KERBEROS_SERVER KRB5_KDC_PROFILE
}
set krb5_init_vars [list ]
# XXX -- fix me later!
foreach i $runvarlist {
    verbose "processing $i"
    if {[regexp "^(\[^=\]*)=(.*)" $i foo evar evalue]} {
	verbose "adding $evar to savelist"
	lappend envvars_tosave $evar
	verbose "savelist $envvars_tosave"
	lappend krb5_init_vars $i
    }
}
set envstackp 0
envstack_push

# setup_runtime_flags
# Sets the proper flags for shared libraries. 
# Configuration is through a site.exp and the runvarlist variable
# Returns 1 if variables were already set, otherwise 0
proc setup_runtime_env { } {
    global env
    global krb5_init_vars

    # Set the variables
    foreach i $krb5_init_vars {
	regexp "^(\[^=\]*)=(.*)" $i foo evar evalue
	set env($evar) "$evalue"
	verbose "$evar=$evalue"
    }
    return 0
}

# get_hostname
# This procedure will get the local hostname.  It sets the global
# variables hostname (the full name) and localhostname (the first part
# of the name).  Returns 1 on success, 0 on failure.

proc get_hostname { } {
    global RESOLVE
    global hostname
    global localhostname
    global domain
    global tmppwd

    if {[info exists hostname] && [info exists localhostname]} {
	return 1
    }

    envstack_push
    setup_runtime_env
    catch "exec $RESOLVE -q >$tmppwd/hostname" exec_output
    envstack_pop
    if ![string match "" $exec_output] {
	verbose -log $exec_output
	perror "can't get hostname"
	return 0
    }
    set file [open $tmppwd/hostname r]
    if { [ gets $file hostname ] == -1 } {
	perror "no output from hostname"
	return 0
    }
    close $file
    catch "exec rm -f $tmppwd/hostname" exec_output
    regexp "^(\[^.\]*)\\.(.*)$" $hostname foo localhostname domain

    set hostname [string tolower $hostname]
    set localhostname [string tolower $localhostname]
    set domain [string tolower $domain]
    verbose "hostname: $hostname; localhostname: $localhostname; domain $domain"

    return 1
}

# modify_principal name options...

proc modify_principal { name args } {
    global KADMIN_LOCAL
    global REALMNAME

    spawn $KADMIN_LOCAL -r $REALMNAME
    expect_after {
	eof {
	    fail "modprinc (kadmin.local)"
	    return 0
	}
	timeout {
	    fail "modprinc (kadmin.local)"
	    return 0
	}
    }
    expect "kadmin.local: "
    send "modprinc $args $name\r"
    expect -re "modprinc \[^\n\r\]* $name"
    expect -re "Principal .* modified."
    send "quit\r"
    expect eof
    catch expect_after
    if ![check_exit_status "kadmin.local modprinc"] {
	perror "kadmin.local modprinc exited abnormally"
    }
    return 1
}

# kdc listens on +0..+3, depending whether we're testing reachable or not
# client tries +1 and +6
# kadmind +4
# kpasswd +5
# krb524 +7
# application servers (krlogind, telnetd, krshd, ftpd, etc) +8
if [info exists PORTBASE] {
    set portbase $PORTBASE
} else {
    set portbase 3085
}

# setup_kerberos_files
# This procedure will create some Kerberos files which must be created
# manually before trying to run any Kerberos programs.  Returns 1 on
# success, 0 on failure.

proc setup_kerberos_files { } {
    global REALMNAME
    global hostname
    global domain
    global tmppwd
    global supported_enctypes
    global kdc_supported_enctypes
    global last_passname_conf
    global multipass_name
    global master_key_type
    global mode
    global portbase

    if ![get_hostname] { 
	return 0
    }

    setup_krb5_conf client
    setup_krb5_conf server
    setup_krb5_conf kdc

    # Create a kdc.conf file.
    if { ![file exists $tmppwd/kdc.conf] \
	    || $last_passname_conf != $multipass_name } {
	if ![info exists master_key_type] {
	    set master_key_type des-cbc-md5
	}
	set conffile [open $tmppwd/kdc.conf w]
	puts $conffile "\[kdcdefaults\]"
	puts $conffile "	kdc_ports = $portbase,[expr 1 + $portbase],[expr 2 + $portbase]"
	puts $conffile "	kdc_tcp_ports = $portbase,[expr 1 + $portbase],[expr 2 + $portbase]"
	puts $conffile ""
	puts $conffile "\[realms\]"
	puts $conffile "	$REALMNAME = \{"
#	puts $conffile "		database_name = $tmppwd/db"
	puts $conffile "		admin_database_name = $tmppwd/adb"
	puts $conffile "		admin_database_lockfile = $tmppwd/adb.lock"
	puts $conffile "		key_stash_file = $tmppwd/stash"
	puts $conffile "		acl_file = $tmppwd/acl"
	puts $conffile "		kadmind_port = [expr 4 + $portbase]"
	puts $conffile "		kpasswd_port = [expr 5 + $portbase]"
	puts $conffile "		max_life = 1:00:00"
	puts $conffile "		max_renewable_life = 3:00:00"
	puts $conffile "		master_key_type = $master_key_type"
	puts $conffile "		master_key_name = master/key"
	puts $conffile "		supported_enctypes = $supported_enctypes"
	puts $conffile "		kdc_supported_enctypes = $kdc_supported_enctypes"
	if { $mode == "tcp" } {
	    puts $conffile "		kdc_ports = [expr 3 + $portbase]"
	    puts $conffile "		kdc_tcp_ports = [expr 1 + $portbase],[expr 3 + $portbase]"
	} else {
	    puts $conffile "		kdc_ports = [expr 1 + $portbase]"
	    puts $conffile "		kdc_tcp_ports = [expr 3 + $portbase]"
	}
	puts $conffile "		default_principal_expiration = 2037.12.31.23.59.59"
	puts $conffile "		default_principal_flags = -postdateable forwardable"
	puts $conffile "		dict_file = $tmppwd/dictfile"
	puts $conffile "	\}"
	puts $conffile ""
	close $conffile
    }

    # Create ACL file.
    if ![file exists $tmppwd/acl] {
	set aclfile [open $tmppwd/acl w]
	puts $aclfile "krbtest/admin@$REALMNAME *"
	close $aclfile
    }

    # Create krb.conf file
    if ![file exists $tmppwd/krb.conf] {
	set conffile [open $tmppwd/krb.conf w]
	puts $conffile "$REALMNAME"
	puts $conffile "$REALMNAME $hostname:[expr 1 + $portbase] admin server"
	close $conffile
    }

    # Create krb.realms file
    if ![file exists $tmppwd/krb.realms] {
	set conffile [open $tmppwd/krb.realms w]
	puts $conffile ".[string toupper $domain] $REALMNAME"
	puts $conffile "[string toupper $domain]. $REALMNAME"
	close $conffile
    }

    # Create dictfile file.
    if ![file exists $tmppwd/dictfile] {
	set dictfile [open $tmppwd/dictfile w]
	puts $dictfile "weak_password"
	close $dictfile
    }

    set last_passname_conf $multipass_name
    return 1
}

proc setup_krb5_conf { {type client} } {
    global tmppwd
    global hostname
    global domain
    global REALMNAME
    global last_passname_conf
    global multipass_name
    global default_tgs_enctypes
    global default_tkt_enctypes
    global permitted_enctypes
    global mode
    global portbase
    global KRB5_DB_MODULE_DIR

    # Create a krb5.conf file.
    if { ![file exists $tmppwd/krb5.$type.conf] \
	    || $last_passname_conf != $multipass_name } {
	set conffile [open $tmppwd/krb5.$type.conf w]
	puts $conffile "\[libdefaults\]"
	puts $conffile "	default_realm = $REALMNAME"
	puts $conffile "	dns_lookup_kdc = false"
	if [info exists default_tgs_enctypes($type)] {
	    puts $conffile \
		    "	default_tgs_enctypes = $default_tgs_enctypes($type)"
	}
	if [info exists default_tkt_enctypes($type)] {
	    puts $conffile \
		    "	default_tkt_enctypes = $default_tkt_enctypes($type)"
	}
	if [info exists permitted_enctypes($type)] {
	    puts $conffile \
		    "	permitted_enctypes = $permitted_enctypes($type)"
	}
	puts $conffile "	krb4_config = $tmppwd/krb.conf"
	puts $conffile "	krb4_realms = $tmppwd/krb.realms"
	puts $conffile "	krb4_srvtab = $tmppwd/v4srvtab"
	if { $mode == "tcp" } {
	    puts $conffile "	udp_preference_limit = 1"
	}
	puts $conffile ""
	puts $conffile "\[realms\]"
	puts $conffile "	$REALMNAME = \{"
	# There's probably nothing listening here.  It would be a good
	# test for the handling of a non-responsive KDC address.  However,
	# on some systems, like Tru64, we often wind up with the client's
	# socket bound to this address, causing our request to appear in
	# our incoming queue as if it were a response, which causes test
	# failures.  If we were running the client and KDC on different
	# hosts, this would be okay....
	#puts $conffile "		kdc = $hostname:[expr 6 + $portbase]"
	puts $conffile "		kdc = $hostname:[expr 1 + $portbase]"
	puts $conffile "		admin_server = $hostname:[expr 4 + $portbase]"
	puts $conffile "		kpasswd_server = $hostname:[expr 5 + $portbase]"
	puts $conffile "		default_domain = $domain"
	puts $conffile "                krb524_server = $hostname:[expr 7 + $portbase]"
	puts $conffile "		database_module = foo_db2"
	puts $conffile "	\}"
	puts $conffile ""
	puts $conffile "\[domain_realm\]"
	puts $conffile "	.$domain = $REALMNAME"
	puts $conffile "	$domain = $REALMNAME"
	puts $conffile ""
	puts $conffile "\[logging\]"
	puts $conffile "	admin_server = FILE:$tmppwd/kadmind5.log"
	puts $conffile "	kdc = FILE:$tmppwd/kdc.log"
	puts $conffile "	default = FILE:$tmppwd/others.log"
	puts $conffile ""
	puts $conffile "\[dbmodules\]"
	puts $conffile "	db_module_dir = $tmppwd/../../../util/fakedest$KRB5_DB_MODULE_DIR"
	puts $conffile "	foo_db2 = {"
	puts $conffile "		db_library = db2"
	puts $conffile "		database_name = $tmppwd/db"
	puts $conffile "	}"
	close $conffile
    }
}

# Save the original values of the environment variables we are going
# to muck with.

# XXX deal with envstack later.

if [info exists env(KRB5_CONFIG)] {
    set orig_krb5_conf $env(KRB5_CONFIG)
} else {
    catch "unset orig_krb5_config"
}

if [info exists env(KRB5CCNAME)] {
    set orig_krb5ccname $env(KRB5CCNAME)
} else {
    catch "unset orig_krb5ccname"
}

if [ info exists env(KRB5RCACHEDIR)] {
    set orig_krb5rcachedir $env(KRB5RCACHEDIR)
} else {
    catch "unset orig_krb5rcachedir"
}

if [ info exists env(KERBEROS_SERVER)] {
    set orig_kerberos_server $env(KERBEROS_SERVER)
} else {
    catch "unset orig_kerberos_server"
}

# setup_kerberos_env
# Set the environment variables needed to run Kerberos programs.

proc setup_kerberos_env { {type client} } {
    global REALMNAME
    global env
    global tmppwd
    global hostname
    global krb5_init_vars
    global portbase

    # Set the environment variable KRB5_CONFIG to point to our krb5.conf file.
    # All the Kerberos tools check KRB5_CONFIG.
    # Actually, V5 doesn't currently use this.
    set env(KRB5_CONFIG) $tmppwd/krb5.$type.conf
    verbose "KRB5_CONFIG=$env(KRB5_CONFIG)"

    # Direct the Kerberos programs at a local ticket file.
    set env(KRB5CCNAME) $tmppwd/tkt
    verbose "KRB5CCNAME=$env(KRB5CCNAME)"

    # Direct the Kerberos programs at a local ticket file.
    set env(KRBTKFILE) $tmppwd/tktv4
    verbose "KRBTKFILE=$env(KRBTKFILE)"

    # Direct the Kerberos server at a cache file stored in the
    # temporary directory.
    set env(KRB5RCACHEDIR) $tmppwd
    verbose "KRB5RCACHEDIR=$env(KRB5RCACHEDIR)"

    # Tell the Kerberos tools how to contact the $REALMNAME server.
    set env(KERBEROS_SERVER) "$REALMNAME:$hostname:[expr 1 + $portbase]"
    verbose "KERBEROS_SERVER=$env(KERBEROS_SERVER)"

    # Get the run time environment variables... (including LD_LIBRARY_PATH)
    setup_runtime_env

    # Set our kdc config file.
    set env(KRB5_KDC_PROFILE) $tmppwd/kdc.conf
    verbose "KRB5_KDC_PROFILE=$env(KRB5_KDC_PROFILE)"

    # Create an environment setup script.  (For convenience)
    if ![file exists $tmppwd/env.sh] {
	set envfile [open $tmppwd/env.sh w]
	puts $envfile "KRB5_CONFIG=$env(KRB5_CONFIG)"
	puts $envfile "KRB5CCNAME=$env(KRB5CCNAME)"
	puts $envfile "KRB5RCACHEDIR=$env(KRB5RCACHEDIR)"
	puts $envfile "KERBEROS_SERVER=$env(KERBEROS_SERVER)"
	puts $envfile "KRB5_KDC_PROFILE=$env(KRB5_KDC_PROFILE)"
	puts $envfile "export KRB5_CONFIG KRB5CCNAME KRB5RCACHEDIR"
	puts $envfile "export KERBEROS_SERVER KRB5_KDC_PROFILE"
	foreach i $krb5_init_vars {
		regexp "^(\[^=\]*)=(.*)" $i foo evar evalue
		puts $envfile "$evar=$env($evar)"
		puts $envfile "export $evar"
	}
	close $envfile
    }
    if ![file exists $tmppwd/env.csh] {
	set envfile [open $tmppwd/env.csh w]
	puts $envfile "setenv KRB5_CONFIG $env(KRB5_CONFIG)"
	puts $envfile "setenv KRB5CCNAME $env(KRB5CCNAME)"
	puts $envfile "setenv KRB5RCACHEDIR $env(KRB5RCACHEDIR)"
	puts $envfile "setenv KERBEROS_SERVER $env(KERBEROS_SERVER)"
	puts $envfile "setenv KRB5_KDC_PROFILE $env(KRB5_KDC_PROFILE)"
	foreach i $krb5_init_vars {
		regexp "^(\[^=\]*)=(.*)" $i foo evar evalue
		puts $envfile "setenv $evar $env($evar)"
	}
	close $envfile
    }
    return 1
}

# Restore the Kerberos environment, in case setup_kerberos_env was
# already called by an earlier test.

proc restore_kerberos_env { } {
    global env
    global orig_krb5_config
    global orig_krb5ccname
    global orig_krb5rcachedir
    global orig_kerberos_server

    if [info exists orig_krb5_config] {
    set env(KRB5_CONFIG) $orig_krb5_config
    } else {
    catch "unset env(KRB5_CONFIG)"
    }

    if [info exists orig_krb5ccname] {
	set env(KRB5CCNAME) $orig_krb5ccname
    } else {
	catch "unset env(KRB5CCNAME)"
    }

    if [info exists orig_krb5rcachedir] {
	set env(KRB5RCACHEDIR) $orig_krb5rcachedir
    } else {
	catch "unset env(KRB5RCACHEDIR)"
    }

    if [info exists orig_kerberos_server] {
	set env(KERBEROS_SERVER) $orig_kerberos_server
    } else {
	catch "unset env(KERBEROS_SERVER)"
    }

}

# setup_kerberos_db
# Initialize the Kerberos database.  If the argument is non-zero, call
# pass at relevant points.  Returns 1 on success, 0 on failure.

proc setup_kerberos_db { standalone } {
    global REALMNAME
    global KDB5_UTIL
    global KADMIN_LOCAL
    global KEY
    global tmppwd
    global spawn_id
    global des3_krbtgt
    global tgt_support_desmd5
    global multipass_name
    global last_passname_db

    set failall 0

    if {!$standalone && [file exists $tmppwd/db.ok] \
	&& $last_passname_db == $multipass_name} {
	return 1
    }

    catch "exec rm -f [glob -nocomplain $tmppwd/db* $tmppwd/adb*]"

    # Creating a new database means we need a new srvtab.
    catch "exec rm -f $tmppwd/srvtab"

    envstack_push
    if { ![setup_kerberos_files] || ![setup_kerberos_env kdc] } {
	set failall 1
    }

    # Set up a common expect_after for use in multiple places.
    set def_exp_after {
	timeout {
	    set test "$test (timeout)"
	    break
	}
	eof {
	    set test "$test (eof)"
	    break
	}
    }

    set test "kdb5_util create"
    set body {
	if $failall {
	    break
	}
	#exec xterm
	verbose "starting $test"
	spawn $KDB5_UTIL -r $REALMNAME create
	expect_after $def_exp_after

	expect "Enter KDC database master key:"

	set test "kdb5_util create (verify)"
	send "masterkey$KEY\r"
	expect "Re-enter KDC database master key to verify:"

	set test "kdb5_util create"
	send "masterkey$KEY\r"
	expect {
	    -re "\[Cc\]ouldn't" {
		expect eof
		break
	    }
	    "Cannot find/read stored" exp_continue
	    "Warning: proceeding without master key" exp_continue
	    eof { }
	}
	catch expect_after
	if ![check_exit_status kdb5_util] {
	    break
	}
    }
    set ret [catch $body]
    catch expect_after
    if $ret {
	set failall 1
	if $standalone {
	    fail $test
	}
    } else {
	if $standalone {
	    pass $test
	}
    }

    # Stash the master key in a file.
    set test "kdb5_util stash"
    set body {
	if $failall {
	    break
	}
	spawn $KDB5_UTIL  -r $REALMNAME stash
	verbose "starting $test"
	expect_after $def_exp_after
	expect "Enter KDC database master key:"
	send "masterkey$KEY\r"
	expect eof
	catch expect_after
	if ![check_exit_status kdb5_util] {
	    break
	}
    }
    set ret [catch $body]
    catch "expect eof"
    catch expect_after
    if $ret {
	set failall 1
	if $standalone {
	    fail $test
	} else {
	    catch "exec rm -f $tmppwd/db.ok $tmppwd/adb.db"
	}
    } else {
	if $standalone {
	    pass $test
	}
    }

    # Add an admin user.
#send_user "will run: $KADMIN_LOCAL -r $REALMNAME\n"
#exec xterm
    set test "kadmin.local ank krbtest/admin"
    set body {
	if $failall {
	    break
	}
	spawn $KADMIN_LOCAL -r $REALMNAME
	verbose "starting $test"
	expect_after $def_exp_after

	expect "kadmin.local: "
	send "ank krbtest/admin@$REALMNAME\r"
	# It echos...
	expect "ank krbtest/admin@$REALMNAME\r"
	expect "Enter password for principal \"krbtest/admin@$REALMNAME\":"
	send "adminpass$KEY\r"
	expect "Re-enter password for principal \"krbtest/admin@$REALMNAME\":"
	send "adminpass$KEY\r"
	expect {
	    "Principal \"krbtest/admin@$REALMNAME\" created" { }
	    "Principal or policy already exists while creating*" { }
	}
	expect "kadmin.local: "
	send "quit\r"
	expect eof
	catch expect_after
	if ![check_exit_status kadmin_local] {
	    break
	}
    }
    set ret [catch $body]
    catch "expect eof"
    catch expect_after
    if $ret {
	set failall 1
	if $standalone {
	    fail $test
	} else {
	    catch "exec rm -f $tmppwd/db.ok $tmppwd/adb.db"
	}
    } else {
	if $standalone {
	    pass $test
	}
    }

    if $des3_krbtgt {
	# Set the TGT key to DES3.
	set test "kadmin.local TGT to DES3"
	set body {
	    if $failall {
		break
	    }
	    spawn $KADMIN_LOCAL -r $REALMNAME -e des3-cbc-sha1:normal
	    verbose "starting $test"
	    expect_after $def_exp_after

	    expect "kadmin.local: "
	    send "cpw -randkey krbtgt/$REALMNAME@$REALMNAME\r"
	    # It echos...
	    expect "cpw -randkey krbtgt/$REALMNAME@$REALMNAME\r"
	    expect {
		"Key for \"krbtgt/$REALMNAME@$REALMNAME\" randomized." { }
	    }
	    expect "kadmin.local: "
	    send "quit\r"
	    expect eof
	    catch expect_after
	    if ![check_exit_status kadmin_local] {
		break
	    }
	}
	set ret [catch $body]
	catch "expect eof"
	catch expect_after
	if $ret {
	    set failall 1
	    if $standalone {
		fail $test
	    } else {
		catch "exec rm -f $tmppwd/db.ok $tmppwd/adb.db"
	    }
	} else {
	    if $standalone {
		pass $test
	    }
	}
    }
    if $tgt_support_desmd5 {
	# Make TGT support des-cbc-md5
	set test "kadmin.local TGT to SUPPORT_DESMD5"
	set body {
	    if $failall {
		break
	    }
	    spawn $KADMIN_LOCAL -r $REALMNAME
	    verbose "starting $test"
	    expect_after $def_exp_after

	    expect "kadmin.local: "
	    send "modprinc +support_desmd5 krbtgt/$REALMNAME@$REALMNAME\r"
	    # It echos...
	    expect "modprinc +support_desmd5 krbtgt/$REALMNAME@$REALMNAME\r"
	    expect {
		"Principal \"krbtgt/$REALMNAME@$REALMNAME\" modified.\r\n" { }
	    }
	    expect "kadmin.local: "
	    send "quit\r"
	    expect eof
	    catch expect_after
	    if ![check_exit_status kadmin_local] {
		break
	    }
	}
	set ret [catch $body]
	catch "expect eof"
	catch expect_after
	if $ret {
	    set failall 1
	    if $standalone {
		fail $test
	    } else {
		catch "exec rm -f $tmppwd/db.ok $tmppwd/adb.db"
	    }
	} else {
	    if $standalone {
		pass $test
	    }
	}
    }
    envstack_pop

    # create the admin database lock file
    catch "exec touch $tmppwd/adb.lock"

    set last_passname_db $multipass_name
    return 1
}

proc start_tail { fname spawnid_var pid_var which standalone } {
    upvar $spawnid_var spawnid
    upvar $pid_var pid
    global timeout

    set f [open $fname a]

    spawn tail -f $fname
    set spawnid $spawn_id
    set pid [exp_pid]

    set markstr "===MARK $pid [clock format [clock seconds]] ==="
    puts $f $markstr
    flush $f

    set p 0
    set otimeout $timeout
    set timeout 1
    set ok 0
    while { $ok == 0 && $p < 3 } {
	expect {
	    -i $spawn_id
	    -ex "$markstr\r\n" { set ok 1 }
	    -re "\[^\r\n\]*\r\n" { exp_continue }
	    timeout {
		# Some versions of GNU tail had a race condition where
		# the first batch of data would be read from the end
		# of the file, and then there was a brief window
		# before calling stat and recording the size of the
		# file.  If the marker is written during that window,
		# then yet another file modification is needed to get
		# the first one noticed.
		if { $p < 3 } {
		    verbose -log "no tail output yet, prodding with a blank line"
		    incr p
		    puts $f ""
		    flush $f
		    exp_continue
		} else {
		    close $f
		    verbose -log "tail $fname output:"
		    verbose -log [exec tail $fname]
		    if {$standalone} {
			verbose -log "tail -f timed out ($timeout sec) looking for mark in $which log"
			fail "$which"
		    } else {
			perror "$which tail -f timed out ($timeout sec) looking for mark in $which log"
		    }
		    stop_kerberos_daemons
		    exec kill $pid
		    expect -i $spawn_id eof
		    wait -i $spawn_id
		    set timeout $otimeout
		    return 0
		}
	    }
	}
    }
    close $f
    set timeout $otimeout
    return 1
}

# start_kerberos_daemons
# A procedure to build a Kerberos database and start up the kerberos
# and kadmind daemons.  This sets the global variables kdc_pid,
# kdc_spawn_id, kadmind_pid, and kadmind_spawn_id.  The procedure
# stop_kerberos_daemons should be used to stop the daemons.  If the
# argument is non-zero, call pass at relevant points.  Returns 1 on
# success, 0 on failure.

proc start_kerberos_daemons { standalone } {
    global BINSH
    global REALMNAME
    global KRB5KDC
    global KADMIND
    global KEY
    global kdc_pid
    global kdc_spawn_id
    global kadmind_pid
    global kadmind_spawn_id
    global tmppwd
    global env
    global timeout

    if ![setup_kerberos_db 0] {
	return 0
    }

    if {$standalone} {
        catch "exec rm -f $tmppwd/krb.log"
	catch "exec rm -f $tmppwd/kadmind.log"
	catch "exec rm -f $tmppwd/krb5kdc_rcache"
    }

    # Start up the kerberos daemon
    # Why are we doing all this with the log file you may ask.
    #   We need a handle on when the server starts. If we log the output
    #   of the server to say stderr, then if we stop looking for output,
    #   buffers will fill and the server will stop working....
    #   So, we look to see when a line is added to the log file and then
    #   check it..
    # The same thing is done a little later for the kadmind
    set kdc_lfile $tmppwd/kdc.log
    set kadmind_lfile $tmppwd/kadmind5.log

    if ![start_tail $kdc_lfile tailf_spawn_id tailf_pid krb5kdc $standalone] {
	return 0
    }

    envstack_push
    setup_kerberos_env kdc
    spawn $KRB5KDC -r $REALMNAME -n -4 full
    envstack_pop
    set kdc_pid [exp_pid]
    set kdc_spawn_id $spawn_id

    expect {
	-i $tailf_spawn_id
	-re "commencing operation\r\n" { }
	-re "krb5kdc: \[a-zA-Z\]* - Cannot bind server socket to \[ 0-9a-fA-F:.\]*\r\n" {
	    verbose -log "warning: $expect_out(0,string)"
	    exp_continue
	}
	"no sockets set up?" {
	    if {$standalone} {
		verbose -log "krb5kdc startup failed to bind listening sockets"
		fail "krb5kdc"
	    } else {
		perror "krb5kdc startup failed to bind listening sockets"
	    }
	    stop_kerberos_daemons
	    exec kill $tailf_pid
	    expect -i $tailf_spawn_id eof
	    wait -i $tailf_spawn_id
	    return 0
	}
	timeout {
	    if {$standalone} {
		verbose -log "krb5kdc startup timed out"
		fail "krb5kdc"
	    } else {
		perror "krb5kdc startup timed out"
	    }
	    stop_kerberos_daemons
	    exec kill $tailf_pid
	    expect -i $tailf_spawn_id eof
	    wait -i $tailf_spawn_id
	    return 0
	}
    }
    exec kill $tailf_pid
    expect -i $tailf_spawn_id eof
    wait -i $tailf_spawn_id

    if {$standalone} {
	pass "krb5kdc"
    }

    # Give the kerberos daemon a few seconds to get set up.
#    sleep 2

    #
    # Save setting of KRB5_KTNAME. We do not want to override kdc.conf
    # file during kadmind startup. (this is in case user has KRB5_KTNAME
    # set before starting make check)
    #
    if [info exists env(KRB5_KTNAME)] {
	set start_save_ktname $env(KRB5_KTNAME)
    }
    catch "unset env(KRB5_KTNAME)"

    if ![start_tail $kadmind_lfile tailf_spawn_id tailf_pid kadmind $standalone] {
	return 0
    }

    # Start up the kadmind daemon
    # XXXX kadmind uses stderr a lot.  the sh -c and redirect can be
    # removed when this is fixed
    envstack_push
    setup_kerberos_env kdc
    spawn $BINSH -c "exec $KADMIND -r $REALMNAME -nofork 2>>$kadmind_lfile"
    envstack_pop
    set kadmind_pid [exp_pid]
    set kadmind_spawn_id $spawn_id

    # Restore KRB5_KTNAME
    if [info exists start_save_ktname] {
        set env(KRB5_KTNAME) $start_save_ktname
        unset start_save_ktname
    }

    expect {
	-i $tailf_spawn_id
	"Seeding random number" exp_continue
	"cannot initialize network" {
	    if {$standalone} {
		verbose -log "kadmind failed network init"
		fail "kadmind"
	    } else {
		perror "kadmind failed network init"
	    }
	    stop_kerberos_daemons
	    exec kill $tailf_pid
	    expect -i $tailf_spawn_id eof
	    wait -i $tailf_spawn_id
	    return 0
	}
	"cannot bind to network address" {
	    if {$standalone} {
		verbose -log "kadmind failed to bind socket"
		fail "kadmind"
	    } else {
		perror "kadmind failed to bind socket"
	    }
	    stop_kerberos_daemons
	    exec kill $tailf_pid
	    expect -i $tailf_spawn_id eof
	    wait -i $tailf_spawn_id
	    return 0
	}
	"No principal in keytab matches desired name" {
	    dump_db
	    exp_continue
	}
	"starting" { }
	timeout {
	    if {$standalone} {
		verbose -log "kadmind failed to start"
		fail "kadmind"
	    } else {
		verbose -log "kadmind failed to start"
		perror "kadmind failed to start"
	    }
#sleep 10
	    stop_kerberos_daemons
	    exec kill $tailf_pid
	    expect -i $tailf_spawn_id eof
	    wait -i $tailf_spawn_id
	    return 0
	}
    }
    exec kill $tailf_pid
    expect -i $tailf_spawn_id eof
    wait -i $tailf_spawn_id

    if {$standalone} {
	pass "kadmind"
    }

    # Give the kadmind daemon a few seconds to get set up.
#    sleep 2

    return 1
}

# stop_kerberos_daemons
# Stop the kerberos daemons.  Returns 1 on success, 0 on failure.

proc stop_kerberos_daemons { } {
    global kdc_pid
    global kdc_spawn_id
    global kadmind_pid
    global kadmind_spawn_id

    verbose "entered stop_kerberos_daemons"

    if [info exists kdc_pid] {
	if [catch "exec kill $kdc_pid" msg] {
	    verbose "kill kdc: $msg"
	}
	if [catch "expect -i $kdc_spawn_id eof" msg] {
	    verbose "expect kdc eof: $msg"
	}
	set kdc_list [wait -i $kdc_spawn_id]
	verbose "wait -i $kdc_spawn_id returned $kdc_list (kdc)"
	unset kdc_pid
	unset kdc_list
    }

    if [info exists kadmind_pid] {
	if [catch "exec kill $kadmind_pid" msg] {
	    verbose "kill kadmind: $msg"
	}
	if [catch "expect -i $kadmind_spawn_id eof" msg] {
	    verbose "expect kadmind eof: $msg"
	}
	set kadmind_list [wait -i $kadmind_spawn_id]
	verbose "wait -i $kadmind_spawn_id returned $kadmind_list (kadmind5)"
	unset kadmind_pid
	unset kadmind_list
    }

    verbose "exiting stop_kerberos_daemons"

    return 1
}

# add_kerberos_key
# Add an key to the Kerberos database.  start_kerberos_daemons must be
# called before this procedure.  If the standalone argument is
# non-zero, call pass at relevant points.  Returns 1 on success, 0 on
# failure.

proc add_kerberos_key { kkey standalone } {
    global REALMNAME
    global KADMIN
    global KEY
    global spawn_id

    # Use kadmin to add an key.
    set test "kadmin ank $kkey"
    set body {
	envstack_push
	setup_kerberos_env client
	spawn $KADMIN -p krbtest/admin@$REALMNAME -q "ank $kkey@$REALMNAME"
	envstack_pop
	verbose "starting $test"
	expect_after {
	    "Cannot contact any KDC" {
		set test "$test (lost KDC)"
		break
	    }
	    timeout {
		set test "$test (timeout)"
		break
	    }
	    eof {
		set test "$test (eof)"
		break
	    }
	}
	expect -re "assword\[^\r\n\]*: *"
	send "adminpass$KEY\r"
	expect "Enter password for principal \"$kkey@$REALMNAME\":"
	send "$kkey"
	send "$KEY\r"
	expect "Re-enter password for principal \"$kkey@$REALMNAME\":"
	send "$kkey"
	send "$KEY\r"
	expect {
	    "Principal \"$kkey@$REALMNAME\" created" { }
	    "Principal or policy already exists while creating*" { }
	}
	expect eof
	if ![check_exit_status kadmin] {
	    break
	}
    }
    set ret [catch $body]
    catch "expect eof"
    catch expect_after
    if $ret {
	if $standalone {
	    fail $test
	}
	return 0
    } else {
	if $standalone {
	    pass $test
	}
	return 1
    }
}

# dump_db
proc dump_db { } {
    global KADMIN_LOCAL
    global REALMNAME

    spawn $KADMIN_LOCAL -r $REALMNAME
    expect_after {
	eof {
	    perror "failed to get debugging dump of database (eof)"
	}
	timeout {
	    perror "failed to get debugging dump of database (timeout)"
	}
    }
    expect "kadmin.local: "
    send "getprincs\r"
    expect "kadmin.local: "
    send "quit\r"
    expect eof
    catch expect_after
}

# add_random_key
# Add a key with a random password to the Kerberos database.
# start_kerberos_daemons must be called before this procedure.  If the
# standalone argument is non-zero, call pass at relevant points.
# Returns 1 on success, 0 on failure.

proc add_random_key { kkey standalone } {
    global REALMNAME
    global KADMIN
    global KEY
    global spawn_id

    # Use kadmin to add an key.
    set test "kadmin ark $kkey"
    set body {
	envstack_push
	setup_kerberos_env client
	spawn $KADMIN -p krbtest/admin@$REALMNAME -q "ank -randkey $kkey@$REALMNAME"
	envstack_pop
	expect_after {
	    timeout {
		set test "$test (timeout)"
		break
	    }
	    eof {
		set test "$test (eof)"
		break
	    }
	}
	expect -re "assword\[^\r\n\]*: *"
	send "adminpass$KEY\r"
	expect {
	    "Principal \"$kkey@$REALMNAME\" created" { }
	    "Principal or policy already exists while creating*" { }
	}
	expect eof
	if ![check_exit_status kadmin] {
	    break
	}
    }
    if [catch $body] {
	catch expect_after
	if $standalone {
	    fail $test
	}
	return 0
    } else {
	catch expect_after
	if $standalone {
	    pass $test
	}
	return 1
    }
}

# setup_srvtab
# Set up a srvtab file.  start_kerberos_daemons and add_random_key
# $id/$hostname must be called before this procedure.  If the
# argument is non-zero, call pass at relevant points.  Returns 1 on
# success, 0 on failure. If the id field is not provided, host is used.

proc setup_srvtab { standalone {id host} } {
    global REALMNAME
    global KADMIN_LOCAL
    global KEY
    global tmppwd
    global hostname
    global spawn_id
    global last_service

    if {!$standalone && [file exists $tmppwd/srvtab] && $last_service == $id} {
	return 1
    }

    catch "exec rm -f $tmppwd/srvtab $tmppwd/srvtab.old"

    if ![get_hostname] {
	return 0
    }

    catch "exec rm -f $hostname-new-srvtab"

    envstack_push
    setup_kerberos_env kdc
    spawn $KADMIN_LOCAL -r $REALMNAME
    envstack_pop
    expect_after {
	-re "(.*)\r\nkadmin.local:  " {
	    fail "kadmin.local srvtab (unmatched output: $expect_out(1,string))"
	    if {!$standalone} {
		catch "exec rm -f $tmppwd/srvtab"
	    }
	    catch "expect_after"
	    return 0
	}
	timeout {
	    fail "kadmin.local srvtab"
	    if {!$standalone} {
		catch "exec rm -f $tmppwd/srvtab"
	    }
	    catch "expect_after"
	    return 0
	}
	eof {
	    fail "kadmin.local srvtab"
	    if {!$standalone} {
		catch "exec rm -f $tmppwd/srvtab"
	    }
	    catch "expect_after"
	    return 0
	}
    }
    expect "kadmin.local:  "
    send "xst -k $hostname-new-srvtab $id/$hostname\r"
    expect "xst -k $hostname-new-srvtab $id/$hostname\r\n"
    expect {
	-re ".*Entry for principal $id/$hostname.* added to keytab WRFILE:$hostname-new-srvtab." { }
	-re "\r\nkadmin.local:  " {
	    if {$standalone} {
		fail "kadmin.local srvtab"
	    } else {
		catch "exec rm -f $tmppwd/srvtab"
	    }
	    catch expect_after
	    return 0
	}
    }
    expect "kadmin.local:  "
    send "quit\r"
    expect eof
    catch expect_after
    if ![check_exit_status "kadmin.local srvtab"] {
	if {!$standalone} {
	    catch "exec rm -f $tmppwd/srvtab"
	}
	return 0
    }

    catch "exec mv -f $hostname-new-srvtab $tmppwd/srvtab" exec_output
    if ![string match "" $exec_output] {
	verbose -log "$exec_output"
	perror "can't mv new srvtab"
	return 0
    }

    if {$standalone} {
	pass "kadmin.local srvtab"
    }

    # Make the srvtab file globally readable in case we are using a
    # root shell and the srvtab is NFS mounted.
    catch "exec chmod a+r $tmppwd/srvtab"

    # Remember what we just extracted
    set last_service $id

    return 1
}

# kinit
# Use kinit to get a ticket.  If the argument is non-zero, call pass
# at relevant points.  Returns 1 on success, 0 on failure.

proc kinit { name pass standalone } {
    global REALMNAME
    global KINIT
    global spawn_id

    # Use kinit to get a ticket.
	#
	# For now always get forwardable tickets. Later when we need to make
	# tests that distiguish between forwardable tickets and otherwise
	# we should but another option to this proc. --proven
	#
    spawn $KINIT -5 -f $name@$REALMNAME
    expect {
	"Password for $name@$REALMNAME:" {
	    verbose "kinit started"
	}
	timeout {
	    fail "kinit"
	    return 0
	}
	eof {
	    fail "kinit"
	    return 0
	}
    }
    send "$pass\r"
    expect eof
    if ![check_exit_status kinit] {
	return 0
    }

    if {$standalone} {
	pass "kinit"
    }

    return 1
}

proc kinit_kt { name keytab standalone testname } {
    global REALMNAME
    global KINIT
    global spawn_id

    # Use kinit to get a ticket.
	#
	# For now always get forwardable tickets. Later when we need to make
	# tests that distiguish between forwardable tickets and otherwise
	# we should but another option to this proc. --proven
	#
    spawn $KINIT -5 -f -k -t $keytab $name@$REALMNAME
    expect {
	timeout {
	    fail "kinit $testname"
	    return 0
	}
	eof { }
    }
    if ![check_exit_status "kinit $testname"] {
	return 0
    }

    if {$standalone} {
	pass "kinit $testname"
    }

    return 1
}

# List tickets.  Requires client and server names, and test name.
# Checks that klist exist status is zero.
# Records pass or fail, and returns 1 or 0.
proc do_klist { myname servname testname } {
    global KLIST
    global tmppwd

    spawn $KLIST -5 -e
    expect {
	-re "Ticket cache:\[ 	\]*(.+:)?$tmppwd/tkt.*Default principal:\[ 	\]*$myname.*$servname\r\n" {
	    verbose "klist started"
	}
	timeout {
	    fail $testname
	    return 0
	}
	eof {
	    fail $testname
	    return 0
	}
    }

    expect eof

    if ![check_exit_status $testname] {
	return 0
    }
    pass $testname
    return 1
}

proc do_klist_kt { keytab testname } {
    global KLIST
    global tmppwd

    spawn $KLIST -5 -e -k $keytab
    expect {
	-re "Keytab name:\[ 	\]*(.+:)?.*KVNO Principal\r\n---- -*\r\n" {
	    verbose "klist started"
	}
	timeout {
	    fail $testname
	    return 0
	}
	eof {
	    fail $testname
	    return 0
	}
    }
    set more 1
    while {$more} {
	expect {
	    -re { *[0-9][0-9]* *[a-zA-Z/@.-]* \([/a-zA-Z 0-9-]*\) *\r\n} {
		verbose -log "key: $expect_out(buffer)"
	    }
	    eof { set more 0 }
	}
    }

    if ![check_exit_status $testname] {
	return 0
    }
    pass $testname
    return 1
}

proc do_klist_err { testname } {
    global KLIST
    global spawn_id

    spawn $KLIST -5
    # Might say "credentials cache" or "credentials cache file".
    expect {
	-re "klist: No credentials cache.*found.*\r\n" {
	    verbose "klist started"
	}
	timeout {
	    fail $testname
	    return 0
	}
	eof {
	    fail $testname
	    return 0
	}
    }
    # We can't use check_exit_status, because we expect an exit status
    # of 1.
    catch "expect eof"
    set status_list [wait -i $spawn_id]
    verbose "wait -i $spawn_id returned $status_list ($testname)"
    if { [lindex $status_list 2] != 0 } {
	fail "$testname (bad exit status) $status_list"
	return 0
    } else { if { [lindex $status_list 3] != 1 } {
	fail "$testname (bad exit status) $status_list"
	return 0
    } else {
	pass $testname
    } }
    return 1
}

proc do_kdestroy { testname } {
    global KDESTROY
    spawn $KDESTROY -5
    if ![check_exit_status $testname] {
	fail $testname
	return 0
    }
    pass $testname
    return 1
}

proc xst { keytab name } {
    global KADMIN_LOCAL
    global REALMNAME

    envstack_push
    setup_kerberos_env kdc
    spawn $KADMIN_LOCAL -r $REALMNAME
    envstack_pop
    catch expect_after
    expect_after {
	-re "(.*)\r\nkadmin.local:  " {
	    fail "kadmin.local xst $keytab (unmatched output: $expect_out(1,string)"
	    catch "expect_after"
	    return 0
	}
	timeout {
	    fail "kadmin.local xst $keytab (timeout)"
	    catch "expect_after"
	    return 0
	}
	eof {
	    fail "kadmin.local xst $keytab (eof)"
	    catch "expect_after"
	    return 0
	}
    }
    expect "kadmin.local:  "
    send "xst -k $keytab $name\r"
    expect -re "xst -k \[^\r\n\]*\r\n.*Entry for principal .* added to keytab WRFILE:.*\r\nkadmin.local:  "
    send "quit\r"
    expect eof
    catch expect_after
    if ![check_exit_status "kadmin.local $keytab"] {
	perror "kadmin.local xst $keytab exited abnormally"
	return 0
    }
    return 1
}

# v4_compatible_enctype
# Returns 1 if v4 testing is enabled this passes encryption types are compatable with kerberos 4 work
proc v4_compatible_enctype {} {
    global supported_enctypes
    global KRBIV

    if ![info exists KRBIV] {
	return 0;
    }

    if { $KRBIV && [string first des-cbc-crc:v4 "$supported_enctypes"] >= 0} {
	return 1
    } else {
	return 0
    }
}

# kinit
# Use kinit to get a ticket.  If the argument is non-zero, call pass
# at relevant points.  Returns 1 on success, 0 on failure.

proc v4kinit { name pass standalone } {
    global REALMNAME
    global KINIT
    global spawn_id
    global des3_krbtgt

    # Use kinit to get a ticket.
	#
	# For now always get forwardable tickets. Later when we need to make
	# tests that distiguish between forwardable tickets and otherwise
	# we should but another option to this proc. --proven
	#
    spawn $KINIT -4 $name@$REALMNAME
    expect {
	"Password for $name@$REALMNAME:" {
	    verbose "v4kinit started"
	}
	timeout {
	    fail "v4kinit"
	    return 0
	}
	eof {
	    fail "v4kinit"
	    return 0
	}
    }
    send "$pass\r"
    expect eof
    if {$des3_krbtgt == 0} {
	if ![check_exit_status v4kinit] {
	    return 0
	}
    } else {
	# Fail if kinit is successful with a des3 TGT.
	set status_list [wait -i $spawn_id]
	set testname v4kinit
	verbose "wait -i $spawn_id returned $status_list ($testname)"
	if { [lindex $status_list 2] != 0 || [lindex $status_list 3] != 1 } {
	    verbose -log "exit status: $status_list"
	    fail "$testname (exit status)"
	}
    }
    if {$standalone} {
	pass "v4kinit"
    }

    return 1
}

proc v4kinit_kt { name keytab standalone } {
    global REALMNAME
    global KINIT
    global spawn_id

    # Use kinit to get a ticket.
	#
	# For now always get forwardable tickets. Later when we need to make
	# tests that distiguish between forwardable tickets and otherwise
	# we should but another option to this proc. --proven
	#
    spawn $KINIT -4 -k -t $keytab $name@$REALMNAME
    expect {
	timeout {
	    fail "v4kinit"
	    return 0
	}
	eof { }
    }
    if ![check_exit_status kinit] {
	return 0
    }

    if {$standalone} {
	pass "v4kinit"
    }

    return 1
}

# List v4 tickets.
# Client and server are regular expressions.
proc v4klist { client server testname } {
    global KLIST
    global tmppwd

    spawn $KLIST -4
    expect {
	-re "Kerberos 4 ticket cache:\[ 	\]*(.+:)?$tmppwd/tkt.*Principal:\[ 	\]*$client.*$server\r\n" {
	    verbose "klist started"
	}
	timeout {
	    fail $testname
	    return 0
	}
	eof {
	    fail $testname
	    return 0
	}
    }

    expect eof

    if ![check_exit_status $testname] {
	return 0
    }
    pass $testname
    return 1
}

# Destroy tickets.
proc v4kdestroy { testname } {
    global KDESTROY
    spawn $KDESTROY -4
    if ![check_exit_status $testname] {
	return 0
    }
    pass $testname
    return 1
}

# Try to list the krb4 tickets -- there shouldn't be any ticket file.
proc v4klist_none { testname } {
    global KLIST
    global tmppwd

    # Double check that the ticket was destroyed.
    spawn $KLIST -4
    expect {
	-re "Kerberos 4 ticket cache:\[ 	\]*(.+:)?$tmppwd/tkt.*klist: You have no tickets cached.*\r\n" {
	    verbose "v4klist started"
	    pass "$testname (output)"
	}
	timeout {
	    fail "$testname (output)"
	    # Skip the 'wait' below, if it's taking too long.
	    untested "$testname (exit status)"
	    return 0
	}
	eof {
	    fail "$testname (output)"
	}
    }
    # We can't use check_exit_status, because we expect an exit status
    # of 1.
    expect eof
    set status_list [wait -i $spawn_id]
    verbose "wait -i $spawn_id returned $status_list (v4klist)"
    if { [lindex $status_list 2] != 0 } {
	fail "$testname (exit status)"
	return 0
    } else {
	if { [lindex $status_list 3] != 1 } {
	    fail "$testname (exit status)"
	    return 0
	} else {
	    pass "$testname (exit status)"
	}
    }
    return 1
}

# Set up a root shell using rlogin $hostname -l root.  This is used
# when testing the daemons that must be run as root, such as telnetd
# or rlogind.  This sets the global variables rlogin_spawn_id and
# rlogin_pid.  Returns 1 on success, 0 on failure.
#
# This procedure will only succeed if the person running the test has
# a valid ticket for a name listed in the /.klogin file.  Naturally,
# Kerberos must already be installed on this machine.  It's a pain,
# but I can't think of a better approach.

if ![info exists can_get_root] { set can_get_root yes }

proc setup_root_shell { testname } {
    global BINSH
    global ROOT_PROMPT
    global KEY
    global RLOGIN
    global RLOGIN_FLAGS
    global hostname
    global rlogin_spawn_id
    global rlogin_pid
    global tmppwd
    global env
    global krb5_init_vars
    global can_get_root

    global timeout

    if [string match $can_get_root no] {
	note "$testname test requires ability to log in as root"
	unsupported $testname
	return 0
    }

    # Make sure we are using the original values of the environment
    # variables.  This means that the caller must call
    # setup_kerberos_env after calling this procedure.

    # XXX fixme to deal with envstack
    restore_kerberos_env

    setup_runtime_env

    set me [exec whoami]
    if [string match root $me] {
	return [setup_root_shell_noremote $testname]
    }

    if ![get_hostname] {
	set can_get_root no
	return 0
    }

    # If you have not installed Kerberos on your system, and you want
    # to run these tests, you can do it if you are willing to put your
    # root password in this file (this is not a very good idea, but
    # it's safe enough if you disconnect from the network and remember
    # to remove the password later).  Change the rlogin in the next
    # line to be /usr/ucb/rlogin (or whatever is appropriate for your
    # system).  Then change the lines after "word:" a few lines
    # farther down to be
    #    send "rootpassword\r"
    #    exp_continue

    eval spawn $RLOGIN $hostname -l root $RLOGIN_FLAGS
    set rlogin_spawn_id $spawn_id
    set rlogin_pid [exp_pid]
    set old_timeout $timeout
    set timeout 300
    set got_refused 0

    expect {
	-re {connect to address [0-9a-fA-F.:]*: Connection refused} {
	    note $expect_out(buffer)
	    set got_refused 1
	    exp_continue
	}
	-re "word:|erberos rlogin failed|ection refused|ection reset by peer|not authorized" {
	    note "$testname test requires ability to rlogin as root"
	    unsupported "$testname"
	    set timeout $old_timeout
	    stop_root_shell
	    set can_get_root no
	    return 0
	}
	"Cannot assign requested address" {
	    note "$testname: rlogin as root 'cannot assign requested address'"
	    unsupported "$testname"
	    set timeout $old_timeout
	    stop_root_shell
	    set can_get_root no
	    return 0
	}
	-re "usage: rlogin|illegal option -- x|invalid option -- x" {
	    note "$testname: rlogin doesn't like command-line flags"
	    unsupported "$testname"
	    set timeout $old_timeout
	    stop_root_shell
	    set can_get_root no
	    return 0
	}
	-re "$ROOT_PROMPT" { }
	timeout {
	    perror "timeout from rlogin $hostname -l root"
	    perror "If you have an unusual root prompt,"
	    perror "try running with ROOT_PROMPT=\"regexp\""
	    set timeout $old_timeout
	    stop_root_shell
	    set can_get_root no
	    return 0
	}
	eof {
	    if {$got_refused} {
		# reported some errors, continued, and failed
		note "$testname test requires ability to log in as root"
		unsupported $testname
	    } else {
		# unknown problem?
#		perror "eof from rlogin $hostname -l root"
		note "eof (and unrecognized messages?) from rlogin $hostname -l root"
		note "$testname test requires ability to log in as root"
		unsupported $testname
	    }
	    stop_root_shell
	    set timeout $old_timeout
	    catch "expect_after"
	    set can_get_root no
	    return 0
	}
    }

    expect_after {
	timeout {
	    perror "timeout from rlogin $hostname -l root"
	    stop_root_shell
	    set timeout $old_timeout
	    catch "expect_after"
	    set can_get_root no
	    return 0
	}
	eof {
	    perror "eof from rlogin $hostname -l root"
	    stop_root_shell
	    set timeout $old_timeout
	    catch "expect_after"
	    set can_get_root no
	    return 0
	}
    }

    # Make sure the root shell is using /bin/sh.
    send "$BINSH\r"
    expect {
	-re "$ROOT_PROMPT" { }
    }

    # Set up a shell variable tmppwd.  The callers use this to keep
    # command line lengths down.  The command line length is important
    # because we are feeding input to a shell via a pty.  On some
    # systems a pty will only accept 255 characters.
    send "tmppwd=$tmppwd\r"
    expect {
	-re "$ROOT_PROMPT" { }
    }

    # Set up our krb5.conf
    send "KRB5_CONFIG=$tmppwd/krb5.server.conf\r"
    expect {
	-re "$ROOT_PROMPT" { }
    }
    send "export KRB5_CONFIG\r"
    expect {
	-re "$ROOT_PROMPT" { }
    }

    # For all of our runtime environment variables - send them over...
    foreach i $krb5_init_vars {
	regexp "^(\[^=\]*)=(.*)" $i foo evar evalue
	send "$evar=$env($evar)\r"
	expect {
		-re "$ROOT_PROMPT" { }
        }

        send "export $evar\r"
        expect {
		-re "$ROOT_PROMPT" { }
        }
    }

    # Move over to the right directory.
    set dir [pwd]
    send "cd $dir\r"
    expect {
	-re "$ROOT_PROMPT" { }
	"$dir:" {
	    perror "root shell can not cd to $dir"
	    set timeout $old_timeout
	    stop_root_shell
	    set can_get_root no
	    return 0
	}
    }

    expect_after
    set timeout $old_timeout

    return 1
}

proc setup_root_shell_noremote { testname } {
    global BINSH
    global ROOT_PROMPT
    global KEY
    global hostname
    global rlogin_spawn_id
    global rlogin_pid
    global tmppwd
    global env
    global krb5_init_vars

    eval spawn $BINSH
    set rlogin_spawn_id $spawn_id
    set rlogin_pid [exp_pid]

    expect_after {
	timeout {
	    perror "timeout from root shell"
	    stop_root_shell
	    catch "expect_after"
	    return 0
	}
	eof {
	    perror "eof from root shell"
	    stop_root_shell
	    catch "expect_after"
	    return 0
	}
    }
    expect {
	-re "$ROOT_PROMPT" { }
    }

    # Set up a shell variable tmppwd.  The callers use this to keep
    # command line lengths down.  The command line length is important
    # because we are feeding input to a shell via a pty.  On some
    # systems a pty will only accept 255 characters.
    send "tmppwd=$tmppwd\r"
    expect {
	-re "$ROOT_PROMPT" { }
    }

    # Set up our krb5.conf
    send "KRB5_CONFIG=$tmppwd/krb5.server.conf\r"
    expect {
	-re "$ROOT_PROMPT" { }
    }
    send "export KRB5_CONFIG\r"
    expect {
	-re "$ROOT_PROMPT" { }
    }

    # For all of our runtime environment variables - send them over...
    foreach i $krb5_init_vars {
	regexp "^(\[^=\]*)=(.*)" $i foo evar evalue
	send "$evar=$env($evar)\r"
	expect {
		-re "$ROOT_PROMPT" { }
        }

        send "export $evar\r"
        expect {
		-re "$ROOT_PROMPT" { }
        }
    }

    # Move over to the right directory.
    set dir [pwd]
    send "cd $dir\r"
    expect {
	-re "$ROOT_PROMPT" { }
	"$dir:" {
	    perror "root shell can not cd to $dir"
	    stop_root_shell
	    return 0
	}
    }

    expect_after

    return 1
}

# Kill off a root shell started by setup_root_shell.

proc stop_root_shell { } {
    global rlogin_spawn_id
    global rlogin_pid

    catch "close -i $rlogin_spawn_id"
    catch "exec kill $rlogin_pid"
    sleep 1
    catch "exec kill -9 $rlogin_pid"
    catch "wait -i $rlogin_spawn_id"
}

# Check the date.  The string will be the output of date on this
# system, and we must make sure that it is in the same timezone as the
# output of date run a second time.  The first date will be run on an
# rlogin or some such connection to the local system.  This is to test
# to make sure that the TZ environment variable is handled correctly.
# Returns 1 on sucess, 0 on failure.

proc check_date { date } {
    catch "exec date" ndate
    set atz ""
    set ntz ""
    scan $date "%s %s %d %d:%d:%d %s %d" adow amon adom ahr amn asc atz ayr
    scan $ndate "%s %s %d %d:%d:%d %s %d" ndow nmon ndom nhr nmn nsc ntz nyr
    if { $atz != $ntz } {
	verbose -log "date check failed: $atz != $ntz"
	return 0
    }
    return 1
}

proc touch { file } {
    set f [open $file "a"]
    puts $f ""
    close $f
}

# Implement this in tcl someday?
proc tail1 { file } {
    exec tail -1 $file
}

# setup_wrapper
# Sets up a wraper script to set the runtime shared library environment 
# variables and then executes a specific command. This is used to allow
# a "rsh klist" or telnetd to execute login.krb5. 
proc setup_wrapper { file command } {
    global BINSH
    global env
    global krb5_init_vars

    # We will start with a BINSH script
    catch "exec rm -f $file"

    set f [open $file "w" 0777]
    puts $f "#!$BINSH"
    puts $f "KRB5_CONFIG=$env(KRB5_CONFIG)"
    puts $f "export KRB5_CONFIG"
    foreach i $krb5_init_vars {
	regexp "^(\[^=\]*)=(.*)" $i foo evar evalue
	puts $f "$evar=$env($evar)"
	puts $f "export $evar"
    }
    puts $f "exec $command"
    close $f
    
    return 1
}

proc krb_exit { } {
    stop_kerberos_daemons
}

# helpful sometimes for debugging the test suite
proc spawn_xterm { } {
    global env
    foreach i {KDB5_UTIL KRB5KDC KADMIND KADMIN KADMIN_LOCAL KINIT KTUTIL KLIST RLOGIN RLOGIND FTP FTPD KPASSWD REALMNAME GSSCLIENT} {
	global $i
	if [info exists $i] { set env($i) [set $i] }
    }
    exec "xterm"
}