#
# PGP functions to query for public keys via WWW
# author: Carl Roth <roth@cse.ucsc.edu>
#
# query the keyserver:
#
#
# 
# Added keyfetching method hkp
# -- Markus Gruber
#

proc Pgp_WWW_Init {} {
global pgp

# preferences
set pgp(pref,keyserver) { keyserver KeyServer "pgp-public-keys@keys.pgp.net"
{Favorite public key server}
"When a signature check fails because of a missing key,
exmh allows you to ask a key server for the key.
Please select a key server that's close to
you so as to spread the load.  Examples include
pgp-public-keys@pgp.mit.edu
pgp-public-keys@keys.pgp.net
pgp-public-keys@keys.us.pgp.net
There are pgp-public-keys@keys.*.pgp.net servers for these domains:
ch de es fi kr nl no uk us pt se hr tw pl
See also http://www.pgp.net/pgpnet/" }
#
set pgp(pref,keyserverUrl) { keyserverUrl KeyServerURL 
{http://keys.pgp.com:11371/pks/lookup?op=get&exact=on&search=0x%s}
{URL to fetch keys interactively}
"The WWW keyserver is forms based.  Enter a URL here where
the key id (sans 0x) is substituted with %s (using format)" }
#
set pgp(pref,keyquerymethod) { keyquerymethod KeyQueryMethod {CHOICE hkp WWW email other}
{Method for querying <label> keys}
"PGP public keys can be queried using email servers
(offline), using WWW servers (interactive)
or the Horowitz Key Protocol.
A user-supplied proc (other) can also be given to fetch the key." }
#
set pgp(pref,keyothermethod) { keyothermethod KeyOtherMethod 
{exec echo "can't find $id" > $tmp} 
{Other method to fetch a <label> key}
"The external method need to fetch the id in \$id and place
it into the temp file \$tmp." }

}

proc Pgp_WWW_QueryKey { v id } {
    global pgp

    # dispatch based on whether we use email or WWW:
    if [info exists pgp($v,keyquerymethod)] {
        switch [set pgp($v,keyquerymethod)] {
            hkp { Pgp_WWW_QueryHKPKey $v $id }
            WWW { Pgp_WWW_QueryWWWKey $v $id }
            email { Pgp_WWW_QueryEmailKey $v $id }
            #email { Pgp_Misc_Send [set pgp($v,keyserver)] "GET 0x$id" }
            default { Pgp_WWW_QueryOtherKey $v $id }
        }
    } else {
        Exmh_Status "No keyserver support for [set pgp($v,fullName)]"
    }
}

proc Pgp_WWW_QueryEmailKey { v id } {
    global pgp

    Exmh_Debug "Pgp_WWW_QueryEmailKey $v $id"

    Exmh_Status "Sending query to get key $id from $pgp($v,keyserver)"
    Pgp_Misc_Send [set pgp($v,keyserver)] "GET 0x$id"
    Exmh_Status "Sent query to get key $id from $pgp($v,keyserver)"
}

proc Pgp_WWW_QueryHKPKey { v id } {
    global pgp

    Exmh_Debug "Pgp_WWW_QueryHKPKey $v $id"

    Exmh_Status "Running [set pgp($v,fullName)] to import key $id via HKP"
    set server [set pgp($v,HKPkeyserverUrl)]
    Pgp_Exec_Batch $v key [subst [set pgp($v,args_HKPimport)]] output
    Exmh_Status "[lindex [split $output \n] end]"
    Exmh_Debug "<Pgp_WWW_QueryHKPKey> $output"
}

proc Pgp_WWW_make_msg {id file} {
    global exmh

    set rcvstore [file dirname $exmh(slocal)]/rcvstore
    set pipe [open "|$rcvstore +$exmh(folder)" w]
    puts $pipe "Mime-Version: 1.0 (generated by exmh)"
    puts $pipe "Content-Type: application/pgp; format=keys-only"
    puts $pipe "Date: [exec date]"
    puts $pipe "From: system"
    puts $pipe "Subject: Output of pgp on id $id"
    puts $pipe ""

    exec cat $file >@$pipe
    close $pipe

    # update the folder listing:
    Flist_FindSeqs
    busy Scan_FolderForce
}

proc Pgp_WWW_QueryStatus {state count length} {
    if {$length} {
	Exmh_Status [format "%s... %.1f%% complete" \
			 $state [expr 100.0 * $count / $length]]
    } else {
	Exmh_Status [format "%s..." $state]
    }
}

proc Pgp_WWW_QueryDone { v url file } {
    global pgp

    upvar #0 $url data
    if {[info exists data(html)]} {
	set fd [open $file w]
	puts -nonewline $fd $data(html)
	close $fd
    }
    set pgp($v,querydone) 1
}

proc Pgp_WWW_QueryWWWKey { v key } {
    global pgp

    set url [format [set pgp($v,keyserverUrl)] $key]
    set pgp($v,querydone) 0
    Exmh_Status "posting query $url"

    set tmp [Mime_TempFile "pgpkey"]
    Http_get $url "Pgp_WWW_QueryDone $v $url $tmp" Pgp_WWW_QueryStatus
    tkwait variable pgp($v,querydone)
    if {[file exists $tmp]} {
	Exmh_Status "Saving key $key"
	if [Pgp_Exec_ExtractKeys $v $tmp out 0] {
	    File_Delete $tmp
	}
    } else {
	Exmh_Status "unable to fetch key!"
    }
}

# query key using an external function
proc Pgp_WWW_QueryOtherKey { v id } {
    global pgp

    Exmh_Status "querying for key \[$id\]..."

    set tmp [Mime_TempFile "pgpkey"]
    set cmd [eval [set pgp($v,keyothermethod)]]
    if {[catch $cmd result]} {
	Exmh_Status [format "unable to get key: %s" \
			 [lindex [split $key "\n"] 0]]
    } else {
	Exmh_Status "filing response"
	Pgp_WWW_make_msg $id $tmp
    }
    File_Delete $tmp
}
