#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"


# This program is a TK interface to the NIST Cerberus sadb command.
# This program is based on a previous program written
# by Michael Oehler for the NIST/NSA BSD IPSEC implementation.
# The code has been rewritten to support the Linux prototype, but 
# alot of what Mike did remains.
# 
# Developed by Rob Glenn, & Michael Oehler
# 
# The "sadb" command is a command line program used to
# manually load the Security Association Database in the
# NIST Cerberus IPsec prototype.
#
# This Tcl/Tk script adds a graphical user interface to sadb.
# 
# Bugs: 
#
#       Way to many globals. Event processing is thus, convoluted.
#
#       The Tcl send command could interfer with this program
#       For security reasons, this program should not be executed 
#       as an non-native xclient.

set SADB_PATH /usr/src/nist/cerberus-0.5/sadb
set SADB_TCL_PATH $SADB_PATH/sadb-tcl

wm title . "XSADB: NIST Cerberus SADB Manager"


# --------- Globals used throughout
set sadb {}
set current_position "None Present"
set sa_position 0
set p_pos 0
set dialog dialog.tcl

source $SADB_TCL_PATH/filesel.tcl

# --------- Generic Dialog Creator
proc make_dialog {w lbl icon text cmd cancel} {
    catch {destroy $w}
    toplevel $w
    wm title $w $lbl

frame $w.f -borderwidth 2 -relief flat
pack $w.f

if { $icon != {} } {
 label $w.f.bitmap -bitmap $icon
  pack $w.f.bitmap
}
label $w.f.lbl -text $text
pack $w.f.lbl

frame $w.f2 -borderwidth 2 -relief flat
pack $w.f2 

if { $cancel } {
  button $w.f2.cancel -text Cancel -command "destroy $w"
  pack $w.f2.cancel -side left -pady 2
}
if { $cmd == {} } {
 set cmd "destroy $w"
}
button $w.f2.ok -text OK -command $cmd
pack $w.f2.ok -side left -pady 2

}

# ----------
# ----------
# ---------- GUI Callbacks
# ----------  These procedure primarily modify the interface
# ----------  and do not necessary parse the "sadb" command.
proc clear_gui {} {
global dst spi prefix protection
set dst {}
set spi {}
set prefix 32
clear_other
Set_Prot_menu 0
}
proc clear_other {} {
global sn peer pspi check_tunnel check_replay check_static check_partial check_inbound check_outbound liprot lispi 
set sn {}
set peer {}
set pspi {}
set check_tunnel 0
set check_replay 0
set check_static 0
set check_partial 0
set check_inbound 0
set check_outbound 0
set liprot {}
set lispi {}
}

proc disable_other {} {
      .main.card.other.right.peer configure -state disabled
      .main.card.other.right.pspi configure -state disabled
      .main.card.other.left.flags configure -foreground gray
      .main.card.other.right.flags.tunnel configure -state disabled -disabledforeground gray
      .main.card.other.right.flags.static configure -state disabled -disabledforeground gray
      .main.card.other.right.flags.replay configure -state disabled -disabledforeground gray
      .main.card.other.right.flags2.inbound configure -state disabled -disabledforeground gray
      .main.card.other.right.flags2.outbound configure -state disabled -disabledforeground gray
      .main.card.other.right.sn configure -state disabled -foreground gray
      .main.card.other.left.sn configure -foreground gray
      .main.card.other.left.peer configure -foreground gray
      .main.card.other.left.pspi configure -foreground gray
      .main.card.other.left.liprot configure -foreground gray
      .main.card.other.left.lispi configure -foreground gray
      .main.card.other.right.lispi configure -state disabled -foreground gray
      .main.card.other.left.ltbr configure -foreground gray
      .main.card.other.left.ltte configure -foreground gray
      .main.card.other.right.ltbr configure -state disabled -foreground gray
      .main.card.other.right.ltte configure -state disabled -foreground gray
      .main.card.other.right.lprot.none configure -state disabled -disabledforeground gray
      .main.card.other.right.lprot.ah configure -state disabled -disabledforeground gray
      .main.card.other.right.lprot.esp configure -state disabled -disabledforeground gray
}

proc enable_other {} {
      global liprot check_static check_partial check_inbound check_outbound
      set check_static 1
      set check_partial 1
      set liprot 0
      set check_inbound 1
      set check_outbound 1
      .main.card.other.right.peer configure -state normal
      .main.card.other.right.pspi configure -state normal
      .main.card.other.left.flags configure -foreground black
      .main.card.other.right.flags.tunnel configure -state normal -foreground black
      .main.card.other.right.flags.replay configure -state normal -foreground black
      .main.card.other.right.flags.static configure -state disabled -disabledforeground black

      .main.card.other.left.sn configure -foreground black
      .main.card.other.left.peer configure -foreground black
      .main.card.other.left.pspi configure -foreground black
      .main.card.other.left.liprot configure -foreground black
      .main.card.other.left.lispi configure -foreground black
      .main.card.other.right.lispi configure -state normal -foreground black
      .main.card.other.left.ltbr configure -foreground black
      .main.card.other.left.ltte configure -foreground black
      .main.card.other.right.ltbr configure -state disabled -foreground black
      .main.card.other.right.ltte configure -state disabled -foreground black
      .main.card.other.right.flags2.inbound configure -state normal -disabledforeground gray
      .main.card.other.right.flags2.outbound configure -state normal -disabledforeground gray
      .main.card.other.right.lprot.none configure -state normal -foreground black
      .main.card.other.right.lprot.ah configure -state normal -foreground black
      .main.card.other.right.lprot.esp configure -state normal -foreground black
}

proc disable_crypto {} {
#      .main.card.crypto.left.lbl1 configure -foreground gray
      .main.card.crypto.left.lbl2 configure -foreground gray
      .main.card.crypto.left.lbl3 configure -foreground gray
      .main.card.crypto.left.lbl4 configure -foreground gray
#      .main.card.crypto.right.e configure -state disabled -foreground gray
      .main.card.crypto.right.cklen configure -state disabled -foreground gray
      .main.card.crypto.right.ivlen configure -state disabled -foreground gray
      .main.card.crypto.right.key.enc configure -state disabled -foreground gray
      .main.card.crypto.right.key.e configure -state disabled -foreground gray
}
proc disable_all_crypto {} {
      disable_crypto
      .main.card.crypto.left.lbl1 configure -foreground gray
      .main.card.crypto.right.e configure -state disabled -foreground gray
}

proc enable_crypto {} {
      .main.card.crypto.left.lbl1 configure -foreground black
      .main.card.crypto.left.lbl2 configure -foreground black
      .main.card.crypto.left.lbl3 configure -foreground black
      .main.card.crypto.left.lbl4 configure -foreground black
      .main.card.crypto.right.e configure -state normal -foreground black
      .main.card.crypto.right.cklen configure -state disabled -foreground black
      .main.card.crypto.right.ivlen configure -state normal -foreground black
      .main.card.crypto.right.key.enc configure -state normal -foreground black
      .main.card.crypto.right.key.e configure -state normal -foreground black
}
proc disable_auth {} {
#      .main.card.ah.left.lbl1 configure -foreground gray
      .main.card.ah.left.lbl2 configure -foreground gray
      .main.card.ah.left.lbl3 configure -foreground gray
      .main.card.ah.left.lbl4 configure -foreground gray
      .main.card.ah.left.lbl5 configure -foreground gray
#      .main.card.ah.right.e configure -state disabled -foreground gray
      .main.card.ah.right.aklen configure -state disabled -foreground gray
      .main.card.ah.right.ivlen configure -state disabled -foreground gray
      .main.card.ah.right.adata configure -state disabled -foreground gray
      .main.card.ah.right.key.auth configure -state disabled -foreground gray
      .main.card.ah.right.key.e configure -state disabled -foreground gray
}

proc disable_all_auth {} {
      disable_auth
      .main.card.ah.left.lbl1 configure -foreground gray
      .main.card.ah.right.e configure -state disabled -foreground gray
}

proc enable_auth {} {
      .main.card.ah.left.lbl1 configure -foreground black
      .main.card.ah.left.lbl2 configure -foreground black
      .main.card.ah.left.lbl3 configure -foreground black
      .main.card.ah.left.lbl4 configure -foreground black
      .main.card.ah.left.lbl5 configure -foreground black
      .main.card.ah.right.e configure -state normal -foreground black
      .main.card.ah.right.aklen configure -state disabled -foreground black
      .main.card.ah.right.ivlen configure -state disabled -foreground gray
      .main.card.ah.right.adata configure -state disabled -foreground black
      .main.card.ah.right.key.auth configure -state normal -foreground black
      .main.card.ah.right.key.e configure -state normal -foreground black
}

# ---------- Sensitize/Insensitize widgets. Pass "black/gray"
proc set_foreground {w color} {
    set info [pack slaves $w]
    foreach i $info {
	set child [pack slaves $i] 
	foreach c $child {
	    $c configure -foreground $color
	}
    }

#    set_esp_mode_menu $color
}

# ---------- 
proc order_warn {} {
set w .order-win
make_dialog $w "Protocol Order Warning" warning {} {} 0

message $w.f.info -width 8c -text "Although IP-ESP-AH(data) is a valid \
protocol combination, be advised that encrypted network data containing \
authenticated data can be spoofed. It is recommended that IP-AH-ESP(data) \
be used instead."
pack $w.f.info -after $w.f.lbl

}

# --------- 
proc set_ah_menu i {
global ah_algo_menu
global auth_key_len
global ah_algo
global auth_data
global auth_iv_length
global auth_key
global sn
switch $i {
 0 { set ah_algo_menu "None (0)"
     set auth_key_len 0
     set auth_data 0
     set auth_iv_length 0
     set auth_key {}
     set ah_algo 0
     disable_auth
    }
 132 { set ah_algo_menu "HMAC-MD5-96 (132)" 
     set auth_key_len 16
     set auth_data 3
     set auth_iv_length 0
     set sn 1
     set ah_algo 132
     .main.card.other.right.sn configure -state disabled -foreground black
     .main.card.ah.right.ivlen configure -state disabled -foreground gray
     .main.card.ah.right.aklen configure -state disabled -foreground black
     .main.card.ah.right.adata configure -state disabled -foreground black
     enable_auth
     }
 133 { set ah_algo_menu "HMAC-SHA-96 (133)" 
     set auth_key_len 20
     set auth_data 3
     set auth_iv_length 0
     set sn 1
     set ah_algo 133
     .main.card.other.right.sn configure -state disabled -foreground black
     .main.card.ah.right.ivlen configure -state disabled -foreground gray
     .main.card.ah.right.aklen configure -state disabled -foreground black
     .main.card.ah.right.adata configure -state disabled -foreground black
     enable_auth
     }
253 { set ah_algo_menu "Authenticator Test (253)" 
     set auth_key_len 16
     set auth_data 5
     set auth_iv_length 0
     set sn {}
     set ah_algo 253
     .main.card.other.right.sn configure -state normal -foreground black
     .main.card.ah.right.ivlen configure -state normal -foreground black
     .main.card.ah.right.aklen configure -state normal -foreground black
     .main.card.ah.right.adata configure -state normal -foreground black
     enable_auth
    }
}
}

proc set_crypto_menu i {
global crypto_algo_menu
global crypto_algo
global enc_key_len
global enc_key
global crypto_iv_len
global sn
switch $i {
 7 { set crypto_algo_menu "None/ESP_NULL (7)" 
     set enc_key_len 0
     set crypto_iv_len 0
     set enc_key {}
     set sn {}
     set crypto_algo 7
     disable_crypto
     .main.card.other.right.sn configure -state disabled -foreground gray
   }
 2 { set crypto_algo_menu "DES/CBC (2)" 
     enable_crypto
     set enc_key_len 8
     set crypto_iv_len 8
     set sn 1
     set crypto_algo 2
     .main.card.crypto.right.cklen configure -state disabled -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 3 { set crypto_algo_menu "3DES/CBC (3)"
     enable_crypto
     set enc_key_len 24
     set crypto_iv_len 8
     set sn 1
     set crypto_algo 3
     .main.card.crypto.right.cklen configure -state disabled -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 4 { set crypto_algo_menu "RC5/CBC (4)" 
     enable_crypto
     set enc_key_len 16
     set crypto_iv_len 8
     set sn 1
     set crypto_algo 4
     .main.card.crypto.right.cklen configure -state normal -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 5 { set crypto_algo_menu "Blowfish/CBC (5)" 
     enable_crypto
     set enc_key_len 16
     set crypto_iv_len 8
     set sn 1
     set crypto_algo 5
     .main.card.crypto.right.cklen configure -state normal -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 6 { set crypto_algo_menu "IDEA/CBC (6)" 
     enable_crypto
     set enc_key_len 16
     set crypto_iv_len 8
     set sn 1
     set crypto_algo 6
     .main.card.crypto.right.cklen configure -state disabled -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 8 { set crypto_algo_menu "MARS/CBC(AES) (8)" 
     enable_crypto
     set enc_key_len 64
     set crypto_iv_len 16
     set sn 1
     set crypto_algo 8
     .main.card.crypto.right.cklen configure -state disabled -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 9 { set crypto_algo_menu "RC6/CBC(AES) (9)" 
     enable_crypto
     set enc_key_len 64
     set crypto_iv_len 16
     set sn 1
     set crypto_algo 9
     .main.card.crypto.right.cklen configure -state disabled -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 10 { set crypto_algo_menu "RIJNDAEL/CBC(AES) (10)" 
     enable_crypto
     set enc_key_len 64
     set crypto_iv_len 16
     set sn 1
     set crypto_algo 10
     .main.card.crypto.right.cklen configure -state disabled -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 11 { set crypto_algo_menu "SERPENT/CBC(AES) (11)" 
     enable_crypto
     set enc_key_len 64
     set crypto_iv_len 16
     set sn 1
     set crypto_algo 11
     .main.card.crypto.right.cklen configure -state disabled -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
 12 { set crypto_algo_menu "TWOFISH/CBC(AES) (12)" 
     enable_crypto
     set enc_key_len 64
     set crypto_iv_len 16
     set sn 1
     set crypto_algo 12
     .main.card.crypto.right.cklen configure -state disabled -foreground black
     .main.card.other.right.sn configure -state disabled -foreground black
   }
252 { set crypto_algo_menu "Crypto Test (plain Text) (252)" 
     enable_crypto
     set enc_key_len 0
     set crypto_iv_len 0
     set sn 1
     set crypto_algo 252
     .main.card.crypto.right.cklen configure -state normal -foreground black
     .main.card.other.right.sn configure -state normal -foreground black
   }
}
}

proc clear_auth {} {
     global ah_algo_menu auth_key_len auth_data auth_iv_length auth_key ah_algo

     set ah_algo_menu "None (0)"
     set auth_key_len 0
     set auth_data 0
     set auth_iv_length 0
     set auth_key {}
     set ah_algo 0
}

proc clear_crypto {} {
     global crypto_algo_menu enc_key_len crypto_iv_len enc_key crypto_algo

     set crypto_algo_menu "None/ESP_NULL (7)" 
     set enc_key_len 0
     set crypto_iv_len 0
     set enc_key {}
     set crypto_algo 7
}

proc Set_Prot_menu i {
global prot_lbl protection global prefix check_static check_inbound check_outbound

clear_crypto
clear_auth

switch $i {
 0 { set prot_lbl "None/NULL-SA" 
      disable_other
      disable_all_crypto
      disable_all_auth
      clear_other
      set protection 0
      .main.card.other.left.flags configure -foreground black
      .main.card.other.right.flags.static configure -state disabled -disabledforeground black
      .main.card.other.right.flags.partial configure -state disabled -disabledforeground black
      .main.card.other.right.flags2.inbound configure -state normal
      .main.card.other.right.flags2.outbound configure -state normal
      set check_static 1
      set check_inbound 1
      set check_outbound 1
      }
 1 { set prot_lbl "Data Authentication (ESP)" 
      enable_other
      disable_all_crypto
      enable_auth
      set protection 1
      set_ah_menu 0
      }
 2 { set prot_lbl "Data Confidentiality (ESP)" 
      enable_other
      enable_crypto
      disable_all_auth
      set protection 2
      set_crypto_menu 7
      }
 3 { set prot_lbl "Data Confidentiality & Authentication (ESP)" 
      enable_other
      enable_crypto
      enable_auth
      set protection 3
      set_crypto_menu 7
      set_ah_menu 0
      }
 4 { set prot_lbl "Header & Data Authentication(AH)" 
      enable_other
      disable_all_crypto
      enable_auth
      set protection 4
      set_ah_menu 0
       }
}
}

proc set_esp_mode_menu color {
global protection
  if { $protection == 1 || $protection > 2 } {
      .main.card.crypto.esp_peer.lbl configure -foreground $color
      .main.card.crypto.esp_peer.e configure -foreground $color
     }
}

# ----------
# ----------
# ---------- SADB Callbacks
# ----------  These procedures primarily parse the data returned from
# ----------  the "sadb" command and format input to the "sadb" command.

# -------- Generate a key by calling "genkey"
# lbl : "Title" var_entry : "the key variable name to set"
proc genkey {var_entry length} {
upvar $var_entry key
global SADB_TCL_PATH

    set key [exec $SADB_TCL_PATH/rkey $length]
}

# -------- The About procedure, pretty generic
proc about {} {
    global SADB_TCL_PATH
    set w .about-win
    make_dialog $w "About XSADB" {} {} {} 0

    label $w.f.nist_image -bitmap @$SADB_TCL_PATH/nist.xbm
    message $w.f.info -width 18c -text "This is a GUI script for the Linux Cerberus sadb \
program.\n\nGUI developed by Rob Glenn & Mike Oehler.\n\nhttp://www.antd.nist.gov/cerberus"
    pack $w.f.nist_image $w.f.info -side left -fill x -after $w.f.lbl
}

# --------- 
proc delete_sa {} {
    global spi dst protection
    global current_position total_position
    global SADB_PATH
    if { $spi == {} || $dst == {} } {
	set w .delete-error
	make_dialog $w "Delete Error" error {} {} 0
	message $w.f.info -width 8c -text "The currently selected SA \
is missing the destination and/or local spi value.  These values must \
be enterned."
	pack $w.f.info
	return
}
set protocol 2

switch $protection {
0 { set protocol 2 }
1 { set protocol 50 }
2 { set protocol 50 }
3 { set protocol 50 } 
4 { set protocol 51 }
}
exec $SADB_PATH/sadb delete d $dst $spi $protocol
if { $current_position == $total_position } {
   incr current_position -1
   if { $current_position == 0 } { set current_position "None Present" }
}

Get_SADB
}

proc flush_sadb {} {
    global SADB_PATH
exec $SADB_PATH/sadb flush
Get_SADB
}
# --------- 
proc get_prot {} {
    global SADB_PATH

set sa_prot [ exec $SADB_PATH/sadb get prot ]
set w .prot-win
make_dialog $w "Current Protection Setting" info {} {} 0

message $w.f.info -width 25c -text $sa_prot
pack $w.f.info -after $w.f.lbl

}

# --------- 
proc Set_Prot {} {

global prot oprot
set w .prot-win
#catch {destroy $w}
toplevel $w
wm title $w "System IPsec Policy Settings"
set w $w.lbl
frame $w
label $w.inbound -text "Inbound" -foreground black -anchor w
label $w.outbound -text "Outbound" -foreground black -anchor w
pack $w.inbound $w.outbound -side left -anchor w
set w .prot-win
set w $w.f
frame $w
set w $w.left
frame $w
  radiobutton $w.r0  -variable prot -value 0 -command "enable_prot"
  radiobutton $w.r1 -variable prot -value 1  -command "enable_prot"
  radiobutton $w.r2  -variable prot -value 2 -command "enable_prot"
  radiobutton $w.r3  -variable prot -value 3 -command "enable_prot"
pack $w.r0 $w.r1 $w.r2 $w.r3 -side top -anchor w  -padx 20
set w .prot-win.f.middle
frame $w
  radiobutton $w.r0  -variable oprot -value 0 -command "enable_prot"
  radiobutton $w.r1 -variable oprot -value 1 -command "enable_prot"
  radiobutton $w.r2  -variable oprot -value 2 -command "enable_prot"
  radiobutton $w.r3  -variable oprot -value 3 -command "enable_prot"
pack $w.r0 $w.r1 $w.r2 $w.r3 -side top -anchor w

set w .prot-win.f.right
frame $w
label $w.prot -text  "IPsec Traffic Only"  -foreground black -anchor w 
label $w.unprot -text  "IPsec & Unprotected Traffic"  -foreground black -anchor w
label $w.null -text  "IPsec & NULL (empty) SAs"  -foreground black -anchor w
label $w.all -text  "All Traffic"  -foreground black -anchor w
pack $w.prot $w.unprot $w.null $w.all -side top -anchor w -pady 2

set w .prot-win.f
pack $w.left $w.middle $w.right -side left 

set w .prot-win.f2
frame $w -borderwidth 2 -relief flat
button $w.reset -text Reset -command "Get_Prot" -state disabled -foreground gray
button $w.cancel -text Close -command "destroy .prot-win"
button $w.change -text Change -command "change_prot .prot-win" -foreground gray -state disabled
pack $w.reset $w.cancel $w.change -side left -pady 2 

set w .prot-win
pack $w.lbl $w.f $w.f2 -side top -padx 50 -fill x -anchor w

Get_Prot
grab set $w
tkwait window $w

}

proc enable_prot {} {
	.prot-win.f2.reset configure -foreground black -state normal
	.prot-win.f2.change configure -foreground black -state normal
}
proc disable_prot {} {
	.prot-win.f2.reset configure -foreground gray -state disabled
	.prot-win.f2.change configure -foreground gray -state disabled
}
proc Get_Prot {} {
global prot oprot
global SADB_PATH

set prot 0
set oprot 0

set sa_prot [ exec $SADB_PATH/sadb get prot ]
set sa_prot [split $sa_prot "\n"]

set tmp [lindex $sa_prot 2]
if { [string first Non $tmp] > -1} {
	incr prot 
}
if { [string first Empty $tmp] > -1} {
	incr prot 2
}
set tmp [lindex $sa_prot 3]
if { [string first Non $tmp] > -1} {
	incr oprot 
}
if { [string first Empty $tmp] > -1} {
	incr oprot 2
}
disable_prot
}

# --------- Obtain the data, execute a command, set the global, wipe window
proc other_destroy {w val } {
upvar $val tmp
   set tmp [$w.f.e get]
   destroy $w
}

proc change_policy_cmd {} {
global prot oprot
global SADB_PATH
	exec $SADB_PATH/sadb set prot $prot $oprot
	if { [winfo exists .policy-warning] } { destroy .policy-warning}

}

proc change_prot {w} {
global prot oprot
global SADB_PATH

if { (($prot == 0) || ($prot == 2)) } {
	make_dialog .policy-warning "System Policy Warning" question \
		"These settings require SAs for ALL communication\nand can cause adverse affects if you are not careful.  Are you sure?" {change_policy_cmd} 1
	grab set .policy-warning
	tkwait window .policy-warning
        Get_Prot
	return
}
if { (($oprot == 0) || ($oprot == 2)) } {
	make_dialog .policy-warning "System Policy Warning" question \
		"These settings require SAs for ALL communication\nand can cause adverse affects if you are not careful.  Are you sure?" {exec $SADB_PATH/sadb set prot $prot $oprot} 1
	grab set .policy-warning
	tkwait window .policy-warning
        Get_Prot
	return
}
exec $SADB_PATH/sadb set prot $prot $oprot
Get_Prot
}


# --------- Issue the "sadb get d" command and strip off the header information
# --------- Keep the SA information in the global list "sadb"
proc Get_SADB {} {
    global SADB_PATH
    global errorCode
    set w .sadb_get_info-win
    global sadb resolve_addr
    if { $resolve_addr } {
    	set sadb  [exec $SADB_PATH/sadb -s get dest]
    } else {
    	set sadb  [exec $SADB_PATH/sadb -s -n get dest]
    }

    # remove sadb header information
    set end   [string length $sadb]
    set sadb [string range $sadb 1 $end]
    set end  [string length $sadb]
    set sadb [split $sadb "\n"]

    set tmp [lindex $sadb 0]
    if { $tmp == {} } {
	global current_position total_position div_position
        clear_gui
	set current_position "None Present"
        set total_position {}
        set div_position {}
        run_list_view
	return
    }

    global current_position sa_position div_position total_position
    if { [string first "None Present" $current_position] == 0 } { set current_position 1 }
    set sa_position 0
    set lines [llength $sadb]
    for {set i 1} { $i<$lines} { incr i 1} {
	set tmp [lindex $sadb $i]
	if { $tmp == {} } {
	    lappend sa_position [expr $i+1]
	}
    }
    set div_position "/"
    set total_position [llength $sa_position]

    if { [string first "None Present" $current_position] < 0 } { 
       Parse_SA [lindex $sa_position [expr $current_position - 1] ]
    } else {
       Parse_SA 0 
    }
    run_list_view
}

# --------- Retrieve the SADB each interval
proc Auto_Update {} {
global auto_update auto_update_interval current_position

    if { $auto_update } {
	    
	Get_SADB

	after [expr $auto_update_interval*1000] {
	    Auto_Update
	}
    }
}

proc run_list_view {} {
    global protection sa_position current_position sadb

    set w .main.listview.top
    
    set total_sa [llength $sa_position]
    $w.f.list delete 0 $total_sa

    if { $sadb == {} } { 
        $w.f.list selection clear 0 $total_sa
        set sa_position 0
        bind .main.listview.top.f.list <Button-1> {}
        return }

    for {set i 0} {$i < $total_sa} {incr i 1} {
        set line [lindex $sa_position $i]
        set tmp [lindex $sadb $line]
        set index $line
    if { [scan $tmp "local_spi %s" spi ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    incr index 2
    set tmp [lindex $sadb $index]
    if { [scan $tmp "destination %s" dst ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    incr index 8

    set tmp [lindex $sadb $index]
    set protocol 0
    if { [scan $tmp "protocol %s" $tmp ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    regexp {\((.*)\)} $tmp protocol
    set protocol [ string trim $protocol " ()" ]

    switch $protocol {
0 { set pstring "PARTIAL" }
2 { set pstring "NULL-SA" }
50 { set pstring "ESP" }
51 { set pstring "AH" }
    }
        $w.f.list insert end [format "%-19s%11s         %-10s" $dst $spi $pstring ]
    }

    $w.f.list selection set [expr $current_position -1]

    bind .main.listview.top.f.list <Button-1> {
        set sel [selection get]
        set entry [.main.listview.top.f.list nearest %y]
        if {$entry >= 0} {
            global current_position
            set current_position [expr $entry+1]
            Parse_SA  [lindex $sa_position $entry]
        }
    }
}

# --------- 
proc Save_SA_File {file_name all} {
    set w .save-warn
    global sadb
    if { $sadb == {} } {
	make_dialog $w "Save Failed" error \
		"Save Failed\nNo SA specified." \
		{} 0
	return
    }
    if { [file exists $file_name] } {

	make_dialog $w "File Exists" question \
		"The file: \"$file_name\" exists\n Overwrite it?" \
		{} 1
	$w.f2.cancel configure -command { 
	    destroy .save-warn
	    return
	}
	grab set $w
	tkwait window $w
    }
    set f [open $file_name w]
    global sa_position current_position div_position total_position
    global dst spi peer pspi check_replay check_tunnel check_partial check_static check_inbound check_outbound sn protection
    global prefix crypto_algo enc_key_len crypto_iv_len enc_key
    global ah_algo auth_key auth_key_len auth_data auth_iv_length
    global liprot lispi
   

    set tmp_position $current_position
    set total_sa [expr ($all==0) ? 1 : [llength $sa_position] ]
    for {set i 1} {$i<=$total_sa} { incr i 1 } {
     
        if {$all == 1} { Parse_SA [lindex $sa_position [expr ($i-1)] ] }


    if { $sn == {} } {
	set seq 0
    } else {
    	set seq 1
    }
    set io_switch "-v"
    if { ($check_inbound == 1) && ($check_outbound == 1) } {
    	set io_switch "-v"
    } else {
    	if { $check_inbound == 1} {
		set io_switch "-i"
	}
    	if { $check_outbound == 1 } {
		set io_switch "-o"
	}
   }
   if { $lispi == {} } {
	set lispi 0
   }
   if { $liprot == 0 } {
        set lispi 0 
   }
    switch $protection {
0 { puts $f "sadb $io_switch add d $dst $prefix $spi $dst $spi 0 0 0 2 0 0\n"
  }
1 { puts $f "sadb $io_switch add d $dst $prefix $spi $peer $pspi $check_tunnel $check_replay $seq 50 $liprot $lispi $crypto_algo 0 0 $ah_algo $auth_iv_length $auth_key_len $auth_key $auth_data\n"
  }
2 { puts $f "sadb $io_switch add d $dst $prefix $spi $peer $pspi $check_tunnel $check_replay $seq 50 $liprot $lispi $crypto_algo $crypto_iv_len $enc_key_len $enc_key 0\n"
  }
3 { puts $f "sadb $io_switch add d $dst $prefix $spi $peer $pspi $check_tunnel $check_replay $seq 50 $liprot $liprot $crypto_algo \
    $crypto_iv_len $enc_key_len $enc_key $ah_algo $auth_iv_length $auth_key_len \
    $auth_key $auth_data\n"
  }
4 { puts $f "sadb $io_switch add d $dst $prefix $spi $peer $pspi $check_tunnel $check_replay $seq 51 $liprot $lispi $ah_algo $auth_iv_length $auth_key_len $auth_key $auth_data\n"
  }
    } 
    }
    set current_position $tmp_position
    Parse_SA [lindex $sa_position [expr $current_position - 1]]
    close $f
    if { [winfo exists .save-warn] } { destroy .save-warn}
    make_dialog .save-info "Save Complete" info "Save Complete" {} 0
    after 1500 { if { [winfo exists .save-info] } { destroy .save-info } }
}

# --------- 
proc Get_SA_File {} {
    set file_name [ tk_filesel .file ]
    if { [file exists $file_name] } {
    	set f [open $file_name r]
    	while {[gets $f line]>=0} {
        	if { [string first "sadb -v add d" $line] != 0 } { continue }

        	eval [concat exec $line ]

    	}
    close $f
    Get_SADB
   }
}

# --------- Issue the "sadb add d" command using the global data
proc Load_SA {} {
    global dst spi peer pspi check_replay check_tunnel check_partial check_static check_inbound check_outbound sn protection liprot lispi
    global prefix crypto_algo enc_key_len crypto_iv_len enc_key
    global ah_algo auth_key auth_key_len auth_data auth_iv_length
    global SADB_PATH

    if {$dst == {}} {
	Get_SADB
	return
    }
    if {$prefix == {}} {
        set prefix 32
    }
    if {$spi == {}} {
	Get_SADB
	return
    }
    if {$peer == {}} {
	set peer $dst
    }
    if {$pspi == {}} {
	set pspi $spi
    }
    set seq $sn
    if { $sn == {} } {
	set seq 0
    }
    set io_switch "-v"
    if { ($check_inbound == 1) && ($check_outbound == 1) } {
    	set io_switch "-v"
    } else {
    	if { $check_inbound == 1} {
		set io_switch "-i"
	}
    	if { $check_outbound == 1 } {
		set io_switch "-o"
	}
   }
   if { $lispi == {} } {
	set lispi 0
   }
   if { $liprot == 0 } {
        set lispi 0 
   }
    switch $protection {
0 { exec $SADB_PATH/sadb $io_switch add d $dst $prefix $spi $dst $spi 0 0 0 2 0 0
  }
1 { exec $SADB_PATH/sadb $io_switch add d $dst $prefix $spi $peer $pspi $check_tunnel $check_replay $seq 50 $liprot $lispi $crypto_algo 0 0 $ah_algo $auth_iv_length $auth_key_len $auth_key $auth_data
  }
2 { exec $SADB_PATH/sadb $io_switch add d $dst $prefix $spi $peer $pspi $check_tunnel $check_replay $seq 50 $liprot $lispi $crypto_algo $crypto_iv_len $enc_key_len $enc_key 0
  }
3 { exec $SADB_PATH/sadb $io_switch add d $dst $prefix $spi $peer $pspi $check_tunnel $check_replay $seq 50 $liprot $lispi $crypto_algo \
    $crypto_iv_len $enc_key_len $enc_key $ah_algo $auth_iv_length $auth_key_len \
    $auth_key $auth_data
  }
4 { exec $SADB_PATH/sadb $io_switch add d $dst $prefix $spi $peer $pspi $check_tunnel $check_replay $seq 51 $liprot $lispi $ah_algo $auth_iv_length $auth_key_len $auth_key $auth_data
  }
    } 
    Get_SADB
}

# --------- Based on the direction, step through the global list, "sadb"
proc sa_step direction {
    global current_position sa_position sadb
    if { $sadb == {} } { return }
    set total_sa [llength $sa_position]

    incr current_position $direction
    if { $current_position<1 } { set current_position $total_sa}
    if { $current_position>$total_sa } { set current_position 1}


}

# --------- Manipulate the GUI based on the SA entry offset by $index
proc Parse_SA index {
    global sadb dst prefix spi liprot lispi br te
    global peer pspi check_tunnel check_replay check_static check_partial
    global check_inbound check_outbound sn
    global crypto_iv_len enc_key_len enc_key 
    global auth_iv_length auth_data auth_key auth_key_len
    set tmp_liprot {}

    clear_other
    set tmp [lindex $sadb $index]
    if { [scan $tmp "local_spi %s" spi ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }

    incr index 2
    set tmp [lindex $sadb $index]
    if { [scan $tmp "destination %s" dst ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    incr index 1
    set tmp [lindex $sadb $index]
    if { [scan $tmp "addr_prefix %s" prefix ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    incr index 1
    set tmp [lindex $sadb $index]
    if { [scan $tmp "ipsec_peer %s" peer ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    incr index 1
    set tmp [lindex $sadb $index]
    if { [scan $tmp "peer_spi %s" pspi ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    incr index 1
    set tmp [lindex $sadb $index]
    if { [scan $tmp "flags %s" flags ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    set tmp_check_static 0
    set tmp_check_partial 0
    set tmp_check_inbound 0
    set tmp_check_outbound 0
    set tmp_check_partial 0
    if { [string first M $flags]>-1 } {
	set tmp_check_static 1
    }
    if { [string first C $flags]>-1 } {
	set check_replay 1
    }
    if { [string first T $flags]>-1 } {
	set check_tunnel 1
    }
    if { [string first I $flags]>-1 } {
	set tmp_check_inbound 1
    }
    if { [string first O $flags]>-1 } {
	set tmp_check_outbound 1
    }
    if { [string first P $flags]>-1 } {
	set tmp_check_partial 1
    }
    incr index 1
    set tmp_sn {}
    set tmp [lindex $sadb $index]
    if { [scan $tmp "sequence_number %s" tmp_sn ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    if { $tmp_sn == 0 } {
       set tmp_sn {}
    }
    incr index 1
    set tmp_br {}
    set tmp [lindex $sadb $index]
    if { [scan $tmp "lifetime-B %s" tmp_br ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    incr index 1
    set tmp_te {}
    set tmp_te2 {}
    set tmp_te3 {}
    set tmp [lindex $sadb $index]
    if { [scan $tmp "lifetime-T %s %s %s" tmp_te tmp_te2 tmp_te3] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    incr index 1
    set tmp [lindex $sadb $index]
    set protocol 0
    if { [scan $tmp "protocol %s" $tmp ] < 1} {
	make_dialog .parse-error "Parse Error" error \
		"Unable to parse \"sadb get destination\"\n$tmp" {} 0
	return
    }
    regexp {\((.*)\)} $tmp protocol
    set protocol [ string trim $protocol " ()" ]

    if { ($protocol == 50) || ($protocol == 51) } {
        incr index 1
        set tmp [lindex $sadb $index]
        if { [scan $tmp "linked-protocol %s" tmp_liprot ] < 1} {
	    make_dialog .parse-error "Parse Error" error \
		    "Unable to parse \"sadb get destination3\"\n$tmp" {} 0
	    return
        }
        regexp {\((.*)\)} $tmp tmp_liprot
        set tmp_liprot [ string trim $tmp_liprot " ()" ]

        incr index 1
        set tmp [lindex $sadb $index]
        if { [scan $tmp "linked-spi %s" lispi ] < 1} {
	    make_dialog .parse-error "Parse Error" error \
		    "Unable to parse \"sadb get destination\"\n$tmp" {} 0
	    return
        }
	if { $lispi == 0 } {
		set lispi {}
	}
    }

    if { $protocol == 50 } {

    	incr index 1
    	set tmp [lindex $sadb $index]
    	set algo 0
    	if { [scan $tmp "algorithm %s" $tmp ] < 1} {
		make_dialog .parse-error "Parse Error" error \
			"Unable to parse \"sadb get destination\"\n$tmp" {} 0
		return
    	}
    	regexp {\((.*)\)} $tmp algo
    	set algo [ string trim $algo " ()" ]

    	if { $algo != 7 } {
    		incr index 1
    		set tmp [lindex $sadb $index]
    		if { [scan $tmp "IVEC_length %s" iv_len ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
    		set tmp [lindex $sadb $index]
    		if { [scan $tmp "key_len %s" key_len ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
    		set tmp [lindex $sadb $index]
    		if { [scan $tmp "key %s" key ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
    		set tmp [lindex $sadb $index]
    		set algo2 0
    		if { [scan $tmp "algorithm %s" $tmp ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		regexp {\((.*)\)} $tmp algo2
    		set algo2 [ string trim $algo2 " ()" ]
   		if { $algo2 == 0 } {
			Set_Prot_menu 2
        		set_crypto_menu $algo 
			set crypto_iv_len $iv_len
			set enc_key_len $key_len
			set enc_key $key
			incr index 9
	    		set tmp [lindex $sadb $index]
		} else {
			Set_Prot_menu 3
			set_crypto_menu $algo
			set crypto_iv_len $iv_len
			set enc_key_len $key_len
			set enc_key $key
			set_ah_menu $algo2

    			incr index 1
	    		set tmp [lindex $sadb $index]
    			if { [scan $tmp "IVEC_length %s" auth_iv_length ] < 1} {
				make_dialog .parse-error "Parse Error" error \
					"Unable to parse \"sadb get destination\"\n$tmp" {} 0
				return
    			}
    			incr index 1
	    		set tmp [lindex $sadb $index]
    			if { [scan $tmp "auth_data_length %s" auth_data ] < 1} {
				make_dialog .parse-error "Parse Error" error \
					"Unable to parse \"sadb get destination\"\n$tmp" {} 0
				return
    			}
    			incr index 1
	    		set tmp [lindex $sadb $index]
    			if { [scan $tmp "key_len %s" auth_key_len ] < 1} {
				make_dialog .parse-error "Parse Error" error \
					"Unable to parse \"sadb get destination\"\n$tmp" {} 0
				return
    			}
    			incr index 1
	    		set tmp [lindex $sadb $index]
    			if { [scan $tmp "key %s" auth_key ] < 1} {
				make_dialog .parse-error "Parse Error" error \
					"Unable to parse \"sadb get destination\"\n$tmp" {} 0
				return
    			}
    		        incr index 4
	    		set tmp [lindex $sadb $index]
		}
    	} else {
		Set_Prot_menu 1
		set_crypto_menu $algo

    		incr index 3
    		set tmp [lindex $sadb $index]
    		set algo2 0
    		if { [scan $tmp "algorithm %s" $tmp ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		regexp {\((.*)\)} $tmp algo2
    		set algo2 [ string trim $algo2 " ()" ]
		set_ah_menu $algo2

    		incr index 1
	    	set tmp [lindex $sadb $index]
    		if { [scan $tmp "IVEC_length %s" auth_iv_length ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
	    	set tmp [lindex $sadb $index]
    		if { [scan $tmp "auth_data_length %s" auth_data ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
	    	set tmp [lindex $sadb $index]
    		if { [scan $tmp "key_len %s" auth_key_len ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
	    	set tmp [lindex $sadb $index]
    		if { [scan $tmp "key %s" auth_key ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 4
	    	set tmp [lindex $sadb $index]
	}

    } else {
	if { $protocol == 51 } {
		Set_Prot_menu 4
    		incr index 1
    		set tmp [lindex $sadb $index]
    		set algo2 0
    		if { [scan $tmp "algorithm %s" $tmp ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		regexp {\((.*)\)} $tmp algo2
    		set algo2 [ string trim $algo2 " ()" ]
		set_ah_menu $algo2

    		incr index 1
	    	set tmp [lindex $sadb $index]
    		if { [scan $tmp "IVEC_length %s" auth_iv_length ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
	    	set tmp [lindex $sadb $index]
    		if { [scan $tmp "auth_data_length %s" auth_data ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
	    	set tmp [lindex $sadb $index]
    		if { [scan $tmp "key_len %s" auth_key_len ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 1
	    	set tmp [lindex $sadb $index]
    		if { [scan $tmp "key %s" auth_key ] < 1} {
			make_dialog .parse-error "Parse Error" error \
				"Unable to parse \"sadb get destination\"\n$tmp" {} 0
			return
    		}
    		incr index 4
	    	set tmp [lindex $sadb $index]
		
	} else {
		Set_Prot_menu 0
		set_crypto_menu 7
		set_ah_menu 0
    		incr index 1
	    	set tmp [lindex $sadb $index]
	} 
    }
    set liprot $tmp_liprot
    set check_static $tmp_check_static
    set check_inbound $tmp_check_inbound
    set check_outbound $tmp_check_outbound
    set check_partial $tmp_check_partial
    set sn $tmp_sn
    set br $tmp_br
    set te "$tmp_te $tmp_te2 $tmp_te3"
}


# ---------- Activate ESP & AH GUI sections
proc Activate order {
    global protection esp_algo ah_algo
    set protection 0

    set color "gray"
    if { $esp_algo } {
	set protection 1
	set color "black"
    }
    set_foreground .main.card.crypto $color

    set color "gray"
    if { $ah_algo } {
	set protection 2
	set color "black"
	incr protection $order
    }
    set_foreground .main.card.ah $color

    Set_Prot_menu $protection

}

proc get_interval {} {
global auto_interval auto_update_interval

set w .auto-win
set auto_interval $auto_update_interval

make_dialog $w "Set Update Interval" {} {} {set_interval $auto_interval} 1
label $w.f.l -text "Update Interval(seconds)" -anchor w
entry $w.f.e -width 4 -textvariable auto_interval 
pack $w.f.l $w.f.e -fill x -side left -padx 30
grab set $w
tkwait window $w
}

proc set_interval i {

global auto_update_interval
set auto_update_interval $i
set w .auto-win
destroy $w
}

# MAIN routine
# --------- Check to see if root is executing the script
set myuid [ exec $SADB_TCL_PATH/getuid ]
if { $myuid } {
	wm title . "Not Root"
	catch {destroy $w}
	frame .f -borderwidth 2 -relief flat
	pack .f
	label .f.bitmap -bitmap error
	pack .f.bitmap
	label .f.lbl -text "Only Root can use this utility."
	pack .f.lbl
	frame .f2 -borderwidth 2 -relief flat
	pack .f2 
	set cmd "destroy ."
	button .f2.ok -text OK -command $cmd
	pack .f2.ok -side left -pady 2
	grab set .
	tkwait window .
    exit
}

set auto_update_interval 5
# --------- Main Menu
frame .menu -relief raised -borderwidth 2
pack .menu -side top -fill x

menubutton .menu.file -text File -menu .menu.file.m -underline 0
menu .menu.file.m
.menu.file.m add command -label "Load SA File" -command { Get_SA_File }
.menu.file.m add command -label "Save SADB as..." -command { Save_SA_File [tk_filesel .file ] 1 }
.menu.file.m add separator
.menu.file.m add command -label "Save SA as..." -command { Save_SA_File [tk_filesel .file ] 0 }
.menu.file.m add command -label "Save SA" -command { Save_SA_File $dst 0 }
.menu.file.m add separator
.menu.file.m add command -label "Quit" -command { destroy . }
pack .menu.file -side left

menubutton .menu.view -text View -menu .menu.view.m -underline 0
menu .menu.view.m
.menu.view.m add command -label "Clear" -command { clear_gui }
.menu.view.m add command -label "Refresh" -command { Get_SADB }
pack .menu.view -side left

menubutton .menu.act -text Operations -menu .menu.act.m -underline 0
menu .menu.act.m
.menu.act.m add command -label "Add SA" -command { Load_SA }
.menu.act.m add separator
.menu.act.m add command -label "Delete SA" -command { delete_sa }
.menu.act.m add command -label "Flush SADB" -command {flush_sadb}
.menu.act.m add separator
.menu.act.m add command -label "System IPsec Policy Settings" -command {Set_Prot}
.menu.act.m add separator

set auto_update 0
.menu.act.m add checkbutton -label "Automatic updates" -variable auto_update \
	-command { Auto_Update }
pack .menu.act  -side left

menubutton .menu.pref -text Preferences -menu .menu.pref.m -underline 0
menu .menu.pref.m
.menu.pref.m add checkbutton -label "Show Host Names" -variable resolve_addr -command {Get_SADB}
.menu.pref.m add command -label "Set Auto Update interval" -command {get_interval}
pack .menu.pref -side left


menubutton .menu.help -text Help -menu .menu.help.m -underline 0
menu .menu.help.m
.menu.help.m add command -label "About XSADB" -command { about } 
.menu.help.m add separator
pack .menu.help -side right

# --------- SADB Information Form Display *ALL* SAs'
set w .main
frame $w -borderwidth 2 -relief flat
pack $w

# ------ This frame holds all information for a single *SA*
 frame $w.card -relief sunken -borderwidth 2
 pack $w.card -side left -padx 2m -pady 2m -in $w

 frame $w.listview -relief sunken -borderwidth 2
 pack $w.listview -side left -padx 2m -pady 2m -in $w


# ------ Required SA info (Destination, protection, & SPI), labels on left
set w .main.card.index
frame $w -relief flat

 set w .main.card.index.left
  frame $w -relief flat
  label $w.dst -text "Destination Address:" -anchor w
  label $w.prefix -text "Prefix Length(bits):" -anchor w
  label $w.spi -text "Local SPI(hex):"  -anchor w
  label $w.prot -text "Protection:" -anchor w

  pack $w.dst $w.prefix $w.spi $w.prot -side top -anchor w

  set w .main.card.index.right
  frame $w -relief flat
  entry $w.dst -width 30 -textvariable dst 
  set prefix 32
  entry $w.prefix -width 4 -textvariable prefix 
  entry $w.spi -width 17 -textvariable spi 
  set protection 0
  set prot_lbl "None/NULL-SA"
  menubutton $w.btn -anchor w -text $protection -textvariable prot_lbl \
   -menu $w.btn.m -relief raised
  menu $w.btn.m
  $w.btn.m add radiobutton -label "None/NULL-SA" \
    -variable protection -value 0 \
    -command {
      Set_Prot_menu 0
     }
  $w.btn.m add radiobutton -label "Data Authentication(ESP)" \
    -variable protection -value 1 \
    -command {
      Set_Prot_menu 1
     }
  $w.btn.m add radiobutton -label "Data Confidentiality(ESP)" \
    -variable protection -value 2 \
    -command {
      Set_Prot_menu 2
     }
  $w.btn.m add radiobutton -label "Data Authentication & Confidentiality(ESP)" \
    -variable protection -value 3 \
    -command {
      Set_Prot_menu 3
     }
  $w.btn.m add radiobutton -label "Header & Data Authentication(AH)" \
    -variable protection -value 4 \
    -command {
       Set_Prot_menu 4
     }
  pack $w.dst $w.prefix $w.spi $w.btn -side top -anchor w

  set w .main.card.index
  pack $w.left $w.right -side left -anchor w -ipadx 35

# ----- Other Information Frame
set w .main.card.other
frame $w -relief raised -borderwidth 2

set w .main.card.other.left
frame $w -relief flat
label $w.peer -text  "Peer Address:"  -anchor w -foreground black
label $w.pspi -text  "Peer SPI:" -anchor w -foreground black
label $w.flags -text "Flags: "  -anchor w -foreground black
label $w.flags2 -text "  "  -anchor w -foreground black
label $w.sn -text    "Sequence Number:"  -anchor w -foreground black
label $w.liprot -text    "Linked Protocol:"  -anchor w -foreground gray
label $w.lispi -text    "Linked SPI:"  -anchor w -foreground gray
label $w.ltbr -text    "Lifetime(bytes remaining):"  -anchor w -foreground gray
label $w.ltte -text    "Lifetime(expires at):"  -anchor w -foreground gray
pack $w.peer $w.pspi $w.flags $w.flags2 $w.sn $w.liprot $w.lispi $w.ltbr $w.ltte -side top -pady 2 -anchor w
pack $w

set w .main.card.other.right
frame $w -relief flat
entry $w.peer -width 30 -textvariable peer -foreground black -state normal
entry $w.pspi -width 17 -textvariable pspi -foreground black -state normal

set w .main.card.other.right.flags
frame $w -relief sunken -borderwidth 2
checkbutton $w.tunnel -text "Tunnel" -variable check_tunnel -state disabled -disabledforeground black
checkbutton $w.replay -text "Check Replay" -variable check_replay -state disabled -disabledforeground black
checkbutton $w.static -text "Static" -variable check_static -state disabled -disabledforeground black
checkbutton $w.partial -text "Partial" -variable check_partial -state disabled -disabledforeground black
pack $w.tunnel $w.replay $w.static $w.partial -side left -anchor w

set w .main.card.other.right.flags2
frame $w -relief sunken -borderwidth 2
checkbutton $w.inbound -text "Inbound" -variable check_inbound -state disabled -disabledforeground black
checkbutton $w.outbound -text "Outbound" -variable check_outbound -state disabled -disabledforeground black
pack $w.inbound $w.outbound -side left -anchor w

set w .main.card.other.right
set sn {}
entry $w.sn -width 17 -textvariable sn -foreground black 
entry $w.lispi -width 17 -textvariable lispi -foreground gray 
entry $w.ltbr -width 30 -textvariable br -foreground gray
entry $w.ltte -width 30 -textvariable te -foreground gray
set liprot 0
set lispi {}
set port {}
set w .main.card.other.right.lprot
frame $w -relief sunken -borderwidth 2
radiobutton $w.none -text "None" -variable liprot -value 0 -foreground gray
radiobutton $w.esp -text "ESP" -variable liprot -value 50 -foreground gray
radiobutton $w.ah -text "AH" -variable liprot -value 51 -foreground gray
pack $w.none $w.esp $w.ah -side left -anchor w

set w .main.card.other.right
pack $w.peer $w.pspi $w.flags $w.flags2 $w.sn $w.lprot $w.lispi $w.ltbr $w.ltte -side top -anchor w

set w .main.card.other
pack $w.left $w.right -side left -ipadx 16

# ----- Crypto Frame
set w .main.card.crypto 
frame $w -borderwidth 2 -relief raised

set widget $w.left
 frame $widget -relief flat

  label $widget.lbl1 -text "Crypto Algorithm:"  -foreground gray  -anchor w
  label $widget.lbl2 -text "Key Length(bytes):" -foreground gray -anchor w
  label $widget.lbl3 -text "Key:" -foreground gray -anchor w
  label $widget.lbl4 -text "IV Length(bytes):                  " -foreground gray -anchor w

  pack  $widget.lbl1  $widget.lbl2 $widget.lbl3 $widget.lbl4 -side top -fill x

set widget $w.right
 frame $widget -relief flat

  clear_crypto

  menubutton $widget.e -state disabled -width 43 -textvariable crypto_algo_menu \
   -menu $widget.e.m -relief raised -foreground gray
  menu $widget.e.m
  $widget.e.m add radiobutton -label "None/ESP_NULL (7)" \
    -variable crypto_algo -value 7 \
    -command { set_crypto_menu 7 }
  $widget.e.m add radiobutton -label "DES/CBC (2)" \
    -variable crypto_algo -value 2 \
    -command { set_crypto_menu 2 }
  $widget.e.m add radiobutton -label "3DES/CBC (3)" \
    -variable crypto_algo -value 3 \
    -command { set_crypto_menu 3 }
  $widget.e.m add radiobutton -label "RC5/CBC (4)" \
    -variable crypto_algo -value 4 \
    -command { set_crypto_menu 4 }
  $widget.e.m add radiobutton -label "Blowfish/CBC (5)" \
    -variable crypto_algo -value 5 \
    -command { set_crypto_menu 5 }
  $widget.e.m add radiobutton -label "IDEA/CBC (6)" \
    -variable crypto_algo -value 6 \
    -command { set_crypto_menu 6 }
  $widget.e.m add radiobutton -label "MARS/CBC(AES) (8)" \
    -variable crypto_algo -value 8 \
    -command { set_crypto_menu 8 }
  $widget.e.m add radiobutton -label "RC6/CBC(AES) (9)" \
    -variable crypto_algo -value 9 \
    -command { set_crypto_menu 9 }
  $widget.e.m add radiobutton -label "RIJNDAEL/CBC(AES) (10)" \
    -variable crypto_algo -value 10 \
    -command { set_crypto_menu 10 }
  $widget.e.m add radiobutton -label "SERPENT/CBC(AES) (11)" \
    -variable crypto_algo -value 11 \
    -command { set_crypto_menu 11 }
  $widget.e.m add radiobutton -label "TWOFISH/CBC(AES) (12)" \
    -variable crypto_algo -value 12 \
    -command { set_crypto_menu 12 }
  $widget.e.m add radiobutton -label "Crypto Test (plain text) (252)" \
    -variable crypto_algo -value 252 \
    -command { set_crypto_menu 252 }

  entry $widget.cklen -state disabled -width 3 -textvariable enc_key_len -foreground gray -state disabled

set widget $widget.key
frame $widget -relief flat
  button $widget.enc -bitmap @$SADB_TCL_PATH/key.xbm -relief raised -foreground gray \
   -command { genkey enc_key $enc_key_len } -state disabled
  entry $widget.e -width 45 -relief sunken -foreground gray -textvariable enc_key -state disabled

 pack $widget.enc $widget.e -side left

set widget $w.right
  entry $widget.ivlen -width 3 -textvariable crypto_iv_len -foreground gray -state disabled

  pack $widget.e $widget.cklen $widget.key $widget.ivlen -side top -anchor w
  pack  $w.left $w.right -side left -padx 4
# ----- Authentication Frame
set w .main.card.ah
frame $w -borderwidth 2 -relief raised

set widget $w.left
  frame $widget
  label $widget.lbl1 -text "Authentication Algorithm:"  -foreground gray 
  label $widget.lbl2 -text "Key Length(bytes):" -foreground gray
  label $widget.lbl3 -text "Key:" -foreground gray -anchor w
  label $widget.lbl4 -text "Checksum Length(32bit words):" -foreground gray
  label $widget.lbl5 -text "IV Length(bytes):" -foreground gray
  pack  $widget.lbl1 $widget.lbl2 $widget.lbl3 $widget.lbl4 $widget.lbl5 -side top -anchor w

set widget $w.right
 frame $widget
  clear_auth
  menubutton $widget.e -width 43 -textvariable ah_algo_menu \
   -menu $widget.e.m -relief raised -foreground gray -state disabled
  menu $widget.e.m
  $widget.e.m add radiobutton -label "None (0)" \
  -variable ah_algo -value 0 -command { set_ah_menu 0 }
  $widget.e.m add radiobutton -label "HMAC-MD5-96 (132)" \
  -variable ah_algo -value 132 -command { set_ah_menu 132 }
  $widget.e.m add radiobutton -label "HMAC-SHA1-96 (133)" \
    -variable ah_algo -value 133 -command { set_ah_menu 133 }
  $widget.e.m add radiobutton -label "Authenticator Test (253)" \
    -variable ah_algo -value 253 -command { set_ah_menu 253 }
  entry $widget.aklen -width 3 -textvariable auth_key_len -foreground gray -state disabled

set widget $widget.key
frame $widget -relief flat
  button $widget.auth -bitmap @$SADB_TCL_PATH/key.xbm -relief raised -foreground gray \
   -command { genkey auth_key $auth_key_len} -state disabled
  entry $widget.e -width 45 -relief sunken -textvariable auth_key -foreground gray
 pack $widget.auth $widget.e -side left

set widget $w.right
  entry $widget.adata -width 3 -textvariable auth_data -foreground gray -state disabled
  entry $widget.ivlen -width 3 -textvariable auth_iv_length -foreground gray -state disabled
  pack  $widget.e $widget.aklen $widget.key $widget.adata $widget.ivlen -side top -anchor w
  pack  $w.left $w.right -side left 

set w .main.card
pack $w.index $w.other $w.ah $w.crypto -side top  -fill x

set w .main.listview.top
frame $w -relief flat
    frame $w.f -borderwidth 2 -relief flat
    pack $w.f
	
    label $w.f.lbl -text "Destination                       SPI             Protocol"
    pack $w.f.lbl -anchor w
    
    frame $w.f2 -borderwidth 2 -relief flat
    pack $w.f2 

   listbox $w.f.list -relief sunken -width 50 -height 29 -yscrollcommand "$w.f.scroll set" -xscrollcommand "$w.f.scrollx set" -font fixed 
   scrollbar $w.f.scroll -command "$w.f.list yview"
   scrollbar $w.f.scrollx -orient horizontal -command "$w.f.list xview"
   pack $w.f.scroll -side right -fill y
   pack $w.f.scrollx -side bottom -fill x
   pack $w.f.list -side left

set w .main.listview
pack $w.top -side top

set w .main
pack $w.card $w.listview -side left -fill y -fill x
    
set w .bottom
frame $w -relief flat
pack $w 
button $w.clear -text "Clear" -command "clear_gui"
button $w.refresh -text "Refresh" -command "Get_SADB"
button $w.add -text "Add" -command "Load_SA"
button $w.delete -text "Delete" -command "delete_sa"
button $w.flush -text "Flush" -command "flush_sadb"
pack $w.clear $w.refresh $w.add $w.delete $w.flush -side left -padx 10
Get_SADB
Auto_Update
