1# pgpInterface.tcl -- 2# created by monnier@didec26.epfl.ch on Mon Dec 12 17:34:38 1994 3 4# 5# 6# 7 8# $Log$ 9# Revision 1.22 2008/06/18 10:06:15 az143 10# patch from debian: added support for gnupg's gpg-agent 11# 12# Revision 1.21 2005/01/01 20:16:20 welch 13# Based on patches from Alexander Zangerl 14# lib/pgpGpg.tcl: 15# lib/pgpPgp5.tcl: 16# fix of an old pgp problem where recipients were duplicated when 17# pgp is run in interactive mode 18# lib/extrasInit.tcl: a small documentation improvement for the 19# pgp(getextcmd) functionality. 20# faces(xfaceProg) gains a default (uncompface -X) 21# lib/pgpExec.tcl: fix for http://bugs.debian.org/164210: multiple gpg 22# subkeys and passphrases. exmh would not ask for the right passphrase. 23# lib/addr.tcl: ldap options gain defaults that are compatible with 24# debian's openldap config 25# lib/mh.tcl: add Msg-Protect and Folder-Protect to the default .mh_profile 26# that is generated when setting up new users. 27# 28# (These changes are inspired by a patch from Alexander, but not the same) 29# lib/inc.tcl: use $install(dir,bin) to specify an absolute path to 30# the inc.expect script 31# lib/seditExtras.tcl: use $install(dir,bin) to specify an absolute path to 32# the exmh-async script 33# lib/mime.tcl: use $install(dir,bin) to specify an absolute path to 34# the ftp.expect script. 35# Also changed MimeMakeBoundary to use [clock seconds] instead of 36# re-writing the output of [exec date]. 37# 38# Revision 1.20 2003/02/18 06:50:43 welch 39# extrasInit.tcl, pgp.tcl - picked up pgp(extpass) patch from Alexander Zangerl 40# flist.tcl - FlistFindSeqsInner added check to eliminate calls to 41# Seq_Set if the sequence information for a folder hasn't changed 42# ftoc.tcl - Changed msgtolinecache and linetomsgcache so that 43# they have no entries for empty ({}) mappings. I was running into 44# a mapping for the last text widget line that didn't contain a message 45# and ended up messing up incremental folder scans 46# Ftoc_MsgNumber doesn't cache anything if there is no mapping 47# Retrieved FtocShowUnseen from exmh-2.5 and use that for the 48# unseen sequence instead of the more general search 49# main.tcl - a slight varition on the fix that slipcon made to the 50# millisecond time stamps. 51# mh.tcl - rooted out an "array unset" that doesn't work in Tcl 8.0 52# thread.tcl - fixed call to Flist_ForgetSequence (changed to Seq_Forget) 53# Minor HTML cleanup, including pointer to the Wiki. 54# I added comments to several files that identify old exmh APIs, including 55# flist.tcl, folder.tcl, mh.tcl, msg.tcl, 56# 57# Revision 1.19 2002/07/16 01:27:54 sysphrog 58# Fixing problems with PGP sign+encrypt, gnupg 1.0.7 support 59# 60# Revision 1.18 2002/05/01 02:24:07 welch 61# A whole collection of patches. If marked with ** then I've lost 62# track of who gave them to me and I apologize for that: 63# exmh-strip.MASTER: added pref initialization to quiet errors caused 64# by changes elsewhere in the main body of exmh 65# install.tcl: fixed errors that occur when you try to display a 66# dialog box (e.g., the Verify window) that is already displayed 67# lib/addr.tcl: a new set of options for configuring LDAP (Mark Bergman) 68# lib/extrasInit.tcl: help text updates about the uquoteAdd resource (**) 69# lib/faces.tcl: fix for space-in-pathname problem (**) 70# lib/fcache.tcl: New Feature! display the count of unseen messages 71# in the folder cache. (Paul Menage) 72# lib/html_get_http.tcl: trap errors from bad http: links 73# lib/inc.tcl: tweaked feedback about inc'ed messages to do case-insensitive 74# grep for Subject: (**) 75# lib/mime.tcl: for for space-in-pathname problem 76# lib/pgpExec.tcl: eliminated Exmh_Debug message that could dump out 77# a massive keyring to the log, taking many many seconds (**) 78# lib/unseenwin.tcl: fix to tolerate space-in-folder-name (I think) (**) 79# 80# Revision 1.17 2001/12/08 00:39:52 kchrist 81# Fixed "GPG silently ignores untrusted keys during encryption" bug. 82# Thanks to Ben Escoto. 83# 84# Revision 1.16 2001/12/06 16:39:13 kchrist 85# Exmh can now parse the GnuPG options file and identify the 86# "default-key" (same as "myname" in PGP). Added "--status-fd 2" to 87# args_decrypt so that the output can be parsed with Pgp_InterpretOutput. 88# 89# Revision 1.15 2000/09/21 15:06:44 valdis 90# Catch PGP stderr so 'Get key' and 'Generate Key' work... 91# 92# Revision 1.14 2000/06/16 18:16:26 valdis 93# Various PGP fixes... 94# 95# Revision 1.13 2000/06/15 17:03:11 valdis 96# Add X-Mailer: change, fix PGP Comment: line... 97# 98# Revision 1.12 2000/04/18 18:38:33 valdis 99# Fix quote character to use ascii rather than iso8859-ish one 100# 101# Revision 1.11 1999/09/27 23:18:45 kchrist 102# More PGP changes. Consolidated passphrase entry to sedit field or 103# pgpExec routine. Made the pgp-sedit field aware of pgp(keeppass) 104# and pgp(echopass). Moved pgp(keeppass), pgp(echopass) and 105# pgp(grabfocus) to PGP General Interface. Fixed a minor bug left 106# over from my previous GUI changes. Made pgp-sedit field appear and 107# disappear based on its enable preference setting. 108# 109# Revision 1.10 1999/09/22 16:36:44 kchrist 110# Changes made to support a different structure under the PGP Crypt... button. 111# Instead of an ON/OFF pgp($v,sign) variable now we use it to specify 112# the form of the signature (none, standard, detached, clear, or w/encrypt). 113# Code changed in several places to support this new variable definition. 114# 115# Updated Sedit.html to include a description of the new interface. 116# 117# Revision 1.9 1999/08/22 18:57:36 bmah 118# Sanitize PGP debugging entries before writing via Exmh_Debug. 119# 120# Revision 1.8 1999/08/13 00:39:05 bmah 121# Fix a number of key/passphrase management problems: pgpsedit now 122# manages PGP versions, keys, and passphrases on a per-window 123# basis. Decryption now works when no passphrases are cached. 124# One timeout parameter controls passphrases for all PGP 125# versions. seditpgp UI slightly modified. 126# 127# Revision 1.7 1999/08/04 22:43:39 cwg 128# Got passphrase timeout to work yet again 129# 130# Revision 1.6 1999/08/04 16:30:17 cwg 131# Don't prompt for a passphrase when we shouldn't. 132# 133# Revision 1.5 1999/08/03 04:05:54 bmah 134# Merge support for PGP2/PGP5/GPG from multipgp branch. 135# 136# Revision 1.4.2.1 1999/06/14 20:05:15 gruber 137# updated multipgp interface 138# 139# Revision 1.4 1999/06/10 16:59:18 cwg 140# Re-enabled the timeout of PGP passwords 141# 142# Revision 1.3 1999/05/04 06:35:38 cwg 143# Fixed crash when aborting out of PGP Password window 144# 145# Revision 1.2 1999/04/10 04:20:08 cwg 146# Do the right thing if pgp(seditpgp) is not enabled. 147# 148# Revision 1.1 1998/05/05 17:55:37 welch 149# Initial revision 150# 151# Revision 1.1 1998/05/05 17:42:59 welch 152# Initial revision 153# 154# Revision 1.11 1998/01/22 00:45:06 bwelch 155# Hack to use aixterm for PGP. 156# 157# Revision 1.10 1997/12/22 20:52:00 bwelch 158# file delete 159# 160# Revision 1.9 1997/07/25 17:13:23 bwelch 161# Fixed pattern match to handle PGP 5.0 date format. 162# 163# Revision 1.8 1997/07/12 23:05:12 bwelch 164# Fixed PGP key extraction from the web servers. 165# Fixed handling of failed signatures so you still see the message. 166# 167# Revision 1.7 1997/06/03 18:29:55 bwelch 168# Added PGP grab-focus and use-expecttk options. 169# Removed +keepbinary=off flag from PGP uses. 170# PGP bin directory is added to the front of PATH, if necessary 171# 172# Revision 1.6 1997/01/25 05:29:23 bwelch 173# Tweaked PgpExec_KeyList that returns a list of keys. 174# Tweaked patterns on PGP output. 175# Added Pgp_ShortenOutput 176# 177# Revision 1.5 1996/12/21 00:57:12 bwelch 178# Log errors from PGP key extraction 179# 180# Revision 1.4 1996/12/01 20:13:59 bwelch 181# Added Pgp_InterpretOutput 182# Added timeouts on password caching. 183# 184# Revision 1.3 1996/03/22 18:42:54 bwelch 185# Added Mh_Rename 186# . 187# 188# Revision 1.2 1995/05/24 05:58:04 bwelch 189# Updates from Stefan 190# 191# Revision 1.1 1995/05/19 17:36:16 bwelch 192# Initial revision 193# 194# Revision 1.2 1995/03/22 19:14:21 welch 195# More new code from Stefan 196# 197# Revision 1.1 1994/12/30 21:49:00 welch 198# Initial revision 199# 200# Revision 1.1 1994/12/17 20:19:16 monnier 201# Initial revision 202# 203 204# execs pgp with the usual flags 205proc Pgp_Exec { v exectype arglist outvar {privatekey {}} {interactive 0} } { 206 global pgp env 207 upvar $outvar output 208 209 Exmh_Debug "Pgp_Exec $v $exectype $arglist $outvar $privatekey $interactive" 210 211 if {![set pgp($v,enabled)]} { 212 error "<[set pgp($v,fullName)]> isn't enabled" 213 } 214 215 set output {} 216 if {![set pgp(keeppass)]} { 217 Pgp_ClearPassword $v 218 } 219 # gnupg agent requested? then batch! 220 if {[set pgp(gpg,useagent)]} { 221 Exmh_Debug "<Pgp_Exec> Pgp_Exec_Batch $v $exectype $arglist output" 222 return [Pgp_Exec_Batch $v $exectype $arglist output] 223 } else { 224 if {$interactive || !([set pgp(keeppass)] || ($privatekey == {}))} { 225 Exmh_Debug "<Pgp_Exec> Pgp_Exec_Interactive $v $exectype $arglist output" 226 return [Pgp_Exec_Interactive $v $exectype $arglist output] 227 } else { 228 if {$privatekey == {}} { 229 Exmh_Debug "<Pgp_Exec> Pgp_Exec_Batch $v $exectype $arglist output" 230 return [Pgp_Exec_Batch $v $exectype $arglist output] 231 } else { 232 Exmh_Debug v=$v 233 234 set keyid [lindex $privatekey 0] 235 Exmh_Debug keyid=$keyid 236 # Check for passphrase. Pgp_GetPass is cache and expire aware! 237 set p [Pgp_GetPass $v $privatekey] 238 #Exmh_Debug "<Pgp_Exec> got passwd >$p<" 239 240 if {[string length $p] == 0} { 241 return 0 242 } 243 Exmh_Debug "<Pgp_Exec> Pgp_Exec_Batch $v $exectype $arglist output \(password\)" 244 return [Pgp_Exec_Batch $v $exectype $arglist output $p] 245 } 246 } 247 } 248} 249 250# batch mode 251proc Pgp_Exec_Batch { v exectype arglist outvar {password {}} } { 252 global pgp exmh errorCode 253 upvar $outvar output 254 255 Exmh_Debug "Pgp_Exec_Batch $v $exectype $arglist $outvar \(password\)" 256 257 set tclcmd [concat exec [set pgp($v,executable,$exectype)] \ 258 [subst [set pgp($v,flags_batch)]] $arglist] 259 260 Exmh_Debug "<Pgp_Exec_Batch> $tclcmd" 261 262 # Set file descriptor for passphrase on stdin 263 if {$password == {}} { 264 Pgp_${v}_PassFdUnset 265 } else { 266 lappend tclcmd << $password 267 Pgp_${v}_PassFdSet 268 } 269 270 set result [catch {eval $tclcmd |& cat} output] 271 Exmh_Debug "<Pgp_Exec_Batch>: Exit status: $result $errorCode" 272 273 # Unset file descriptor for passphrase 274 Pgp_${v}_PassFdUnset 275 276 regsub -all "\x07" $output "" output 277 return $result 278} 279 280# interactive mode 281proc Pgp_Exec_Interactive { v exectype arglist outvar } { 282 global tcl_platform pgp 283 upvar $outvar output 284 285 Exmh_Debug "Pgp_Exec_Interactive $v $exectype $arglist $outvar" 286 287 set pgpcmd [set pgp($v,executable,$exectype)] 288 set args [concat [subst [set pgp($v,flags_interactive)]] $arglist] 289 290 # Be sure, that passphrase isn't read from stdin 291 Pgp_${v}_PassFdUnset 292 293 # Build shellcommand 294 set shcmd " 295 $pgpcmd \"[join [Pgp_Misc_Map x { 296 regsub {([$\"\`])} $x {\\1} x 297 set dummy $x 298 } $args] {" "}]\"; 299 echo 300 echo press Return...; 301 read dummy" 302 303 set logfile [Mime_TempFile "xterm"] 304 if { ( $tcl_platform(os) == "AIX" ) && [ file executable "/usr/bin/X11/aixterm" ] } { 305 set xterm "aixterm" 306 } else { 307 set xterm "xterm" 308 } 309 310 # Hint: XFree86 xterm does not support output logging (Markus) 311 # -l and -lf not supported 312 313 set tclcmd {exec $xterm -l -lf $logfile -title [set pgp($v,fullName)] -e sh -c $shcmd} 314 Exmh_Debug "<Pgp_Exec_Interactive> $tclcmd" 315 set result [catch $tclcmd] 316 if [catch {open $logfile r} log] { 317 set output {} 318 } else { 319 set output [read $log] 320 close $log 321 } 322 323 eval [set pgp($v,cmd_cleanOutput)] 324 325 return $result 326} 327 328proc Pgp_Exec_CheckPassword { v password key } { 329 global pgp 330 331 Exmh_Debug "Pgp_Exec_CheckPassword $v \(password\) $key" 332 333 set in [Mime_TempFile "pwdin"] 334 set out [Mime_TempFile "pwdout"] 335 set filio [open $in w 0600] 336 puts $filio "salut" 337 close $filio 338 set keyid [lindex $key 0] 339 340 Pgp_Exec_Batch $v sign [subst [set pgp($v,args_signClear)]] err $password 341 342 File_Delete $in 343 344 # pgp thinks he knows better how to name files ! 345 if {![file exists $out] && [file exists "$out.asc"]} { 346 Mh_Rename "$out.asc" $out 347 } 348 if {![file exists $out]} { 349 if [regexp [set pgp($v,pat_checkError)] $err x match] { 350 Exmh_Status ?${match}? 351 } 352 Exmh_Debug "<Pgp_Exec_CheckPassword> $err" 353 return 0 354 } else { 355 File_Delete $out 356 return 1 357 } 358} 359 360# returns a list of keys. Each "key" is a list whose first four elements are 361# keyid algo subkeyid algo 362# and the next ones are the corresponding userids 363# {keyid algo subkeyid algo userid userid userid ...} 364proc Pgp_Exec_KeyList { v pattern keyringtype } { 365 global pgp 366 367 Exmh_Debug "Pgp_Exec_Keylist $v $pattern $keyringtype" 368 369 set pattern [string trimleft $pattern "<>|2"] 370 set arglist [subst [set pgp($v,args_list$keyringtype)]] 371 ldelete arglist {} 372 373 Pgp_Exec_Batch $v key $arglist keylist 374 375 Exmh_Debug "<Pgp_Exec_Keylist>: $keylist" 376 377 # drop revoked and noninteresting keys 378 regsub -all [set pgp($v,pat_dropKeys)] $keylist {} keylist 379 380 # Form a list of keys 381 regsub -all [set pgp($v,pat_splitKeys)] $keylist \x81 keylist 382 set keylist [split $keylist \x81] 383 384 # This print statement converts keylist from a Tcl list to 385 # a string. For really big keylists, this is reportedly very expensive 386 # Exmh_Debug "<Pgp_Exec_Keylist>: Splitted keylist: $keylist" 387 388 # Match out interesting keys 389 set keypattern [set pgp($v,pat_key$keyringtype)] 390 391 # subkeyparsing 392 if [info exists pgp($v,pat_key${keyringtype}_sub)] { 393 set subkeypattern [set pgp($v,pat_key${keyringtype}_sub)] 394 } 395 396 # uid parsing 397 set uidpattern [set pgp($v,pat_uid)] 398 399 # grep keys 400 set AllowedToFollow 0 401 set keys {} 402 foreach line $keylist { 403 catch {unset userid} 404 catch {unset keyid} 405 set goodline 0 406 # 407 if {[eval [set pgp($v,cmd_keyMatch)]]} { 408 if {[info exists userids] && [info exists keyids]} { 409 if {[llength $keyids] < 4} { 410 lappend keyids {} {} 411 } 412 lappend keys [concat $keyids $userids] 413 unset keyids 414 unset userids 415 } 416 lappend keyids "0x$keyid" $algo 417 catch {lappend userids $userid} 418 set AllowedToFollow 1 419 set goodline 1 420 } 421 if [info exists subkeypattern] { 422 if {[eval [set pgp($v,cmd_keyMatch_sub)]] && $AllowedToFollow} { 423 lappend keyids "0x$keyid" $algo 424 set goodline 1 425 } 426 } 427 if {[eval [set pgp($v,cmd_uidMatch)]] && $AllowedToFollow} { 428 lappend userids $userid 429 set goodline 1 430 } 431 if {!$goodline} { 432 set AllowedToFollow 0 433 } 434 } 435 if {[info exists userids] && [info exists keyids]} { 436 if {[llength $keyids] < 4} { 437 lappend keyids {} {} 438 } 439 lappend keys [concat $keyids $userids] 440 } 441 442 # keys is of the format { {keyid algo subkeyid algo userid userid} {} {}...} 443 return $keys 444} 445 446# parse config file 447# this is only needed to set pgp($v,myname) 448proc Pgp_Exec_ParseConfigTxt { v file } { 449 global pgp 450 451 Exmh_Debug "Pgp_Exec_ParseConfigTxt $file" 452 453 if [catch {open $file r} in] { 454 return 455 } 456 if {$v != "gpg"} { 457 set pat "^\[ \t]*(\[a-z]+)\[ \t]*=(\[^#]*)" 458 } else { 459 # GnuPG uses space as separator and options may have dashes 460 set pat "^\[ \t]*(\[a-z-]+)\[ \t]*(\[^#]*)" 461 } 462 for {set len [gets $in line]} {$len >= 0} {set len [gets $in line]} { 463 if [regexp -nocase $pat $line {} option value] { 464 set pgp($v,config,[string tolower $option]) [string trim $value " \t\""] 465 } 466 } 467 close $in 468} 469 470 471############### 472# Encrypt/Sign 473 474proc Pgp_Exec_Encrypt { v in out tokeys } { 475 global pgp 476 477 Exmh_Debug "Pgp_Exec_Encrypt $v $in $out $tokeys" 478 479 Pgp_Exec_Batch $v encrypt [subst [set pgp($v,args_encrypt)]] output 480 if {[Pgp_Exec_CheckSuccess $v $out $output "encrypted text"]} { 481 # pgp refuses to generate an encrypted message 482 # if a key was untrusted 483 # interactively proceed 484 catch {file delete $out} 485 Pgp_Exec_Interactive $v encrypt [subst [set pgp($v,args_encrypt)]] output 486 Pgp_Exec_CheckSuccess $v $out $output "encrypted text" 487 } 488} 489 490proc Pgp_Exec_EncryptSign { v in out sigkey tokeys } { 491 global pgp 492 493 Exmh_Debug "Pgp_Exec_EncryptSign $v $in $out $tokeys" 494 495 set keyid [lindex $sigkey 0] 496 Pgp_Exec $v encrypt [subst [set pgp($v,args_encryptSign)]] output $sigkey 497 if {[Pgp_Exec_CheckSuccess $v $out $output "signed and encrypted text"]} { 498 # pgp refuses to generate an encrypted/signed message 499 # if a key was untrusted 500 # interactively proceed 501 catch {file delete $out} 502 Pgp_Exec $v encrypt [subst [set pgp($v,args_encryptSign)]] output $sigkey 1 503 Pgp_Exec_CheckSuccess $v $out $output "signed and encrypted text" 504 } 505} 506 507proc Pgp_Exec_Sign { v in out sigkey opt } { 508 global pgp 509 510 Exmh_Debug "Pgp_Exec_Sign $v $in $out $sigkey $opt" 511 512 set keyid [lindex $sigkey 0] 513 switch $opt { 514 standard {Pgp_Exec $v sign [subst [set pgp($v,args_signBinary)]] output $sigkey} 515 detached {Pgp_Exec $v sign [subst [set pgp($v,args_signDetached)]] output $sigkey} 516 clearsign {Pgp_Exec $v sign [subst [set pgp($v,args_signClear)]] output $sigkey} 517 default {set output "Pgp_Exec_Sign error. Unknown option."} 518 } 519 Pgp_Exec_CheckSuccess $v $out $output "signed text" 520} 521 522# Look if pgp generated pgp code 523proc Pgp_Exec_CheckSuccess {v out output object} { 524 global pgp 525 526 Exmh_Debug "Pgp_Exec_CheckSuccess $v $out $output $object" 527 528 # pgp thinks he knows better how to name files ! 529 if {![file exists $out] && [file exists "$out.asc"]} { 530 Mh_Rename "$out.asc" $out 531 } 532 533 if {$v != "gpg"} { 534 # pgp5 refuses to generate ciphertext in batchmode 535 # if tokey is untrusted 536 if {![file exists $out]} { 537 if {[regexp [set pgp($v,pat_Untrusted)] $output]} { 538 return 1 539 } else { 540 error "[set pgp($v,fullName)] refused to generate the ${object}:\n$output" 541 } 542 } else { 543 return 0 544 } 545 } else { 546 # GnuPG will also not encrypt to a key if it is untrusted but if 547 # any of the encryption keys are trusted a file will be generated 548 if {[regexp "^(.*\n)*gpg:.*no (info|indication)" $output]} { 549 return 1 550 } else { 551 return 0 552 } 553 } 554} 555 556 557################# 558# Decrypt/Verify 559 560# get the key to use for decryption 561proc Pgp_Exec_GetDecryptKey {v in recipients} { 562 global pgp 563 564 Exmh_Debug "Pgp_Exec_GetDecryptKey $v $in $recipients" 565 566 # If the user has time (this doesn't consume more than a half second) 567 # and has set preferences to run pgp twice, 568 # run pgp a first time to get out the decryption keyid 569 set runtwice 0 570 if {[info exists pgp($v,runtwice)] && [set pgp($v,runtwice)]} { 571 set runtwice 1 572 } 573 if {$runtwice} { 574 Exmh_Debug "<Pgp_Exec_GetDecryptKey> Pgp_Exec_GetDecryptKeyid $v $in" 575 set keyid [Pgp_Exec_GetDecryptKeyid $v $in] 576 if {$keyid == {}} { 577 return {} 578 } elseif {[string match $keyid SYM]} { 579 # SYMMETRIC ENCRYPTION 580 set key [list SYM {} {} {} "symmetrically encrypted message"] 581 } else { 582 # One of user's private keys? If so, than use it. 583 # make sure that we look at *all* subkeys 584 foreach key [set pgp($v,privatekeys)] { 585 for {set i 0} {$i<[expr [llength $key]-1]} {incr i 2} { 586 if {[regexp $keyid [lindex $key $i]]} { 587 return $key 588 } 589 } 590 } 591 return {} 592 } 593 } else { 594 set recipients [string tolower $recipients] 595 # Messages get encrypted with the subkey for dsa/elg 596 # I don't know if there are subkeyids in the recipients list if dsa/elg 597 # Lets search for mainkeys 598 set useablekeys [Pgp_Misc_Filter key \ 599 {[string first [string tolower [string range [lindex $key 0] 2 end]] $recipients] >= 0} \ 600 [set pgp($v,privatekeys)]] 601 # If no mainkeys were found, search for subkeys 602 if {[llength $useablekeys] == 0} { 603 set useablekeys [Pgp_Misc_Filter key \ 604 {[string first [string tolower [string range [lindex $key 2] 2 end]] $recipients] >= 0} \ 605 [set pgp($v,privatekeys)]] 606 } 607 set knownkeys [Pgp_Misc_Filter key \ 608 {[info exists pgp($v,pass,[lindex $key 0])]} $useablekeys] 609 610 if {[llength $knownkeys] > 0} { 611 set key [lindex $knownkeys 0] 612 } elseif {[llength $useablekeys] > 0} { 613 set key [lindex $useablekeys 0] 614 } else { 615 set key {} 616 } 617 } 618 return $key 619} 620 621proc Pgp_Exec_GetDecryptKeyid {v in} { 622 global pgp 623 624 Exmh_Debug "Pgp_Exec_GetDecryptKeyid $v $in" 625 626 Pgp_Exec_Batch $v verify [subst [set pgp($v,args_getDecryptKeyid)]] output 627 if {[regexp [set pgp($v,pat_getDecryptKeyid)] $output {} keyid]} { 628 } elseif {[regexp [set pgp($v,pat_getDecryptSym)] $output]} { 629 set keyid SYM 630 } else { 631 Exmh_Debug "<Pgp_Exec_GetDecryptKeyid> No key matches" 632 return {} 633 } 634 Exmh_Debug "<Pgp_Exec_GetDecryptKeyid> keyid $keyid" 635 return $keyid 636} 637 638proc Pgp_Exec_Decrypt { v in out outvar recipients } { 639 global pgp 640 upvar $outvar output 641 642 Exmh_Debug "Pgp_Exec_Decrypt $v $in $out $outvar $recipients" 643 644 set key [Pgp_Exec_GetDecryptKey $v $in $recipients] 645 Exmh_Debug "<Pgp_Exec_Decrypt> $key" 646 647 Pgp_Exec $v verify [subst [set pgp($v,args_decrypt)]] output $key 648} 649 650proc Pgp_Exec_Verify { v in outvar {out {}}} { 651 upvar $outvar output 652 global pgp 653 654 Exmh_Debug "Pgp_Exec_Verify $v $in $outvar $out" 655 656 if {$out == {}} { 657 Exmh_Debug "<Pgp_Exec_VerifyOnly>: Pgp_Exec_Verify $v $in $outvar $out" 658 Pgp_Exec $v verify [subst [set pgp($v,args_verifyOnly)]] output 659 } else { 660 Exmh_Debug "<Pgp_Exec_VerifyOut>: Pgp_Exec_Verify $v $in $outvar $out" 661 Pgp_Exec $v verify [subst [set pgp($v,args_verifyOut)]] output 662 } 663} 664 665proc Pgp_Exec_VerifyDetached { v sig text outvar } { 666 upvar $outvar output 667 global pgp 668 669 Exmh_Debug "Pgp_Exec_VerifyDetached $v $sig $text $outvar" 670 671 Pgp_Exec $v verify [subst [set pgp($v,args_verifyDetached)]] output 672} 673 674################## 675# NOT WITH GNUPG 676# 677# This is called if expectk is enabled. It seemed the best (easiest 678# for me) way to do it was to have this proc terminate when the 679# message is finished displaying just as Exec_Decrypt would do. 680# However, this is a problem for the the expectk script 681# (PgpDecryptExpect), which may need to communicate with exmh to ask 682# for passwords, etc. 683 684# My slow and inelegant solution was to tell exmh-bg all the necessary 685# information and let PgpDecryptExpect communicate with exmh-bg, 686# exiting when done. 687# 688proc Pgp_Exec_DecryptExpect { v infile outfile msgvar } { 689 global exmh exwin sedit pgp 690 upvar $msgvar msg 691 692 # First update exmh-bg arrays. I hope that pgp, getpass, 693 # and exwin will be enough. For exwin seems we have 694 # to temporarily change the mtext error to avoid an error when 695 # the password window is closed and focus is returned to .msg.t 696 697 send $exmh(bgInterp) [list array set pgp [array get pgp]] 698 send $exmh(bgInterp) [list array set getpass [array get getpass]] 699 send $exmh(bgInterp) [list array set sedit [array get sedit]] 700 send $exmh(bgInterp) [list array set exwin [array get exwin]] 701 send $exmh(bgInterp) [list set exwin(mtext) .] 702 703 if [catch {exec $exmh(expectk) -f $exmh(library)/PgpDecryptExpect \ 704 $v $infile $outfile $exmh(bgInterp)} error] { 705 Exmh_Debug "<PGP Exec_DecryptExpect> error: $error" 706 Exmh_Status "Error executing expect process" warn 707 } 708 709 set msg [lindex [send $exmh(bgInterp) {list $pgpmsg}] 0] 710 send $exmh(bgInterp) [list unset pgpmsg] 711 712 # Now reload pass and exwin from exmh-bg 713 foreach index [send $exmh(bgInterp) [list array names pgp $v,pass,*]] { 714 set pgp($index) [send $exmh(bgInterp) [list set pgp($index)]] 715 send $exmh(bgInterp) [list unset pgp($index)] 716 } 717 # The following appears no longer to be necessary, but now I don't see 718 # how to change the position of the getpass window 719 # 720 # set exwin(geometry,.getpass) \ 721 # [send $exmh(bgInterp) list {$exwin(geometry,.getpass)}] 722} 723 724#################### 725 726proc Pgp_Exec_ExtractKeys { v file outvar {interactive 1} } { 727 global env pgp 728 upvar $outvar output 729 730 Exmh_Debug "Pgp_Exec_ExtractKeys $v $file $outvar $interactive" 731 732 set output {} 733 if [Pgp_Exec $v key [subst [set pgp($v,args_importKey)]] output {} $interactive] { 734 Exmh_Status "Key extract failed" 735 Exmh_Debug "<Pgp_Exec_ExtractKeys> $output" 736 return 0 737 } else { 738 Exmh_Debug "<Pgp_Exec_ExtractKeys> $output" 739 return 1 740 } 741} 742 743# Get the passphrase for keyinstance key. We also take care of setting 744# passphrase timeouts. Return a stored passphrase when possible. 745proc Pgp_GetPass { v key } { 746 global pgp 747 748 if {[info exists pgp(extpass)] && [set pgp(extpass)] \ 749 && [info exists pgp(getextcmd)]} { 750 Exmh_Debug "Pgp_GetPass $v $key external" 751 set keyid [lindex $key 0] 752 set cmd [format $pgp(getextcmd) $keyid] 753 while (1) { 754 Exmh_Debug "running cmd $cmd" 755 if [ catch {exec sh -c "$cmd"} result ] { 756 Exmh_Debug "error running cmd: $result" 757 Exmh_Status "Error executing external cmd" warn 758 return {} 759 } else { 760 if {[Pgp_Exec_CheckPassword $v $result $key]} { 761 return $result 762 } else { 763 Exmh_Debug "bad passphrase" 764 if {[info exists pgp(delextcmd)]} { 765 Exmh_Debug "trying to invalidate bad passphrase" 766 if [catch {exec sh -c "[format $pgp(delextcmd) $keyid]"}] { 767 Exmh_Debug "invalidation failed" 768 return {} 769 } 770 } 771 } 772 } 773 } 774 } else { 775 Exmh_Debug "Pgp_GetPass $v $key" 776 777 if {[lsearch -glob [set pgp($v,privatekeys)] "[lindex $key 0]*"] < 0} { 778 return {} 779 } 780 781 # Search the passphrase "cache". Need to set-timeout here in case 782 # the pass phrase was created via the seditpgp entry field. 783 # Because of DecryptExpects asymmetric passphrase storage 784 # we need to look for both mainkey and subkey separately 785 set keyid [lindex $key 0] 786 set subkeyid [lindex $key 2] 787 if {([info exists pgp($v,pass,$keyid)]) && \ 788 ([string length $pgp($v,pass,$keyid)] > 0)} { 789 Pgp_SetPassTimeout $v $keyid 790 if {[string length $subkeyid] > 0} { 791 Pgp_SetPassTimeout $v $subkeyid 792 } 793 return [set pgp($v,pass,$keyid)] 794 } elseif {([string length $subkeyid] > 0) && \ 795 ([info exists pgp($v,pass,$subkeyid)]) && \ 796 ([string length $pgp($v,pass,$subkeyid)] > 0)} { 797 Pgp_SetPassTimeout $v $subkeyid 798 return [set pgp($v,pass,$subkeyid)] 799 } 800 801 # Not in "cache" (or expired) go ask for it. 802 while 1 { 803 Exmh_Debug "Attempt to get passphrase for [lindex $key 0] [lindex $key 1] [lindex $key 4]" 804 if [catch {Pgp_Misc_GetPass $v "Enter [set pgp($v,fullName)] passphrase" \ 805 "Passphrase for [lindex $key 0] [lindex $key 1] [lindex $key 4]"} password] { 806 return {} 807 } elseif {[string match $keyid SYM]} { 808 # SYMMETRIC ENCRYPTION 809 return $password 810 } elseif {[Pgp_Exec_CheckPassword $v $password $key]} { 811 if [set pgp(keeppass)] { 812 set pgp($v,pass,$keyid) $password 813 Pgp_SetPassTimeout $v $keyid 814 # Because of DecryptExpect we need to store passphrase 815 # for mainkey and subkey 816 if {[string length $subkeyid] > 0} { 817 set pgp($v,pass,$subkeyid) $password 818 Pgp_SetPassTimeout $v $subkeyid 819 } 820 } 821 return $password 822 } 823 } 824 } 825} 826 827proc Pgp_SetPassTimeout {v keyid} { 828 global pgp 829 830 if [info exists pgp(timeout,$keyid)] { 831 Exmh_Debug "Cancelling previous timeout for $keyid" 832 after cancel $pgp(timeout,$keyid) 833 unset pgp(timeout,$keyid) 834 } 835 Exmh_Debug "Setting timeout for $keyid ($v) in $pgp(passtimeout) minutes" 836 set pgp(timeout,$keyid) \ 837 [after [expr $pgp(passtimeout) * 60 * 1000] \ 838 [list Pgp_ClearPassword $v $keyid]] 839} 840 841# wipe password away 842proc Pgp_ClearPassword { v {keyid {}} } { 843 global pgp 844 845 if {[string length $keyid] == 0} { 846 foreach index [array names pgp $v,pass*] { 847 Exmh_Debug "Clearing pgp($index)" 848 set pgp($index) {} 849 } 850 set pgp($v,pass,) {} 851 } else { 852 catch {Exmh_Debug "Clearing only pgp($v,pass,$keyid)"} 853 catch {set pgp($v,pass,$keyid) {}} 854 } 855} 856 857proc Pgp_Exec_GetKeys { v keyid file } { 858 global pgp 859 860 Exmh_Debug "Pgp_Exec_GetKeys $v $keyid $file" 861 862 set arglist [subst [set pgp($v,args_exportKey)]] 863 ldelete arglist {} 864 if [Pgp_Exec $v key $arglist msg] { 865 error $msg 866 } else { 867 Pgp_Exec_CheckSuccess $v $file $msg "key block for $keyid" 868 } 869} 870 871# Shutdown Cleanup 872proc Pgp_CheckPoint {} { 873 foreach cmd { Pgp_Match_CheckPoint } { 874 if {[info command $cmd] != {}} { 875 if [catch {$cmd} err] { 876 puts stderr "$cmd: $err" 877 } 878 } 879 } 880} 881 882 883### Init ### 884 885proc Pgp_Exec_Init {} { 886 global env pgp 887 888 Pgp_SetPath 889 890 # needed in pgpMatch 891 if {![info exists env(LOCALHOST)]} { 892 if [catch {exec uname -n} env(LOCALHOST)] { 893 set env(LOCALHOST) localhost 894 } 895 } 896 897 foreach v $pgp(supportedversions) { 898 if {[set pgp($v,enabled)]} { 899 set pgp($v,pass,) {} 900 # Parse config file 901 if { [set pgp($v,parse_config)] } { 902 Pgp_Exec_ParseConfigTxt $v [set pgp($v,configFile)] 903 } 904 if {![file exists [set pgp($v,secring)]]} { 905 set pgp($v,secring) {} 906 } 907 set pgp($v,privatekeys) [Pgp_Exec_KeyList $v $pgp($v,ownPattern) Sec] 908 # GnuPG uses default-key for what PGP uses myname 909 if {![info exists pgp($v,config,myname] && \ 910 [info exists pgp($v,config,default-key)]} { 911 set pgp($v,config,myname) $pgp($v,config,default-key) 912 } 913 # 914 if [info exists pgp($v,config,myname)] { 915 set myname [string tolower [set pgp($v,config,myname)]] 916 foreach key [set pgp($v,privatekeys)] { 917 if {[string first $myname [string tolower $key]] >= 0} { 918 # pgp($v,myname) holds the default key to use 919 # for each version of PGP. It will be used 920 # to initialize pgp($v,myname,$id) in each 921 # sedit window. 922 set pgp($v,myname) $key 923 break 924 } 925 } 926 if {![info exists pgp($v,myname)]} { 927 if [catch {Pgp_Match_Simple $v [set pgp($v,config,myname)] Sec} key] { 928 tk_messageBox -type ok -icon warning \ 929 -title "[set pgp($v,fullName)] Init" \ 930 -message "The name specified in your [set pgp($v,fullName)] config file couldn't be unambiguously found in your key rings !" 931 set pgp($v,myname) {} 932 } else { 933 set pgp($v,myname) $key 934 } 935 } 936 } else { 937 set pgp($v,myname) [lindex [set pgp($v,privatekeys)] 0] 938 } 939 } 940 } 941} 942