[Tkabber-dev] r1825 - trunk/tkabber

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Aug 3 17:20:06 MSD 2009


Author: sergei
Date: 2009-08-03 17:20:05 +0400 (Mon, 03 Aug 2009)
New Revision: 1825

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/gpgme.tcl
Log:
	* gpgme.tcl: Entirely switched to TclGPG which broke compatibility with
	  TclGPGME.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2009-08-01 16:10:10 UTC (rev 1824)
+++ trunk/tkabber/ChangeLog	2009-08-03 13:20:05 UTC (rev 1825)
@@ -1,3 +1,8 @@
+2009-08-03  Sergei Golovan  <sgolovan at nes.ru>
+
+	* gpgme.tcl: Entirely switched to TclGPG which broke compatibility with
+	  TclGPGME.
+
 2009-08-01  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/comm.tcl: Raised priority of cleanup function in

Modified: trunk/tkabber/gpgme.tcl
===================================================================
--- trunk/tkabber/gpgme.tcl	2009-08-01 16:10:10 UTC (rev 1824)
+++ trunk/tkabber/gpgme.tcl	2009-08-03 13:20:05 UTC (rev 1825)
@@ -35,7 +35,7 @@
     upvar 2 $rowvar row
     upvar 2 $bodyvar body
 
-    if {!$replyP || [cequal $type error]} {
+    if {!$replyP || [string equal $type error]} {
 	return
     }
 
@@ -66,11 +66,7 @@
 
 #############################################################################
 
-if {![catch {package require gpg}]} {
-    set gpgPkg gpg
-} elseif {![catch {package require gpgme}]} {
-    set gpgPkg gpgme
-} else {
+if {[catch {package require gpg}]} {
     debugmsg ssj "unable to load the GPG package, so no crypto!"
     return
 }
@@ -143,30 +139,28 @@
 
 
 proc ::ssj::once_only {xlib {armorP 0}} {
-    global env gpgPkg
+    global env
     variable options
     variable ctx
 
     debugmsg ssj "ONCE_ONLY $xlib"
 
-    if {[info exists ctx($xlib)] && ![cequal $ctx($xlib) ""]} {
-        $ctx($xlib) -operation set   \
-		      -property  armor \
-		      -value     $armorP
+    if {[info exists ctx($xlib)] && ![string equal $ctx($xlib) ""]} {
+        $ctx($xlib) set -property armor \
+			-value    $armorP
 
         return
     }
 
-    set ctx($xlib) [${gpgPkg}::context]
-    $ctx($xlib) -operation set   \
-		  -property  armor \
-		  -value     $armorP
+    set ctx($xlib) [gpg::new]
+    $ctx($xlib) set -property armor \
+		    -value    $armorP
+    $ctx($xlib) set -property encoding \
+		    -value    utf-8
 
-
     if {![info exists env(GPG_AGENT_INFO)]} {
-        $ctx($xlib) -operation set                 \
-		      -property  passphrase-callback \
-		      -value     [list ::ssj::passphrase $xlib]
+        $ctx($xlib) set -property passphrase-callback \
+			-value    [list ::ssj::passphrase $xlib]
     }
 
     set pattern [connection_bare_jid $xlib]
@@ -179,21 +173,16 @@
     }
     lappend patterns $pattern ""
     foreach p $patterns {
-        set command [list $ctx($xlib) -operation start-key -secretonly true]
-        if {![cequal $p ""]} {
+        set command [list $ctx($xlib) list-keys -secretonly true]
+        if {![string equal $p ""]} {
             lappend command -patterns [list $p]
         }
-        eval $command
+        set keys [eval $command]
 
-        for {set keys {}} \
-            {![cequal [set key [$ctx($xlib) -operation next-key]] ""]} \
-            {lappend keys $key} {}
-        $ctx($xlib) -operation done-key
-
         if {[llength $keys] > 0} {
             break
         }
-        if {[cequal $p ""]} {
+        if {[string equal $p ""]} {
             return
         }
         set firstP 0
@@ -221,7 +210,7 @@
     set titles {}
     set balloons {}
     foreach key $keys {
-	set key_info [$ctx($xlib) -operation info-key -key $key]
+	set key_info [$ctx($xlib) info-key -key $key]
         foreach {k v} $key_info {
 	    if {[string equal $k email]} {
 		lappend titles $key $v
@@ -229,7 +218,7 @@
 		break
 	    }
 	}
-        foreach {k v} [$ctx($xlib) -operation info-key -key $key] {
+        foreach {k v} [$ctx($xlib) info-key -key $key] {
 	    if {![string equal $k subkeys]} {
 		continue
 	    }
@@ -296,23 +285,15 @@
     variable options
 
     array set params $data
-    set lines [split [string trimright $params(description)] "\n"]
-    set text [lindex $lines 0]
 
-    if {[set x [string first " " [set keyid [lindex $lines 1]]]] > 0} {
-        set userid [string range $keyid [expr $x+1] end]
-        if {!$options(one-passphrase)} {
-            set keyid [string range $keyid 0 [expr $x-1]]
-        } else {
-            regexp { +([^ ]+)} [lindex $lines 2] ignore keyid
-        }
-    } else {
-        set userid unknown!
+    if {!$options(one-passphrase)} {
+        set params(keyid) $params(subkeyid)
     }
+    set keyid $params(keyid)
 
-    if {([cequal $text ENTER]) \
-            && ([info exists passphrase($keyid)]) \
-            && (![cequal $passphrase($keyid) ""])} {
+    if {([string equal $params(hint) enter]) && \
+            [info exists passphrase($keyid)] && \
+            ![string equal $passphrase($keyid) ""]} {
         return $passphrase($keyid)
     }
 
@@ -322,16 +303,16 @@
     }
 
     set title [::msgcat::mc "Please enter passphrase"]
-    switch -- $text {
-        ENTER {
+    switch -- $params(hint) {
+        enter {
         }
 
-        TRY_AGAIN {
+        try_again {
             set title [::msgcat::mc "Please try again"]
         }
 
         default {
-            append title ": " $text
+            append title ": " $params(hint)
         }
     }
     Dialog $pw -title $title -separator 1 -anchor e -default 0 -cancel 1
@@ -343,8 +324,8 @@
 			userid [::msgcat::mc "User ID"]] {
         label $pf.l$k -text ${v}:
         entry $pf.$k
-        $pf.$k insert 0 [set $k]
-        if {[string length [set $k]] <= 72} {
+        $pf.$k insert 0 $params($k)
+        if {[string length $params($k)] <= 72} {
             $pf.$k configure -width 0
         }
         if {[info tclversion] >= 8.4} {
@@ -371,10 +352,7 @@
     $pw add -text [::msgcat::mc "OK"] -command "$pw enddialog 0"
     $pw add -text [::msgcat::mc "Cancel"] -command "$pw enddialog 1"
 
-    if {[set abort [$pw draw $pf.password]]} {
-        $params(token) -operation cancel
-	# TODO: unset options(sign-traffic) etc. ?
-    }
+    set abort [$pw draw $pf.password]
 
     destroy $pw
 
@@ -382,6 +360,8 @@
 	set passphrase($keyid) $passphrase($xlib,$keyid)
 	unset passphrase($xlib,$keyid)
         return $passphrase($keyid)
+    } else {
+	return -code break
     }
 }
 
@@ -410,9 +390,9 @@
 
     once_only $xlib
 
-    if {[catch {$ctx($xlib) -operation verify \
-			      -input     [binary format a* [encoding convertto utf-8 $data]]  \
-			      -signature [armor:decode $signature]} result]} {
+    if {[catch {$ctx($xlib) verify \
+			    -input     $data  \
+			    -signature [armor:decode $signature]} result]} {
         debugmsg ssj "verify processing error ($xlib): $result ($from)"
 
         if {![info exists warnings(verify-traffic,$xlib)]} {
@@ -438,7 +418,7 @@
         array set sparams $signature
 
         if {[info exists sparams(key)]} {
-            set sparams(key) [$ctx($xlib) -operation info-key -key $sparams(key)]
+            set sparams(key) [$ctx($xlib) info-key -key $sparams(key)]
             foreach {k v} $sparams(key) {
 		switch -- $k {
 		    keyid {
@@ -464,7 +444,7 @@
     catch {unset params}
     array set params [list signatures $signatures]
 
-    if {![cequal $result good]} {
+    if {![string equal $result good]} {
         if {[info exists s2e($result)]} {
             set result $s2e($result)
         }
@@ -488,15 +468,14 @@
     variable warnings
     variable gpg_error_id
 
-    if {(!$options(sign-traffic)) || ([cequal $data ""])} {
+    if {(!$options(sign-traffic)) || ([string equal $data ""])} {
         return
     }
 
     once_only $xlib 1
 
-    if {[catch {$ctx($xlib) -operation sign  \
-			      -input     [binary format a* [encoding convertto utf-8 $data]] \
-			      -mode      detach} result]} {
+    if {[catch {$ctx($xlib) sign -input $data \
+				 -mode  detach} result]} {
         set options(sign-traffic) 0
 
         debugmsg ssj "signature processing error ($xlib): $result ($data)"
@@ -539,8 +518,8 @@
     array set params $pinfo
 
     foreach {k v} $pinfo {
-	if {![cequal $k signatures]} {
-	    if {![cequal $v ""]} {
+	if {![string equal $k signatures]} {
+	    if {![string equal $v ""]} {
 		append text [format "%s: %s\n" $k $v]
 	    }
 	}
@@ -554,7 +533,7 @@
 	    switch -- $k {
 		key {
 		    foreach {k v} $v {
-			if {![cequal $k subkeys]} {
+			if {![string equal $k subkeys]} {
 			    continue
 			}
 			foreach subkey $v {
@@ -578,17 +557,17 @@
 		    append info [format "%s: %s\n" $k $v]
 		}
 		default {
-		    if {![cequal $v ""]} {
+		    if {![string equal $v ""]} {
 			append info [format "%s: %s\n" $k $v]
 		    }
 		}
 	    }
 	}
 
-	if {![cequal $addrs ""]} {
+	if {![string equal $addrs ""]} {
 	    set info "email: $addrs\n$info"
 	}
-	if {![cequal $info ""]} {
+	if {![string equal $info ""]} {
 	    append text "\n" [string trimright $info]
 	}
     }
@@ -614,7 +593,7 @@
 	    switch -- $k {
 		key {
 		    foreach {k v} $v {
-			if {![cequal $k subkeys]} {
+			if {![string equal $k subkeys]} {
 			    continue
 			}
 			foreach subkey $v {
@@ -657,15 +636,15 @@
 	set args [list -image gpg/vsigned]
     }
 
-    if {![cequal [set info [signed:info $pinfo]] ""]} {
+    if {![string equal [set info [signed:info $pinfo]] ""]} {
 	lappend args -helptext $info -helptype balloon
     }
 
     eval [list Label $lb] $args -cursor arrow \
 	 -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0
 
-    if {[info exists params(reason)] && [cequal $params(reason) nokey]} {
-	bind $lb <3> [list ::ssj::signed:popup $pinfo]
+    if {[info exists params(reason)] && [string equal $params(reason) nokey]} {
+	bind $lb <3> [list ::ssj::signed:popup [double% $pinfo]]
     }
     return $lb
 }
@@ -685,14 +664,10 @@
 
 proc ::ssj::signed:user_menu {m xlib jid} {
     variable signed
-    global curuser
 
-    if {[cequal $jid "\$curuser"]} {
-	set jid $curuser
-    }
     if {[info exists signed($xlib,$jid)]} {
 	array set params $signed($xlib,$jid)
-	if {[info exists params(status)] && [cequal $params(status) nokey]} {
+	if {[info exists params(status)] && [string equal $params(status) nokey]} {
 	    $m add command -label [::msgcat::mc "Fetch GPG key"] \
 		-command [list ::ssj::fetchkeys \
 			       $signed($xlib,$jid)]
@@ -787,8 +762,7 @@
 
     once_only $xlib
 
-    if {[catch {$ctx($xlib) -operation decrypt \
-			      -input     [armor:decode $data]} result]} {
+    if {[catch {$ctx($xlib) decrypt -input [armor:decode $data]} result]} {
         debugmsg ssj "decryption processing error ($xlib): $result ($from)"
 
         if {![info exists warnings(decrypt,$from)]} {
@@ -805,20 +779,18 @@
     debugmsg ssj "DECRYPT: $xlib; $from; $result"
 
     array set params $result
-    binary scan $params(plaintext) a* temp_utf8
-    return [encoding convertfrom utf-8 $temp_utf8]
+    return $params(plaintext)
 }
 
 
 proc ::ssj::encrypted:output {xlib data to} {
-    global gpgPkg
     variable ctx
     variable e4me
     variable j2k
     variable options
     variable gpg_error_id
 
-    if {[cequal $data ""]} {
+    if {[string equal $data ""]} {
         return
     }
 
@@ -836,27 +808,23 @@
         set name $bto
     }
 
-    set recipient [${gpgPkg}::recipient]
-    $recipient -operation add   \
-	       -name      $name \
-               -validity  full
+    set recipient [gpg::recipient]
+    $recipient add -name     $name \
+		   -validity full
     foreach signer $e4me($xlib) {
-        $recipient -operation add \
-                   -name      $signer \
-                   -validity  full
+        $recipient add -name     $signer \
+		       -validity full
     }
 
     once_only $xlib 1
 
     set code \
 	[catch {
-	    $ctx($xlib) \
-		-operation encrypt \
-		-input [binary format a* [encoding convertto utf-8 $data]] \
-		-recipients $recipient
+	    $ctx($xlib) encrypt -input      $data \
+				-recipients $recipient
 	 } result]
 
-    rename $recipient {}
+    $recipient free
 
     if {$code} {
         debugmsg ssj "encryption processing error ($xlib): $result ($data)"
@@ -891,8 +859,7 @@
     variable ctx
     variable warnings
 
-    set s [$ctx($xlib) -operation get -property last-op-info]
-    if {[cequal $s ""]} {
+    if {[catch {$ctx($xlib) set -property last-op-info} s]} {
         return
     }
 
@@ -906,7 +873,7 @@
 
     if {![info exists warnings($what)]} {
         set warnings($what) ""
-    } elseif {[cequal $warnings($what) $keys]} {
+    } elseif {[string equal $warnings($what) $keys]} {
         return
     }
 
@@ -981,12 +948,11 @@
 }
 
 proc ::ssj::encryptP {xlib jid} {
-    global gpgPkg
     variable ctx
     variable j2k
     variable options
 
-    if {[cequal $jid ""]} {
+    if {[string equal $jid ""]} {
 	return $options(encrypt-traffic)
     }
 
@@ -1035,20 +1001,18 @@
         set name $bjid
     }
 
-    [set recipient [${gpgPkg}::recipient]] \
-            -operation add   \
-            -name      $name \
-            -validity  full
+    [set recipient [gpg::recipient]] add \
+				     -name     $name \
+				     -validity full
 
-    if {[catch {$ctx($xlib) -operation  encrypt        \
-			      -input      "Hello world." \
-			      -recipients $recipient}]} {
+    if {[catch {$ctx($xlib) encrypt -input      "Hello world." \
+				    -recipients $recipient}]} {
         set options(encrypt-tried,$xlib,$jid) 0
     } else {
         set options(encrypt-tried,$xlib,$jid) 1
     }
 
-    rename $recipient {}
+    $recipient free
 
     return $options(encrypt-tried,$xlib,$jid)
 }
@@ -1056,29 +1020,25 @@
 #############################################################################
 
 proc ::ssj::e4meP {xlib keys} {
-    global gpgPkg
     variable ctx
     variable e4me
     variable signers
 
-    $ctx($xlib) -operation set     \
-		  -property  signers \
-		  -value     [set signers($xlib) $keys]
+    $ctx($xlib) set -property signers \
+		    -value    [set signers($xlib) $keys]
 
     set e4me($xlib) {}
     foreach signer $signers($xlib) {
-        [set recipient [${gpgPkg}::recipient]] \
-                -operation add     \
-                -name      $signer \
-                -validity  full
+        [set recipient [gpg::recipient]] add \
+					 -name     $signer \
+					 -validity full
 
-        if {![catch {$ctx($xlib) -operation  encrypt        \
-				   -input      "Hello world." \
-				   -recipients $recipient} result]} {
+        if {![catch {$ctx($xlib) encrypt -input      "Hello world." \
+					 -recipients $recipient} result]} {
             lappend e4me($xlib) $signer
         }
 
-        rename $recipient {}
+        $recipient free
     }
 }
 
@@ -1093,12 +1053,12 @@
 proc ::ssj::encrypt:toggleP {{xlib ""} {jid ""}} {
     variable options
 
-    if {[cequal $jid ""]} {
+    if {[string equal $jid ""]} {
 	set options(encrypt-traffic) [expr {!$options(encrypt-traffic)}]
         return
     }
 
-    if {![cequal $xlib ""]} {
+    if {![string equal $xlib ""]} {
 	if {![info exists options(encrypt,$xlib,$jid)]} {
 	    set options(encrypt,$xlib,$jid) [encryptP $xlib $jid]
 	}
@@ -1129,10 +1089,10 @@
     variable options
     variable trace
 
-    if {[cequal $jid ""]} {
+    if {[string equal $jid ""]} {
 	set k encrypt-traffic
     } else {
-	if {![cequal $xlib ""]} {
+	if {![string equal $xlib ""]} {
 	    set k encrypt,$xlib,$jid
 	} else {
 	    return -code error \
@@ -1192,7 +1152,7 @@
 	    }
 
 	    # in case the sender didn't check the exit code from gpg...
-	    if {[cequal $signature ""]} return
+	    if {[string equal $signature ""]} return
 
 	    set status ""
 	    foreach {key val} $args {
@@ -1262,7 +1222,7 @@
 		    switch -- $k {
 			key {
 			    foreach {k v} $v {
-				if {![cequal $k subkeys]} continue
+				if {![string equal $k subkeys]} continue
 
 				foreach subkey $v {
 				    catch {unset sparams}
@@ -1283,7 +1243,7 @@
 				[format "0x%s" [string range $v end-7 end]]
 			}
 			default {
-			    if {[cequal $v ""]} { continue }
+			    if {[string equal $v ""]} { continue }
 			}	
 		    }
 
@@ -1295,7 +1255,7 @@
 	    userinfo::pack_entry $jid $x $i presence_$i [::msgcat::mc "Reason:"]
 	    if {![info exists params(reason)]} {
 		set params(reason) [::msgcat::mc "Presence is signed"]
-		if {![cequal $addrs ""]} {
+		if {![string equal $addrs ""]} {
 		    append params(reason) [::msgcat::mc " by "] $addrs
 		}
 	    }
@@ -1355,7 +1315,7 @@
     upvar 2 $rowvar row
     upvar 2 $bodyvar body
 
-    if {!$replyP || [cequal $type error]} {
+    if {!$replyP || [string equal $type error]} {
 	return
     }
 



More information about the Tkabber-dev mailing list