[Tkabber-dev] [tclgpg] r75 committed - * tclgpg.tcl: Fixed encrypting to the recipients with several public...

tclgpg at googlecode.com tclgpg at googlecode.com
Fri Jan 10 22:37:08 MSK 2014


Revision: 75
Author:   sgolovan
Date:     Fri Jan 10 18:36:46 2014 UTC
Log:      	* tclgpg.tcl: Fixed encrypting to the recipients with several  
public
	  keys where some of them are expired or revoked.

	* tclgpg.test: Covered the change above.

	* doc/gpg.man, tclgpg.tcl, tclgpg.test: Extended copyright period.

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

Modified:
  /trunk/ChangeLog
  /trunk/doc/gpg.man
  /trunk/gnupg/pubring.gpg
  /trunk/gnupg/secring.gpg
  /trunk/gnupg/trustdb.gpg
  /trunk/tclgpg.tcl
  /trunk/tclgpg.test

=======================================
--- /trunk/ChangeLog	Sat Jan 29 07:49:22 2011 UTC
+++ /trunk/ChangeLog	Fri Jan 10 18:36:46 2014 UTC
@@ -1,3 +1,12 @@
+2014-01-10  Sergei Golovan  <sgolovan at nes.ru>
+
+	* tclgpg.tcl: Fixed encrypting to the recipients with several public
+	  keys where some of them are expired or revoked.
+
+	* tclgpg.test: Covered the change above.
+
+	* doc/gpg.man, tclgpg.tcl, tclgpg.test: Extended copyright period.
+
  2011-01-29  Sergei Golovan  <sgolovan at nes.ru>

  	* tclgpg.tcl: Added --use-agent option to the gpg call, which makes
=======================================
--- /trunk/doc/gpg.man	Fri Jul  2 04:35:44 2010 UTC
+++ /trunk/doc/gpg.man	Fri Jan 10 18:36:46 2014 UTC
@@ -1,7 +1,7 @@
  [comment {-*- tcl -*- doctools manpage}]
  [comment {$Id$}]
  [manpage_begin gpg n 1.0]
-[copyright {2008-2010 Sergei Golovan <sgolovan at nes.ru>}]
+[copyright {2008-2014 Sergei Golovan <sgolovan at nes.ru>}]
  [moddesc {Tcl interface to GNU Privacy Guard}]
  [titledesc {Tcl Interface to GnuPG}]
  [require Tcl 8.4]
=======================================
--- /trunk/gnupg/pubring.gpg	Sat Aug 15 19:58:44 2009 UTC
+++ /trunk/gnupg/pubring.gpg	Fri Jan 10 18:36:46 2014 UTC
Binary file, no diff available.
=======================================
--- /trunk/gnupg/secring.gpg	Sat Aug 15 19:58:44 2009 UTC
+++ /trunk/gnupg/secring.gpg	Fri Jan 10 18:36:46 2014 UTC
Binary file, no diff available.
=======================================
--- /trunk/gnupg/trustdb.gpg	Sat Aug 15 19:58:44 2009 UTC
+++ /trunk/gnupg/trustdb.gpg	Fri Jan 10 18:36:46 2014 UTC
@@ -43,3 +43,14 @@
   ÎY	À­pDºñ©JbvæÅ/      %          
   ºUÔ{
  EãSxÔô‰4kCKPoâç                 
+ èÌ«®ô»ê
+ÝeMX?¡äe]      '          
+ Ž1ÜB>!Z¦«xš1
+Ù™                 
+ /—ì×DJ¸jdš!8ÛÙ–ì-[¿Û       )          
+ NEïÜ’§{*èÜÄôˆjPÃ2À                  
+ aó?dGÜ!õÎȉmþ£±
+      +          
+ _ƒ-gAk“ßU
+t
+ëѪTvg                 
=======================================
--- /trunk/tclgpg.tcl	Sat Jan 29 07:49:22 2011 UTC
+++ /trunk/tclgpg.tcl	Fri Jan 10 18:36:46 2014 UTC
@@ -2,7 +2,7 @@
  #
  #        Tcl interface to GNU Privacy Guard.
  #
-# Copyright (c) 2008-2009 Sergei Golovan <sgolovan at nes.ru>
+# Copyright (c) 2008-2014 Sergei Golovan <sgolovan at nes.ru>
  #
  # See the file "license.terms" for information on usage and redistribution
  # of this file, and for a DISCLAMER OF ALL WARRANTIES.
@@ -1370,6 +1370,8 @@
  }

  proc ::gpg::ParseGPG {token operation commands channels input} {
+    Debug 2 "$token $operation $commands $channels $input"
+
      variable Version
      variable keys

@@ -1387,6 +1389,8 @@
      if {![info exists state(signatures)]} {
          set state(signatures) {}
      }
+
+    set state(decryption_started) 0

      # Parse gpg status output

@@ -1400,9 +1404,16 @@
          switch -- [lindex $fields 1] {
              BEGIN_ENCRYPTION -
              BEGIN_SIGNING {
+                set state(keyexpired) 0
+                set state(keyrevoked) 0
                  set eof 1
                  break
              }
+            BEGIN_DECRYPTION {
+                set state(keyexpired) 0
+                set state(keyrevoked) 0
+                set state(decryption_started) 1
+            }
              USERID_HINT {
                  set state(userid_hint) [join [lrange $fields 3 end]]
              }
@@ -1460,8 +1471,7 @@
                      "" -
                      verify {}
                      default {
-                        FinishWithError $channels $commands "Key expired"
-                        return
+                        set state(keyexpired) 1
                      }
                  }
              }
@@ -1470,8 +1480,7 @@
                      "" -
                      verify {}
                      default {
-                        FinishWithError $channels $commands "Key revoked"
-                        return
+                        set state(keyrevoked) 1
                      }
                  }
              }
@@ -1594,7 +1603,17 @@
              return
          }

-        set data [FinishGPG $token $operation $channels $input]
+        if {[info exists state(keyexpired)] && $state(keyexpired)} {
+            FinishWithError $channels $commands "Key expired"
+            return
+        }
+
+        if {[info exists state(keyrevoked)] && $state(keyrevoked)} {
+            FinishWithError $channels $commands "Key revoked"
+            return
+        }
+
+        set data [FinishGPG $token $operation $channels $commands $input]

          CleanupGPG $channels

@@ -1618,7 +1637,7 @@
      }
  }

-proc ::gpg::FinishGPG {token operation channels input} {
+proc ::gpg::FinishGPG {token operation channels commands input} {
      Debug 2 "$token $operation $channels $input"

      foreach {filename stdin_fd stdout_fd stderr_fd status_fd command_fd} \
@@ -1671,12 +1690,19 @@
          sign {
              # Supply message for encryption or signing

-            puts -nonewline $stdin_fd $input
+            if {[catch {puts -nonewline $stdin_fd $input}]} {
+                FinishWithError $channels $commands "Key is unusable"
+                return
+            }
              catch {close $stdin_fd}

              set data [read $stdout_fd]
          }
          decrypt {
+            if {!$state(decryption_started)} {
+                FinishWithError $channels $commands "Encrypted message is  
corrupted"
+                return
+            }
              set plaintext [read $stdout_fd]
              set data [list plaintext $plaintext]
          }
=======================================
--- /trunk/tclgpg.test	Sun Nov 15 09:50:54 2009 UTC
+++ /trunk/tclgpg.test	Fri Jan 10 18:36:46 2014 UTC
@@ -2,7 +2,7 @@
  #
  #       This file is part of the TclGPG library. It contains tests.
  #
-# Copyright (c) 2008-2009 Sergei Golovan <sgolovan at nes.ru>
+# Copyright (c) 2008-2014 Sergei Golovan <sgolovan at nes.ru>
  #
  # See the file "license.terms" for information on usage and redistribution
  # of this file, and for a DISCLAMER OF ALL WARRANTIES.
@@ -172,14 +172,18 @@
  } -returnCodes error \
      -result {unknown option "-prop": must be -property} \
      -cleanup {$c free}
+
+set keylist {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712\
+             2F97ECD7444AB86A649A2138DBD996EC2D5BBFDB\
+             61F33F648D8D47DC21F5CE1F1FC8896DFEA3B10D\
+             6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
+             CC13143A088AEECCB99AF05778E9B5C778DC9112\
+             E815CCABAEF4BBEA0DDD654D137F583FA1E4655D}

  test list-keys-1.1 {List all public keys synchronously} -body {
      set c [::gpg::new]
      lsort [$c list-keys]
-} -result {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712\
-        6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
-        CC13143A088AEECCB99AF05778E9B5C778DC9112} \
-    -cleanup {$c free}
+} -result $keylist -cleanup {$c free}

  test list-keys-1.2 {List all public keys asynchronously} -setup {
      proc ::result {status keys} {
@@ -195,22 +199,18 @@
      $c free
      rename ::result ""
      unset ::listkeys
-} -result {ok {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712\
-        6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
-        CC13143A088AEECCB99AF05778E9B5C778DC9112}}
+} -result [list ok $keylist]

  test list-keys-1.3 {List matching public keys synchronously} -body {
      set c [::gpg::new]
      $c list-keys -patterns {revoked}
-} -result {6A5E179C7201BA252BEEC16F36F27239DFA10A4E} -cleanup {$c free}
+} -result {6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
+        2F97ECD7444AB86A649A2138DBD996EC2D5BBFDB} -cleanup {$c free}

  test list-keys-2.1 {List all secret keys synchronously} -body {
      set c [::gpg::new]
      lsort [$c list-keys -secretonly true]
-} -result {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712\
-        6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
-        CC13143A088AEECCB99AF05778E9B5C778DC9112} \
-    -cleanup {$c free}
+} -result $keylist -cleanup {$c free}

  test list-keys-2.2 {List all secret keys asynchronously} -setup {
      proc ::result {status keys} {
@@ -226,9 +226,7 @@
      $c free
      rename ::result ""
      unset ::listkeys
-} -result {ok {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712\
-        6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
-        CC13143A088AEECCB99AF05778E9B5C778DC9112}}
+} -result [list ok $keylist]

  test list-keys-2.3 {List matching secret keys synchronously} -body {
      set c [::gpg::new]
@@ -398,26 +396,118 @@
      $c set -property signers -value  
0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
      $c sign -input $message
  } -returnCodes error -result {Bad passphrase} -cleanup {$c free}
+
+test sign-1.3 {Sign with revoked key} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    $c set -property signers -value  
6A5E179C7201BA252BEEC16F36F27239DFA10A4E
+    $c sign -input $message
+} -returnCodes error -result {Key is unusable} -cleanup {$c free}

  test encrypt-1.1 {Encrypt to unknown recipient} -body {
      set c [::gpg::new]
      set r [::gpg::recipient]
      $r add -name unknown at example.org -validity full
+    puts stderr [$c encrypt -input $message -recipients $r]
+} -cleanup {
+    $c free
+    $r free
+} -returnCodes error -result {Public key not found}
+
+test encrypt-1.2 {Encrypt to a recipient with expired key} -body {
+    set c [::gpg::new]
+    set r [::gpg::recipient]
+    $r add -name sergei at golovan.ru -validity full
      $c encrypt -input $message -recipients $r
  } -cleanup {
      $c free
      $r free
  } -returnCodes error -result {Public key not found}

-#test encrypt-1.2 {Encrypt to a recipient with expired key} -body {
-#    set c [::gpg::new]
-#    set r [::gpg::recipient]
-#    $r add -name ??? -validity full
-#    $c encrypt -input $message -recipients $r
-#} -cleanup {
-#    $c free
-#    $r free
-#} -returnCodes error -result {Unusable public key}
+test encrypt-1.3 {Encrypt to a recipient with revoked key} -body {
+    set c [::gpg::new]
+    set r [::gpg::recipient]
+    $r add -name sergei1 at golovan.ru -validity full
+    $c encrypt -input $message -recipients $r
+} -cleanup {
+    $c free
+    $r free
+} -returnCodes error -result {Public key not found}
+
+test encrypt-1.4 {Encrypt to a recipient with both expired&valid keys}  
-body {
+    set c [::gpg::new]
+    set r [::gpg::recipient]
+    $r add -name sgolovan at gmail.com -validity full
+    $c encrypt -input $message -recipients $r
+    list ok ; # only testing non-error status
+} -cleanup {
+    $c free
+    $r free
+} -result {ok}
+
+test decrypt-1.1 {Decrypt with a revoked key} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-callback -value pcb1
+    $c decrypt -input \
+"-----BEGIN PGP MESSAGE-----
+Version: GnuPG v1.4.6 (GNU/Linux)
+
+hIwDH92Qmdvb5zoBA/0ZuZSuX/t7mybydfWfgiAuWttcvMKbT71MgyMlI9JJHK5/
+D2qq0bISQAClMBYuFmv12TM5ar3jp/ixbOfXsTLbWtim4asHdZYQ0Adm9Z8umHjm
+38GZo7NWg/kEnPGyElmmBqvBHbgdpV1ToswQY+yxYRibpCuCCgZbFr4ml9IFBdJO
+AbzATKk7pm5fkM9lHy/k4DHDwtpYmjuBId7H/muc0yYCFjSY0CpBFWmW0r/1GSRI
+NZCKk8sVxdQlM039q/PjwvwuJ5HVcw9SjrxluFky
+=tcxU
+-----END PGP MESSAGE-----"
+} -cleanup {
+    $c free
+} -result [list plaintext $message]
+
+test decrypt-1.2 {Decrypt incorrect message} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-callback -value pcb1
+    $c decrypt -input \
+"-----BEGIN PGP MESSAGE-----
+Version: GnuPG v1.4.6 (GNU/Linux)
+
+hIwDH92Qmdvb5zoBA/0ZuZSuX/t7mybydfWfgiAuWttcvMKbT71MgyMlI9JJHK5/
+AbzATKk7pm5fkM9lHy/k4DHDwtpYmjuBId7H/muc0yYCFjSY0CpBFWmW0r/1GSRI
+NZCKk8sVxdQlM039q/PjwvwuJ5HVcw9SjrxluFky
+=tcxU
+-----END PGP MESSAGE-----"
+} -cleanup {
+    $c free
+} -returnCodes error -result {Encrypted message is corrupted}
+
+test decrypt-1.3 {Decrypt with an incorrect passphrase} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-callback -value pcb2
+    $c decrypt -input \
+"-----BEGIN PGP MESSAGE-----
+Version: GnuPG v1.4.6 (GNU/Linux)
+
+hIwDH92Qmdvb5zoBA/0ZuZSuX/t7mybydfWfgiAuWttcvMKbT71MgyMlI9JJHK5/
+D2qq0bISQAClMBYuFmv12TM5ar3jp/ixbOfXsTLbWtim4asHdZYQ0Adm9Z8umHjm
+38GZo7NWg/kEnPGyElmmBqvBHbgdpV1ToswQY+yxYRibpCuCCgZbFr4ml9IFBdJO
+AbzATKk7pm5fkM9lHy/k4DHDwtpYmjuBId7H/muc0yYCFjSY0CpBFWmW0r/1GSRI
+NZCKk8sVxdQlM039q/PjwvwuJ5HVcw9SjrxluFky
+=tcxU
+-----END PGP MESSAGE-----"
+} -cleanup {
+    $c free
+} -returnCodes error -result {Decryption failed}
+
+test decrypt-1.4 {Decrypt and check the signature} -body {
+    set c [::gpg::new]
+    set r [::gpg::recipient]
+    $r add -name sgolovan at gmail.com -validity full
+    $c encrypt -input $message -recipients $r
+    list ok ; # only testing non-error status
+} -cleanup {
+    $c free
+    $r free
+} -result {ok}

  cleanupTests



More information about the Tkabber-dev mailing list