[Tkabber-dev] r764 - trunk/tkabber

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Oct 20 23:05:31 MSD 2006


Author: sergei
Date: 2006-10-20 23:05:28 +0400 (Fri, 20 Oct 2006)
New Revision: 764

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/gpgme.tcl
Log:
	* gpgme.tcl:
	  Don't check signature if message encryption fails.
	  Some code cleanup.

2006-10-15  Sergei Golovan  <sgolovan at nes.ru>

	* ifacetk/iface.tcl: Restored "Activate lists at startup" menu
	  item for privacy lists. Since it is autosaved when switched it
	  makes sense to use it again.

	* custom.tcl: Fixed sorting subgroups.

2006-10-14  Sergei Golovan  <sgolovan at nes.ru>



Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-10-20 16:20:44 UTC (rev 763)
+++ trunk/tkabber/ChangeLog	2006-10-20 19:05:28 UTC (rev 764)
@@ -15,6 +15,8 @@
 	  Draw icon from gpg-badencrypted.gif when message cannot be
 	  deciphered. Draw it even if no GPG support at all to make
 	  messages more clear.
+	  Don't check signature if message encryption fails.
+	  Some code cleanup.
 
 2006-10-15  Sergei Golovan  <sgolovan at nes.ru>
 

Modified: trunk/tkabber/gpgme.tcl
===================================================================
--- trunk/tkabber/gpgme.tcl	2006-10-20 16:20:44 UTC (rev 763)
+++ trunk/tkabber/gpgme.tcl	2006-10-20 19:05:28 UTC (rev 764)
@@ -27,11 +27,47 @@
     }
 }
 
-hook::add draw_message_hook ::ssj::draw_encrypted 7
+hook::add draw_message_hook ::ssj::draw_encrypted 6
 
 #############################################################################
 
-if {[catch { package require gpgme }]} {
+proc ::ssj::process_x_encrypted {rowvar bodyvar f x connid from type replyP} {
+    upvar 2 $rowvar row
+    upvar 2 $bodyvar body
+
+    if {!$replyP || [cequal $type error]} {
+	return
+    }
+
+    foreach xa $x {
+	jlib::wrapper:splitxml $xa tag vars isempty cdata children
+	set xmlns [jlib::wrapper:getattr $vars xmlns]
+
+	if {$xmlns != $::NS(encrypted)} continue
+
+	# we already deciphered it in rewrite_message_hook
+	set lb [join [lrange [split $f .] 0 end-1] .].title.encrypted
+	if {[winfo exists $lb]} {
+	    destroy $lb
+	}
+
+	if {[cequal $cdata ""] || \
+	    [cequal [info commands ::ssj::encrypted:input] ""]} {
+	    Label $lb -image gpg/badencrypted
+	} else {
+	    Label $lb -image gpg/encrypted
+	}
+	grid $lb -row 1 -column 3 -sticky e
+    }
+
+    return
+}
+
+hook::add message_process_x_hook ::ssj::process_x_encrypted 21
+
+#############################################################################
+
+if {[catch {package require gpgme}]} {
     debugmsg ssj "unable to load the GPGME package, so no crypto!"
     set have_gpgme 0
     return
@@ -95,7 +131,7 @@
                 expired    [::msgcat::mc "The signature is good but has expired"] \
                 expiredkey [::msgcat::mc "The signature is good but the key has expired"]]
 
-    catch { unset warnings }
+    catch {unset warnings}
     array set warnings {}
 
     variable signedid 0
@@ -174,7 +210,7 @@
     }
 
     set dw .selectkey$connid
-    catch { destroy $dw }
+    catch {destroy $dw}
 
     set titles {}
     set balloons {}
@@ -184,25 +220,25 @@
                 continue
             }
             foreach subkey $v {
-                catch { unset params }
+                catch {unset params}
                 array set params $subkey
                 if {![info exists params(email)]} {
                     continue
                 }
 		lappend titles $key $params(email)
-                if {![catch { format "%d%s/%s %s %s" $params(length)         \
-                                     [string range $params(algorithm) 0 0]   \
-                                     [string range $params(keyid) end-7 end] \
-                                     [clock format $params(created)          \
-                                            -format "%Y-%m-%d"]              \
-                                     $params(userid) } text]} {
+                if {![catch {format "%d%s/%s %s %s" $params(length)         \
+                                    [string range $params(algorithm) 0 0]   \
+                                    [string range $params(keyid) end-7 end] \
+                                    [clock format $params(created)          \
+                                           -format "%Y-%m-%d"]              \
+                                    $params(userid)} text]} {
 		    lappend balloons $key $text
 		}
 	    }
 	}
     }
 
-    CbDialog $dw [format [::msgcat::mc "Select Key for Signing %s Traffic"] $pattern] \
+    CbDialog $dw [::msgcat::mc "Select Key for Signing %s Traffic" $pattern] \
         [list [::msgcat::mc "Select"] "::ssj::once_only_aux $dw $connid" \
 	      [::msgcat::mc "Cancel"] "destroy $dw"] \
 	::ssj::selectkey$connid $titles $balloons \
@@ -346,17 +382,17 @@
 
     once_only $connid
 
-    if {[catch { $ctx($connid) -operation verify \
-			       -input     [binary format a* [encoding convertto utf-8 $data]]  \
-			       -signature [armor:decode $signature] } result]} {
+    if {[catch {$ctx($connid) -operation verify \
+			      -input     [binary format a* [encoding convertto utf-8 $data]]  \
+			      -signature [armor:decode $signature]} result]} {
         debugmsg ssj "verify processing error ($connid): $result ($from)"
 
         if {![info exists warnings(verify-traffic,$connid)]} {
 
             set warnings(verify-traffic,$connid) 1
             after idle [list NonmodalMessageDlg .verify_error$connid -aspect 50000 -icon error \
-                -message [format [::msgcat::mc "Error in signature verification software: %s."] \
-				 $result]]
+                -message [::msgcat::mc "Error in signature verification software: %s." \
+				       $result]]
         }
 
         set params(reason) $result
@@ -371,7 +407,7 @@
 
     set signatures {}
     foreach signature $params(signatures) {
-        catch { unset sparams }
+        catch {unset sparams}
         array set sparams $signature
 
         if {[info exists sparams(key)]} {
@@ -381,7 +417,7 @@
                     continue
                 }
                 foreach subkey $v {
-                    catch { unset kparams }
+                    catch {unset kparams}
                     array set kparams $subkey
                     if {[info exists kparams(keyid)]} {
                         set j2k($from) $kparams(keyid)
@@ -393,7 +429,7 @@
 
         lappend signatures [array get sparams]
     }
-    catch { unset params }
+    catch {unset params}
     array set params [list signatures $signatures]
 
     if {![cequal $result good]} {
@@ -406,9 +442,8 @@
             set warnings(verify,$from) 1
             incr gpg_error_id
             after idle [list NonmodalMessageDlg .verify_error$gpg_error_id -aspect 50000 -icon error \
-                -message [format \
-			      [::msgcat::mc "%s purportedly signed by %s can't be verified.\n\n%s."] \
-			      $what $from $result]]
+                -message [::msgcat::mc "%s purportedly signed by %s can't be verified.\n\n%s." \
+				       $what $from $result]]
         }
     }
 
@@ -428,9 +463,9 @@
 
     once_only $connid 1
 
-    if {[catch { $ctx($connid) -operation sign  \
-			       -input     [binary format a* [encoding convertto utf-8 $data]] \
-			       -mode      detach } result]} {
+    if {[catch {$ctx($connid) -operation sign  \
+			      -input     [binary format a* [encoding convertto utf-8 $data]] \
+			      -mode      detach} result]} {
         set options(sign-traffic) 0
 
         debugmsg ssj "signature processing error ($connid): $result ($data)"
@@ -438,11 +473,16 @@
         if {[llength $args] == 0} {
             set buttons ok
             set cancel 0
-            set message [format [::msgcat::mc "Unable to sign presence information: %s.\n\nPresence will be sent, but signing traffic is now disabled."] $result]
+            set message [::msgcat::mc "Unable to sign presence information:\
+				       %s.\n\nPresence will be sent, but\
+				       signing traffic is now disabled." $result]
         } else {
             set buttons {ok cancel}
             set cancel 1
-            set message [format [::msgcat::mc "Unable to sign message body: %s.\n\nSigning traffic is now disabled.\n\nSend it WITHOUT a signature?"] $result]
+            set message [::msgcat::mc "Unable to sign message body:\
+				       %s.\n\nSigning traffic is now\
+				       disabled.\n\nSend it WITHOUT a signature?"\
+				      $result]
         }
 
         incr gpg_error_id
@@ -487,7 +527,7 @@
 			    continue
 			}
 			foreach subkey $v {
-			    catch { unset sparams }
+			    catch {unset sparams}
 			    array set sparams $subkey
 			    if {[info exists sparams(email)]} {
 				append addrs $s $sparams(email)
@@ -525,7 +565,7 @@
     return [string trimleft $text]
 }
 
-proc ::ssj::signed:Label {lb pinfo} {
+proc ::ssj::signed:Label {lb jid pinfo} {
     array set params $pinfo
     if {[info exists params(reason)]} {
 	set args [list -image gpg/badsigned]
@@ -587,7 +627,7 @@
 
     set keyids {}        
     foreach signature $params(signatures) {
-	catch { unset sparams }
+	catch {unset sparams}
 	array set sparams $signature
 
 	if {[info exists sparams(fingerprint)]} {
@@ -614,21 +654,22 @@
     upvar 2 $vbody body
     upvar 2 $vx x
 
+    set badenc 0
     set xs {}
-
     foreach xe $x {
-	jlib::wrapper:splitxml $xe tag vars isempty chdata children
+	jlib::wrapper:splitxml $xe tag vars isempty cdata children
 
-	if {![cequal [jlib::wrapper:getattr $vars xmlns] jabber:x:encrypted]} {
+	if {![cequal [jlib::wrapper:getattr $vars xmlns] $::NS(encrypted)]} {
 	    lappend xs $xe
-	    continue
-	} elseif {[cequal $chdata ""]} {
-	    # in case the sender didn't check the exit code from gpg...
-	    lappend xs $xe
-	} elseif {[catch {ssj::encrypted:input $connid $from $chdata} msg]} {
-	    set body [format [::msgcat::mc ">>> Unable to decipher data: %s <<<"] $msg]
-	    # Add empty x tag to show problems with gpg...
-	    lappend xs [jlib::wrapper:createtag x -vars {xmlns jabber:x:encrypted}]
+	} elseif {[cequal $cdata ""]} {
+	    # in case the sender didn't check the exit code from gpg we ignore
+	    # jabber:x:encrypted
+	} elseif {[catch {ssj::encrypted:input $connid $from $cdata} msg]} {
+	    set body [::msgcat::mc ">>> Unable to decipher data: %s <<<" $msg]
+	    # Add empty x tag to show problems with gpg
+	    lappend xs [jlib::wrapper:createtag x \
+			    -vars [list xmlns $::NS(encrypted)]]
+	    set badenc 1
 	} else {
 	    set body $msg
 	    lappend xs $xe
@@ -636,6 +677,18 @@
     }
 
     set x $xs
+
+    if {!$badenc} return
+
+    # if decryption failed, then remove signature. It can't be correct.
+    set xs {}
+    foreach xe $x {
+	jlib::wrapper:splitxml $xe tag vars isempty cdata children
+
+	if {![cequal [jlib::wrapper:getattr $vars xmlns] $::NS(signed)]} {
+	    lappend xs $xe
+	}
+    }
 }
 
 hook::add rewrite_message_hook ::ssj::rewrite_message_body 10
@@ -649,17 +702,16 @@
 
     once_only $connid
 
-    if {[catch { $ctx($connid) -operation decrypt \
-			       -input     [armor:decode $data] } result]} {
+    if {[catch {$ctx($connid) -operation decrypt \
+			      -input     [armor:decode $data]} result]} {
         debugmsg ssj "decryption processing error ($connid): $result ($from)"
 
         if {![info exists warnings(decrypt,$from)]} {
             set warnings(decrypt,$from) 1
             incr gpg_error_id
             after idle [list NonmodalMessageDlg .decrypt_error$gpg_error_id -aspect 50000 -icon error \
-                -message [format \
-			      [::msgcat::mc "Data purported sent by %s can't be deciphered.\n\n%s."] \
-			      $from $result]]
+                -message [::msgcat::mc "Data purported sent by %s can't be deciphered.\n\n%s." \
+				       $from $result]]
         }
 
         error $result
@@ -734,11 +786,10 @@
                 -buttons {ok cancel} \
 		-default 0 \
 		-cancel 1 \
-                -message [format \
-			      [::msgcat::mc \
-				   "Unable to encipher data for %s:\
-				    %s.\n\nEncrypting traffic to this user is\
-				    now disabled.\n\nSend it as PLAINTEXT?"] \
+                -message [::msgcat::mc \
+			      "Unable to encipher data for %s:\
+			       %s.\n\nEncrypting traffic to this user is\
+			       now disabled.\n\nSend it as PLAINTEXT?" \
 			      $to $result]]} {
             error ""
         }
@@ -794,7 +845,7 @@
     }
 
     Dialog $w \
-	   -title [format [::msgcat::mc "Change security preferences for %s"] $jid] \
+	   -title [::msgcat::mc "Change security preferences for %s" $jid] \
 	   -separator 1 -anchor e -default 0 -cancel 1
 
     $w add -text [::msgcat::mc "OK"] \
@@ -899,9 +950,9 @@
             -name      $name \
             -validity  full
 
-    if {[catch { $ctx($connid) -operation  encrypt        \
-			       -input      "Hello world." \
-			       -recipients $recipient }]} {
+    if {[catch {$ctx($connid) -operation  encrypt        \
+			      -input      "Hello world." \
+			      -recipients $recipient}]} {
         set options(encrypt-tried,$connid,$jid) 0
     } else {
         set options(encrypt-tried,$connid,$jid) 1
@@ -930,9 +981,9 @@
                 -name      $signer \
                 -validity  full
 
-        if {![catch { $ctx($connid) -operation  encrypt        \
-				    -input      "Hello world." \
-				    -recipients $recipient } result]} {
+        if {![catch {$ctx($connid) -operation  encrypt        \
+				   -input      "Hello world." \
+				   -recipients $recipient} result]} {
             lappend e4me($connid) $signer
         }
 
@@ -1011,7 +1062,7 @@
 
     set new {}
     foreach script $trace($name2) {
-        if {[catch { eval $script } result]} {
+        if {[catch {eval $script} result]} {
             debugmsg ssj "$result -- $script"
         } else {
             lappend new $script
@@ -1026,9 +1077,9 @@
     variable signed
 
     if {$connid == {}} {
-	catch { array unset signed }
+	catch {array unset signed}
     } else {
-	catch { array unset signed $connid,* }
+	catch {array unset signed $connid,*}
     }
 }
 
@@ -1042,7 +1093,7 @@
     switch -- $type {
 	unavailable -
 	available {
-	    catch { unset signed($connid,$from) }
+	    catch {unset signed($connid,$from)}
 
 	    set signature ""
 	    foreach xs $x {
@@ -1077,7 +1128,7 @@
 proc ::ssj::make_signature {varname connid status} {
     upvar 2 $varname var
     if {![cequal $status ""] && \
-	    ![catch { signed:output $connid $status } cdata] && \
+	    ![catch {signed:output $connid $status} cdata] && \
 	    ![cequal $cdata ""]} {
 	lappend var [jlib::wrapper:createtag x \
 			 -vars [list xmlns $::NS(signed)] \
@@ -1113,7 +1164,7 @@
 	foreach j $jids {
 	    regexp {[^,]*,(.*)} $j -> fjid
 	    set x [userinfo::pack_frame $presenceinfo.presence_$i $fjid]
-	    catch { array unset params }
+	    catch {array unset params}
 	    array set params $signed($j)
 
 	    set kv {}
@@ -1127,7 +1178,7 @@
 				if {![cequal $k subkeys]} continue
 
 				foreach subkey $v {
-				    catch { unset sparams }
+				    catch {unset sparams}
 				    array set sparams $subkey
 				    if {[info exists sparams(email)]} {
 					append addrs $s $sparams(email)
@@ -1237,9 +1288,9 @@
 	    destroy $lb
 	}
 
-	signed:Label $lb \
-	    [signed:input $connid $from $chdata $body \
-		 [::msgcat::mc "Message body"]]
+	signed:Label $lb $from
+		     [signed:input $connid $from $chdata $body \
+				   [::msgcat::mc "Message body"]]
 	grid $lb -row 1 -column 2 -sticky e
     }
 
@@ -1250,37 +1301,6 @@
 
 #############################################################################
 
-proc ::ssj::process_x_encrypted {rowvar bodyvar f x connid from type replyP} {
-    upvar 2 $rowvar row
-    upvar 2 $bodyvar body
-
-    if {!$replyP || [cequal $type error]} {
-	return
-    }
-
-    foreach xa $x {
-	jlib::wrapper:splitxml $xa tag vars isempty chdata children
-	set xmlns [jlib::wrapper:getattr $vars xmlns]
-
-	if {$xmlns != $::NS(encrypted)} continue
-
-	# we already deciphered it in client:message...
-	set lb [join [lrange [split $f .] 0 end-1] .].title.encrypted
-	if {[winfo exists $lb]} {
-	    destroy $lb
-	}
-
-	Label $lb -image gpg/encrypted
-	grid $lb -row 1 -column 3 -sticky e
-    }
-
-    return
-}
-
-hook::add message_process_x_hook ::ssj::process_x_encrypted 21
-
-#############################################################################
-
 proc ::ssj::signed:icon {} {
     return [lindex [list toolbar/gpg-unsigned toolbar/gpg-signed] \
                    [signP]]
@@ -1311,14 +1331,14 @@
 	set connid [chat::get_connid $chatid]
         catch {
             $chatw window create end \
-                  -window [signed:Label $chatw.signed$signedid \
+                  -window [signed:Label $chatw.signed$signedid $from \
                               [signed:input $connid $from $chdata $body \
                                   [::msgcat::mc "Message body"]]]
         }
     }
 }
 
-hook::add draw_message_hook ::ssj::draw_signed 6
+hook::add draw_message_hook ::ssj::draw_signed 7
 
 ###############################################################################
 



More information about the Tkabber-dev mailing list