1# $Id$ 2 3namespace eval ::ssj {} 4 5############################################################################# 6# Draw icons aside encrypted messages even if no GPG support 7 8proc ::ssj::draw_encrypted {chatid from type body x} { 9 # we already deciphered it in rewrite_message_hook 10 11 set chatw [chat::chat_win $chatid] 12 13 foreach xe $x { 14 ::xmpp::xml::split $xe tag xmlns attrs cdata subels 15 16 if {![string equal $xmlns $::NS(encrypted)]} { 17 continue 18 } 19 20 if {[string equal $cdata ""] || \ 21 [string equal [info commands ::ssj::encrypted:input] ""]} { 22 $chatw image create end -image gpg/badencrypted 23 } else { 24 $chatw image create end -image gpg/encrypted 25 } 26 break 27 } 28} 29 30hook::add draw_message_hook ::ssj::draw_encrypted 6 31 32############################################################################# 33 34proc ::ssj::process_x_encrypted {rowvar bodyvar f x xlib from id type replyP} { 35 upvar 2 $rowvar row 36 upvar 2 $bodyvar body 37 38 if {!$replyP || [string equal $type error]} { 39 return 40 } 41 42 foreach xa $x { 43 ::xmpp::xml::split $xa tag xmlns attrs cdata subels 44 45 if {$xmlns != $::NS(encrypted)} continue 46 47 # we already deciphered it in rewrite_message_hook 48 set lb [join [lrange [split $f .] 0 end-1] .].title.encrypted 49 if {[winfo exists $lb]} { 50 destroy $lb 51 } 52 53 if {[string equal $cdata ""] || \ 54 [string equal [info commands ::ssj::encrypted:input] ""]} { 55 Label $lb -image gpg/badencrypted 56 } else { 57 Label $lb -image gpg/encrypted 58 } 59 grid $lb -row 1 -column 3 -sticky e 60 } 61 62 return 63} 64 65hook::add message_process_x_hook ::ssj::process_x_encrypted 21 66 67############################################################################# 68 69if {[catch {package require gpg}]} { 70 debugmsg ssj "unable to load the GPG package, so no crypto!" 71 return 72} 73 74namespace eval ::ssj { 75 variable options 76 77 custom::defgroup GPG [::msgcat::mc "GPG options (signing and encryption)."] \ 78 -group Tkabber 79 80 custom::defvar options(one-passphrase) 1 \ 81 [::msgcat::mc "Use the same passphrase for signing and decrypting messages."] \ 82 -group GPG -type boolean 83 84 custom::defvar options(sign-traffic) 0 \ 85 [::msgcat::mc "GPG-sign outgoing presence updates."] \ 86 -group GPG -type boolean 87 88 custom::defvar options(sign-personal-messages) 0 \ 89 [::msgcat::mc "GPG-sign outgoing personal messages."] \ 90 -group GPG -type boolean 91 92 custom::defvar options(sign-groupchat-messages) 0 \ 93 [::msgcat::mc "GPG-sign outgoing groupchat messages."] \ 94 -group GPG -type boolean 95 96 custom::defvar options(encrypt-traffic) 0 \ 97 [::msgcat::mc "GPG-encrypt outgoing messages where possible."] \ 98 -group GPG -type boolean 99 100 custom::defvar options(prevent-replay-attack) 1 \ 101 [::msgcat::mc "Add your JID and timestamp to the GPG-signed outgoing messages\ 102 or presence updates. This prevents replay attacks, but shows\ 103 your JID in every message or presence status."] \ 104 -group GPG -type boolean 105 106 custom::defvar options(key) "" \ 107 [::msgcat::mc "Use specified key ID for signing and decrypting messages."] \ 108 -group GPG -type string 109 110 custom::defvar options(display_sig_warnings) 1 \ 111 [::msgcat::mc "Display warning dialogs when signature verification fails."] \ 112 -group GPG -type boolean 113} 114 115 116package require base64 117 118 119namespace eval ::ssj { 120 variable ctx 121 variable e4me 122 variable j2k 123 variable options 124 variable passphrase 125 variable s2e 126 variable signers 127 variable warnings 128 variable gpg_error_id 0 129 130 array set ctx {} 131 132 array set j2k {} 133 134 array set options {} 135 136 array set passphrase {} 137 138 array set s2e \ 139 [list none [::msgcat::mc "No information available"] \ 140 bad [::msgcat::mc "Invalid signature"] \ 141 nokey [::msgcat::mc "Signature not processed due to missing key"] \ 142 nosig [::msgcat::mc "Malformed signature block"] \ 143 error [::msgcat::mc "Error in signature processing"] \ 144 diff [::msgcat::mc "Multiple signatures having different authenticity"] \ 145 expired [::msgcat::mc "The signature is good but has expired"] \ 146 expiredkey [::msgcat::mc "The signature is good but the key has expired"]] 147 148 catch {unset warnings} 149 array set warnings {} 150 151 variable signedid 0 152} 153 154 155proc ::ssj::once_only {xlib} { 156 global env 157 variable options 158 variable ctx 159 160 debugmsg ssj "ONCE_ONLY $xlib" 161 162 if {[info exists ctx($xlib)] && ![string equal $ctx($xlib) ""]} { 163 return 164 } 165 166 set ctx($xlib) [gpg::new] 167 $ctx($xlib) set -property armor \ 168 -value true 169 $ctx($xlib) set -property encoding \ 170 -value utf-8 171 172 if {![info exists env(GPG_AGENT_INFO)]} { 173 $ctx($xlib) set -property passphrase-callback \ 174 -value [list ::ssj::passphrase $xlib] 175 } 176 177 set pattern [connection_bare_jid $xlib] 178 179 set firstP 1 180 if {$options(key) != ""} { 181 set patterns [list $options(key)] 182 } else { 183 set patterns {} 184 } 185 lappend patterns $pattern "" 186 foreach p $patterns { 187 set command [list $ctx($xlib) list-keys -secretonly true] 188 if {![string equal $p ""]} { 189 lappend command -patterns [list $p] 190 } 191 set keys [eval $command] 192 193 if {[llength $keys] > 0} { 194 break 195 } 196 if {[string equal $p ""]} { 197 return 198 } 199 set firstP 0 200 } 201 202 switch -- [llength $keys] { 203 0 { 204 return 205 } 206 207 1 { 208 if {$firstP} { 209 e4meP $xlib $keys 210 return 211 } 212 } 213 214 default { 215 } 216 } 217 218 set dw .selectkey[psuffix $xlib] 219 catch {destroy $dw} 220 221 set titles {} 222 set balloons {} 223 foreach key $keys { 224 set key_info [$ctx($xlib) info-key -key $key] 225 foreach {k v} $key_info { 226 if {[string equal $k email]} { 227 lappend titles $key $v 228 lappend balloons $key [key_balloon_text $key_info] 229 break 230 } 231 } 232 foreach {k v} [$ctx($xlib) info-key -key $key] { 233 if {![string equal $k subkeys]} { 234 continue 235 } 236 237 foreach subkey $v { 238 foreach {k1 v1} $subkey { 239 if {[string equal $k1 email]} { 240 lappend titles $key $v1 241 lappend balloons $key [key_balloon_text $subkey] 242 break 243 } 244 } 245 } 246 } 247 } 248 249 CbDialog $dw [::msgcat::mc "Select Key for Signing %s Traffic" $pattern] \ 250 [list [::msgcat::mc "Select"] "::ssj::once_only_aux $dw $xlib" \ 251 [::msgcat::mc "Cancel"] "destroy $dw"] \ 252 ::ssj::selectkey[psuffix $xlib] $titles $balloons \ 253 -modal local 254} 255 256proc ::ssj::key_balloon_text {key} { 257 array set params $key 258 if {[catch {format "%d%s/%s %s" $params(length) \ 259 [string range $params(algorithm) 0 0] \ 260 [string range $params(keyid) end-7 end] \ 261 [clock format $params(created) \ 262 -format "%Y-%m-%d"]} text]} { 263 return "" 264 } 265 266 foreach {k v} $key { 267 switch -- $k { 268 userid { 269 append text [format "\n\t%s" $v] 270 } 271 } 272 } 273 return $text 274} 275 276proc ::ssj::once_only_aux {dw xlib} { 277 variable selectkey[psuffix $xlib] 278 279 set keys {} 280 foreach key [array names selectkey[psuffix $xlib]] { 281 if {[set selectkey[psuffix $xlib]($key)]} { 282 lappend keys $key 283 } 284 } 285 286 destroy $dw 287 288 if {[llength $keys] > 0} { 289 e4meP $xlib $keys 290 } 291} 292 293 294proc ::ssj::passphrase {xlib data} { 295 variable passphrase 296 variable options 297 298 array set params $data 299 300 if {!$options(one-passphrase)} { 301 set params(keyid) $params(subkeyid) 302 } 303 set keyid $params(keyid) 304 305 if {([string equal $params(hint) enter]) && \ 306 [info exists passphrase($keyid)] && \ 307 ![string equal $passphrase($keyid) ""]} { 308 return $passphrase($keyid) 309 } 310 311 set pw .passphrase[psuffix $xlib] 312 if {[winfo exists $pw]} { 313 destroy $pw 314 } 315 316 set title [::msgcat::mc "Please enter passphrase"] 317 switch -- $params(hint) { 318 enter { 319 } 320 321 try_again { 322 set title [::msgcat::mc "Please try again"] 323 } 324 325 default { 326 append title ": " $params(hint) 327 } 328 } 329 Dialog $pw -title $title -separator 1 -anchor e -default 0 -cancel 1 330 331 set pf [$pw getframe] 332 grid columnconfigure $pf 1 -weight 1 333 334 foreach {k v} [list keyid [::msgcat::mc "Key ID"] \ 335 userid [::msgcat::mc "User ID"]] { 336 label $pf.l$k -text ${v}: 337 entry $pf.$k 338 $pf.$k insert 0 $params($k) 339 if {[string length $params($k)] <= 72} { 340 $pf.$k configure -width 0 341 } 342 if {[info tclversion] >= 8.4} { 343 set bgcolor [lindex [$pf.$k configure -background] 4] 344 $pf.$k configure -state readonly -readonlybackground $bgcolor 345 } else { 346 $pf.$k configure -state disabled 347 } 348 } 349 350 label $pf.lpassword -text [::msgcat::mc "Passphrase:"] 351 entry $pf.password \ 352 -textvariable ::ssj::passphrase($xlib,$keyid) \ 353 -show * 354 set passphrase($xlib,$keyid) "" 355 356 grid $pf.lkeyid -row 0 -column 0 -sticky e 357 grid $pf.keyid -row 0 -column 1 -sticky ew 358 grid $pf.luserid -row 1 -column 0 -sticky e 359 grid $pf.userid -row 1 -column 1 -sticky ew 360 grid $pf.lpassword -row 2 -column 0 -sticky e 361 grid $pf.password -row 2 -column 1 -sticky ew 362 363 $pw add -text [::msgcat::mc "OK"] -command "$pw enddialog 0" 364 $pw add -text [::msgcat::mc "Cancel"] -command "$pw enddialog 1" 365 366 set abort [$pw draw $pf.password] 367 368 destroy $pw 369 370 if {!$abort} { 371 set passphrase($keyid) $passphrase($xlib,$keyid) 372 unset passphrase($xlib,$keyid) 373 return $passphrase($keyid) 374 } else { 375 return -code break 376 } 377} 378 379 380proc ::ssj::armor:encode {text} { 381 if {[set x [string first "\n\n" $text]] >= 0} { 382 set text [string range $text [expr {$x + 2}] end] 383 } 384 if {[set x [string first "\n-----" $text]] > 0} { 385 set text [string range $text 0 [expr {$x - 1}]] 386 } 387 388 return $text 389} 390 391proc ::ssj::armor:decode {text} { 392 return "-----BEGIN PGP MESSAGE-----\n\n$text\n-----END PGP MESSAGE-----" 393} 394 395proc ::ssj::signed:input {xlib from signature data what} { 396 variable ctx 397 variable j2k 398 variable s2e 399 variable warnings 400 variable options 401 402 once_only $xlib 403 404 if {[catch {$ctx($xlib) verify \ 405 -input $data \ 406 -signature [armor:decode $signature]} result]} { 407 debugmsg ssj "verify processing error ($xlib): $result ($from)" 408 409 if {![info exists warnings(verify-traffic,$xlib)]} { 410 set warnings(verify-traffic,$xlib) 1 411 hook::run gpg_input_error_hook $xlib $from software \ 412 [::msgcat::mc "Error in signature verification software: %s." \ 413 $result] 414 } 415 416 set params(reason) $result 417 418 return [array get params] 419 } 420 421 debugmsg ssj "VERIFY: $xlib $from ($data); $result" 422 423 array set params $result 424 set result $params(status) 425 426 set signatures {} 427 foreach signature $params(signatures) { 428 catch {unset sparams} 429 array set sparams $signature 430 431 if {[info exists sparams(key)]} { 432 set sparams(key) [$ctx($xlib) info-key -key $sparams(key)] 433 foreach {k v} $sparams(key) { 434 switch -- $k { 435 keyid { 436 set j2k($from) $v 437 break 438 } 439 subkeys { 440 foreach subkey $v { 441 catch {unset kparams} 442 array set kparams $subkey 443 if {[info exists kparams(keyid)]} { 444 set j2k($from) $kparams(keyid) 445 break 446 } 447 } 448 } 449 } 450 } 451 } 452 453 lappend signatures [array get sparams] 454 } 455 catch {unset params} 456 array set params [list signatures $signatures] 457 458 if {![string equal $result good]} { 459 if {[info exists s2e($result)]} { 460 set result $s2e($result) 461 } 462 set params(reason) $result 463 464 if {![info exists warnings(verify,$from)] && $options(display_sig_warnings)} { 465 set warnings(verify,$from) 1 466 hook::run gpg_input_error_hook $xlib $from $what \ 467 [::msgcat::mc "%s purportedly signed by %s can't be verified: %s." \ 468 $what $from $result] 469 } 470 } 471 472 return [array get params] 473} 474 475 476proc ::ssj::signed:output {xlib data args} { 477 variable ctx 478 variable options 479 variable warnings 480 variable gpg_error_id 481 482 if {[llength $args] == 0} { 483 # Presence 484 if {!$options(sign-traffic)} return 485 } else { 486 # Message 487 set to [lindex $args 0] 488 set chatid [chat::chatid $xlib $to] 489 if {[chat::is_groupchat $chatid]} { 490 if {!$options(sign-groupchat-messages)} return 491 } else { 492 if {!$options(sign-personal-messages)} return 493 } 494 } 495 496 once_only $xlib 497 498 if {[catch {$ctx($xlib) sign -input $data \ 499 -mode detach} result]} { 500 set options(sign-traffic) 0 501 set options(sign-personal-messages) 0 502 set options(sign-groupchat-messages) 0 503 504 debugmsg ssj "signature processing error ($xlib): $result ($data)" 505 506 if {[llength $args] == 0} { 507 set buttons ok 508 set cancel 0 509 set message [::msgcat::mc "Unable to sign presence information:\ 510 %s.\n\nPresence will be sent, but\ 511 signing traffic is now disabled." $result] 512 } else { 513 set buttons {ok cancel} 514 set cancel 1 515 set message [::msgcat::mc "Unable to sign message body:\ 516 %s.\n\nSigning traffic is now\ 517 disabled.\n\nSend it WITHOUT a signature?"\ 518 $result] 519 } 520 521 incr gpg_error_id 522 if {[MessageDlg .sign_error$gpg_error_id -aspect 50000 -icon error -type user \ 523 -buttons $buttons -default 0 -cancel $cancel \ 524 -message $message]} { 525 error "" 526 } 527 528 return 529 } 530 set result [armor:encode $result] 531 532 debugmsg ssj "SIGN: $data; $result" 533 whichkeys $xlib sign 534 535 return $result 536} 537 538proc ::ssj::signed:info {pinfo} { 539 540 set text "" 541 array set params $pinfo 542 543 foreach {k v} $pinfo { 544 if {![string equal $k signatures]} { 545 if {![string equal $v ""]} { 546 append text [format "%s: %s\n" $k $v] 547 } 548 } 549 } 550 551 foreach signature $params(signatures) { 552 set info "" 553 set addrs "" 554 set s "" 555 foreach {k v} $signature { 556 switch -- $k { 557 key { 558 foreach {k v} $v { 559 if {![string equal $k subkeys]} { 560 continue 561 } 562 foreach subkey $v { 563 catch {unset sparams} 564 array set sparams $subkey 565 if {[info exists sparams(email)]} { 566 append addrs $s $sparams(email) 567 set s "\n " 568 } 569 } 570 } 571 } 572 created { 573 append info "created: [clock format $v]\n" 574 } 575 expires { 576 append info "expires: [clock format $v]\n" 577 } 578 fingerprint { 579 append info [format "keyid: 0x%s\n" [string range $v end-7 end]] 580 append info [format "%s: %s\n" $k $v] 581 } 582 default { 583 if {![string equal $v ""]} { 584 append info [format "%s: %s\n" $k $v] 585 } 586 } 587 } 588 } 589 590 if {![string equal $addrs ""]} { 591 set info "email: $addrs\n$info" 592 } 593 if {![string equal $info ""]} { 594 append text "\n" [string trimright $info] 595 } 596 } 597 598 return [string trimleft $text] 599} 600 601proc ::ssj::signed:Label {lb xlib jid pinfo} { 602 if {[set rjid [muc::get_real_jid $xlib $jid]] == ""} { 603 set rjid [::xmpp::jid::stripResource $jid] 604 } else { 605 set rjid [::xmpp::jid::stripResource $rjid] 606 } 607 608 array set params $pinfo 609 610 set checks {} 611 set trust 0 612 foreach signature $params(signatures) { 613 set emails {} 614 set valid 0 615 foreach {k v} $signature { 616 switch -- $k { 617 key { 618 foreach {k v} $v { 619 if {![string equal $k subkeys]} { 620 continue 621 } 622 foreach subkey $v { 623 catch {unset sparams} 624 array set sparams $subkey 625 if {[info exists sparams(email)]} { 626 lappend emails $sparams(email) 627 } 628 } 629 } 630 } 631 validity { 632 switch -- $v { 633 ultimate - 634 full - 635 marginal { 636 set valid 1 637 } 638 never - 639 undefined - 640 unknown - 641 default { 642 set valid 0 643 } 644 } 645 } 646 } 647 } 648 if {$valid && ([lsearch -exact $emails $rjid] >= 0)} { 649 set trust 1 650 break 651 } 652 } 653 654 if {[info exists params(reason)]} { 655 set args [list -image gpg/badsigned] 656 } elseif {$trust} { 657 set args [list -image gpg/signed] 658 } else { 659 set args [list -image gpg/vsigned] 660 } 661 662 if {![string equal [set info [signed:info $pinfo]] ""]} { 663 lappend args -helptext $info -helptype balloon 664 } 665 666 eval [list Label $lb] $args -cursor arrow \ 667 -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 668 669 if {[info exists params(reason)] && [string equal $params(reason) nokey]} { 670 bind $lb <<ContextMenu>> [list ::ssj::signed:popup [double% $pinfo]] 671 } 672 return $lb 673} 674 675############################################################################### 676 677proc ::ssj::signed:popup {pinfo} { 678 set m .signed_label_popupmenu 679 if {[winfo exists $m]} { 680 destroy $m 681 } 682 menu $m -tearoff 0 683 $m add command -label [::msgcat::mc "Fetch GPG key"] \ 684 -command [list ::ssj::fetchkeys $pinfo] 685 tk_popup $m [winfo pointerx .] [winfo pointery .] 686} 687 688proc ::ssj::signed:user_menu {m xlib jid} { 689 variable signed 690 691 if {[info exists signed($xlib,$jid)]} { 692 array set params $signed($xlib,$jid) 693 if {[info exists params(status)] && [string equal $params(status) nokey]} { 694 $m add command -label [::msgcat::mc "Fetch GPG key"] \ 695 -command [list ::ssj::fetchkeys \ 696 $signed($xlib,$jid)] 697 } 698 } 699} 700 701hook::add chat_create_user_menu_hook ::ssj::signed:user_menu 78 702 703############################################################################### 704 705proc ::ssj::fetchkeys {pinfo} { 706 variable gpg_error_id 707 708 array set params $pinfo 709 710 set keyids {} 711 foreach signature $params(signatures) { 712 catch {unset sparams} 713 array set sparams $signature 714 715 if {[info exists sparams(fingerprint)]} { 716 lappend keyids [string range $sparams(fingerprint) end-7 end] 717 } 718 } 719 set res [catch {set output [eval [list exec gpg --recv-keys] $keyids]} errMsg] 720 incr gpg_error_id 721 if {$res} { 722 NonmodalMessageDlg .keyfetch_ok$gpg_error_id -aspect 50000 -icon error \ 723 -message "Key fetch error\n\n$errMsg" 724 } else { 725 NonmodalMessageDlg .keyfetch_error$gpg_error_id -aspect 50000 -icon info \ 726 -message "Key fetch result\n\n$output" 727 } 728} 729 730############################################################################### 731 732proc ::ssj::rewrite_message_body \ 733 {vxlib vfrom vid vtype vis_subject vsubject vbody verr vthread vpriority vx} { 734 upvar 2 $vxlib xlib 735 upvar 2 $vfrom from 736 upvar 2 $vbody body 737 upvar 2 $vx x 738 739 set badenc 0 740 set xs {} 741 foreach xe $x { 742 ::xmpp::xml::split $xe tag xmlns attrs cdata subels 743 744 if {![string equal $xmlns $::NS(encrypted)]} { 745 lappend xs $xe 746 } elseif {[string equal $cdata ""]} { 747 # in case the sender didn't check the exit code from gpg we ignore 748 # jabber:x:encrypted 749 } elseif {[catch {ssj::encrypted:input $xlib $from $cdata} msg]} { 750 set body [::msgcat::mc ">>> Unable to decipher data: %s <<<" $msg] 751 # Add empty x tag to show problems with gpg 752 lappend xs [::xmpp::xml::create x -xmlns $::NS(encrypted)] 753 set badenc 1 754 } else { 755 set body $msg 756 lappend xs $xe 757 } 758 } 759 760 set x $xs 761 762 if {$badenc} { 763 # if decryption failed, then remove signature. It can't be correct. 764 765 set xs {} 766 foreach xe $x { 767 ::xmpp::xml::split $xe tag xmlns attrs cdata subels 768 769 if {![string equal $xmlns $::NS(signed)]} { 770 lappend xs $xe 771 } 772 } 773 set x $xs 774 } else { 775 # Check the signature before some other plugin rewrites the message body 776 777 set xs {} 778 foreach xe $x { 779 ::xmpp::xml::split $xe tag xmlns attrs cdata subels 780 781 if {![string equal $xmlns $::NS(signed)]} { 782 lappend xs $xe 783 } else { 784 # in case the sender didn't check the exit code from gpg... 785 if {![string equal $cdata ""]} { 786 # Create special tag with signature info 787 lappend xs [::xmpp::xml::create "" -xmlns $::NS(signed) \ 788 -attrs [signed:input $xlib $from $cdata $body \ 789 [::msgcat::mc "Message body"]]] 790 } 791 } 792 } 793 set x $xs 794 } 795 return 796} 797 798hook::add rewrite_message_hook ::ssj::rewrite_message_body 70 799 800############################################################################### 801 802proc ::ssj::encrypted:input {xlib from data} { 803 variable ctx 804 variable warnings 805 variable gpg_error_id 806 807 once_only $xlib 808 809 if {[catch {$ctx($xlib) decrypt -input [armor:decode $data]} result]} { 810 debugmsg ssj "decryption processing error ($xlib): $result ($from)" 811 812 if {![info exists warnings(decrypt,$from)]} { 813 set warnings(decrypt,$from) 1 814 incr gpg_error_id 815 after idle [list NonmodalMessageDlg .decrypt_error$gpg_error_id -aspect 50000 -icon error \ 816 -message [::msgcat::mc "Data purported sent by %s can't be deciphered.\n\n%s." \ 817 $from $result]] 818 } 819 820 error $result 821 } 822 823 debugmsg ssj "DECRYPT: $xlib; $from; $result" 824 825 array set params $result 826 return $params(plaintext) 827} 828 829 830proc ::ssj::encrypted:output {xlib data to} { 831 variable ctx 832 variable e4me 833 variable j2k 834 variable options 835 variable gpg_error_id 836 837 if {[string equal $data ""]} { 838 return 839 } 840 841 if {![encryptP $xlib $to]} { 842 return 843 } 844 845 set bto [::xmpp::jid::stripResource $to] 846 847 if {[info exists j2k($to)]} { 848 set name $j2k($to) 849 } elseif {[llength [set k [array names j2k $to/*]]] > 0} { 850 set name $j2k([lindex $k 0]) 851 } else { 852 set name $bto 853 } 854 855 set recipient [gpg::recipient] 856 $recipient add -name $name \ 857 -validity full 858 foreach signer $e4me($xlib) { 859 $recipient add -name $signer \ 860 -validity full 861 } 862 863 once_only $xlib 864 865 set code \ 866 [catch { 867 $ctx($xlib) encrypt -input $data \ 868 -recipients $recipient 869 } result] 870 871 $recipient free 872 873 if {$code} { 874 debugmsg ssj "encryption processing error ($xlib): $result ($data)" 875 876 set options(encrypt,$xlib,$to) 0 877 incr gpg_error_id 878 if {[MessageDlg .encrypt_error$gpg_error_id \ 879 -aspect 50000 \ 880 -icon error \ 881 -type user \ 882 -buttons {ok cancel} \ 883 -default 0 \ 884 -cancel 1 \ 885 -message [::msgcat::mc \ 886 "Unable to encipher data for %s:\ 887 %s.\n\nEncrypting traffic to this user is\ 888 now disabled.\n\nSend it as PLAINTEXT?" \ 889 $to $result]]} { 890 error "" 891 } 892 893 return 894 } 895 set result [armor:encode $result] 896 897 debugmsg ssj "ENCRYPT: $xlib; $data; $result" 898 899 return $result 900} 901 902proc ::ssj::whichkeys {xlib what} { 903 variable ctx 904 variable warnings 905 906 if {[catch {$ctx($xlib) set -property last-op-info} s]} { 907 return 908 } 909 910 set keys {} 911 while {([set x [string first <fpr> $s]] > 0) \ 912 && ([set y [string first </fpr> $s]] > $x) \ 913 && ($x+45 == $y)} { 914 lappend keys [string range $s [expr {$x + 20}] [expr {$y - 1}]] 915 set s [string range $s $y end] 916 } 917 918 if {![info exists warnings($what)]} { 919 set warnings($what) "" 920 } elseif {[string equal $warnings($what) $keys]} { 921 return 922 } 923 924 set warnings($what) $keys 925 debugmsg ssj "${what}ing with $keys" 926} 927 928############################################################################# 929 930proc ::ssj::prefs {xlib jid} { 931 variable ctx 932 variable options 933 variable optionsX 934 935 set w [win_id security_preferences [list $xlib $jid]] 936 937 if {[winfo exists $w]} { 938 focus -force $w 939 return 940 } 941 942 Dialog $w \ 943 -title [::msgcat::mc "Change security preferences for %s" $jid] \ 944 -separator 1 -anchor e -default 0 -cancel 1 945 946 $w add -text [::msgcat::mc "OK"] \ 947 -command [list ::ssj::prefs_ok $w $xlib $jid] 948 $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w] 949 950 set f [$w getframe] 951 952 if {![info exists options(encrypt,$xlib,$jid)]} { 953 set options(encrypt,$xlib,$jid) [encryptP $xlib $jid] 954 } 955 956 set optionsX(encrypt,$xlib,$jid) $options(encrypt,$xlib,$jid) 957 checkbutton $f.encrypt \ 958 -text [::msgcat::mc "Encrypt traffic"] \ 959 -variable ::ssj::optionsX(encrypt,$xlib,$jid) 960 961 pack $f.encrypt -side left 962 pack [frame $f.f -width 9c -height 2c] 963 964 $w draw $f.name 965} 966 967proc ::ssj::prefs_ok {w xlib jid} { 968 variable options 969 variable optionsX 970 971 set options(encrypt,$xlib,$jid) $optionsX(encrypt,$xlib,$jid) 972 973 destroy $w 974} 975 976proc ::ssj::prefs_user_menu {m xlib jid} { 977 $m add command -label [::msgcat::mc "Edit security..."] \ 978 -command [list ::ssj::prefs $xlib $jid] 979} 980 981hook::add chat_create_user_menu_hook ::ssj::prefs_user_menu 78 982hook::add roster_conference_popup_menu_hook ::ssj::prefs_user_menu 78 983hook::add roster_service_popup_menu_hook ::ssj::prefs_user_menu 78 984hook::add roster_jid_popup_menu_hook ::ssj::prefs_user_menu 78 985 986############################################################################# 987 988proc ::ssj::signP {} { 989 variable options 990 991 return $options(sign-traffic) 992} 993 994proc ::ssj::encryptP {xlib jid} { 995 variable ctx 996 variable j2k 997 variable options 998 999 if {[string equal $jid ""]} { 1000 return $options(encrypt-traffic) 1001 } 1002 1003 lassign [roster::get_category_and_subtype $xlib $jid] \ 1004 category subtype 1005 switch -- $category { 1006 conference - 1007 server - 1008 gateway - 1009 service { 1010 set resP 0 1011 } 1012 1013 default { 1014 set resP 1 1015 } 1016 } 1017 1018 set bjid [::xmpp::jid::stripResource $jid] 1019 1020 if {[info exists options(encrypt,$xlib,$jid)]} { 1021 return $options(encrypt,$xlib,$jid) 1022 } elseif {[info exists options(encrypt,$xlib,$bjid)]} { 1023 return $options(encrypt,$xlib,$bjid) 1024 } elseif {[info exists options(encrypt,$jid)]} { 1025 return $options(encrypt,$jid) 1026 } elseif {[info exists options(encrypt,$bjid)]} { 1027 return $options(encrypt,$jid) 1028 } 1029 1030 if {!$options(encrypt-traffic)} { 1031 return 0 1032 } 1033 1034 if {[info exists options(encrypt-tried,$xlib,$jid)]} { 1035 return $options(encrypt-tried,$xlib,$jid) 1036 } 1037 1038 once_only $xlib 1039 1040 if {[info exists j2k($jid)]} { 1041 set name $j2k($jid) 1042 } elseif {($resP) && ([llength [set k [array names j2k $jid/*]]] > 0)} { 1043 set name $j2k([lindex $k 0]) 1044 } else { 1045 set name $bjid 1046 } 1047 1048 [set recipient [gpg::recipient]] add \ 1049 -name $name \ 1050 -validity full 1051 1052 if {[catch {$ctx($xlib) encrypt -input "Hello world." \ 1053 -recipients $recipient}]} { 1054 set options(encrypt-tried,$xlib,$jid) 0 1055 } else { 1056 set options(encrypt-tried,$xlib,$jid) 1 1057 } 1058 1059 $recipient free 1060 1061 return $options(encrypt-tried,$xlib,$jid) 1062} 1063 1064############################################################################# 1065 1066proc ::ssj::e4meP {xlib keys} { 1067 variable ctx 1068 variable e4me 1069 variable signers 1070 1071 $ctx($xlib) set -property signers \ 1072 -value [set signers($xlib) $keys] 1073 1074 set e4me($xlib) {} 1075 foreach signer $signers($xlib) { 1076 [set recipient [gpg::recipient]] add \ 1077 -name $signer \ 1078 -validity full 1079 1080 if {![catch {$ctx($xlib) encrypt -input "Hello world." \ 1081 -recipients $recipient} result]} { 1082 lappend e4me($xlib) $signer 1083 } 1084 1085 $recipient free 1086 } 1087} 1088 1089############################################################################# 1090 1091proc ::ssj::sign:toggleP {} { 1092 variable options 1093 1094 set options(sign-traffic) [expr {!$options(sign-traffic)}] 1095} 1096 1097proc ::ssj::encrypt:toggleP {{xlib ""} {jid ""}} { 1098 variable options 1099 1100 if {[string equal $jid ""]} { 1101 set options(encrypt-traffic) [expr {!$options(encrypt-traffic)}] 1102 return 1103 } 1104 1105 if {![string equal $xlib ""]} { 1106 if {![info exists options(encrypt,$xlib,$jid)]} { 1107 set options(encrypt,$xlib,$jid) [encryptP $xlib $jid] 1108 } 1109 set options(encrypt,$xlib,$jid) \ 1110 [expr {!$options(encrypt,$xlib,$jid)}] 1111 } else { 1112 return -code error \ 1113 "::ssj::encrypt:toggleP: xlib is empty and jid is not" 1114 } 1115} 1116 1117############################################################################# 1118 1119proc ::ssj::signed:trace {script} { 1120 variable options 1121 variable trace 1122 1123 if {![info exists trace(sign-traffic)]} { 1124 set trace(sign-traffic) {} 1125 1126 ::trace variable ::ssj::options(sign-traffic) w ::ssj::trace 1127 } 1128 1129 lappend trace(sign-traffic) $script 1130} 1131 1132proc ::ssj::encrypted:trace {script {xlib ""} {jid ""}} { 1133 variable options 1134 variable trace 1135 1136 if {[string equal $jid ""]} { 1137 set k encrypt-traffic 1138 } else { 1139 if {![string equal $xlib ""]} { 1140 set k encrypt,$xlib,$jid 1141 } else { 1142 return -code error \ 1143 "::ssj::encrypted:trace: xlib is empty and jid is not" 1144 } 1145 } 1146 if {![info exists trace($k)]} { 1147 set trace($k) {} 1148 1149 ::trace variable ::ssj::options($k) w ::ssj::trace 1150 } 1151 1152 lappend trace($k) $script 1153} 1154 1155proc ::ssj::trace {name1 name2 op} { 1156 variable trace 1157 1158 set new {} 1159 foreach script $trace($name2) { 1160 if {[catch {eval $script} result]} { 1161 debugmsg ssj "$result -- $script" 1162 } else { 1163 lappend new $script 1164 } 1165 } 1166 set trace($name2) $new 1167} 1168 1169############################################################################# 1170 1171proc ::ssj::clear_signatures {xlib} { 1172 variable signed 1173 1174 array unset signed $xlib,* 1175} 1176 1177hook::add disconnected_hook ::ssj::clear_signatures 1178 1179############################################################################# 1180 1181proc ::ssj::check_signature {xlib from type x args} { 1182 variable signed 1183 1184 switch -- $type { 1185 unavailable - 1186 available { 1187 catch {unset signed($xlib,$from)} 1188 1189 set signature "" 1190 foreach xs $x { 1191 ::xmpp::xml::split $xs tag xmlns attrs cdata subels 1192 if {$xmlns == $::NS(signed)} { 1193 set signature $cdata 1194 break 1195 } 1196 } 1197 1198 # in case the sender didn't check the exit code from gpg... 1199 if {[string equal $signature ""]} return 1200 1201 set status "" 1202 foreach {key val} $args { 1203 switch -- $key { 1204 -status { set status $val } 1205 } 1206 } 1207 1208 set signed($xlib,$from) \ 1209 [signed:input $xlib $from $signature $status \ 1210 [::msgcat::mc "Presence information"]] 1211 } 1212 } 1213} 1214 1215hook::add client_presence_hook ::ssj::check_signature 1216 1217############################################################################# 1218 1219proc ::ssj::add_timestamp_to_signature {varname xlib} { 1220 variable options 1221 upvar 2 $varname var 1222 1223 if {!$options(prevent-replay-attack)} return 1224 1225 if {![catch {signed:output $xlib $var} cdata] && 1226 ![string equal $cdata ""]} { 1227 set timestamp [clock format [clock seconds] \ 1228 -format "%Y%m%dT%TZ" -gmt true] 1229 if {![string equal $var ""]} { 1230 set var " $var" 1231 } 1232 set var "\[[::xmpp::jid::removeResource [connection_jid $xlib]],\ 1233 $timestamp\]$var" 1234 } 1235 return 1236} 1237 1238hook::add rewrite_presence_status_hook ::ssj::add_timestamp_to_signature 1239 1240proc ::ssj::make_signature {varname xlib status} { 1241 upvar 2 $varname var 1242 1243 if {![catch {signed:output $xlib $status} cdata] && \ 1244 ![string equal $cdata ""]} { 1245 lappend var [::xmpp::xml::create x -xmlns $::NS(signed) \ 1246 -cdata $cdata] 1247 } 1248 return 1249} 1250 1251hook::add presence_xlist_hook ::ssj::make_signature 1252 1253############################################################################# 1254 1255proc ::ssj::add_timestamp {vxlib vto vid vtype vsubject vbody verr vthread vx} { 1256 variable options 1257 upvar 2 $vxlib xlib 1258 upvar 2 $vto to 1259 upvar 2 $vbody body 1260 upvar 2 $vx x 1261 1262 if {!$options(prevent-replay-attack)} return 1263 1264 if {![info exists body]} return 1265 1266 if {![catch { ssj::signed:output $xlib $body $to } cdata] && 1267 ![string equal $cdata ""]} { 1268 set timestamp [clock format [clock seconds] \ 1269 -format "%Y%m%dT%TZ" -gmt true] 1270 if {![string equal $body ""]} { 1271 set body " $body" 1272 } 1273 set body "\[[::xmpp::jid::removeResource [connection_jid $xlib]],\ 1274 $timestamp\] $body" 1275 } 1276 return 1277} 1278 1279hook::add rewrite_outgoing_message_hook ::ssj::add_timestamp 5 1280 1281proc ::ssj::sign_encrypt_body {vxlib vto vid vtype vsubject vbody verr vthread vx} { 1282 upvar 2 $vxlib xlib 1283 upvar 2 $vto to 1284 upvar 2 $vbody body 1285 upvar 2 $vx x 1286 1287 if {![info exists body]} return 1288 1289 foreach tag [list signed encrypted] { 1290 if {[catch { ssj::${tag}:output $xlib $body $to } cdata]} { 1291 debugmsg message "ssj::${tag}:output: $cdata" 1292 1293 # Disable sending the message 1294 hook::unset_flag rewrite_outgoing_message_hook send 1295 1296 return 1297 } 1298 1299 if {![string equal $cdata ""]} { 1300 lappend x [::xmpp::xml::create x -xmlns $::NS($tag) -cdata $cdata] 1301 if {[string equal $tag encrypted]} { 1302 set body [::msgcat::mc "This message is encrypted."] 1303 } 1304 } 1305 } 1306 return 1307} 1308 1309hook::add rewrite_outgoing_message_hook ::ssj::sign_encrypt_body 1310 1311############################################################################# 1312 1313proc ::ssj::userinfo {tab xlib jid editable} { 1314 variable signed 1315 1316 if {$editable} return 1317 1318 set bare_jid [::xmpp::jid::stripResource $jid] 1319 set chatid [chat::chatid $xlib $bare_jid] 1320 if {[chat::is_groupchat $chatid]} { 1321 if {[info exists signed($xlib,$jid)]} { 1322 set jids [list $xlib,$jid] 1323 } else { 1324 set jids [list] 1325 } 1326 } else { 1327 set jids [array names signed $xlib,$bare_jid/*] 1328 } 1329 if {[llength $jids] > 0} { 1330 set presenceinfo [$tab insert end presenceinfo \ 1331 -text [::msgcat::mc "Presence"]] 1332 set i 0 1333 foreach j $jids { 1334 regexp {[^,]*,(.*)} $j -> fjid 1335 set x [userinfo::pack_frame $presenceinfo.presence_$i $fjid] 1336 catch {array unset params} 1337 array set params $signed($j) 1338 1339 set kv {} 1340 set addrs "" 1341 set s "" 1342 foreach signature $params(signatures) { 1343 foreach {k v} $signature { 1344 switch -- $k { 1345 key { 1346 foreach {k v} $v { 1347 if {![string equal $k subkeys]} continue 1348 1349 foreach subkey $v { 1350 catch {unset sparams} 1351 array set sparams $subkey 1352 if {[info exists sparams(email)]} { 1353 append addrs $s $sparams(email) 1354 set s ", " 1355 } 1356 } 1357 } 1358 continue 1359 } 1360 status { continue } 1361 created - 1362 expires { set v [clock format $v] } 1363 fingerprint { 1364 lappend kv keyid \ 1365 [format "0x%s" [string range $v end-7 end]] 1366 } 1367 default { 1368 if {[string equal $v ""]} { continue } 1369 } 1370 } 1371 1372 lappend kv $k $v 1373 } 1374 } 1375 1376 1377 userinfo::pack_entry $jid $x $i presence_$i [::msgcat::mc "Reason:"] 1378 if {![info exists params(reason)]} { 1379 set params(reason) [::msgcat::mc "Presence is signed"] 1380 if {![string equal $addrs ""]} { 1381 append params(reason) [::msgcat::mc " by "] $addrs 1382 } 1383 } 1384 set userinfo::userinfo(presence_$i,$jid) $params(reason) 1385 incr i 1386 1387 foreach {k v} $kv { 1388 userinfo::pack_entry $jid $x $i presence_$i \ 1389 [::msgcat::mc [string totitle ${k}:]] 1390 set userinfo::userinfo(presence_$i,$jid) $v 1391 incr i 1392 } 1393 } 1394 } 1395} 1396 1397hook::add userinfo_hook ::ssj::userinfo 90 1398 1399############################################################################# 1400 1401proc ::ssj::message_buttons {mw xlib jid} { 1402 set bbox1 [ButtonBox $mw.bottom.buttons1 -spacing 0] 1403 1404 # TODO reflect changes of xlib 1405 set b [$bbox1 add \ 1406 -image [encrypted:icon $xlib $jid] \ 1407 -helptype balloon \ 1408 -helptext [::msgcat::mc "Toggle encryption"] \ 1409 -height 24 \ 1410 -width 24 \ 1411 -relief link \ 1412 -bd $::tk_borderwidth \ 1413 -command [list ::ssj::encrypt:toggleP $xlib $jid]] 1414 encrypted:trace \ 1415 "$b configure -image \[::ssj::encrypted:icon [list $xlib] [list $jid]\]" \ 1416 $xlib $jid 1417 1418 pack $bbox1 -side left -fill x -padx 2m -pady 2m 1419} 1420 1421hook::add open_message_post_hook ::ssj::message_buttons 1422 1423############################################################################# 1424 1425proc ::ssj::process_x_signed {rowvar bodyvar f x xlib from id type replyP} { 1426 upvar 2 $rowvar row 1427 upvar 2 $bodyvar body 1428 1429 if {!$replyP || [string equal $type error]} { 1430 return 1431 } 1432 1433 foreach xa $x { 1434 ::xmpp::xml::split $xa tag xmlns attrs cdata subels 1435 1436 if {$tag != "" || $xmlns != $::NS(signed)} { 1437 continue 1438 } 1439 1440 set lb [join [lrange [split $f .] 0 end-1] .].title.signed 1441 if {[winfo exists $lb]} { 1442 destroy $lb 1443 } 1444 1445 grid [signed:Label $lb $xlib $from $attrs] -row 1 -column 2 -sticky e 1446 } 1447 1448 return 1449} 1450 1451hook::add message_process_x_hook ::ssj::process_x_signed 20 1452 1453############################################################################# 1454 1455proc ::ssj::signed:icon {} { 1456 return [lindex [list toolbar/gpg-unsigned toolbar/gpg-signed] \ 1457 [signP]] 1458} 1459 1460proc ::ssj::encrypted:icon {{xlib ""} {jid ""}} { 1461 return [lindex [list toolbar/gpg-unencrypted toolbar/gpg-encrypted] \ 1462 [encryptP $xlib $jid]] 1463} 1464 1465############################################################################# 1466 1467proc ::ssj::draw_signed {chatid from type body x} { 1468 variable signedid 1469 1470 set chatw [chat::chat_win $chatid] 1471 1472 foreach xe $x { 1473 ::xmpp::xml::split $xe tag xmlns attrs cdata subels 1474 1475 if {$tag != "" || ![string equal $xmlns $::NS(signed)]} { 1476 continue 1477 } 1478 1479 incr signedid 1480 set xlib [chat::get_xlib $chatid] 1481 catch { 1482 set lb $chatw.signed$signedid 1483 $chatw window create end \ 1484 -window [signed:Label $lb $xlib $from $attrs] 1485 $lb configure -bg [get_conf $chatw -bg] 1486 } 1487 } 1488} 1489 1490hook::add draw_message_hook ::ssj::draw_signed 7 1491 1492############################################################################### 1493 1494proc ::ssj::chat_window_button {chatid type} { 1495 set xlib [chat::get_xlib $chatid] 1496 set jid [chat::get_jid $chatid] 1497 set cw [chat::winid $chatid] 1498 1499 Button $cw.status.encrypted \ 1500 -relief flat \ 1501 -image [encrypted:icon $xlib $jid] \ 1502 -helptype balloon \ 1503 -helptext [::msgcat::mc "Toggle encryption"] \ 1504 -command [list ::ssj::encrypt:toggleP $xlib $jid] 1505 1506 encrypted:trace "$cw.status.encrypted configure \ 1507 -image \[::ssj::encrypted:icon $xlib $jid\]" \ 1508 $xlib $jid 1509 pack $cw.status.encrypted -side left -before $cw.status.mb 1510} 1511 1512hook::add open_chat_post_hook ::ssj::chat_window_button 1513 1514############################################################################### 1515 1516proc ::ssj::toolbar {} { 1517 set idx [ifacetk::add_toolbar_button \ 1518 [signed:icon] \ 1519 ::ssj::sign:toggleP \ 1520 [::msgcat::mc "Toggle signing presence updates"]] 1521 signed:trace \ 1522 [list ifacetk::set_toolbar_icon $idx ::ssj::signed:icon] 1523 1524 set idx [ifacetk::add_toolbar_button \ 1525 [encrypted:icon] \ 1526 ::ssj::encrypt:toggleP \ 1527 [::msgcat::mc "Toggle encryption (when possible)"]] 1528 encrypted:trace \ 1529 [list ifacetk::set_toolbar_icon $idx ::ssj::encrypted:icon] 1530} 1531 1532hook::add finload_hook ::ssj::toolbar 1533 1534############################################################################### 1535 1536proc ::ssj::setup_menu {} { 1537 variable options 1538 1539 catch { 1540 set m [.mainframe getmenu tkabber] 1541 set ind [$m index [::msgcat::mc "View"]] 1542 incr ind -1 1543 1544 set mm .ssj_menu 1545 menu $mm -tearoff $::ifacetk::options(show_tearoffs) 1546 $mm add checkbutton -label [::msgcat::mc "Sign presence updates"] \ 1547 -variable ::ssj::options(sign-traffic) 1548 $mm add checkbutton -label [::msgcat::mc "Encrypt messages (when possible)"] \ 1549 -variable ::ssj::options(encrypt-traffic) 1550 1551 $m insert $ind cascade -label [::msgcat::mc "Encryption"] \ 1552 -menu $mm 1553 } 1554} 1555 1556 1557hook::add finload_hook ::ssj::setup_menu 1558 1559############################################################################### 1560 1561proc ::ssj::add_user_popup_info {infovar xlib jid} { 1562 variable signed 1563 1564 upvar 0 $infovar info 1565 1566 if {[info exists signed($xlib,$jid)]} { 1567 set signed_info [signed:info $signed($xlib,$jid)] 1568 append info [::msgcat::mc "\n\tPresence is signed:"] 1569 regsub -all {(\n)} "\n$signed_info" "\\1\t " extra 1570 append info $extra 1571 } 1572} 1573 1574hook::add roster_user_popup_info_hook ::ssj::add_user_popup_info 99 1575 1576############################################################################### 1577 1578proc ::ssj::process_gpg_input_error {xlib from what message} { 1579 show_error $message 1580} 1581 1582hook::add gpg_input_error_hook ::ssj::process_gpg_input_error 99 1583 1584proc ::ssj::show_error {message} { 1585 set w .gpg_error 1586 1587 if {![winfo exists $w]} { 1588 Dialog $w -title [::msgcat::mc "GPG error"] \ 1589 -modal none -transient no \ 1590 -separator 1 -anchor e -default 0 1591 $w add -text [::msgcat::mc "Close"] -command [list destroy $w] 1592 1593 set f [$w getframe] 1594 text $f.text -wrap word -yscrollcommand [list $f.vsb set] 1595 scrollbar $f.vsb -orient vertical -command [list $f.text yview] 1596 grid $f.text $f.vsb -sticky ns 1597 grid $f.text -sticky news 1598 grid rowconfigure $f 0 -weight 1 1599 grid columnconfigure $f 0 -weight 1 1600 1601 $w draw 1602 } 1603 1604 set t [$w getframe].text 1605 $t configure -state normal 1606 $t insert end [format {[%s]: %s} \ 1607 [clock format [clock seconds]] $message\n\n] 1608 $t configure -state disabled 1609} 1610 1611# vim:ts=8:sw=4:sts=4:noet 1612