#!/bin/sh
# -*- Tcl -*-
# Find wish in the path.  Who knows if this works on Windows...\
	exec krb5_clnt_tk "$0" -- ${1+"$@"}

# Tk script for a prototype Passport GUI
# Copyright 1996 Cygnus Solutions
# Written by Stephen Peters and Michael Graff
#
# Permission to use, copy, modify, and distribute this software and
# its documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and
# that both that copyright notice and this permission notice appear in
# Solutionsing documentation.  Cygnus Solutions makes no representations
# about the suitability of this software for any purpose.  It is
# provided "as is" without express or implied warranty.

# DEFAULTS -- these could be loaded from a tkadmin.cf file.

set labelopt "-background #008 -foreground #fff"
set funcopt "-width 40"

# The admin principal to pass to kadmin; if this is "", it will
# probably get set to <username>/admin.
set kadmin(principal) "admin/admin"
catch {
    if { [info exists env(USER)] } {
	set kadmin(principal) "$env(USER)/admin"
    } elseif { [info exists env(LOGNAME) ] } {
	set kadmin(principal) "$env(LOGNAME)/admin"
    }
}
# The admin password to use for kadmin; if this is "", it will be prompted.
set kadmin(password) ""

# Realm name...
set kadmin(realm) ""

# default filter name
set princ_filter(name) "*"

# debug flag
set debug 0

if { $debug } {
    set kadmin_dir "."
} else {
    if { [info exists env(KERBNET_HOME)] } {
	set kadmin_dir $env(KERBNET_HOME)
    } else {
	if { $tcl_platform(platform) == "unix" } {
	    set kadmin_dir "/usr/cygnus/kerbnet-1.2"
	} else {
	    set kadmin_dir "c:/cygnus/kerbnet"
	}
    }
}

# The kadmin program -- this is the default Unix location.
set kadmin(program) "$kadmin_dir/sbin/tkadmin"

# The group file -- eventually this is part of the Passport DB
#XXX set kadmin(groupdb) "$kadmin_dir/passgroup"

proc print_syntax { } {
    global argv0
    
    puts "Usage: $argv0 \[options\]..."
    puts "Options:"
    puts "  -p PRINC,"
    puts "  --principal PRINC     Use PRINCIPAL as Kerberos administrator."
    puts "  -w PASSWORD,"
    puts "  --password PASSWORD   Use PASSWORD as Kerberos admin password."
    puts "  -r REALM,"
    puts "  --realm REALM         Administer Kerberos realm REALM."
    #XXX  puts "  -g FILE,"
    #XXX  puts "  --groupfile FILE      Specify new location for group file."
    puts "  -d, --debug           Send debugging information to stdout."
    puts "  -h, --help            Print this message."
}  

proc parse_args { } {
    global kadmin argv debug
    # look through argv and pull out principal, realm, group and password
    
    set a $argv
    
    while {$a != ""} {
	switch -- [lindex $a 0] {
	    --principal -
	    -p { set kadmin(principal) [lindex $a 1]; set a [lreplace $a 0 1] }
	    --password -
	    -w { set kadmin(password) [lindex $a 1]; set a [lreplace $a 0 1] }
	    --realm -
	    -r { set kadmin(realm) [lindex $a 1]; set a [lreplace $a 0 1] }
#XXX        --groupfile -
#XXX        -g { set kadmin(groupdb) [lindex $a 1]; set a [lreplace $a 0 1] }
	    --local -
	    -l { set kadmin(program) $kadmin(program).local; set a [lreplace $a 0 0] }
	    --debug -
	    -d { set debug 1; set a [lreplace $a 0 0] }
	    --help -
	    -h { print_syntax; exit }
	    default { 
		puts "Unknown argument [lindex $a 0]"; set a [lreplace $a 0 0] 
	    }
	}
    }
}

proc get_defaults { } {
    # figures out default values for items in kadmin(...)
    global kadmin env auto_path argv0 kadmin_dir debug
    
    # get arguments
    parse_args
    
    if { $debug } {
	lappend auto_path "."
    }
    lappend auto_path "$kadmin_dir/lib/tcl"
    lappend auto_path "$kadmin_dir/lib/tcl/tkadmin"
    if { $debug} {
	puts "Auto-load path: $auto_path"
    }

    # get a default realm name
    if {$kadmin(realm) == ""} {
	set kadmin(realm) [krb5_get_default_realm]
    }

    # Otherwise, just use kadmin's defaults for the principal name...
    if {$kadmin(password) == ""} {
      	# pop up dialog box prompting for password
	toplevel .pw
	wm title .pw "Admin Password Entry"
      
        frame .pw.realm
	label .pw.realm.l -width 9 -text "Realm:" -anchor e
	entry .pw.realm.e -textvariable kadmin(realm)
	pack .pw.realm.l -side left
	pack .pw.realm.e -side right -expand yes -fill x
	bind .pw.realm.e <Return> {
	    if {$kadmin(password) == "" } {
		focus .pw.princ.e
	    } else { destroy .pw}
	}

        frame .pw.princ
	label .pw.princ.l -width 9 -text "Principal:" -anchor e
	entry .pw.princ.e -textvariable kadmin(principal)
	pack .pw.princ.l -side left
	pack .pw.princ.e -side right -expand yes -fill x
	bind .pw.princ.e <Return> {
	    if {$kadmin(password) == "" } {
		focus .pw.password.e
	    } else { destroy .pw}
	}

        frame .pw.password
	label .pw.password.l -width 9 -text "Password:" -anchor e
	entry .pw.password.e -show {*} -textvariable kadmin(password)
	pack .pw.password.l -side left
	pack .pw.password.e -side right -expand yes -fill x
	bind .pw.password.e <Return> {
	    if {$kadmin(password) == "" } {
		focus .pw.password.e
	    } else { destroy .pw}
	}

	pack .pw.realm .pw.princ .pw.password  -side top 
	focus .pw.password.e
	tkwait window .pw
	update
    }

    if { $kadmin(realm) != "" } {
	set kadmin(principal) [add_realm_name $kadmin(principal)]
    }
    
    # perform initial login
    if { [catch {
	kadm5_init -princ $kadmin(principal) -password $kadmin(password)\
		-realm $kadmin(realm)
    } res ] } {
	tk_dialog .dialog {Error} "Could not log in: $res" {} 0 Ok
	exit
    }
}

proc enable_or_disable { w var1 var2 } {
    global debug

    upvar #0 $var1 v1
    upvar #0 $var2 v2

    if { $v1 == $v2 } {
	$w.r config -state disabled
	return 0
    }

    $w.r config -state normal
    return 1
}

proc revert_entry { w var1 var2 func } {
    upvar #0 $var1 v1
    upvar #0 $var2 v2

    set v1 $v2
    $w.r config -state disabled
    if {[string length $v2]} {
	$w.e icursor [string length $v2]
    }

    if { $func != "" } {
	$func $w.e $var1
    }

    update idletasks

    return 0
}

#
# stuff contains:
#   a text literal, used as a label.  If "", a blank field is created.
#   optional modifications for the field [default | none | "string"]
#   variable to use as value, and to store the result in
#   variable to use as the saved version of this field.  If "", revert is off.
#   options for the entry field.  [default | none | "string"]
#   
proc create_entrylist { w stuff } {
    global labelopt funcopt principal policy

    set num 0
    frame $w

    set longest 0

    foreach x $stuff {
	if { $longest <= [string length [lindex $x 0]] } {
	    set longest [string length [lindex $x 0]]
	}
    }

    set longest [expr $longest + 1]

    #
    # Run through the list and create all the subframes and such.  Pack
    # them all in at the end.
    #
    foreach x $stuff {
	set wn $w.$num

	#
	# suck the items we are passed off and sanity check them
	#
	set _label [list [lindex $x 0]]
	set _labopt [lindex $x 1]
	set _var [lindex $x 2]
	set _oldvar [lindex $x 3]
	set _func [lindex $x 4]
	set _funcopt [lindex $x 5]
	set _checkfunc [lindex $x 6]

	if { [string index $_labopt 0] == "+" } {
	    set _labopt [concat $labelopt [split [string range $_labopt 1 end] " "]]
	} elseif { $_labopt == "none" } {
	    set _labopt ""
	} elseif { $_labopt == "default" } {
	    set _labopt $labelopt
	}

	if { [string index $_funcopt 0] == "+" } {
	    set _funcopt [concat $funcopt -textvariable $_var \
		    [split [string range $_funcopt 1 end] " "]]
	} elseif { $_funcopt == "none" } {
	    set _funcopt ""
	} elseif { $_funcopt == "default" } {
	    set _funcopt [concat $funcopt -textvariable $_var]
	}

	frame $wn

	eval [concat label $wn.l -anchor e -width $longest $_labopt \
		-text $_label]
	eval [concat $_func $wn.e $_funcopt]

	#
	# bind the function to call when focus is lost
	#
	if { $_checkfunc != "" } {
	    bind $wn.e <FocusOut> "+$_checkfunc $wn.e $_var 1"
	    bind $wn.e <Any-KeyPress> \
		    "+$_checkfunc $wn.e $_var 0"
	}

	#
	# if the revert button is to be used, bind that too
	#
	if { $_oldvar != "" } {
	    if { [string match "*menubutton*" $_func] } {
		bind $wn.e <Any-Button> \
			"+enable_or_disable $wn $_var $_oldvar"
	    } else {
		bind $wn.e <Any-KeyPress> \
			"+enable_or_disable $wn $_var $_oldvar"
		bindtags $wn.e "Entry $wn.e $w all"
	    }

	    button $wn.r -pady 1 -text "Revert" -state disabled -width 6 \
		    -command [list revert_entry $wn $_var $_oldvar $_checkfunc]
	} else {
	    button $wn.r -pady 1 -text "" -state disabled -width 6 -relief flat
	}
	    
	pack $wn.l -side left
	pack $wn.r -side right
	pack $wn.e -side left -expand yes -fill x
	pack $wn -expand yes -fill x -side top

	set num [expr $num + 1]
    }
}

#
# refresh the data.  It is assumed that $w exists, and all fields are
# in the same order as create_entrylist would have created them.
# That is, $stuff has not changed between calls to create_entrylist and
# refresh_entrylist.
#
proc refresh_entrylist { w stuff } {
    global labelopt funcopt principal policy

    set num 0
    set retval 0

    #
    # refresh the already-created entrylist
    #
    foreach x $stuff {
	set wn $w.$num

	#
	# suck the items we are passed off and sanity check them
	#
	set _var [lindex $x 2]
	set _oldvar [lindex $x 3]

	if { $_oldvar != "" } {
	    set retval \
		    [expr $retval + [enable_or_disable $wn $_var $_oldvar]]
	}

	set num [expr $num + 1]
    }
    update idletasks

    return $retval
}

#
# revert all the items in the entrylist
#
proc revert_entrylist { w stuff } {
    global labelopt funcopt principal policy

    set num 0

    #
    # refresh the already-created entrylist
    #
    foreach x $stuff {
	set wn $w.$num

	#
	# suck the items we are passed off and sanity check them
	#
	set _var [lindex $x 2]
	set _oldvar [lindex $x 3]

	if { $_oldvar != "" } {
	    $wn.r invoke
	}

	set num [expr $num + 1]
    }
    update idletasks
}

proc check_expire { w var { change 1 } } {
    upvar #0 $var _var

    if { [catch { set exp [kadm5_strtodate $_var] } ] } {
	if { $change && $w != "" } { $w config -fg red }
	return 1
    } else {
	if { $change && $w != "" } { $w config -fg black }
	if { $change } { set _var [kadm5_datetostr $exp] }
	return 0
    }
}

proc check_lifetime { w var { change 1 } } {
    upvar #0 $var _var

    if { [catch { set exp [kadm5_strtodur $_var] } ] } {
	if { $change && $w != "" } { $w config -fg red }
	return 1
    } else {
	if { $change && $w != "" } { $w config -fg black }
	if { $change } { set _var [kadm5_durtostr $exp]	}
	return 0
    }
}

proc kadm5_strtodur_none { str } {
    if { $str == "none" } { return 0 }
    return [kadm5_strtodur $str]
}

proc kadm5_durtostr_none { dur } {
    if { $dur <= 0 } { return "none" }
    return [kadm5_durtostr $dur]
}

proc check_lifetime_none { w var { change 1 } } {
    upvar #0 $var _var

    if { [catch { set exp [kadm5_strtodur_none $_var] } ] } {
	if { $change && $w != "" } { $w config -fg red }
	return 1
    } else {
	if { $change && $w != "" } { $w config -fg black }
	if { $change } { set _var [kadm5_durtostr_none $exp]	}
	return 0
    }
}

proc check_decimal { w var { change 1 } } {
    upvar #0 $var _var

    set var2 [string trim $_var]

    if { [regexp {[^0-9]} $var2] } {
	if { $change && $w != "" } { $w config -fg red }
	return 1
    } else {
	if { $change && $w != "" } { $w config -fg black }
	if { $change } { set _var $var2 }
	return 0
    }
}

proc check_principal_name { w var { change 1 } } {
    upvar #0 $var _var

    set var2 [string trim $_var]

    if { $var2 == "" } { return 0 }

    if { [regexp "(\ |\t|\n)+" $var2] } {
	if { $change && $w != "" } { $w config -fg red }
	return 1
    } else {
	if { $change && $w != "" } { $w config -fg black }
	if { $change } { set _var $var2 }
	return 0
    }
}

proc check_policy_name { w var { change 1 } } {
    upvar #0 $var _var

    set var2 [string trim $_var]

    if { [regexp "(\ |\t|\n)+" $var2] } {
	if { $change && $w != "" } { $w config -fg red }
	return 1
    } else {
	if { $change && $w != "" } { $w config -fg black }
	if { $change } { set _var $var2 }
	return 0
    }
}    

proc add_realm_name { p } {
    global kadmin

    if { ! [regexp {.+@.+} $p] } {
	return "$p\@$kadmin(realm)"
    } else {
	return $p
    }
}


proc close_kadm_connection { } {
  global debug

  kadm5_destroy
  if {$debug} { puts "Connection closed" }
  destroy .
}

wm withdraw .

get_defaults
# set up bindings for when toplevel window is destroyed (app quit)
wm protocol . WM_DELETE_WINDOW close_kadm_connection
load_policies
#XXX load_groupdb
create_win_princs

tkwait window .princs

kadm5_destroy
if {$debug} { puts "Connection closed" }

