# 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.
#&&![string match "/bin/sh" $arg] sh is used to start kadmind!
if [string match "/" [string index $arg 0]]&&![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"]}
}
{
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"]}
}
}
# {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
file delete $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
file delete $tmppwd/hostname
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"
# Testing with a colon in the name exercises default handling
# for pathnames.
puts $conffile " key_stash_file = $tmppwd/stash:foo"
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 "file delete [glob -nocomplain $tmppwd/db* $tmppwd/adb*]"
# Creating a new database means we need a new srvtab.
file delete $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 {
file delete $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 {
file delete $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 {
file delete $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 {
file delete $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} {
file delete $tmppwd/krb.log $tmppwd/kadmind.log $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
}
file delete $tmppwd/srvtab $tmppwd/srvtab.old
if ![get_hostname] {
return 0
}
file delete $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} {
file delete $tmppwd/srvtab
}
catch "expect_after"
return 0
}
timeout {
fail "kadmin.local srvtab"
if {!$standalone} {
file delete $tmppwd/srvtab
}
catch "expect_after"
return 0
}
eof {
fail "kadmin.local srvtab"
if {!$standalone} {
file delete $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 {
file delete $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} {
file delete $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
global spawn_id
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|Ticket expired" {
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
file delete $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"
}