# key.tcl --
#
#       This file is a part of Off-the-record messaging plugin for
#       the Tkabebr XMPP client. It implements interface for private
#       key management (storing, generating, exporting, importing).

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

namespace eval key {
    variable ns http://tkabber.jabber.ru/otr
    variable otrdir [file join $::configdir otr]
    if {![file exists $otrdir]} {
        file mkdir $otrdir
        catch {file attributes $otrdir -permissions 0700}
    }
    # State variable with all key data
    variable 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"] \
              -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 200 \
                      -mode indeterminate
    # HACK: The following configure works for Ttk only. There's no need to
    # switch mode back and forth in Tk.
    catch {$f.pb configure -mode determinate}
    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 %llX $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]
    catch {$f.pb configure -mode indeterminate}
    $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
    catch {$f.pb configure -mode determinate}
    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
    }]

# vim:ft=tcl:ts=8:sw=4:sts=4:et
