# $Id$

package require otr::crypto
package require otr::key

namespace eval key {
    set ns http://tkabber.jabber.ru/otr
    set otrdir [file join $::configdir otr]
    if {![file exists $otrdir]} {
	file mkdir $otrdir
	catch {file attributes $otrdir -permissions 0700}
    }
    # State variable with all key data
    set Keys [dict create]

    hook::add finload_hook [namespace current]::restore
}

proc key::store {keys} {
    variable otrdir

    if {![catch {
	    set fd [open [file join $otrdir keys.xml.new] w]
	    fconfigure $fd -encoding utf-8

	    puts $fd {<?xml version="1.0" encoding="UTF-8"?>}
	    puts $fd [serialize_keys $keys]

	    close $fd
	} res]} {
	file rename -force -- [file join $otrdir keys.xml.new] \
			      [file join $otrdir keys.xml]
    }
}

proc key::serialize_keys {keys} {
    variable ns

    set subtags {}
    dict for {jid val} $keys {
	lappend subtags [serialize_key $jid $val]
    }

    ::xmpp::xml::toTabbedText [::xmpp::xml::create privkeys \
					-xmlns $ns \
					-subelements $subtags]
}

proc key::serialize_key {jid key} {
    variable ns

    set attrs [list jid	 $jid \
		    type DSA \
		    p	 [format %llx [lindex $key 0]] \
		    q	 [format %llx [lindex $key 1]] \
		    g	 [format %llx [lindex $key 2]] \
		    y	 [format %llx [lindex $key 3]] \
		    x	 [format %llx [lindex $key 4]]]

    ::xmpp::xml::create key -xmlns $ns \
			    -attrs $attrs
}

proc key::restore {} {
    variable otrdir
    variable Keys

    if {[catch {set fd [open [file join $otrdir keys.xml]]}]} {
	return [dict create]
    }

    set data [read $fd]
    close $fd

    set Keys [deserialize_keys [lindex [::xmpp::xml::parseData $data] 0]]
}

proc key::deserialize_keys {xmlel} {
    variable ns

    ::xmpp::xml::split $xmlel tag xmlns attrs cdata subels

    if {$tag ne "privkeys"} {
	return -code error "The root element must be 'privkeys'"
    }
    if {$xmlns ne $ns} {
	return -code error "The namespace must be '$ns'"
    }
    set keys [dict create]
    foreach subel $subels {
	::xmpp::xml::split $subel tag1 xmlns1 attrs1 cdata1 subels1
	if {[::xmpp::xml::getAttr $attrs1 type] eq "DSA"} {
	    scan [::xmpp::xml::getAttr $attrs1 p] %llx p
	    scan [::xmpp::xml::getAttr $attrs1 q] %llx q
	    scan [::xmpp::xml::getAttr $attrs1 g] %llx g
	    scan [::xmpp::xml::getAttr $attrs1 y] %llx y
	    scan [::xmpp::xml::getAttr $attrs1 x] %llx x
	    dict set keys [::xmpp::xml::getAttr $attrs1 jid] \
			  [list $p $q $g $y $x]
	}
    }
    set keys
}

proc key::set_key {vkeys jid key} {
    upvar $vkeys keys

    set jid [::xmpp::jid::normalize $jid]
    dict set keys $jid $key
    set keys
}

proc key::del_key {vkeys jid} {
    upvar $vkeys keys

    set jid [::xmpp::jid::normalize $jid]
    if {[dict exists $keys $jid]} {
	dict unset keys $myjid
    }
    set keys
}

proc key::get_key {keys jid} {
    set jid [::xmpp::jid::normalize $jid]
    if {[catch {dict get $keys $jid} res]} {
	return {}
    } else {
	return $res
    }
}

proc key::manage_keys_dialog {} {
    variable Keys
    variable keyjid
    variable progress
    variable help
    variable fingerprint

    set w .otreditkeys

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

    Dialog $w -title [::msgcat::mc "Manage OTR private keys"] \
	      -separator 1 -anchor e -default 0 -cancel 0

    set f [$w getframe]

    $w add -text [::msgcat::mc "Close"] \
	   -command [list destroy $w]

    # Start with the existing keys
    set jids [lsort [dict keys $Keys]]
    # Next, the existing connections
    foreach xlib [connections] {
	lappend jids \
	       [::xmpp::jid::normalize [::xmpp::jid::removeResource [connection_jid $xlib]]]
    }
    # Next the existing profiles
    for {set i 1} {[info exists ::loginconf$i]} {incr i} {
	upvar #0 ::loginconf$i loginconf
	if {$loginconf(user) ne "" && $loginconf(server) ne ""} {
	    lappend jids [::xmpp::jid::normalize \
			[::xmpp::jid::jid $loginconf(user) $loginconf(server)]]
	}
    }
    # Finally, the ::loginconf
    if {$::loginconf(user) ne "" && $::loginconf(server) ne ""} {
	lappend jids [::xmpp::jid::normalize \
			[::xmpp::jid::jid $::loginconf(user) $::loginconf(server)]]
    }
    set jids [lsort -unique -dictionary $jids]

    if {[llength [connections]] > 0} {
	set keyjid [::xmpp::jid::normalize \
	    [::xmpp::jid::removeResource [connection_jid [lindex [connections] 0]]]]
    } else {
	set keyjid [lindex $jids 0]
    }

    trace add variable [namespace current]::keyjid write \
	  [namespace code [list fill_dialog $w $f]]

    bind $w <Destroy> [list unset -nocomplain [namespace current]::keyjid]
    bind $w <Destroy> +[list unset -nocomplain [namespace current]::progress]
    bind $w <Destroy> +[list unset -nocomplain [namespace current]::help]
    bind $w <Destroy> +[list unset -nocomplain [namespace current]::fingerprint]

    bind $w <<Copy>> [namespace code [list add_to_clipboard]]

    message $f.header -text [::msgcat::mc "Manage OTR long term DSA private key for your JID"] \
		      -width 12c
    grid $f.header -row 0 -column 0 -columnspan 2 -sticky nsew

    tk_optionMenu $f.jid [namespace current]::keyjid {*}$jids
    grid $f.jid -row 1 -column 0 -columnspan 2 -sticky ew

    message $f.help -textvariable [namespace current]::help -width 12c
    grid $f.help -row 2 -column 0 -columnspan 2 -sticky nsew

    message $f.fingerprint -textvariable [namespace current]::fingerprint -width 12c
    grid $f.fingerprint -row 3 -column 0 -columnspan 2 -sticky nsew

    button $f.import -text [::msgcat::mc "Import key..."] \
		-command [namespace code [list import_key $w]]
    grid $f.import -row 4 -column 0 -sticky nsew

    button $f.export -text [::msgcat::mc "Export key..."] \
		-command [namespace code [list export_key $w]]
    grid $f.export -row 4 -column 1 -sticky nsew

    button $f.gen -text [::msgcat::mc "Generate new key"] \
		-command [namespace code [list generate_key $w]]
    grid $f.gen -row 5 -column 0 -sticky nsew

    button $f.delete -text [::msgcat::mc "Delete key"] \
		-command [namespace code [list delete_key $w]]
    grid $f.delete -row 5 -column 1 -sticky nsew

    set progress -1
    ProgressBar $f.pb -variable [namespace current]::progress \
		      -maximum 40000 \
		      -type infinite
    grid $f.pb -row 6 -column 0 -columnspan 2 -sticky ew

    frame $f.f -width 12c -height 0m
    grid $f.f -row 7 -column 0 -columnspan 2 -sticky ew

    fill_dialog $w

    $w draw
}

# key::add_to_clipboard --
#
#	Add the current fingerprint to clipboard.
#
# Arguments:
#	None
#
# Result:
#	Empty string.
#
# Side effects:
#	The current DSA key fingerprint is put to clipboard.

proc key::add_to_clipboard {} {
    variable fingerprint

    clipboard clear
    clipboard append $fingerprint
}

# key::fill_dialog --
#
#	Private procedure which showa an appropriate help message and
#	enables or disables the dialog controls depending on whether a DSA
#	key for the selected JID exists.
#
# Arguments:
#	w	    Dialog window path.
#	args	    Ignored arguments from [trace] command.
#
# Result:
#	Empty string.
#
# Side effects:
#	The help message in the keys dialog is set, the buttons are enabled
#	or disabled.

proc key::fill_dialog {w args} {
    variable Keys
    variable keyjid
    variable help
    variable fingerprint

    if {![winfo exists $w]} return

    set f [$w getframe]

    if {[dict exists $Keys $keyjid]} {
	set help [::msgcat::mc "The fingerprint of your long term OTR DSA private\
			key for this JID is the following:"]
	set key [dict get $Keys $keyjid]
	binary scan [::otr::crypto::DSAFingerprint $key] Iu* nums
	set res {}
	foreach n $nums {
	    lappend res [format %X $n]
	}
	set fingerprint $res
	$f.import configure -state normal
	$f.export configure -state normal
	$f.gen configure -state normal
	$f.delete configure -state normal
    join $res
    } else {
	set help [::msgcat::mc "You don't have a private DSA key for this JID.\
		    Either import a 1024 bit DSA private key, or generate one."]
	set fingerprint ""
	$f.import configure -state normal
	$f.export configure -state disabled
	$f.gen configure -state normal
	$f.delete configure -state disabled
    }
    return
}

# key::import_key --
#
#	Private procedure which imports DSA key to a key file in PEM format
#	and either adds it or replaces the existing one.
#
# Arguments:
#	w	    Dialog window path.
#
# Result:
#	Empty string.
#
# Side effects:
#	The key for a given JID is read from an external file. The filename
#	where to get the key is asked in an addiyional dialog. JID for which
#	the key is to import is taken from the $keyjid variable. The key
#	itself is stored to the global $Keys dictionary and to the
#	~/.tkabber/otr/keys.xml file.

proc key::import_key {w} {
    variable Keys
    variable keyjid

    set filename [tk_getOpenFile \
		      -initialdir $::configdir \
		      -filetypes [list [list [::msgcat::mc "Key files"] *.key] \
				      [list [::msgcat::mc "All files"] *]]]
    if {$filename == ""} return

    if {![file readable $filename]} {
	MessageDlg .otrfileunreadable -aspect 50000 -icon error \
	    -message [::msgcat::mc "Can't open the key file \"%s\"" $filename] \
	    -type user -buttons ok -default 0 -cancel 0
	return
    }

    if {[catch {::otr::key::readPEM $filename} key]} {
	MessageDlg .otrfileunreadable -aspect 50000 -icon error \
	    -message [::msgcat::mc "Can't import DSA key from the file \"%s\": %s" $filename $key] \
	    -type user -buttons ok -default 0 -cancel 0
	return
    }

    if {![dict exists $Keys $keyjid] || [dict get $Keys $keyjid] ne $key} {
	dict set Keys $keyjid $key
	store $Keys
	[namespace parent]::clear_all_jid $keyjid
    }
    fill_dialog $w
    return
}

# key::export_key --
#
#	Private procedure which exports existing DSA key to a key file in PEM
#	format.
#
# Arguments:
#	w	    Dialog window path.
#
# Result:
#	Empty string.
#
# Side effects:
#	The key for a given JID is saved into an external file. The filename
#	where to save the key is asked in an addiyional dialog. JID for which
#	the key is to export is taken from the $keyjid variable. The key
#	itself is taken from the global $Keys dictionary.

proc key::export_key {w} {
    variable Keys
    variable keyjid

    set filename [tk_getSaveFile \
		      -initialdir $::configdir \
		      -initialfile otr-$keyjid.key \
		      -filetypes [list [list [::msgcat::mc "Key files"] *.key] \
				      [list [::msgcat::mc "All files"] *]]]
    if {$filename == ""} return

    set key [dict get $Keys $keyjid]

    ::otr::key::writePEM $key $filename
    return
}

# key::delete_key --
#
#	Private procedure which deletes DSA key from the keys dictionary and
#	from the external storage.
#
# Arguments:
#	w	    Dialog window path.
#
# Result:
#	Empty string.
#
# Side effects:
#	The key for a given JID is deleted from the $Keys dictionary and
#	from ~/.tkabber/otr/keys.xml. JID for which the key is to delete
#	is taken from the $keyjid variable.

proc key::delete_key {w} {
    variable Keys
    variable keyjid

    if {[dict exists $Keys $keyjid]} {
	dict unset Keys $keyjid
	store $Keys
	[namespace parent]::clear_all_jid $keyjid
    }
    fill_dialog $w
    return
}

# key::generate_key --
#
#	Private procedure which generates and store new DSA private key.
#	Before starting, the dialog controls are disabled, upon finishing,
#	they are enabled again.
#
# Arguments:
#	w	    Dialog window path.
#
# Result:
#	Empty string.
#
# Side effects:
#	New key is generated and stored into the $Keys dictionary and
#	~/.tkabber/otr/keys.xml. JID for which to store the key is taken
#	from the $keyjid variable. Progress is tracking by increasing
#	the $progress variable upon each internal iteration.

proc key::generate_key {w} {
    variable Keys
    variable keyjid
    variable progress

    set L 1024
    set N 160

    $w itemconfigure 0 -state disabled
    set f [$w getframe]
    $f.jid configure -state disabled
    $f.import configure -state disabled
    $f.export configure -state disabled
    $f.gen configure -state disabled
    $f.delete configure -state disabled

    set newkey [::otr::key::generate $L $N]
    incr progress

    if {![dict exists $Keys $keyjid] || [dict get $Keys $keyjid] ne $newkey} {
	dict set Keys $keyjid $newkey
	store $Keys
	[namespace parent]::clear_all_jid $keyjid
    }
    set progress -1
    fill_dialog $w
    $w itemconfigure 0 -state normal
    $f.jid configure -state normal
    return
}

# ::otr::crypto::GenPrimesIteration --
#	A dirty hack which overrides ::otr::crypto::genPrimesIteration and
#	adds a side effect which updates progressbar. This helps not freezing
#	the GUI during DSA private key generation.
#	[subst] substitutes [namespace current].

rename ::otr::crypto::GenPrimesIteration ::otr::crypto::GenPrimesIteration:old

proc ::otr::crypto::GenPrimesIteration {L t q p0 pseed pgen_counter} \
    [subst -novariables {
	incr [namespace current]::key::progress
	update
	::otr::crypto::GenPrimesIteration:old $L $t $q $p0 $pseed $pgen_counter
    }]

