# -*- Tcl -*-

# Principal handling functions

# if the princ_fix result doesn't start with -, it's a flag
set princ_fix(expire) {-expire}
set princ_fix(pw_expire) {-pwexpire}
set princ_fix(tix_life) {-maxlife}
set princ_fix(renew_life) {-maxrenewlife}
set princ_fix(password) {-password}
set princ_fix(kvno) {-kvno}

set allattrs { \
	DISALLOW_POSTDATED DISALLOW_FORWARDABLE DISALLOW_TGT_BASED \
	DISALLOW_RENEWABLE DISALLOW_PROXIABLE DISALLOW_DUP_SKEY \
	DISALLOW_ALL_TIX REQUIRES_PRE_AUTH REQUIRES_HW_AUTH \
	REQUIRES_PWCHANGE DISALLOW_SVR PWCHANGE_SERVICE \
    }
set allattr_name { \
	{Disallow Postdated} {Disallow Forwardable} {Disallow TGT Based} \
	{Disallow Renewable} {Disallow Proxiable} {Disallow Duplicate SKey} \
	{Disallow All Tickets} {Requires Preauth} {Requires Hardware Auth} \
	{Requires Password Change} {Disallow SVR} {Password Changing Service}
}

set princ_fix(DISALLOW_POSTDATED)    {disallow_postdated}
set princ_fix(DISALLOW_FORWARDABLE)  {disallow_forwardable}
set princ_fix(DISALLOW_TGT_BASED)    {disallow_tgs_req}
set princ_fix(DISALLOW_RENEWABLE)    {disallow_renewable}
set princ_fix(DISALLOW_PROXIABLE)    {disallow_proxiable}
set princ_fix(DISALLOW_DUP_SKEY)     {disallow_dup_skey}
set princ_fix(DISALLOW_ALL_TIX)      {disallow_tix}
set princ_fix(REQUIRES_PRE_AUTH)     {requires_preauth}
set princ_fix(REQUIRES_HW_AUTH)      {requires_hwauth}
set princ_fix(REQUIRES_PWCHANGE)     {needchange}
set princ_fix(DISALLOW_SVR)          {disallow_svr}
set princ_fix(PWCHANGE_SERVICE)      {password_changing_service}

set princ_func(expire) kadm5_strtodate
set princ_func(pw_expire) kadm5_strtodate
set princ_func(tix_life) kadm5_strtodur_none
set princ_func(renew_life) kadm5_strtodur

#
# WARNING:  If the order changes (in particular, if the "password policy"
# field moves) you _must_ edit a lot of stuff in this file and in policy.tk
# due to programmer laziness (and lack of Tcl/Tk experience)
#
# Search for .5. to start with.
#
set principal_mod_fields {
    { "Principal:" {+-background #000} \
	    principal(name) "" \
	    label "+-relief flat -anchor w" }
    { "Principal Expires:" default \
	    principal(expire) save_principal(expire) \
	    entry default check_expire }
    { "Password Expires:" default \
	    principal(pw_expire) save_principal(pw_expire) \
	    entry default check_expire }
    { "Max Ticket Lifetime:" default \
	    principal(tix_life) save_principal(tix_life) \
	    entry default check_lifetime_none }
    { "Max Renewable Lifetime:" default \
	    principal(renew_life) save_principal(renew_life) \
	    entry default check_lifetime }
    { "Password Policy:" default \
	    principal(policy) "" \
	    "global principal ; menubutton" \
	    "-relief ridge -menu .principal.fields.5.e.m -text \$principal(policy)" }
    { "Key Version Number:" {+-background #000} \
	    principal(kvno) "" \
	    label "+-relief flat -anchor w" }
    { "Last Password Change:" {+-background #000} \
	    principal(pwchange) "" \
	    label "+-relief flat -anchor w" }
    { "Last Modification:" {+-background #000} \
	    principal(modtime) "" \
	    label "+-relief flat -anchor w" }
    { "Last Modification By:" {+-background #000} \
	    principal(modprinc) "" \
	    label "+-relief flat -anchor w" }
    { "Last Successful Auth:" {+-background #000} \
	    principal(goodauth) "" \
	    label "+-relief flat -anchor w" }
    { "Last Failed Auth:" {+-background #000} \
	    principal(badauth) "" \
	    label "+-relief flat -anchor w" }
    { "Failed Password Attempts:" {+-background #000} \
	    principal(fail) "" \
	    label "+-relief flat -anchor w" }
}

set principal_add_fields {
    { "Principal:" default \
	    add_principal(name) "" \
	    entry default check_principal_name }
    { "Principal Expires:" default \
	    add_principal(expire) "" \
	    entry default check_expire }
    { "Password Expires:" default \
	    add_principal(pw_expire) "" \
	    entry default check_expire }
    { "Max Ticket Lifetime:" default \
	    add_principal(tix_life) "" \
	    entry default check_lifetime_none }
    { "Max Renewable Lifetime:" default \
	    add_principal(renew_life) "" \
	    entry default check_lifetime }
    { "Password Policy:" default \
	    add_principal(policy) "" \
	    "global add_principal ; menubutton" \
	    "-relief ridge -menu .add_principal.fields.5.e.m" }
}

set principal_ren_fields {
    { "New Name:" default \
	    add_principal(name) "" \
	    entry default check_principal_name }
    { "Principal Expires:" default \
	    add_principal(expire) ren_principal(expire) \
	    entry default check_expire }
    { "Password Expires:" default \
	    add_principal(pw_expire) ren_principal(pw_expire) \
	    entry default check_expire }
    { "Max Ticket Lifetime:" default \
	    add_principal(tix_life) ren_principal(tix_life) \
	    entry default check_lifetime_none }
    { "Max Renewable Lifetime:" default \
	    add_principal(renew_life) ren_principal(renew_life) \
	    entry default check_lifetime }
    { "Password Policy:" default \
	    add_principal(policy) "" \
	    "global add_principal ; menubutton" \
	    "-relief ridge -menu .add_principal.fields.5.e.m" }
}

proc show_princ_info { princ {silent_fail 0}} {
    global principal save_principal

    set cmd {set princ_info [kadm5_getprinc $princ]}
    if {[catch {eval $cmd} res] != 0} {
	if {$silent_fail} {
	    if {[winfo exists .principal]} {
		destroy .principal
		update_princs $princ
	    }
	    return
	}
	tk_dialog .error {Error} \
		"Unable to find principal $princ: $res" {} 0 OK
	update_princs $princ
	return
    }
    
    # princ_info appears to contain: principal name, expiration time,
    # date pw changed, pw expiration date, maximum ticket life,
    # principal who last modified the account, date modified, attribute
    # list, key version no, master key version no, policy name (or
    # [none] if no policy), max renewable life, last successful auth,
    # last failed auth, failed pw attempts, and a list of keys.  Then,
    # for each key, there is a version number, key version number, and
    # two type codes...see kadmin/tcltk/tcl_kadm5.c

    set principal(name) [lindex $princ_info 0]
    set principal(expire) [kadm5_datetostr [lindex $princ_info 1]]
    set principal(pwchange) [kadm5_datetostr [lindex $princ_info 2]]
    set principal(pw_expire) [kadm5_datetostr [lindex $princ_info 3]]
    set principal(tix_life) [kadm5_durtostr_none [lindex $princ_info 4]]
    set principal(modprinc) [lindex $princ_info 5]
    set principal(modtime) [kadm5_datetostr [lindex $princ_info 6]]
    set principal(attr) [lindex $princ_info 7]
    set principal(kvno) [lindex $princ_info 8]
    set principal(mkvno) [lindex $princ_info 9]
    set principal(policy) [lindex $princ_info 10]
    set principal(renew_life) [kadm5_durtostr [lindex $princ_info 11]]
    set principal(goodauth) [kadm5_datetostr [lindex $princ_info 12]]
    set principal(badauth) [kadm5_datetostr [lindex $princ_info 13]]
    set principal(fail) [lindex $princ_info 14]
    
    set principal(password) ""
    
    princ_attr_setfields principal $principal(attr)
    
    # populate principal window
    if {$principal(policy) == ""} {
	set principal(policy) {[none]}
    }
    
    # save the information 
    foreach k [array names principal] {
	set save_principal($k) $principal($k)
    }
    
    create_mod_win_info
    
    set w .principal
}

proc change_password_sel { } {
    global princ_fix _password debug
    
    # check the listbox
    set l [.princs.lb curselection]
    if { [llength $l] == 0 } {
	tk_dialog .dialog {Changing Password} "No principals selected." \
		"" 0 Ok
    } elseif {[llength $l] != 1} {
	tk_dialog .dialog {Changing Password} \
		"You must select exactly one principal to change the password"\
		"" 0 Ok
    } else {
	set name [.princs.lb get $l]

	set cmd {set princ_info [kadm5_getprinc $name]}
	if {[catch {eval $cmd} res] != 0} {
	    tk_dialog .error {Error} \
		    "Could not find principal $name in the database" {} 0 OK
	    update_princs $name
	    return
	}
	
	set attr [lindex $princ_info 7]

	if {[princ_attr_isset $attr "REQUIRES_PWCHANGE"]} {
	    set force "+"
	} else {
	    set force "-"
	}

	get_password $name $force 1

	if {[winfo exists .principal]} {
	    global principal
	    
	    if {$principal(name) == $name} {
		show_princ_info $name 1
	    }
	}
    }
}

proc edit_princ_sel { } {
    global debug
    
    # check the listbox
    set l [.princs.lb curselection]
    if { [llength $l] == 0 } {
	tk_dialog .dialog {Editing Principal} "No principals selected." \
		"" 0 Ok
    } elseif {[llength $l] != 1} {
	tk_dialog .dialog {Editing Principal} \
		"You must select exactly one principal to edit"\
		"" 0 Ok
    } else {
	show_princ_info [.princs.lb get [lindex $l 0]] 1
    }
}

proc rename_princ_sel { } {
    global debug add_principal ren_principal principal_ren_fields allattrs
    global allattr_name
    
    # check the listbox
    set l [.princs.lb curselection]
    if { [llength $l] == 0 } {
	tk_dialog .dialog {Rename Principal} "No principals selected." \
		"" 0 Ok
    } elseif {[llength $l] != 1} {
	tk_dialog .dialog {Rename Principal} \
		"You must select exactly one principal to rename"\
		"" 0 Ok
    } else {
	set ren_principal(name) [.princs.lb get [lindex $l 0]]
	
	set cmd {set princ_info [kadm5_getprinc $ren_principal(name)]}
	if {[catch {eval $cmd} res] != 0} {
	    tk_dialog .error {Error} \
		    "Unable to find principal $princ: $res" {} 0 OK
	    update_princs $princ
	    return
	}
	
	# princ_info appears to contain: principal name, expiration time,
	# date pw changed, pw expiration date, maximum ticket life,
	# principal who last modified the account, date modified, attribute
	# list, key version no, master key version no, policy name (or
	# [none] if no policy), max renewable life, last successful auth,
	# last failed auth, failed pw attempts, and a list of keys.  Then,
	# for each key, there is a version number, key version number, and
	# two type codes...see kadmin/tcltk/tcl_kadm5.c
	
	set add_principal(name) [lindex $princ_info 0]
	set add_principal(expire) [kadm5_datetostr [lindex $princ_info 1]]
	set add_principal(pw_expire) [kadm5_datetostr [lindex $princ_info 3]]
	set add_principal(tix_life) [kadm5_durtostr_none [lindex $princ_info 4]]
	set add_principal(attr) [lindex $princ_info 7]
	set add_principal(policy) [lindex $princ_info 10]
	set add_principal(renew_life) [kadm5_durtostr [lindex $princ_info 11]]

	princ_attr_setfields add_principal $add_principal(attr)
    
	foreach k [concat expire pw_expire tix_life policy renew_life \
		$allattrs] {
	    set ren_principal($k) $add_principal($k)
	}
	
	# make a dummy setup
	set add_principal(password) ""

	create_ren_win_info "Rename"
	
	.add_principal.fields.5.e config -text $add_principal(policy)
	
	focus .add_principal.fields.0.e
    }
}

proc copy_princ_sel { } {
    global debug add_principal ren_principal principal_ren_fields allattrs
    
    # check the listbox
    set l [.princs.lb curselection]
    if { [llength $l] == 0 } {
	tk_dialog .dialog {Error} "No principals selected." \
		"" 0 Ok
    } elseif {[llength $l] != 1} {
	tk_dialog .dialog {Error} \
		"You must select exactly one principal to copy"\
		"" 0 Ok
    } else {
	global add_principal
	
	set ren_principal(name) [.princs.lb get [lindex $l 0]]
	
	set cmd {set princ_info [kadm5_getprinc $ren_principal(name)]}
	if {[catch {eval $cmd} res] != 0} {
	    tk_dialog .error {Error} \
		    "Unable to find principal $princ: $res" {} 0 OK
	    update_princs $princ
	    return
	}
	
	# princ_info appears to contain: principal name, expiration time,
	# date pw changed, pw expiration date, maximum ticket life,
	# principal who last modified the account, date modified, attribute
	# list, key version no, master key version no, policy name (or
	# [none] if no policy), max renewable life, last successful auth,
	# last failed auth, failed pw attempts, and a list of keys.  Then,
	# for each key, there is a version number, key version number, and
	# two type codes...see kadmin/tcltk/tcl_kadm5.c
	
	set add_principal(name) [lindex $princ_info 0]
	set add_principal(expire) [kadm5_datetostr [lindex $princ_info 1]]
	set add_principal(pw_expire) [kadm5_datetostr [lindex $princ_info 3]]
	set add_principal(tix_life) [kadm5_durtostr_none [lindex $princ_info 4]]
	set add_principal(attr) [lindex $princ_info 7]
	set add_principal(policy) [lindex $princ_info 10]
	set add_principal(renew_life) [kadm5_durtostr [lindex $princ_info 11]]

	princ_attr_setfields add_principal $add_principal(attr)
    
	# populate principal window
	if {$add_principal(policy) == ""} {
	    set add_principal(policy) {[none]}
	}
	
	foreach k [concat expire pw_expire tix_life policy renew_life \
		$allattrs] {
	    set ren_principal($k) $add_principal($k)
	}
	
	# make a dummy setup
	set add_principal(password) ""
	set add_principal(name) ""

	create_ren_win_info "Copy"
	
	.add_principal.fields.5.e config -text $add_principal(policy)
	
	focus .add_principal.fields.0.e
    }
}

#
#
#
proc verify_password { w } {
    global _password debug

    if {$_password(password) != $_password(checkpass)} {
	tk_dialog .dialog {Password Mismatch} \
		{Passwords do not match.  Please re-enter.} \
		"" 0 "OK"
	return
    }
    
    # otherwise, passwords match and we can remove the password box
    set _password(cancel) 0
    destroy $w
}   

#
#
#
proc get_password { name force {doit 1} {doit2 1}} {
    global _password debug princ_fix

    set _password(checkpass) ""
    set _password(password) ""
    set _password(REQUIRES_PWCHANGE) $force

    set _password(cancel) 1

    toplevel .password
    wm title .password "Password Entry"
    
    label .password.l -text "Enter the password for $name twice:"
    entry .password.pass -show {*} -textvariable _password(password)
    entry .password.chkpass -show {*} -textvariable _password(checkpass)
    focus .password.pass
    
    checkbutton .password.force -variable _password(REQUIRES_PWCHANGE) \
	    -text "Force user to change password on next login" \
	    -onvalue "+" -offvalue "-"
    
    button .password.ok -text "Ok" \
	    -command [list verify_password .password]
    button .password.cancel -text "Cancel" \
	    -command "set _password(cancel) 1 ; destroy .password"

    pack .password.l .password.pass .password.chkpass \
	    .password.force -side top -expand yes -fill x
    pack .password.cancel .password.ok -side right
    
    grab .password
    tkwait window .password
    grab release .password
    
    set pass_changed 0
    set flags_changed 0

    if {$doit && $_password(cancel) == 0} {
	if {$_password(password) != {}} {
	    set cmd [list kadm5_cpw -password $_password(password) $name]
	    if {$debug} {
		puts $cmd
	    }
	    if {[catch {eval $cmd} res] != 0} {
		tk_dialog .error {Error} \
			"Could not change password: $res" {} 0 OK
		return
	    }
	    set pass_changed 1
	}
	
	if {$doit2 && $_password(REQUIRES_PWCHANGE) != $force} {
	    set cmd [list kadm5_modprinc \
		    $_password(REQUIRES_PWCHANGE)$princ_fix(REQUIRES_PWCHANGE) $name]
	    if {$debug} {
		puts $cmd
	    }
	    if {[catch {eval $cmd} res] != 0} {
		tk_dialog .error {Error} \
			"Password changed, but the force flag could not be updated: $res" {} 0 Ok
		return
	    }
	    set flags_changed 1
	}
	if {$pass_changed && $flags_changed} {
	    tk_dialog .dialog {Success} "Password and flags changed." {} 0 Ok
	} elseif {$pass_changed} {
	    tk_dialog .dialog {Success} "Password changed." {} 0 Ok
	} elseif {$flags_changed} {
	    tk_dialog .dialog {Success} "Flags changed." {} 0 Ok
	}
    }
}

proc commit_princ_changes { } {
    global save_principal principal princ_fix princ_func debug
    global principal_mod_fields _password allattrs

    set cmd ""

    # Loop through principal, save_principal changes and see what's
    # different.
    foreach k [concat expire pw_expire tix_life renew_life kvno $allattrs] {
	if {($principal($k) != $save_principal($k))} {
	    if {[string index $princ_fix($k) 0] == "-"} {
		if {[info exists princ_func($k)]} {
		    if { [catch {
			lappend cmd $princ_fix($k) \
				[$princ_func($k) $principal($k)]
		    } ] } {
			tk_dialog .dialog {Invalid Entry} "\"$principal($k)\" is invalid." {} 0 Ok
			return
		    }
		} else {
		    lappend cmd $princ_fix($k) $principal($k)
		}
	    } else {
		lappend cmd "$principal($k)$princ_fix($k)"
	    }
	}
    }
    
    set principal(policy) [lindex [.principal.fields.5.e config -text] 4]
    if { $save_principal(policy) != $principal(policy) } {
	if {$principal(policy) == {[none]}} {
	    lappend cmd -clearpolicy
	} else {
	    lappend cmd -policy $principal(policy)
	}
    }
    
    if {$cmd == ""} {
	destroy .principal
	return
    }

    set cmd [concat kadm5_modprinc $cmd $principal(name)]
    
    # cross your fingers and run the command
    if { $debug } {
	puts $cmd
    }
    if {[catch {eval $cmd} res] != 0} {
	tk_dialog .error {Error} \
		"Unable to commit changes: $res" {} 0 OK
    }
    
    set save_principal(password) {}
    
    # re-populate this window and princs list
    destroy .principal
    #    show_princ_info $principal(name) 1
    #    populate_princs
    if {[winfo exists .policy]} {
	global policy
	
	show_pol_info $policy(name)
    }
}

proc commit_princ_add { } {
    global add_principal princ_fix princ_func _password debug
    global principal_add_fields allattrs

    if {$add_principal(name) == ""} {
	tk_dialog .error {Error: no principal name} \
		"You must specify a principal name when adding" \
		{} 0 Ok
	return
    }

    set add_principal(name) [add_realm_name $add_principal(name)]

    if { [check_principal_name "" add_principal(name) 1] } {
	tk_dialog .error {Error} \
		"Invalid principal name.  (Be certain to include the realm)" \
		{} 0 Ok
	return
    }

    set cmd kadm5_addprinc
    
    #
    # First check the options that the user can screw up on
    #
    foreach k [concat expire pw_expire tix_life renew_life] {
	if {[string index $princ_fix($k) 0] == "-"} {
	    if {[info exists princ_func($k)]} {
		lappend cmd $princ_fix($k) [$princ_func($k) $add_principal($k)]
	    } else {
		lappend cmd $princ_fix($k) $add_principal($k)
	    }
	} else {
	    lappend cmd "$add_principal($k)$princ_fix($k)"
	}
    }

    #
    # Make certain a password was entered
    #
    if {$add_principal(password) == ""} {
	while {$add_principal(password) == ""} {
	    get_password $add_principal(name) $add_principal(REQUIRES_PWCHANGE) 0
	    if {$_password(cancel)} {
		tk_dialog .dialog {Error:  Must supply a password} \
			{You must supply a password for a new principal} \
			"" 0 Ok
	    } else {
		set add_principal(password) $_password(password)
		set add_principal(REQUIRES_PWCHANGE) $_password(REQUIRES_PWCHANGE)
	    }
	}
    }

    #
    # other changes (password, attributes)
    #
    foreach k [concat password $allattrs] {
	if {[string index $princ_fix($k) 0] == "-"} {
	    if {[info exists princ_func($k)]} {
		lappend cmd $princ_fix($k) [$princ_func($k) $add_principal($k)]
	    } else {
		lappend cmd $princ_fix($k) $add_principal($k)
	    }
	} else {
	    lappend cmd "$add_principal($k)$princ_fix($k)"
	}
    }


    set add_principal(policy) [lindex [.add_principal.fields.5.e config -text] 4]
    if {$add_principal(policy) != {[none]}} {
	lappend cmd -policy $add_principal(policy)
    }

    lappend cmd $add_principal(name)

    # cross your fingers and run the command
    
    if { $debug } {
	puts $cmd
    }
    if {[catch {eval $cmd} res] != 0} {
	tk_dialog .error {Error} \
		"Could not add principal: $res" {} 0 OK
	return
    }
    
    # destroy this window and refresh princs list
    destroy .add_principal
    update_princs $add_principal(name)

    if {[winfo exists .policy]} {
	global policy
	
	show_pol_info $policy(name)
    }
}

proc commit_princ_ren { {type "Rename"} } {
    global add_principal princ_fix princ_func _password debug
    global principal_ren_fields ren_principal allattrs

    if {$add_principal(name) == ""} {
	tk_dialog .error {Error} \
		"You must supply a principal name" {} 0 Ok
	return
    }

    set add_principal(name) [add_realm_name $add_principal(name)]

    if { [check_principal_name "" add_principal(name) 1] } {
	tk_dialog .error {Error} \
		"Invalid principal name.  (Be certain to include the realm)" \
		{} 0 Ok
	return
    }

    set cmd kadm5_addprinc
    
    if {$add_principal(password) == ""} {
	while {$add_principal(password) == ""} {
	    get_password $add_principal(name) $add_principal(REQUIRES_PWCHANGE) 0
	    if {$_password(cancel)} {
		tk_dialog .dialog {Error:  Must supply a password} \
			{You must supply a password for a new principal} \
			"" 0 Ok
	    } else {
		set add_principal(password) $_password(password)
		set add_principal(REQUIRES_PWCHANGE) $_password(REQUIRES_PWCHANGE)
	    }
	}
    }

    foreach k [concat password expire pw_expire tix_life renew_life \
	    $allattrs] {
	if {$k == "name"} {
	    continue
	}
	if {[string index $princ_fix($k) 0] == "-"} {
	    if {[info exists princ_func($k)]} {
		lappend cmd $princ_fix($k) [$princ_func($k) $add_principal($k)]
	    } else {
		lappend cmd $princ_fix($k) $add_principal($k)
	    }
	} else {
	    lappend cmd "$add_principal($k)$princ_fix($k)"
	}
    }

    set add_principal(policy) [lindex [.add_principal.fields.5.e config -text] 4]
    if {$add_principal(policy) != {[none]} && $add_principal(policy) != ""} {
	lappend cmd -policy $add_principal(policy)
    }

    lappend cmd $add_principal(name)

    # cross your fingers and run the command
    if { $debug } {
	puts $cmd
    }
    if {[catch {eval $cmd} res] != 0} {
	tk_dialog .error {Error} \
		"Could not add while renaming: $res" {} 0 OK
	return
    }

    if { $type == "Rename" } {
	set cmd [list kadm5_delprinc $ren_principal(name)]
	if { $debug } {
	    puts $cmd
	}
	if {[catch {eval $cmd} res] != 0} {
	    tk_dialog .error {Error} \
		    "Could not delete while renaming: $res" {} 0 OK
	    return
	}
	if {[winfo exists .principal] && \
		$ren_principal(name) == $pname} {
	    show_princ_info $pname 1
	}
    }
    
    # destroy this window and refresh princs list
    destroy .add_principal
    update_princs $ren_principal(name)
    update_princs $add_principal(name)

    if {[winfo exists .policy]} {
	global policy
	
	show_pol_info $policy(name)
    }
}

proc config_policy_menu { m } {
    global policy_list
    global policy

    $m.m delete 0 last
    
    $m.m add command -label {[none]} -command "$m config -text {\[none\]}"
    
    foreach p $policy_list {
	$m.m add command -label $p -command "$m config -text $p"
    }
}
  
proc create_mod_win_info { } {
    global principal save_principal principal_mod_fields _password
    global allattrs allattr_name

    set _password(cancel) 1

    set w .principal

    if {[winfo exists $w]} {
	refresh_entrylist $w.fields $principal_mod_fields
	wm deiconify $w
	raise $w
	return
    }

    # create the window for showing principal information 
    toplevel $w
    wm title $w "Principal Information"
    
    create_entrylist $w.fields $principal_mod_fields

    menu $w.fields.5.e.m -tearoff 0
    config_policy_menu $w.fields.5.e
    
    frame $w.bts
    button $w.bts.cancel -width 15 -text "Cancel" -command "destroy $w"
    button $w.bts.commit -width 15 -text "Commit Changes" -command commit_princ_changes
    button $w.bts.revert -width 15 -text "Revert All" \
	    -command "revert_entrylist $w.fields \$principal_mod_fields;
    foreach a \$allattrs { set principal(\$a) \$save_principal(\$a) }"
    button $w.bts.change_pw -width 15 -text "Change Password" \
	    -command [list change_password_then_show_princ \
	    principal(name) principal(REQUIRES_PWCHANGE)]

    pack $w.bts.change_pw -side left -anchor w
    pack $w.bts.revert $w.bts.commit $w.bts.cancel \
	-side left -expand yes -anchor e

    set lmax 0
    foreach i $allattr_name {
	set l [string length $i]
	if { $l > $lmax } {
	    set lmax $l
	}
    }
    
    frame $w.attrs

    set perrow 3
    
    set b 0
    foreach i $allattrs {
	set a [expr $b / $perrow]
	if { $b % $perrow == 0 } {
	    frame $w.attrs.$a
	}
	set cmd [list checkbutton $w.attrs.$a.$b -width $lmax \
		-onvalue {+} -offvalue {-} \
		-text [lindex $allattr_name $b] \
		-variable principal($i) -anchor w]
	eval $cmd
	pack $w.attrs.$a.$b -side right -anchor e
	if { $b % $perrow != 0 } {
	    pack $w.attrs.$a -anchor e
	}
	incr b
    }

    if { $b % $perrow < $perrow - 1 } {
	pack $w.attrs.$a -anchor e
    }

    # pack it all in
    pack $w.fields -side top -anchor w -fill x
    pack $w.attrs -side top -anchor w -expand yes -fill both
    pack $w.bts -side bottom -fill x
}

proc change_password_then_show_princ { name force } {
    global _password principal_mod_fields

    upvar #0 $name _name
    upvar #0 $force _force

    get_password $_name $_force 1 0

    if {$_password(cancel) == 0} {
	set _force $_password(REQUIRES_PWCHANGE)
    }
    refresh_entrylist .principal.fields $principal_mod_fields
}

proc add_get_new_password { name force passvar } {
    global _password

    upvar #0 $name _name
    upvar #0 $force _force
    upvar #0 $passvar _passvar

    get_password $_name $_force 0

    if {$_password(cancel) == 0} {
	set _force $_password(REQUIRES_PWCHANGE)
	set _passvar $_password(password)
    }
}

proc create_add_win_info { } {
    global add_principal principal_add_fields allattrs allattr_name
    
    set w .add_principal

    if {[winfo exists $w]} {
	destroy $w
    }

    # create the window for showing principal information 
    toplevel $w
    wm title $w "Principal Information"
    
    create_entrylist $w.fields $principal_add_fields

    menu $w.fields.5.e.m -tearoff 0
    config_policy_menu $w.fields.5.e
    
    princ_attr_setfields add_principal {}

#   princ_attr_print add_principal

    set lmax 0
    foreach i $allattr_name {
	set l [string length $i]
	if { $l > $lmax } {
	    set lmax $l
	}
    }
    
    frame $w.attrs

    set perrow 3
    
    set b 0
    foreach i $allattrs {
	set a [expr $b / $perrow]
	if { $b % $perrow == 0 } {
	    frame $w.attrs.$a
	}
	set cmd [list checkbutton $w.attrs.$a.$b -width $lmax \
		-onvalue {+} -offvalue {-} \
		-text [lindex $allattr_name $b] \
		-variable add_principal($i)]
	eval $cmd
	pack $w.attrs.$a.$b -side right -anchor e
	if { $b % $perrow != 0 } {
	    pack $w.attrs.$a -anchor e
	}
	incr b
    }

    if { $b % $perrow < $perrow - 1 } {
	pack $w.attrs.$a -anchor e
    }

    frame $w.bts
    button $w.bts.password -text "Set Password" \
	    -command "add_get_new_password add_principal(name) add_principal(REQUIRES_PWCHANGE) add_principal(password)"
    button $w.bts.cancel -text "Cancel" -command "destroy $w"
    button $w.bts.commit -text "Commit Add" -command commit_princ_add
    pack $w.bts.password $w.bts.cancel $w.bts.commit -side left
    
    # pack it all in
    pack $w.fields -side top -anchor w -fill both
    pack $w.attrs -side top -anchor w -fill both
    pack $w.bts -side bottom -anchor e
}

proc create_ren_win_info { type } {
    global add_principal principal_ren_fields allattrs allattr_name

    set w .add_principal

    if {[winfo exists $w]} {
	destroy $w
    }

    # create the window for showing principal information 
    toplevel $w
    wm title $w "Principal Information"
    
    create_entrylist $w.fields $principal_ren_fields

    menu $w.fields.5.e.m -tearoff 0
    config_policy_menu $w.fields.5.e
    
    set lmax 0
    foreach i $allattr_name {
	set l [string length $i]
	if { $l > $lmax } {
	    set lmax $l
	}
    }
    
    frame $w.attrs
    
    set perrow 3
    
    set b 0
    foreach i $allattrs {
	set a [expr $b / $perrow]
	if { $b % $perrow == 0 } {
	    frame $w.attrs.$a
	}
	set cmd [list checkbutton $w.attrs.$a.$b -width $lmax \
		-onvalue {+} -offvalue {-} \
		-text [lindex $allattr_name $b] \
		-variable add_principal($i)]
	eval $cmd
	pack $w.attrs.$a.$b -side right -anchor e
	if { $b % $perrow != 0 } {
	    pack $w.attrs.$a -anchor e
	}
	incr b
    }
    
    if { $b % $perrow < $perrow - 1 } {
	pack $w.attrs.$a -anchor e
    }
    
    frame $w.bts
    button $w.bts.password -text "Set Password" \
	    -command "add_get_new_password add_principal(name) add_principal(REQUIRES_PWCHANGE) add_principal(password)"
    button $w.bts.cancel -text "Cancel" -command "destroy $w"
    button $w.bts.commit -text "Commit $type" \
	    -command [list commit_princ_ren $type]
    pack $w.bts.password $w.bts.cancel $w.bts.commit -side left
    
    # pack it all in
    pack $w.fields -side top -anchor w -fill both
    pack $w.attrs -side top -anchor w -fill both
    pack $w.bts -side bottom -anchor e
}

proc populate_princs { } {
  global princ_filter group

  # populate the principals window

#  if {$princ_filter(name) == "" || $princ_filter(name) == "*"} {
#XXX    if {[tk_dialog .error {Requested All Principals} \
#XXX	"You've requested a listing of all principals in the database.  Depending on the size of the database, this could take hours to complete.  Are you sure?" \
#XXX	{} 0 No Yes] != 0} {
#      set gp [kadm5_getprincs]
#XXX    }
#  } else {
#XXX    if {$princ_filter(usegroup) == 1} {
#XXX      # use group names
#XXX      if {[info exists group($princ_filter(name))]} {
#XXX	set gp $group($princ_filter(name))
#XXX      } else {
#XXX	tk_dialog .error {No Such Group} \
#XXX	    "No such group as \"$princ_filter(name)\"." {} 0 OK
#XXX	return
#XXX      }
#XXX    } else {
#      set gp [kadm5_getprincs $princ_filter(name)]
#XXX    }
#  }
  .princs.lb populate $princ_filter(name)
}

proc update_princs { name } {
  # update principal window to sync with given entry
  
  # if the entry has an "@" sign in it, it's assumed to be
  # canonicalized.  Otherwise, we run a getprinc to get the canon version.
  if { [string first {@} $name ] == -1 } {
    set name [lindex [kadm5_getprinc $name] 0]
  }
  .princs.lb update $name
}

proc delete_princ { } {
    global debug principal

    # check the listbox
    set l [.princs.lb curselection]
    if { [llength $l] == 0 } {
	tk_dialog .dialog {Principal Deletion} "No principals selected." \
		"" 0 Ok
    } else {
	if {[llength $l] == 1} {
	    set prompt "Are you sure you want to delete `[.princs.lb get $l]'?"
	} else {
	    set prompt \
		    "Are you sure you want to delete the [llength $l] selected principals?"
	}
	set result [tk_dialog .dialog {Principal Deletion} $prompt "" 0 No Yes]
	if {$result == 1} {
	    foreach p $l {
		lappend targlist [.princs.lb get $p]
	    }
	    foreach pname $targlist {
		if { $debug } {
		    puts "kadm5_delprinc $pname"
		}
		kadm5_delprinc $pname
		
		if {[winfo exists .principal] && \
			$principal(name) == $pname} {
		    destroy .principal
		}
		# update principal listbox
		update_princs $pname
	    }
	}
    }
}

proc add_princ { } {
    global add_principal
    
    create_add_win_info
    
    # make a dummy setup
    set add_principal(name) ""
    set add_principal(expire) "never"
    set add_principal(pw_expire) "never"
    set add_principal(tix_life) "10 hours"
    set add_principal(renew_life) "7 days"
    set add_principal(password) ""
    set add_principal(attr) {REQUIRES_PWCHANGE}
    set add_principal(policy) {[none]}
    .add_principal.fields.5.e config -text $add_principal(policy)
    
    princ_attr_setfields add_principal $add_principal(attr)
    
    focus .add_principal.fields.0.e
}

proc create_princ_menu { } {
    global debug auto_path
    # the default menu for the application
    frame .princs.menu -relief raised -borderwidth 2
    
    menubutton .princs.menu.kadmin -text "File" -menu .princs.menu.kadmin.m \
	    -underline 0
    menu .princs.menu.kadmin.m -tearoff 0
    .princs.menu.kadmin.m add command -label "Refresh" -underline 0 \
	    -command { populate_pols ; populate_princs }
    .princs.menu.kadmin.m add command -label "Quit" -underline 0 \
	    -command {destroy .}
    
    if {$debug} {
	.princs.menu.kadmin.m add separator
	.princs.menu.kadmin.m add command -label "Reload" -underline 0 \
		-command { source principal.tk ; source policy.tk ; source ktlist.tk ; source filecomplete.tk ; source dynlistbox.tk }
    }
    
    menubutton .princs.menu.principal -text "Principal" -underline 0 \
	    -menu .princs.menu.principal.m
    menu .princs.menu.principal.m -tearoff 0
    .princs.menu.principal.m add command -label "Add New" -underline 0 \
	    -command add_princ
    .princs.menu.principal.m add command -label "Delete" -underline 0 \
	    -command delete_princ
    .princs.menu.principal.m add command -label "Edit" -underline 0 \
	    -command edit_princ_sel
    .princs.menu.principal.m add command -label "Rename" -underline 0 \
	    -command rename_princ_sel
    .princs.menu.principal.m add command -label "Copy" -underline 3 \
	    -command copy_princ_sel
    .princs.menu.principal.m add command -label "Change Password" \
	    -underline 0 -command change_password_sel
    .princs.menu.principal.m add command -label "Deactivate" \
	    -underline 6 -command [list activate_princ_sel 0]
    .princs.menu.principal.m add command -label "Reactivate" \
	    -underline 3 -command [list activate_princ_sel 1]
    
    menubutton .princs.menu.policy -text "Policy" -underline 1 \
	    -menu .princs.menu.policy.m
    menu .princs.menu.policy.m -tearoff 0
    .princs.menu.policy.m add command -label "Show List" -underline 0 \
	    -command populate_pols
    
    menubutton .princs.menu.keytab -text "Keytab" -underline 0 \
	    -menu .princs.menu.keytab.m
    menu .princs.menu.keytab.m -tearoff 0
    .princs.menu.keytab.m add command -label "Create" \
	    -underline 0 -command keytab_create
    .princs.menu.keytab.m add command -label "Modify" \
	    -underline 0 -command keytab_modify
    
#XXX  menubutton .princs.menu.group -text "Group" -menu .princs.menu.group.m
#XXX  menu .princs.menu.group.m
#XXX  .princs.menu.group.m add command -label "Show List" \
#XXX      -command populate_groups
#XXX  .princs.menu.group.m add command -label "New" \
#XXX      -command add_group

#XXX  pack .princs.menu.kadmin .princs.menu.principal .princs.menu.policy \
#XXX      .princs.menu.group -side left
  
    pack .princs.menu.kadmin .princs.menu.principal .princs.menu.policy \
	    .princs.menu.keytab \
	    -side left
    
    foreach dir $auto_path {
	if { [catch { set i [image create photo -file $dir/cyglogo-sm.gif] }] \
		== 0 } {
	    break
	}
    }
    
    catch {
	label .princs.menu.logo -relief sunken -image $i
	pack .princs.menu.logo -side right -anchor e
    }
}

proc create_win_princs { } {
    global princ_filter
    
    # create and open the principal list window
    toplevel .princs
    wm title .princs "Principal List"
    
    frame .princs.filter
    entry .princs.filter.e -relief sunken -textvariable princ_filter(name)
    menubutton .princs.filter.menu -text "Filter:" \
	    -relief ridge -menu .princs.filter.menu.m
    menu .princs.filter.menu.m
    #XXX  .princs.filter.menu.m add command -label {Filter} -command {
    #XXX    .princs.filter.menu config -text "Filter:"
    #XXX    set princ_filter(usegroup) 0
    #XXX  }
    .princs.filter.menu.m add command -label {*} -command {
	set princ_filter(name) {*}
	set princ_filter(usegroup) 0
	populate_princs
    }
    .princs.filter.menu.m add command -label {*/admin} -command {
	set princ_filter(name) {*/admin}
	set princ_filter(usegroup) 0
	populate_princs
    }
    .princs.filter.menu.m add command -label {host/*} -command {
	set princ_filter(name) {host/*}
	set princ_filter(usegroup) 0
	populate_princs
    }
    .princs.filter.menu.m add command -label {*@*} -command {
	set princ_filter(name) {*@*}
	set princ_filter(usegroup) 0
	populate_princs
    }
    #XXX  .princs.filter.menu.m add command -label {Group} -command {
    #XXX    .princs.filter.menu config -text "Group:"
    #XXX    set princ_filter(usegroup) 1
    #XXX  }
    pack .princs.filter.menu -side left
    pack .princs.filter.e -side right -expand yes -fill x
    
    #XXX  set princ_filter(name) "human-resources"
    #XXX  set princ_filter(usegroup) 1
    #XXX  .princs.filter.menu config -text "Group:"
    bind .princs.filter.e <Return> {populate_princs}
    #bind .princs.filter.e <Tab> {populate_princs}

    
    dynlistbox .princs.lb kadm5_getnextprincs -width 45
    bind .princs.lb.lb <Double-1> {
	show_princ_info [.princs.lb get [lindex [.princs.lb curselection] 0]]
    }
    
    create_princ_menu
    pack .princs.menu -side top -fill x
    
    pack .princs.filter -side top -fill x
    
    pack .princs.lb -side left -expand yes -fill both
    
    # read in the principals
    populate_princs
    
    bind .princs <Destroy> {destroy .}
}

#
# Work with principal attributes.
#

proc princ_attr_set { attr mem } {
    if { [princ_attr_isset $attr $mem] } {
	return $attr
    }

    lappend attr $mem

    return $attr
}

proc princ_attr_clear { attr mem } {
    set pos [lsearch -exact $attr $mem]
    if {$pos == -1} {
	return $attr
    }

    set rattr {}

    #
    # This isn't very clever, but for now it will have to do.
    #
    set attrlen [llength $attr]
    for {set pos 0} {$pos < $attrlen} {incr pos} {
	set val [lindex $attr $pos]
	if {$val != $mem} {
	    lappend rattr $val
	}
    }

    return $rattr
}

proc princ_attr_isset { attr mem } {
    if {[lsearch -exact $attr $mem] == -1} {
	return 0
    }

    return 1
}

proc princ_attr_isclear { attr mem } {
    if {[lsearch -exact $attr $mem] != -1} {
	return 0
    }

    return 1
}

proc princ_attr_setfields { pr attr } {
    global allattrs

    upvar #0 $pr _pr

    foreach i $allattrs {
	set _pr($i) {-}
    }

    foreach i $attr {
	set _pr($i) {+}
    }
}

proc princ_attr_print { pr } {
    global allattrs

    upvar #0 $pr _pr

    foreach i $allattrs {
	puts "_pr($i) = $_pr($i)"
    }
}

proc activate_princ_sel { onoff } {
    global debug

    if { $onoff == 0 } {
	set action "deactivate"
	set actioned "deactivated"
	set cmd "+disallow_tix"
    } else {
	set action "reactivate"
	set actioned "reactivated"
	set cmd "-disallow_tix"
    }
    
    # check the listbox
    set l [.princs.lb curselection]
    if { [llength $l] == 0 } {
	tk_dialog .dialog {Error} "No principals selected." \
		"" 0 Ok
	return
    }

    set error 0
    foreach i $l {
	set p [.princs.lb get $i]
	if { [catch { kadm5_modprinc $cmd $p } res] } {
	    tk_dialog .dialog {Error} "Could not $action $p: $res" {} 0 Ok
	    incr error
	}
    }

    if { $error == 0 } {
	tk_dialog .dialog {Success} "All selected principals $actioned" {} 0 Ok
    }
}

proc keytab_modify {} {
    set file [tk_getOpenFile -title "Open Existing Keytab" \
	-filetypes {{Keytab {*.keytab}} {"All Files" {*}}}]

    if { $file == "" } {
	return
    }

    if { ! [file exists $file] } {
	tk_dialog .dialog {Error} \
		"File does not exist: $file" {} \
		0 Ok
	return
    }

    # Tack on WRFILE: so kt_populate doesn't get confused by Windows
    # drive specifications
    set file "WRFILE:$file"

    if {[winfo exists .kt]} {
	destroy .kt
    }
    
    kt_create .kt .princs.lb
    kt_populate .kt $file
}

proc keytab_create {} {
    set file [tk_getSaveFile -title "Open New Keytab" \
	-filetypes {{Keytab {*.keytab}} {"All Files" {*}}}]
    
    if { $file == "" } {
	return
    }
    
    if { [file exists $file] } {
	tk_dialog .dialog {Error} \
		"File exists: $file" {} \
		0 Ok
	return
    }

    # Tack on WRFILE: so kt_new doesn't get confused by Windows drive
    # specifications.
    set file "WRFILE:$file"

    if {[winfo exists .kt]} {
	destroy .kt
    }

    kt_create .kt .princs.lb
    kt_new .kt $file
}

proc refresh_principal_windows {} {
    foreach w [list .principal .add_principal .ren_principal] {
	if {[winfo exists $w]} {
	    config_policy_menu $w.fields.5.e
	}
    }
}
