[Tkabber-dev] [tclgpg] r59 committed - * tclgpg.tcl: Reduced number of known properties. Fixed error message...

codesite-noreply at google.com codesite-noreply at google.com
Sat Aug 15 23:59:01 MSD 2009


Revision: 59
Author: sgolovan
Date: Sat Aug 15 12:58:44 2009
Log: 	* tclgpg.tcl: Reduced number of known properties. Fixed error messages
	  in set and unset commands when the property is not specified. Fixed
	  subkeys element of parsed key info.

	* tclgpg.test: Added several tests to the test suite.

	* gnupg/*: Added GnuPG keyring which is used in tests.

	* Makefile.in: Fixed test target.

http://code.google.com/p/tclgpg/source/detail?r=59

Added:
  /trunk/gnupg/pubring.gpg
  /trunk/gnupg/pubring.gpg~
  /trunk/gnupg/random_seed
  /trunk/gnupg/secring.gpg
  /trunk/gnupg/trustdb.gpg
Modified:
  /trunk/ChangeLog
  /trunk/Makefile.in
  /trunk/tclgpg.tcl
  /trunk/tclgpg.test

=======================================
--- /dev/null	
+++ /trunk/gnupg/pubring.gpg	Sat Aug 15 12:58:44 2009
Binary file, no diff available.
=======================================
--- /dev/null	
+++ /trunk/gnupg/pubring.gpg~	Sat Aug 15 12:58:44 2009
Binary file, no diff available.
=======================================
--- /dev/null	
+++ /trunk/gnupg/random_seed	Sat Aug 15 12:58:44 2009
Binary file, no diff available.
=======================================
--- /dev/null	
+++ /trunk/gnupg/secring.gpg	Sat Aug 15 12:58:44 2009
Binary file, no diff available.
=======================================
--- /dev/null
+++ /trunk/gnupg/trustdb.gpg	Sat Aug 15 12:58:44 2009
@@ -0,0 +1,39 @@
+gpg   J†ß¯                       
+                                       
+                            $          
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+                                       
+    
+                                  
+                                       
+                                       
+                                       
+                            "          
+                                       
+                                       
+                                       
+                                       
+                                       
+                                        ¢Òl é„ÀZ­hUåaMà                  
+ µžÕÏk<gu³ãÍVvÎXÚo                   j^œrº%+îÁo6òr9ß¡
+N      !          
+ Yu<cÈ–óš
+[¶Ãö¤                  Ì:Šî̹šðWxéµÇxÜ‘      #          
+ (UFÐF ma®
+aümTüÓ                  ÎY	À­pDºñ©JbvæÅ/      %          
+ ºUÔ{
+EãSxÔô‰4kCKPoâç                 
=======================================
--- /trunk/ChangeLog	Fri Aug 14 05:23:37 2009
+++ /trunk/ChangeLog	Sat Aug 15 12:58:44 2009
@@ -1,3 +1,15 @@
+2009-08-15  Sergei Golovan  <sgolovan at nes.ru>
+
+	* tclgpg.tcl: Reduced number of known properties. Fixed error messages
+	  in set and unset commands when the property is not specified. Fixed
+	  subkeys element of parsed key info.
+
+	* tclgpg.test: Added several tests to the test suite.
+
+	* gnupg/*: Added GnuPG keyring which is used in tests.
+
+	* Makefile.in: Fixed test target.
+
  2009-08-14  Sergei Golovan  <sgolovan at nes.ru>

  	* tclgpg.tcl: Fixed message and signatures encodings when armor
=======================================
--- /trunk/Makefile.in	Fri Jan 30 09:09:58 2009
+++ /trunk/Makefile.in	Sat Aug 15 12:58:44 2009
@@ -233,7 +233,7 @@
  	done

  test: binaries libraries
-	$(TCLSH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS)
+	$(TCLSH) `@CYGPATH@ $(srcdir)/tclgpg.test` $(TESTFLAGS)

  shell: binaries libraries
  	@$(TCLSH) $(SCRIPT)
=======================================
--- /trunk/tclgpg.tcl	Fri Aug 14 05:23:37 2009
+++ /trunk/tclgpg.tcl	Sat Aug 15 12:58:44 2009
@@ -180,7 +180,8 @@

  # ::gpg::Set --
  #
-#       Set a given GPG context property to a given value.
+#       Set a given GPG context property to a given value or query GPG  
context
+#       property.
  #
  # Arguments:
  #       token           A GPG context token created in ::gpg::context.
@@ -190,7 +191,7 @@
  #                       unset.
  #
  # Result:
-#       Empty string in case of success, or an error if a property is  
missing
+#       Property value in case of success, or an error if a property is  
missing
  #       or unknown.
  #
  # Side effects:
@@ -216,15 +217,14 @@
          }
      }

-    variable properties [list protocol armor textmode number-of-certs \
-                              keylistmode passphrase-callback \
-                              progress-callback idle-callback signers \
-                              encoding passphrase-encoding]
+    variable properties [list armor textmode passphrase-callback \
+                              signers encoding passphrase-encoding \
+                              last-op-info]

      if {![info exists prop]} {
          return -code error \
                 [format "missing property:\
-                        must be %s" $prop [JoinOptions $properties]]
+                        must be %s" [JoinOptions $properties]]
      } elseif {[lsearch -exact $properties $prop] >= 0} {
          if {![info exists value]} {
              if {[info exists state($prop)]} {
@@ -289,15 +289,13 @@
          }
      }

-    set properties [list protocol armor textmode number-of-certs \
-                         keylistmode passphrase-callback \
-                         progress-callback idle-callback signers \
-                         encoding passphrase-encoding last-op-info]
+    set properties [list armor textmode passphrase-callback \
+                         signers encoding passphrase-encoding]

      if {![info exists prop]} {
          return -code error \
                 [format "missing property:\
-                        must be %s" $prop [JoinOptions $properties]]
+                        must be %s" [JoinOptions $properties]]
      } elseif {[lsearch -exact $properties $prop] >= 0} {
          # Restoring the default settings or unsetting the property

@@ -865,7 +863,7 @@
              lappend state(subkeys) $state(subkey)
          }
          if {[llength $state(subkeys)] > 0} {
-            lappend state(key) state(subkeys) $state(subkeys)
+            lappend state(key) subkeys $state(subkeys)
          }
          array set tmp $state(key)
          if {[info exists tmp(fingerprint)]} {
=======================================
--- /trunk/tclgpg.test	Sat Jan 17 07:59:16 2009
+++ /trunk/tclgpg.test	Sat Aug 15 12:58:44 2009
@@ -21,16 +21,234 @@
  package forget gpg
  package require -exact gpg 1.0

-test gpg-1.1 {Create context} -body {
-  set c [gpg::context]
-  string equal [info procs $c] $c
-} -result 1
-
-test gpg-1.2 {Create and destroy context} -body {
-  set c [gpg::context]
-  rename $c ""
-  info procs $c
-} -result ""
+test new-1.1 {Create context} -body {
+    set c [::gpg::new]
+    set res [list [string equal [info procs $c] $c] \
+                  [string equal [info vars $c] $c]]
+    $c free
+    set res
+} -result {1 1}
+
+test free-1.1 {Create and destroy context} -body {
+    set c [::gpg::new]
+    $c free
+    list [info procs $c] [info vars $c]
+} -result {{} {}}
+
+test set-1.1 {Set armor property} -body {
+    set c [::gpg::new]
+    $c set -property armor -value true
+    set res [$c set -property armor]
+    $c free
+    set res
+} -result true
+
+test set-1.2 {Set textmode property} -body {
+    set c [::gpg::new]
+    $c set -property textmode -value true
+    set res [$c set -property textmode]
+    $c free
+    set res
+} -result true
+
+test set-1.3 {Set encoding property} -body {
+    set c [::gpg::new]
+    $c set -property encoding -value utf-8
+    set res [$c set -property encoding]
+    $c free
+    set res
+} -result utf-8
+
+test set-1.4 {Set passphrase-encoding property} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-encoding -value utf-8
+    set res [$c set -property passphrase-encoding]
+    $c free
+    set res
+} -result utf-8
+
+test set-1.5 {Set passphrase-callback property} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-callback -value pcb
+    set res [$c set -property passphrase-callback]
+    $c free
+    set res
+} -result pcb
+
+test set-1.6 {Set unknown property} -body {
+    set c [::gpg::new]
+    set code [catch {$c set -property unknown -value val} res]
+    $c free
+    list $code $res
+} -result {1 {unknown property "unknown": must be armor, textmode,  
passphrase-callback, signers, encoding, passphrase-encoding, or  
last-op-info}}
+
+test set-1.7 {Query unknown property} -body {
+    set c [::gpg::new]
+    set code [catch {$c set -property unknown} res]
+    $c free
+    list $code $res
+} -result {1 {unknown property "unknown": must be armor, textmode,  
passphrase-callback, signers, encoding, passphrase-encoding, or  
last-op-info}}
+
+test set-1.8 {Set armor property to invalid value} -body {
+    set c [::gpg::new]
+    set code [catch {$c set -property armor -value v} res]
+    $c free
+    list $code $res
+} -result {1 {invalid armor value "v": must be boolean}}
+
+test set-1.9 {Set textmode property to invalid value} -body {
+    set c [::gpg::new]
+    set code [catch {$c set -property textmode -value v} res]
+    $c free
+    list $code $res
+} -result {1 {invalid textmode value "v": must be boolean}}
+
+test set-1.10 {Set without a property} -body {
+    set c [::gpg::new]
+    set code [catch {$c set} res]
+    $c free
+    list $code $res
+} -result {1 {missing property: must be armor, textmode,  
passphrase-callback, signers, encoding, passphrase-encoding, or  
last-op-info}}
+
+test set-1.11 {Set with an incorrect option} -body {
+    set c [::gpg::new]
+    set code [catch {$c set -prop armor} res]
+    $c free
+    list $code $res
+} -result {1 {unknown option "-prop": must be -property or -value}}
+
+test unset-1.1 {Unset armor property} -body {
+    set c [::gpg::new]
+    $c unset -property armor
+    set res [$c set -property armor]
+    $c free
+    set res
+} -result false
+
+test unset-1.2 {Unset textmode property} -body {
+    set c [::gpg::new]
+    $c unset -property textmode
+    set res [$c set -property textmode]
+    $c free
+    set res
+} -result false
+
+test unset-1.3 {Unset encoding property} -body {
+    set c [::gpg::new]
+    $c unset -property encoding
+    set res [$c set -property encoding]
+    $c free
+    set res
+} -result [encoding system]
+
+test unset-1.4 {Unset passphrase-encoding property} -body {
+    set c [::gpg::new]
+    $c unset -property passphrase-encoding
+    set res [$c set -property passphrase-encoding]
+    $c free
+    set res
+} -result [encoding system]
+
+test unset-1.5 {Unset passphrase-callback property} -body {
+    set c [::gpg::new]
+    $c unset -property passphrase-callback
+    set code [catch {$c set -property passphrase-callback} res]
+    $c free
+    list $code $res
+} -result {1 {property "passphrase-callback" isn't set}}
+
+test unset-1.6 {Unset unknown property} -body {
+    set c [::gpg::new]
+    set code [catch {$c unset -property unknown} res]
+    $c free
+    list $code $res
+} -result {1 {unknown property "unknown": must be armor, textmode,  
passphrase-callback, signers, encoding, or passphrase-encoding}}
+
+test unset-1.7 {Unset without a property} -body {
+    set c [::gpg::new]
+    set code [catch {$c unset} res]
+    $c free
+    list $code $res
+} -result {1 {missing property: must be armor, textmode,  
passphrase-callback, signers, encoding, or passphrase-encoding}}
+
+test unset-1.8 {Unset with an incorrect option} -body {
+    set c [::gpg::new]
+    set code [catch {$c unset -prop armor} res]
+    $c free
+    list $code $res
+} -result {1 {unknown option "-prop": must be -property}}
+
+test list-keys-1.1 {List all public keys synchronously} -body {
+    set c [::gpg::new]
+    set res [$c list-keys]
+    $c free
+    lsort $res
+} -result {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712  
6A5E179C7201BA252BEEC16F36F27239DFA10A4E  
CC13143A088AEECCB99AF05778E9B5C778DC9112}
+
+test list-keys-1.2 {List all public keys asynchronously} -body {
+    proc ::result {status keys} {
+        set ::listkeys [list $status $keys]
+    }
+    set c [::gpg::new]
+    $c list-keys -command ::result
+    vwait ::listkeys
+    $c free
+    set res $::listkeys
+    rename ::result ""
+    unset ::listkeys
+    list [lindex $res 0] [lsort [lindex $res 1]]
+} -result {ok {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712  
6A5E179C7201BA252BEEC16F36F27239DFA10A4E  
CC13143A088AEECCB99AF05778E9B5C778DC9112}}
+
+test list-keys-1.3 {List matching public keys synchronously} -body {
+    set c [::gpg::new]
+    set res [$c list-keys -patterns {revoked}]
+    $c free
+    set res
+} -result {6A5E179C7201BA252BEEC16F36F27239DFA10A4E}
+
+test list-keys-2.1 {List all secret keys synchronously} -body {
+    set c [::gpg::new]
+    set res [$c list-keys -secretonly true]
+    $c free
+    lsort $res
+} -result {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712  
6A5E179C7201BA252BEEC16F36F27239DFA10A4E  
CC13143A088AEECCB99AF05778E9B5C778DC9112}
+
+test list-keys-2.2 {List all secret keys asynchronously} -body {
+    proc ::result {status keys} {
+        set ::listkeys [list $status $keys]
+    }
+    set c [::gpg::new]
+    $c list-keys -secretonly true -command ::result
+    vwait ::listkeys
+    $c free
+    set res $::listkeys
+    rename ::result ""
+    unset ::listkeys
+    list [lindex $res 0] [lsort [lindex $res 1]]
+} -result {ok {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712  
6A5E179C7201BA252BEEC16F36F27239DFA10A4E  
CC13143A088AEECCB99AF05778E9B5C778DC9112}}
+
+test list-keys-2.3 {List matching secret keys synchronously} -body {
+    set c [::gpg::new]
+    set res [$c list-keys -patterns {working}]
+    $c free
+    set res
+} -result {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712}
+
+test info-key-1.1 {Info of matching public key} -body {
+    set c [::gpg::new]
+    set keys [$c list-keys -patterns {working}]
+    array set ares [$c info-key -key [lindex $keys 0]]
+    $c free
+    list $ares(keyid) $ares(name) $ares(comment) $ares(email)
+} -result {4A6276E6C52F1712 {Sergei Golovan} {working key for testing  
TclGPG} sgolovan at gmail.com}
+
+proc pcb1 {args} {
+    return 1234567890
+}
+
+proc pcb2 {args} {
+    return 0987654321
+}

  cleanupTests



More information about the Tkabber-dev mailing list