#! /bin/sh

# A trailing backslash comments out the next line for tcl but not sh: \
KRB5_TCLBINDIR=${KRB5_TCLBINDIR=/usr/cygnus/kerbnet-1.2/bin}
# more ... \
progbase=$KRB5_TCLBINDIR/krb5_clnt_
# \
if test x != "x$DISPLAY" && test -x ${progbase}tk ; then i=tk ; else i=tcl ; fi
# Sigh.  Never got as far as adding the tk interface, so skip it for now: \
i=tcl
# \
exec ${KRB5_TCLBINDIR=/usr/cygnus/kerbnet-1.2/bin}/krb5_clnt_$i $0 -- ${1+"$@"}

# now we're running tcl code...
# Support for krb5.conf and similar config files.
# These interfaces are likely to change for a future version; don't
# rely on them.
#
# Suggested revisions:
# * Use itcl classes to hide internals; one for basic format, more for
#   krb5 and kdc specific stuff.  Tags like "libdefaults" shouldn't occur
#   outside this file.
# * More regular names.  Which functions create new objects?  Which will
#   modify existing ones?  Which require exactly one exist already?  Which
#   return lists?
# * No global variables.  Make the profiles be objects themselves.
#
set default_tgs_enctypes des-cbc-crc
set default_tkt_enctypes des-cbc-crc

set profile {}

# other pathnames to check for krb.conf?
if [file exists /usr/kerberos/lib/krb.conf] {
    set krb4_compat yes
    set krb4_config /usr/kerberos/lib/krb.conf
    set krb4_realms /usr/kerberos/lib/krb.realms
} else {
    set krb4_compat no
    set krb4_config /usr/kerberos/lib/krb.conf
    set krb4_realms /usr/kerberos/lib/krb.realms
}
if [file exists /etc/srvtab]&&![file exists /etc/krb-srvtab] {
    set krb4_srvtab /etc/srvtab
} else {
    set krb4_srvtab /etc/krb-srvtab
}

proc make_pair { tag value } {
    if ![krb5tcl_is_okay_tagname $tag] {
	error [list $tag is not a valid tag name]
    }
    if ![krb5tcl_is_okay_value $value] {
	error [list $value is not a valid value for this field]
    }
    return [list value $tag $value]
}

proc make_section { tag values } {
    if ![krb5tcl_is_okay_tagname $tag] {
	error [list $tag is not a valid tag name]
    }
    return [list section $tag $values]
}

proc issection { x { name {} } } {
    if [string compare [lindex $x 0] section] { return 0 }
    if ![string compare $name ""] { return 1 }
    if ![string compare $name [lindex $x 1]] { return 1 }
    return 0
}

proc ensure_top_section { tag } {
    global profile
    foreach x $profile {
	if [issection $x $tag] {
	    return
	}
    }
    lappend profile [make_section $tag ""]
}

proc have_profile_section { args } {
    global profile
    have_section $profile $args
}
proc have_section { prof names } {
    set sname [lindex $names 0]
    set rest [lrange $names 1 end]
    foreach x $prof {
	if "[issection $x $sname]" {
	    if [llength $rest] {
		return [have_section [lindex $x 2] $rest]
	    } else { return 1 }
	}
    }
    return 0
}

proc mapcar { p vals } {
    set result ""
    foreach x $vals {
	set cmd $p
	lappend cmd $x
	lappend result [uplevel $cmd]
    }
    return $result
}

# FROB_SECTION CMD TAGLIST SEC
# Find subsections of SEC identified by remaining entries in TAGLIST,
# and apply CMD when we've narrowed them down as much as possible.
# The CMD invocation gets the {section FOO LIST-OF-DATA-ITEMS} list.
proc frob_section { cmd taglist sec } {
#    puts [list frob_section $cmd $taglist $sec]
    set this_tag [lindex $taglist 0]
    if [llength $taglist]==0 {
	error "frob_section requires non-empty tag list"
    }
    if [issection $sec $this_tag] {
#	puts "name matches"
	if [llength $taglist]>1 {
#	    puts "more tags"
	    set othertags [lrange $taglist 1 end]
	    set rcmdpfx [list frob_section $cmd $othertags]
	    set newcontents [mapcar $rcmdpfx [lindex $sec 2]]
	    return [make_section $this_tag $newcontents]
	} else {
	    lappend cmd $sec
#	    puts [list frob_section invoking $cmd]
	    return [eval $cmd]
	}
    } else {
#	puts [list frob_section not sec $this_tag : $sec]
	return $sec
    }
}

proc frob_profile { cmd taglist } {
    global profile
#    puts \n[list ... STARTING FROB_PROFILE $cmd $taglist ...]\n
    set profile [mapcar [list frob_section $cmd $taglist] $profile]
    return
}

# ADD_SECTION ID ?ID...?
# Creates a new section, using the successive IDs as the tag names
# at each level going down.  Only the lowest-level subsection is
# created; higher-level ones must already exist.  If multiple higher-level
# subsections exist, all identified by the same sequence of tag names,
# only one has the new subsection created; which this is is undefined.
proc add_section.1 { lev newsecname sec } {
    # get access to add_section local vars
    upvar #$lev done done
    # now, do some work
    if !$done {
	set done 1
	set last [lindex $sec 2]
	lappend last [make_section $newsecname {}]
	return [lreplace $sec 2 2 $last]
    } else {
	return $sec
    }
}
proc add_section { args } {
    set lastname [lindex $args end]
    set done 0

    frob_profile "add_section.1 [info level] $lastname" [lreplace $args end end]
}

# ADD_PAIR TAG VALUE ?SEC SUBSEC ...?
proc add_pair.1 { lev tag value sec } {
    # get access to add_section local vars
    upvar #$lev done done
    # now, do some work
    if !$done {
	set done 1
	set last [lindex $sec 2]
	lappend last [make_pair $tag $value]
	return [lreplace $sec 2 2 $last]
    } else { return $sec }
}
proc add_pair { tag value args } {
    set done 0
    frob_profile [list add_pair.1 [info level] $tag $value] $args
    return
}
proc remove_values { tag args } {
    frob_profile "purge_section_entries $tag" $args
}

proc create_realm { rname } {
    ensure_top_section realms
    if ![have_realm $rname] { add_section realms $rname }
}
proc have_realm { rname } {
    have_profile_section realms $rname
}
proc remove_realm_info { realm tag } {
    if ![have_realm $realm] { error [list realm $realm does not exist] }
    frob_profile "purge_section_entries $tag" [list realms $realm]
}
proc add_realm_pair { realm tag value } {
    if ![have_realm $realm] { error [list realm $realm does not exist] }
    add_pair $tag $value realms $realm
}

proc default_set_pair { tag value args } {
    if [llength [eval [concat get_value_list $args [list $tag]]]]==0 {
	eval [list add_pair $tag $value] $args
    }
}
proc default_set_realm_pair { realm tag value } {
    if [llength [get_value_list realms $realm $tag]]==0 {
	add_realm_pair $realm $tag $value
    }
}

proc purge_section_entries { name sec } {
    set newcontents {}
    foreach x [lindex $sec 2] {
	set type [lindex $x 0]
	if [string compare $type value]&&[string compare $type section] {
	    lappend newcontents $x
	} else {
	    if [string compare [lindex $x 1] $name] {
		lappend newcontents $x
	    }
	}
    }
    set result [lreplace $sec 2 2 $newcontents]
    return $result
}

proc get_value_list.1 { lev tag sec } {
    upvar #$lev result result
    foreach x [lindex $sec 2] {
	if ![string compare value [lindex $x 0]]&&![string compare $tag [lindex $x 1]] {
	    lappend result [lindex $x 2]
	}
    }
    return $sec
}
proc get_value_list_va { tags } {
    set result {}
    frob_profile [list get_value_list.1 [info level] [lindex $tags end]] \
	    [lreplace $tags end end]
    return $result
}
proc get_value_list { args } { get_value_list_va $args }
proc get_value { args } {
    set values [get_value_list_va $args]
    switch [llength $values] {
	0	{ error [list No values for $args .] }
	1	{ return [lindex $values 0] }
	default	{ error [list Multiple values defined for $args .] }
    }
}

proc set_kdcs { rname args } {
    remove_realm_info $rname kdc
    eval [concat [list add_kdcs $rname] $args]
}
proc add_kdcs { rname args } {
    foreach kdc $args { add_kdc $rname $kdc }
}
proc add_kdc { rname kdc } {
    add_realm_pair $rname kdc $kdc
}
proc get_kdcs { rname } {
    get_value_list realms $rname kdc
}

proc set_admin_server { realm asname } {
    remove_realm_info $realm admin_server
    add_realm_pair $realm admin_server $asname
}
proc get_admin_server { realm } {
    set x [get_value_list realms $realm admin_server]
    switch [llength $x] {
	0	{ error [list No admin server for realm $realm.] }
	1	{ return [lindex $x 0] }
	default	{ error [list Multiple admin servers defined for realm $realm.] }
    }
}

proc set_default_domain { realm domain } {
    remove_realm_info $realm default_domain
    add_realm_pair $realm default_domain $domain
}

proc set_libdefault { tag value } {
    ensure_top_section libdefaults
    frob_profile "purge_section_entries $tag" libdefaults
    add_pair $tag $value libdefaults
}
proc set_domain_realm { domain realm } {
    ensure_top_section domain_realm
    frob_profile "purge_section_entries $domain" domain_realm
    add_pair $domain $realm domain_realm
}
proc set_default_realm { realm } {
    if ![have_realm $realm] { error [list realm $realm does not exist] }
    set_libdefault default_realm $realm
}

proc set_v4_config { config realms srvtab } {
    set_libdefault krb4_srvtab $srvtab
    set_libdefault krb4_config $config
    set_libdefault krb4_realms $realms
}
proc set_v4_iconvert { realm v4 v5 } {
    if ![have_profile_section realms $realm v4_instance_convert] {
	add_section realms $realm v4_instance_convert
    }
    frob_profile "purge_section_entries $v4" \
	    [list realms $realm v4_instance_convert]
    add_pair $v4 $v5 realms $realm v4_instance_convert
}

proc krb5_setup_default_config { } {
    default_set_pair default_tgs_enctypes des-cbc-crc libdefaults
    default_set_pair default_tkt_enctypes des-cbc-crc libdefaults

    if ![have_realm ATHENA.MIT.EDU] {
	create_realm ATHENA.MIT.EDU
	set_kdcs ATHENA.MIT.EDU \
		kerberos.mit.edu kerberos-1.mit.edu kerberos-2.mit.edu:88
	set_admin_server ATHENA.MIT.EDU kerberos.mit.edu
	set_default_domain ATHENA.MIT.EDU mit.edu

	set_v4_iconvert ATHENA.MIT.EDU mit mit.edu
	set_v4_iconvert ATHENA.MIT.EDU lithium lithium.lcs.mit.edu

	set_domain_realm .mit.edu ATHENA.MIT.EDU
	set_domain_realm mit.edu ATHENA.MIT.EDU
    }

    if 0 {
	set_domain_realm .media.mit.edu MEDIA-LAB.MIT.EDU
	set_domain_realm media.mit.edu MEDIA-LAB.MIT.EDU
    }

    if ![have_realm CYGNUS.COM] {
	create_realm CYGNUS.COM
	set_kdcs CYGNUS.COM \
		kerberos.cygnus.com kerberos-1.cygnus.com
	set_admin_server CYGNUS.COM kerberos.cygnus.com
    }

#    set_default_realm CYGNUS.COM

    global krb4_compat krb4_config krb4_realms krb4_srvtab
    if ![string compare $krb4_compat yes] {
	set_v4_config $krb4_config $krb4_realms $krb4_srvtab
    }

    # no data on this realm at present
#    set_domain_realm .ucsc.edu CATS.UCSC.EDU
}

proc with_profile { varname script } {
    global profile
    upvar 1 $varname alt_profile
    set tmp $profile
    set profile $alt_profile
    set result [uplevel $script]
    set alt_profile $profile
    set profile $tmp
    return result
}
# This script is expected to run with the non-local version of the admin
# library linked in.  So when the database is in fact local, we need to
# run kadmin.local to perform the operations.  Once the KDC and admin
# server are running, of course, we can use the non-local version with
# no problems; we just wind up having to authenticate to it despite having
# direct write access to the database.
#
# With tcl's dynamic library support, it'd be nice to load the admin
# library only after we've decided which version we need.  But we aren't
# using that support at this point in time.  Oh well.

#set kdb5_util_prog "../kadmin/dbutil/kdb5_util"
#set kadmin_local_prog "../kadmin/cli/kadmin.local"
set kdb5_util_prog "$krb5_path(prefix)/sbin/kdb5_util"
set kadmin_local_prog "$krb5_path(prefix)/sbin/kadmin.local"

# assumes config files have already been written

# run a command, feeding it passwords, and check for expected output
proc create_db.run { cmd passwords tmpname expected } {
    catch {
	set f [open "|$cmd >&$tmpname" w]
	puts $f $passwords
	close $f
    } errs
    if [string length $errs] {
	error "error running \"$cmd\": $errs"
    }

    # Now look at the output from running the program.
    set output ""
    catch {
	set f [open $tmpname r]
	set output [read -nonewline $f]
	close $f
    } errs
    if [string length $errs] {
	error "can't check log of Kerberos database commands: $errs"
    }
    set output [split $output "\n"]

    # Check for certain OS-specific warning messages we can safely discard.
    if [regexp "^ld.so:" [lindex $output 0]] {
	set output [lrange $output 1 end]
    }

    # Check for the expected output strings.
    foreach x $expected {
	set out [lindex $output 0]
	if [regexp "^$x\$" $out] {
	    set output [lrange $output 1 end]
	} else {
	    regsub "^$x" $out "" out
	    error "unexpected output from \"$cmd\":\n$out"
	}
    }
    if [llength $output] {
	error "unexpected output from \"$cmd\":\n[join $output \"\n\"]"
    }
}
proc get_temp_file { } {
    global env tmpdir
    # Find a place for a temporary file.
    if ![info exists tmpdir] {
	if [info exists env(TMPDIR)] {
	    set tmpdir $env(TMPDIR)
	    if {![file isdirectory $tmpdir] || ![file writable $tmpdir]} {
		error "Environment variable TMPDIR says $tmpdir but it's not writable."
	    }
	} else {
	    foreach d { /tmp /var/tmp /usr/tmp } {
		if [file isdirectory $d]&&[file writable $d] {
		    set tmpdir $d
		    break
		}
	    }
	    if ![info exists tmpdir] {
		error "Unable to find a writable temporary directory."
	    }
	}
    }
    return "$tmpdir/kn[pid]inst.tmp"
}
proc create_db { password } {
    global kdb5_util_prog
    global realm

    set tmpname [get_temp_file]

    # Run "kdb5_util create"
    create_db.run "$kdb5_util_prog create -s" \
	    "$password\n$password\n" $tmpname [list		\
	"Initializing database '.*' for realm '$realm',"	\
	"master key name 'K/M@$realm'"				\
	"You will be prompted for the database Master Password." \
	"It is important that you NOT FORGET this password."	\
	"Enter KDC database master key:"			\
	"Re-enter KDC database master key to verify:"		\
    ]
    file delete $tmpname
}
proc create_admin_inst { apassword } {
    global realm kadmin_local_prog admin_principal
    set tmpname [get_temp_file]
    # Okay.  Now, create the admin/admin entry.
    create_db.run "$kadmin_local_prog -q \"ank $admin_principal\"" \
	    "$apassword\n$apassword\n" $tmpname [list		\
	"Enter password for principal \"$admin_principal@$realm\": "	\
	"Re-enter password for principal \"$admin_principal@$realm\": " \
	"Principal \"$admin_principal@.*\" created."			\
    ]
    file delete $tmpname
}
proc load_db { dumpfile } {
    global kdb5_util_prog

    exec $kdb5_util_prog load $dumpfile
}

proc setup_database { realm dbdir } {
    set dbfile $dbdir/principal.db
    set stash_file $dbdir/.k5.$realm
    set kadmin_keytab $dbdir/kadm5.keytab

    if [file exists $dbfile] then {
	puts \
"\nAn old KDC database appears to be present.  If you want to continue using
that database, see the documentation for how to proceed; this script is
intended primarily for new installations, and does not yet handle existing
databases.\n"
	if [ask-yesno "Delete the database?" n] {
	    eval file delete [glob $dbdir/principal.*] \
		    $stash_file $kadmin_keytab
	} else {
	    puts "Okay.  Check the documentation and start this configuration"
	    puts "program again later."
	    exit 0
	}
    }
    # Okay.  Now, there's no database.
    puts "\nPreparing to create the KDC database..."
    set password [askpw "Enter the database master password:" \
	    "For verification, enter the master password again:"]
    puts "Creating the KDC database..."
    create_db $password
}
# ASK QUESTION VALIDATION_PROC ?DEFAULT?
proc ask_varargs { q validate arglist } {
    set args $arglist
    if [llength $args]==0 {
	set have_default 0
    } elseif [llength $args]==1 {
	set have_default 1
	set default [lindex $args 0]
	if ![string compare "" $default] { set have_default 0 }
    } else {
	error "wrong # args: should be \"ask prompt validate-proc ?default?\""
    }
    while 1 {
	puts -nonewline "$q "
	if $have_default { puts -nonewline "\[$default\] " }
	flush stdout
	if -1==[gets stdin answer] { exit 1 }
	set answer [string trim $answer]
	if "$have_default && ![string compare {} $answer]" {
	    set answer $default
	}
	if ![string length $validate] { return $answer }
	if [$validate $answer] { return $answer }
    }
}
proc ask { q validate args } { ask_varargs $q $validate $args }

proc pause { } {
    ask "Hit Return or Enter to continue>" {}
}

proc v.realm { r } {
    if ![regexp -nocase {^[a-z0-9.-]+$} $r] {
	puts "Invalid characters found in realm name \"$r\".  Please"
	puts "enter a valid realm name."
	puts ""
	return 0
    }
    return 1
}
proc ask_realm { q args } { ask_varargs $q v.realm $args }

proc v.yes-no { ans } {
    switch [string range $ans 0 0] {
	"y" -
	"Y" -
	"n" -
	"N" { return 1 }
    }
    puts "Please answer yes or no."
    return 0
}

proc ask-yesno { q args } {
    switch [string range $args 0 0] {
	""  {}
	"y" -
	"Y" { set args yes }
	"n" -
	"N" { set args no }
    }
    set ans [ask_varargs $q v.yes-no $args]
    switch [string range $ans 0 0] {
	"y" -
	"Y" { return 1 }
	"n" -
	"N" { return 0 }
    }
    error "bad return value from 'ask'"
}

proc v.hostname-or-addr { h } {
    set is_ok 0
    if ![regexp -nocase {^[a-z0-9_./-]+$} $h] {
	puts "Invalid characters found in host name \"$h\".  Please"
	puts "enter a valid host name."
	return 0
    }
    catch {krb5tcl_canonicalize_hostname $h ; set is_ok 1} err
    if $is_ok { return 1 }
    # Here only if caught an error.
    if [ask-yesno "$err (\"$h\") -- use it anyways?" y] {
	return 1
    } else {
	return 0
    }
}
proc v.kdcaddr { h } {
    # if colon form is used, it must be followed by exactly one port number
    set x [split $h ":"]
    if [llength $x]<1||[llength $x]>2 {
	puts "Hostname or hostname:portnumber combination required."
	return 0
    }
    if [v.hostname-or-addr [lindex $x 0]]==0 { return 0 }
    if [llength $x]==1 { return 1 }
    set port [lindex $x 1]
    if ![regexp "^\[0-9\]\[0-9\]*$" $port] {
	puts "Port specification must consist of exactly one number."
	return 0
    }
    if "$port < 1 || $port > 65535" {
	puts "Port number $port outside range 1..65535."
	return 0
    }
    return 1
}
proc v.hostname-addr-or-empty { h } {
    if ![string compare $h ""] { return 1 }
    v.hostname-or-addr $h
}
proc v.kdcaddr-or-empty { h } {
    if ![string compare $h ""] { return 1 }
    v.kdcaddr $h
}
proc ask_hostname { q args } { ask_varargs $q v.hostname-or-addr $args }
proc ask_maybe_hostname { q args } {
    ask_varargs $q v.hostname-addr-or-empty $args
}

proc askpw { prompt1 { prompt2 "" } } {

    if ![string compare $prompt2 ""] {
	set prompt2 "Verifying: $prompt1"
    }

    set err ""
    set ok 0
    set result ""
    while {!$ok} {
	catch {
	    set result [krb5tcl_read_password "$prompt1 " "$prompt2 "]
	    set ok 1
	} err
	if $ok {
	    return $result
	} else {
	    if ![string compare "Password mismatch" $err] {
		puts "Password mismatch; please try again.\n"
	    } else {
		error $err
	    }
	}
    }
}

# Edit system config files -- services, inetd.conf.
# Might also benefit from data hiding with itcl.

set sysconfig_begin   "#begin-kerbnet-additions"
set sysconfig_end     "#end-kerbnet-additions"
set sysconfig_disable "#disabled-for-kerbnet#"

proc sysconfig_read { file } {
    # Read file and return list of lines.

    # Let errors propagate.
    set f [open $file r]
    set contents [read -nonewline $f]
    close $f

    split $contents "\n"
}

proc sysconfig_remove_kerbnet { contents } {
    global sysconfig_begin sysconfig_end sysconfig_disable

    set result {}
    set omit 0
    foreach x $contents {
	if ![string compare $sysconfig_begin $x] { set omit 1 }
	if !$omit {
	    regsub "^$sysconfig_disable" $x "" x
	    lappend result $x
	}
	if ![string compare $sysconfig_end $x] { set omit 0 }
    }
    if $omit {
	error "end-kerbnet-additions marker not found"
    }
    return $result
}

proc foreach_counted { counter varname list body } {
    upvar 1 $varname v
    upvar 1 $counter idx
    set limit [llength $list]
    for {set idx 0} {$idx < $limit} {incr idx} {
	set v [lindex $list $idx]
	uplevel 1 $body
    }
}

# Specific to /etc/services....

# file contents - lines
set etc_services {}
# new entries to be added in kerbnet section -
#  list of { { name ?name...? } port/proto comment }
set new_services {}

# I don't want to change any lines I don't have to modify.  So I
# don't convert back and forth.  (Converting but keeping a mapping
# from the parsed form back to the original might help.  Try it,
# later...)

# Cache speeds it up a little.
proc parse_service_line { line } {
    global service_parse_cache
    if ![info exists service_parse_cache($line)] {
	set split1 [split $line "#"]
	set data [lindex $split1 0]
	regsub -all "\[ \t\]+" [string trim $data] " " data
	set comment [join [lrange $split1 1 end] "#"]

	set fields [split $data " "]
	if [llength $fields]==0 { return [list {} {} $comment] }
	set port [lindex $fields 1]
	set names [lreplace $fields 1 1]

	set service_parse_cache($line) [list $names $port $comment]
    }
    return $service_parse_cache($line)
}

proc unparse_service_line { data } {
    set names [lindex $data 0]
    if [llength $names] {
	set name [lindex $names 0]
	if [string length $name]>7 {
	    set sep "\t"
	} else {
	    set sep "\t\t"
	}
	if [string length [lindex $data 1]]>7 {
	    set sep2 "\t"
	} else {
	    set sep2 "\t\t"
	}
	set othernames [lrange $names 1 end]
	if [string length $othernames]>7 {
	    set sep3 " "
	} else {
	    set sep3 "\t"
	}
	set cmt [lindex $data 2]
	if [string length $cmt] { set cmt "$sep3#$cmt" }
	return "$name$sep[lindex $data 1]$sep2$othernames$cmt"
    } else {
	# comment only
	return "#[lindex $data 2]"
    }
}

proc add_service { names port comment } {
    global etc_services new_services
    set proto [lindex [split $port /] 1]
    if [llength $names] {
	# If matching entries exists (ignoring comments and additional names)
	# don't add them again.  Saves time in the remove_service passes.
	foreach x $etc_services {
	    set parsed [parse_service_line $x]
	    set port2 [lindex $parsed 1]
	    if [string compare $port $port2] continue
	    foreach name [lindex $parsed 0] {
		set idx [lsearch -exact $names $name]
		if $idx>=0 { set names [lreplace $names $idx $idx] }
	    }
	}
	if ![llength $names] { return }
	foreach name $names { remove_service $name $proto }
    }
    lappend new_services [list $names $port $comment]
}

proc remove_service { name proto } {
    global etc_services
    global new_services
    global sysconfig_disable

    for {set i 0} {$i < [llength $etc_services]} {incr i} {
	# This repeated parsing is wasteful, but I don't want to
	# change (by reassembly) any lines I'm not modifying.
	set line [parse_service_line [lindex $etc_services $i]]
	if [string compare $proto [lindex [split [lindex $line 1] /] 1]] {
	    continue
	}
	set idx [lsearch -exact [lindex $line 0] $name]
	if $idx>=0 {
	    set etc_services \
		    [lreplace $etc_services $i $i "$sysconfig_disable[lindex $etc_services $i]"]
	    set names [lindex $line 0]
	    if [llength $names]>1 {
		set names [lreplace $names $idx $idx]
		add_service $names [lindex $line 1] [lindex $line 2]
	    }
	}
    }
    for {set i 0} {$i < [llength $new_services]} {incr i} {
	set line [lindex $new_services $i]
	if [string compare $proto [lindex [split [lindex $line 1] /] 1]] {
	    continue
	}
	set idx [lsearch -exact [lindex $line 0] $name]
	if $idx>=0 {
	    set new_services [lreplace $new_services $i $i]
	    incr i -1
	    set names [lindex $line 0]
	    if [llength $names]>1 {
		set names [lreplace $names $idx $idx]
		add_service $names [lindex $line 1] [lindex $line 2]
	    }
	}
    }
}

proc get_service { name } {
    set result {}

    global etc_services new_services
    foreach x $etc_services {
	set y [parse_service_line $x]
	if [lsearch -exact [lindex $y 0] $name]>=0 {
	    lappend result [lindex $y 1]
	}
    }
    foreach y $new_services {
	if [lsearch -exact [lindex $y 0] $name]>=0 {
	    lappend result [lindex $y 1]
	}
    }
    return $result
}
proc have_service { name } { return [llength [get_service $name]]>0 }


set etc_services [sysconfig_read /etc/services]
set etc_services [sysconfig_remove_kerbnet $etc_services]

set krb5_services [list \
	{klogin 543/tcp "Kerberos authenticated rlogin"}		\
	{{kshell kcmd} 544/tcp "Kerberos remote shell"} 		\
	{kerberos-adm 749/tcp "Kerberos 5 admin/changepw"}		\
	{kerberos-adm 749/udp "Kerberos 5 admin/changepw"}		\
	{krb5_prop 754/tcp "Kerberos slave propagation"}		\
	{eklogin 2105/tcp "Kerberos auth/encrypted rlogin"}		\
	{krb524 4444/tcp "Kerberos 5 to 4 ticket conv"}]
proc set_up_extra_services_list {} {
    # xxx special, for krb4 compat
    global krb5_services
    if [have_service kerberos] {
	set kerberos_name kerberos-sec
    } else {
	set kerberos_name {kerberos kdc}
    }
    lappend krb5_services [list $kerberos_name 88/udp "Kerberos V5 KDC"]
    lappend krb5_services [list $kerberos_name 88/tcp "Kerberos V5 KDC"]
}

proc show_needed_services_entries {} {
    global krb5_services

    puts "\nThese are the entries you need to ensure are present in"
    puts "your /etc/services file:\n"
    foreach x $krb5_services {
	puts "[unparse_service_line $x]"
    }
    puts "\n"
    pause
}

proc update_services { } {
    global krb5_services
    global insttype
    set_up_extra_services_list

    global pkg
    puts "$pkg requires various entries to be present in /etc/services."
    puts -nonewline "They can be added now, or you can add them later."
    if [info exists insttype] { set x $insttype } else { set x foo }
    if [string compare $x appclient] {
	puts "  (But note that"
	puts "installing an application server or KDC may require that these"
	puts -nonewline "entries exist during the installation process.)"
    }
    puts ""
    if [ask-yesno "Update /etc/services now?" y] {
	global etc_services new_services
	global sysconfig_begin sysconfig_end

	puts -nonewline "Working..." ; flush stdout

	foreach x $krb5_services {
	    eval add_service $x
	}

	set newfile /etc/services.new
	if [catch {
	    set f [open $newfile w]
	    foreach x $etc_services {
		puts $f $x
	    }
	    if [llength $new_services] {
		puts $f $sysconfig_begin
		foreach x $new_services {
		    puts $f [unparse_service_line $x]
		}
		puts $f $sysconfig_end
	    }
	    close $f
	    file delete -force /etc/services.old
	    exec ln /etc/services /etc/services.old
	    file rename -force $newfile /etc/services
	    puts "done.  (Old version in /etc/services.old.)"
	} err] {
	    puts "error updating /etc/services:\n$err\n"
	    puts "Abort this script, fix the error and start again, or"
	    puts "install the changes yourself."
	    show_needed_services_entries
	}

	global service_parse_cache
	unset service_parse_cache
    } else {
	show_needed_services_entries
    }
}

# Specific to /etc/inetd.conf....

# list of lines
set etc_inetd {}
# list of { service stream/dgram tcp/udp nowait/wait user pathname args }
#      or { comment-including-# }
set new_inetd {}

proc parse_inetd_line { line } {
    if [regexp "^#" $line] {
	return [list $line]
    }
    regsub -all "\[ \t\]+" [string trim $line] " " line
    set fields [split $line]
    if [llength $fields]<7 {
	error "too few fields in /etc/inetd line ($line)?"
    }
    lreplace $fields 6 end [lrange $fields 6 end]
}
proc unparse_inetd_line { data } {
    if [llength $data]>1 {
	return "[lindex $data 0]\t[lindex $data 1] [lindex $data 2] [lindex $data 3] [lindex $data 4]\t[lindex $data 5]\t[lindex $data 6]";
    } else {
	return [lindex $data 0]
    }
}

proc add_krb_daemon { service cmd } {
    set args $cmd

    global krb5_path generic_prefix
    global etc_inetd new_inetd
    global sysconfig_disable

    foreach_counted i x $etc_inetd {
	if [regexp "^$service\[ \t\]" $x] {
	    set etc_inetd [lreplace $etc_inetd $i $i "$sysconfig_disable[lindex $etc_inetd $i]"]
	    break
	}
    }
    foreach_counted i x $new_inetd {
	if ![string compare [lindex $x 0] $service] {
	    error "already adding inetd service $service"
	}
    }
    if [info exists generic_prefix] {
	set progname "$generic_prefix/sbin/[lindex $args 0]"
    } else {
	set progname "$krb5_path(prefix)/sbin/[lindex $args 0]"
    }
    lappend new_inetd [list $service stream tcp nowait root $progname $args]
}

set krb5_daemons {}

if 1 {
    # insecure version
    set krb5_daemon_invocation(ftp)	{ftpd}
    set krb5_daemon_invocation(klogin)	{klogind -k -i}
    set krb5_daemon_invocation(eklogin)	{klogind -k -i -e}
    set krb5_daemon_invocation(kshell)	{kshd -k -i -A}
    set krb5_daemon_invocation(telnet)	{telnetd -a none}
    set krb5_daemon_invocation(krb5_prop) {kpropd}
} else {
    # secure version
    set krb5_daemon_invocation(ftp)	{ftpd -a}
    set krb5_daemon_invocation(klogin)	{klogind -5 -c}
    set krb5_daemon_invocation(eklogin)	{klogind -5 -c -e}
    set krb5_daemon_invocation(kshell)	{kshd -5 -c -A}
    set krb5_daemon_invocation(telnet)	{telnetd -a valid}
    set krb5_daemon_invocation(krb5_prop) {kpropd}
}

proc show_new_inetd { } {
    global new_inetd
    puts "\nThese are the entries you need to put in /etc/inetd.conf:\n"
    foreach x $new_inetd { puts [unparse_inetd_line $x] }
    puts ""
    puts "Then send a hangup (HUP) signal to inetd, to get it to reread the"
    puts "config file.\n"
    pause
}
proc update_inetd { } {
    global sysconfig_begin sysconfig_end
    global etc_inetd new_inetd pkg
    global krb5_daemons krb5_daemon_invocation

    if ![llength $krb5_daemons] return

    set etc_inetd [sysconfig_read /etc/inetd.conf]
    set etc_inetd [sysconfig_remove_kerbnet $etc_inetd]

    foreach d $krb5_daemons {
	add_krb_daemon $d $krb5_daemon_invocation($d)
    }

    if [ask-yesno "Update /etc/inetd.conf with new services now?" y] {
	set newfile /etc/inetd.conf.new
	if [catch {
	    set f [open $newfile w]
	    foreach x $etc_inetd {
		puts $f $x
	    }
	    if [llength $new_inetd] {
		puts $f $sysconfig_begin
		foreach x $new_inetd {
		    puts $f [unparse_inetd_line $x]
		}
		puts $f $sysconfig_end
	    }
	    close $f
	    file delete -force /etc/inetd.conf.old
	    exec ln /etc/inetd.conf /etc/inetd.conf.old
	    file rename -force $newfile /etc/inetd.conf
	    puts "\nDone.  (Old version in /etc/inetd.conf.old.)\n"
	    puts "You'll need to send a hangup (HUP) signal to the inetd"
	    puts "process when you've finished configuring $pkg, to get it to"
	    puts "reread inetd.conf.\n"
	    pause
	} err] {
	    puts "Error updating /etc/inetd.conf:\n$err\n"
	    puts "Abort this script, fix the error and start again, or"
	    puts "install the changes yourself."
	    show_new_inetd
	}
    } else {
	show_new_inetd
    }
}
update_inetd
# For debugging only.  I really wish the command loop were written in
# tcl rather than coded directly in C, buried in tclMain.c where I can't
# get at it from tcl code...
proc interactive { } {
    set partial ""
    while 1 {
	# use tcl_prompt2 if incomplete command pending
	if [string length $partial] {
	    set varname tcl_prompt2
	    set dflprompt "> "
	} else {
	    set varname tcl_prompt1
	    set dflprompt "% "
	}
	if [info exists $varname] {
	    eval [set $varname]
	} else {
	    puts -nonewline $dflprompt
	}
	flush stdout
	if [gets stdin cmd]==-1 { return }
	# check for incomplete command...
	set cmd "$partial$cmd"
	if ![info complete $cmd] {
	    set partial "$cmd\n"
	    continue
	}
	set partial ""
	set success 0
	set err ""
	set result ""
	catch {set result [uplevel $cmd] ; set success 1 ; return} err
	if [string compare "" $err] { puts $err } \
		elseif [string compare "" $result] { puts $result }
    }
}

# Print the current profile data to the terminal.
proc prof {} {
    global profile
    krb5tcl_write_profile /dev/tty $profile
}
# who to report bugs to
set bug_addr bugs@cygnus.com
# additional instructions, or empty
set bug_how " using the send-pr program"
# name and version of package
set pkg KerbNet
set pkgvers $krb5_version

set symlink_name /usr/cygnus/kerbnet


# Support code.

# Always returns a hostname.
proc safe_canonicalize { hostname } {
    set result $hostname
    catch {set result [krb5tcl_canonicalize_hostname $hostname]}
    return [string toupper $result]
}

proc write_profile { data file } {
    if [catch {
	krb5tcl_write_profile $file.new $data
	krb5tcl_system_only_write $file.new
	exec mv -f $file.new $file
    } err] {
	puts "Can't write profile $file:\n$err"
	exit 1
    }
}
proc save_krb5_conf {} {
    global profile
    global krb5_path
    write_profile $profile $krb5_path(profile)
}
proc save_kdc_conf {} {
    global kdc_conf
    global krb5_path
    write_profile $kdc_conf $krb5_path(kdc_profile)
}

proc symlink { target linkname } {
    exec ln -s $target $linkname
}

proc configure_symlink {} {
    global symlink_name krb5_path
    set ret {}

    set x [get_value_list kerbnet-config symlink-name]
    if [llength $x]==1 { set symlink_name [lindex $x 0] }
    if [file exists $symlink_name] {
	set targ {}
	if ![catch {set targ [file readlink $symlink_name]} err] {
	    if ![string compare $targ $krb5_path(prefix)] {
		set ret $symlink_name
	    } else {
		# Don't use elseif here, the condition gets evaluated too early!
		if [ask-yesno "Symbolic link $symlink_name currently points to $targ;\nupdate it to point to $krb5_path(prefix)?" y] {
		    file delete -force $symlink_name
		    symlink $krb5_path(prefix) $symlink_name
		    set ret $symlink_name
		}
	    }
	} else {
	    # Something's there, but readlink as root failed.  Skip it.
	}
    } else {
	if [ask-yesno "Create symlink $symlink_name pointing to $krb5_path(prefix)?" y] {
	    symlink $krb5_path(prefix) $symlink_name
	    set ret $symlink_name
	}
    }
    if [string length $ret] {
	remove_values symlink-name kerbnet-config
	add_pair symlink-name $symlink_name kerbnet-config
	save_krb5_conf
    }
    return $ret
}


if ![krb5tcl_have_system_privs] {
    puts "This script must be run as root."
    exit 1
}

if ![info exists krb5_path(kdc_profile)] {
    set krb5_path(kdc_profile) $krb5_path(prefix)/lib/krb5kdc/kdc.conf
}

puts "Welcome to the $pkg installation program.

This program will ask you several questions, and configure your $pkg
installation based on your answers.  You may interrupt it at any time with
your terminal interrupt character (usually ^C), or responding to any question
with an end-of-file (^D); either will cause the configuration process to be
aborted.

We assume you have read the installation documentation that describes what a
Kerberos realm is, what a KDC is, etc.  If you have not, please read that
documentation before proceeding.

Please report any problems to $bug_addr$bug_how.

"

set realm ""
set hostname [info hostname]
set chostname [safe_canonicalize $hostname]

puts "Configuring $pkgvers on host $hostname ...\n"

if [file exists $krb5_path(profile)] {
    if [catch { set profile [krb5tcl_read_profile $krb5_path(profile)] } x] {
	puts "Error reading $krb5_path(profile): $x"
	puts "Ignoring it...\n"
    } else {
	puts "Using old information in $krb5_path(profile) for defaults...\n"
    }
}

proc fixperms {} {
    global krb5_path
    # Use "/." in case of symlinks.
    exec chown -R root $krb5_path(prefix)/.
    exec chmod -R go-w $krb5_path(prefix)/.
    if [file exists $krb5_path(prefix)/sbin/xdm-restart] {
	exec chmod u+s $krb5_path(prefix)/sbin/xdm-restart
    }
    exec chmod u+s $krb5_path(prefix)/bin/ksu
    exec chmod u+s $krb5_path(prefix)/bin/v4rcp
}

if [catch {
    # UNIX-specific...
    puts "Checking/fixing ownership and permissions of $krb5_path(prefix)...\n"
    fixperms
} err] {
    puts "Error: $err"
    exit 1
}

set x [get_value_list libdefaults default_realm]
if [llength $x]==1 {
    set realm [lindex $x 0]
}

if [string length $realm]==0 {
    set hsplit [split $hostname .]
    if [llength $hsplit]>1 {
	if [llength $hsplit]>2 { set hsplit [lrange $hsplit 1 end] }
	set realm [string toupper [join $hsplit .]]
    }
}

puts "Configuring realm information:\n"
set realm [ask "Name of local realm?" v.realm $realm]

set kdc_list [get_kdcs $realm]
if [llength $kdc_list]>0 {
    puts "The previously defined list of KDCs for realm $realm is:"
    foreach x $kdc_list { puts "\t$x" }
    puts ""
    if ![ask-yesno "Do you want to keep this list of KDCs?" yes] {
	set kdc_list {}
    }
} else {
    set kdc_list {}
}

if [llength $kdc_list]==0 {
    puts "\nPlease enter a list of Kerberos server (KDC) hostnames.  End the"
    puts "list with a blank line."
    while 1 {
	set kdc [ask "KDC #[expr 1 + [llength $kdc_list]] name?" v.hostname-addr-or-empty]
	if ![string compare $kdc ""] {
	    if [llength $kdc_list] break
	    puts "You have entered no KDC names.  Kerberos cannot operate without"
	    puts "at least one KDC.  Please enter your KDC hostnames now, or quit"
	    puts "the installation process."
	    continue
	}
	lappend kdc_list $kdc
	# Is the local host going to be a KDC?
	if ![string compare [safe_canonicalize $kdc] $chostname] {
	    set insttype 3
	}
    }
}

set x [lindex $kdc_list 0]
if [catch {set x [get_admin_server $realm]} err] { }
puts "\nNow you must select the name of the Kerberos administrative server.
This is usually one of the KDCs, as listed above.\n"
set admin_server [ask "$realm admin server name?" v.hostname-or-addr $x]

# This is pretty gratuitous, but by doing this here and now we
# maintain the order of entries in krb5.conf that we've always
# used before.
ensure_top_section libdefaults

create_realm $realm
set_default_realm $realm
eval "set_kdcs $realm $kdc_list"
set_admin_server $realm $admin_server

krb5_setup_default_config

ensure_top_section kerbnet-config
remove_values version kerbnet-config
add_pair version $krb5_version kerbnet-config

puts -nonewline "Writing realm info to $krb5_path(profile)..."
flush stdout
save_krb5_conf
puts "done.\n\nLocal system configuration for $chostname:"

proc v.install-type { x } {
    switch -- $x {
	"1"	-
	"2"	-
	"3"	-
	"4"	{ return 1 }
    }
    puts "\n\"$x\" is not a valid choice."
    return 0
}

set prompt "\nWill this machine be a:
  1) Kerberos application (rsh, rlogin, telnet) client system only
  2) Kerberos application server (and client) system
  3) slave KDC (and application client/server)
  4) master KDC with admin server (and application client/server)

Please enter the corresponding number for the configuration you
wish to install:"

set insttype 2
if ![string compare [safe_canonicalize $admin_server] $chostname] {
    set insttype 4
} else {
    foreach kdc $kdc_list {
	if ![string compare [safe_canonicalize $kdc] $chostname] {
	    set insttype 3
	}
    }
}

set insttype [ask $prompt v.install-type $insttype]
set insttype [lindex {nil appclient appserver slave-kdc master-kdc} $insttype]
puts ""

# Configure application clients.
set generic_prefix [configure_symlink]
if ![string length $generic_prefix] { set generic_prefix $krb5_path(prefix) }
puts ""

update_services
puts ""

proc fini {} {
    global pkg

    puts "\n$pkg basic configuration is now complete.  For advanced configuration,"
    puts "including /bin/login and xdm, see the documentation provided with $pkg."
    puts "\nHave a nice day."
    exit 0
}

# IF this will be an application client only, no other updates are
# needed.
if ![string compare appclient $insttype] { fini }

# Configure application servers.

puts "Which application services do you wish to run on this host?"
foreach x {ftp telnet {klogin "Kerberos rlogin"} {eklogin "encrypted Kerberos login"} {kshell "Kerberos remote shell"}} {
    set name [lindex $x 0]
    if [llength $x]==1 {
	set prompt $name
    } else {
	set prompt "$name ([lindex $x 1])"
    }
    if [ask-yesno "  $prompt?" y] { lappend krb5_daemons $name }
}

update_inetd

# Configure KDCs.

proc v.localstatedir { d } {
    if [string compare [file pathtype $d] absolute] {
	puts "Directory name must be absolute."
	return 0
    }
    if [file exists $d]&&![file isdirectory $d] {
	puts "$d is not a directory."
	return 0
    }
    return 1
}

proc setup_localstatedir {} {
    global conf_dir
    global profile

    ensure_top_section kerbnet-config

    set x [get_value_list kerbnet-config conf-dir]
    if [llength $x] {
	set conf_dir [lindex $x 0]
    } else {
	puts "You need to select a directory to store config files that will"
	puts "be preserved across releases.  (At the moment, only the KDC"
	puts "config file and database are stored there.)\n"
	puts "This directory should NOT be stored under the installation"
	puts "directory for any version of this product.  It should be on"
	puts "local disk storage for this machine, not accessed over the net."
	if [file isdirectory /var] {
	    set lsd /var/kerbnet
	} else {
	    set lsd /etc/kerbnet
	}
	set conf_dir [ask "Config file directory?" v.localstatedir $lsd]

	add_pair conf-dir $conf_dir kerbnet-config
    }
    if ![file exists $conf_dir] {
	if [catch {file mkdir $conf_dir} err] {
	    puts "** Error: $err"
	    puts "Please fix this error and try again."
	    exit 1
	}
    }
    if [catch {krb5tcl_system_only_write $conf_dir} err] {
	puts "** Error: $err"
    }
    save_krb5_conf
}

set have_old_db 0
if [string match *kdc $insttype] {
    if [catch {
	# do KDC stuff

	setup_localstatedir
	if ![file exists $conf_dir/kdc] { file mkdir $conf_dir/kdc }
	if ![file exists $krb5_path(prefix)/lib/krb5kdc] {
	    symlink $conf_dir/kdc $krb5_path(prefix)/lib/krb5kdc
	}

	global kdc_conf
	set kdc_conf {}
	if [file exists $krb5_path(kdc_profile)] {
	    if [catch {set kdc_conf [krb5tcl_read_profile $krb5_path(kdc_profile)]} err] {
		puts "$err\nError loading $krb5_path(kdc_profile), ignoring."
	    } else {
		puts "Using $krb5_path(kdc_profile) for KDC defaults..."
	    }
	}
	with_profile kdc_conf {
	    ensure_top_section kdcdefaults
	    ensure_top_section realms
	    create_realm $realm
	    default_set_pair kdc_ports 750,88 kdcdefaults
	    default_set_realm_pair $realm kdc_ports 750,88
	    default_set_realm_pair $realm kadmind_port 749
	    default_set_realm_pair $realm max_life "10h 0m 0s"
	    default_set_realm_pair $realm max_renewable_life "7d 0h 0m 0s"
	    default_set_realm_pair $realm master_key_type des-cbc-crc
	    default_set_realm_pair $realm supported_enctypes "des-cbc-crc:normal des-cbc-crc:v4"
	}
	save_kdc_conf

	setup_database $realm $conf_dir/kdc
    } err] {
	# error happened
	puts $err
	exit 1
    }
}

set admin_principal {}
proc v.local_principal {n} {
    if ![regexp -nocase {^[A-Za-z0-9./-]+$} $n] {
	puts "Principal name \"$n\" contains invalid characters.  Please"
	puts "enter a valid principal name."
	return 0
    }
    return 1
}
proc get_admin_principal {} {
    ask "Admin principal name (without realm)?" v.local_principal admin/admin
}


set kdcdir $krb5_path(prefix)/lib/krb5kdc
if ![string compare master-kdc $insttype]&&!$have_old_db {
    if [catch {
	if [string length $admin_principal]==0 {
	    puts "For administrative purposes, a principal with privileged"
	    puts "access to the database will be created now.  The default"
	    puts "name is \"admin/admin\", but you may choose another name."
	    puts ""
	    set admin_principal [get_admin_principal]
	}
	set apassword [askpw "Enter the admin password:" \
		"For verification, enter the admin password again:"]
	create_admin_inst $apassword
	set f [open "$kdcdir/kadm5.acl" w]
	puts $f "$admin_principal@$realm *"
	close $f

	# Don't use built in fns, we're running with a remote client that
	# needs kadmind already running.
	file delete -force $kdcdir/kadm5.keytab
	exec $kadmin_local_prog -q "ktadd -k $kdcdir/kadm5.keytab \
		kadmin/admin kadmin/changepw" </dev/null
    } err] {
	# error
	puts $err
	exit 1
    }
} else {
    if [string length $admin_principal]==0 {
	puts "The name of a principal with administrative access to the"
	puts "database is needed now.  If this principal does not exist,"
	puts "or does not have access to register, change, and retrieve"
	puts "keys, the rest of the installation may fail."
	puts ""
	set admin_principal [get_admin_principal]
    }
    set apassword [askpw "Please enter the password for \"$admin_principal\":" \
	    "For verification, enter the password again:"]
}
if ![string compare master-kdc $insttype] {
    if [catch {
	puts -nonewline "Starting new master KDC daemons: kdc..."
	flush stdout
	exec "$generic_prefix/sbin/krb5kdc"
	puts -nonewline " kadmind..."
	flush stdout
	exec "$generic_prefix/sbin/kadmind"
	puts "done."
    } err] {
	puts "Error starting Kerberos daemons: $err"
	exit 1
    }
}
if ![string compare slave-kdc $insttype] {
    if [catch {
	set f [open $kdcdir/kpropd.acl a]
	puts $f "host/[string tolower [safe_canonicalize $admin_server]]@$realm"
	close $f
    } err] {
	puts "Error writing to $kdcdir/kpropd.acl:\n  $err"
	exit 1
    }
    lappend krb5_daemons krb5_prop
}

# Okay.  Now we have the admin password, and if we're the master KDC, the
# daemons have been started.  If we're not the master, assume they've been
# started.

set kadmin_connect_done 0
proc kadmin_connect {} {
    global kadmin_connect_done realm apassword admin_principal
    if $kadmin_connect_done return
    puts "Connecting to admin server..."
    if [catch {kadm5_init -realm $realm -princ $admin_principal -password $apassword} err] {
	puts "Error initializing connection to kadmin server:\n  $err"
	puts "Please fix the problem and try again."
	exit 1
    }
    set kadmin_connect_done 1
}

set my_inst [string tolower $chostname]
set my_princ "host/$my_inst@$realm"
set keytab /etc/v5srvtab

set need_host_key 1
if [file exists $keytab] {
    if [catch [list kadm5_ktlist $keytab] keys] {
	puts "Error checking for $my_princ in keytab $keytab:\n$keys"
	puts "Please fix the problem and try again."
	exit 1
    }
    foreach x $keys {
	set princ [lindex $x 2]
	if ![string compare $princ $my_princ] {
	    set need_host_key 0
	    break
	}
    }
}
puts ""
if $need_host_key {
    kadmin_connect
    puts -nonewline "\nCreating host key ($my_princ) for\napplication services..."
    flush stdout
    if [catch {kadm5_getprinc $my_princ} err] {
	# assume error meant it doesn't exist
	if [catch {kadm5_addprinc -randkey $my_princ} err] {
	    puts "Error creating host key in database:\n  $err"
	    exit 1
	}
    }
    kadm5_ktadd $my_princ
    puts "done.\n"
} else {
    puts "Found a host key ($my_princ) already in"
    puts "$keytab; not creating a new one.\n"
}

if ![string compare master-kdc $insttype]&&[llength $kdc_list]>1 {
    set slavelist {}
    set as [safe_canonicalize $admin_server]
    foreach kdc $kdc_list {
	if [string compare $as [safe_canonicalize $kdc]] {
	    lappend slavelist $kdc
	}
    }
    if [llength $slavelist]<[llength $kdc_list]&&[llength $slavelist]>0 {
	if [catch {
	    if [file exists $krb5_path(prefix)/install/do-kprop] {
		file delete -force $krb5_path(prefix)/install/do-kprop
	    }
	    exec sed -e "s,@realm@,$realm,g" -e "s,@kdclist@,$slavelist,g" \
		    -e "s,@prefix@,$krb5_path(prefix),g" \
		    <$krb5_path(prefix)/install/do-kprop.in \
		    >$krb5_path(prefix)/install/do-kprop
	    exec chmod a+x $krb5_path(prefix)/install/do-kprop
	    puts "\nPlease arrange for $generic_prefix/install/do-kprop to be"
	    puts "run often (perhaps hourly or more often) on this machine.\n"
	} err] {
	    puts "\nError writing slave propagation script:\n  $err"
	    puts "You'll have to fix this up by hand; see the documentation.\n"
	}
    } else {
	# Reality check bounced?
	puts "Error working out the list of slaves.  You'll have to write the slave"
	puts "propagation script yourself.  See"
	puts "      $krb5_path(prefix)/install/do-kprop.in"
	puts "as an example.\n"
    }
}

switch -- $insttype {
    master-kdc	{
	puts "Please arrange for $generic_prefix/install/rc.master to"
	puts "be run at boot time."
    }
    slave-kdc	{
	puts "Please arrange for $generic_prefix/install/rc.slave to"
	puts "be run at boot time, and remember to set up slave propagation"
	puts "from the master KDC.  Do NOT start the KDC on this machine"
	puts "until you have done a database propagation."
    }
    appserver	{
    }
}
fini
