[Tkabber-dev] [tclgpg] r61 committed - * tclgpg.tcl: Moved error generating code to a separate procedure....

codesite-noreply at google.com codesite-noreply at google.com
Sun Aug 16 22:51:48 MSD 2009


Revision: 61
Author: sgolovan
Date: Sun Aug 16 11:51:30 2009
Log: 	* tclgpg.tcl: Moved error generating code to a separate procedure.
	  Return error "Bad passphrase" to a caller.

	* tclgpg.test: Added another set of tests to the test suite.

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

Modified:
  /trunk/ChangeLog
  /trunk/gnupg/random_seed
  /trunk/tclgpg.tcl
  /trunk/tclgpg.test

=======================================
--- /trunk/ChangeLog	Sat Aug 15 13:08:28 2009
+++ /trunk/ChangeLog	Sun Aug 16 11:51:30 2009
@@ -1,3 +1,10 @@
+2009-08-16  Sergei Golovan  <sgolovan at nes.ru>
+
+	* tclgpg.tcl: Moved error generating code to a separate procedure.
+	  Return error "Bad passphrase" to a caller.
+
+	* tclgpg.test: Added another set of tests to the test suite.
+
  2009-08-15  Sergei Golovan  <sgolovan at nes.ru>

  	* tclgpg.tcl: Reduced number of known properties. Fixed error messages
=======================================
--- /trunk/gnupg/random_seed	Sat Aug 15 12:58:44 2009
+++ /trunk/gnupg/random_seed	Sun Aug 16 11:51:30 2009
Binary file, no diff available.
=======================================
--- /trunk/tclgpg.tcl	Sat Aug 15 12:58:44 2009
+++ /trunk/tclgpg.tcl	Sun Aug 16 11:51:30 2009
@@ -1393,6 +1393,7 @@
                  set state(userid_hint) [join [lrange $fields 3 end]]
              }
              NEED_PASSPHRASE {
+                set state(badpassphrase) 0
                  if {![package vsatisfies $Version 2.0]} {
                      if {![info exists state(hint)]} {
                          set state(hint) enter
@@ -1400,7 +1401,8 @@
                          set state(hint) try_again
                      }
                      if {[catch {Set $token -property passphrase-callback}  
pcb]} {
-                        NoPassphrase $channels $commands
+                        FinishWithError $channels $commands "No passphrase"
+                        return
                      }
                      set arglist [list token $token \
                                        hint $state(hint) \
@@ -1409,7 +1411,8 @@
                                        subkeyid [lindex $fields 3]]
                      Debug 2 $arglist
                      if {[catch {eval $pcb [list $arglist]} passphrase]} {
-                        NoPassphrase $channels $commands
+                        FinishWithError $channels $commands "No passphrase"
+                        return
                      } else {
                          # Passphrase encoding may differ from message  
encoding,
                          # so we have to save command-fd encoding in case  
when
@@ -1425,15 +1428,18 @@
                  }
              }
              NEED_PASSPHRASE_SYM {
+                set state(badpassphrase) 0
                  if {![package vsatisfies $Version 2.0]} {
                      if {[catch {Set $token -property passphrase-callback}  
pcb]} {
-                        NoPassphrase $channels $commands
+                        FinishWithError $channels $commands "No passphrase"
+                        return
                      }
                      if {[catch {
                              eval $pcb [list [list token $token \
                                                    hint enter]]
                           } passphrase]} {
-                        NoPassphrase $channels $commands
+                        FinishWithError $channels $commands "No passphrase"
+                        return
                      } else {
                          # Passphrase encoding may differ from message  
encoding,
                          # so we have to save command-fd encoding in case  
when
@@ -1448,19 +1454,20 @@
                      }
                  }
              }
+            BAD_PASSPHRASE {
+                set state(badpassphrase) 1
+            }
+            DECRYPTION_FAILED {
+                FinishWithError $channels $commands "Decryption failed"
+                return
+            }
              KEYEXPIRED {
                  switch -- $operation {
                      "" -
                      verify {}
                      default {
-                        CleanupGPG $channels
-                        if {[llength $commands] == 0} {
-                            return -code error "Key expired"
-                        } else {
-                            uplevel #0 [lindex $commands 0] \
-                                       [list error "Key expired"]
-                            return
-                        }
+                        FinishWithError $channels $commands "Key expired"
+                        return
                      }
                  }
              }
@@ -1469,14 +1476,8 @@
                      "" -
                      verify {}
                      default {
-                        CleanupGPG $channels
-                        if {[llength $commands] == 0} {
-                            return -code error "Key revoked"
-                        } else {
-                            uplevel #0 [lindex $commands 0] \
-                                       [list error "Key revoked"]
-                            return
-                        }
+                        FinishWithError $channels $commands "Key revoked"
+                        return
                      }
                  }
              }
@@ -1582,6 +1583,11 @@
      }

      if {$eof || [eof $status_fd] || [llength $commands] == 0} {
+        if {[info exists state(badpassphrase)] && $state(badpassphrase)} {
+            FinishWithError $channels $commands "Bad passphrase"
+            return
+        }
+
          set data [FinishGPG $token $operation $channels $input]

          CleanupGPG $channels
@@ -1596,12 +1602,12 @@
      return
  }

-proc ::gpg::NoPassphrase {channels commands} {
+proc ::gpg::FinishWithError {channels commands error} {
      CleanupGPG $channels
      if {[llength $commands] == 0} {
-        return -code error "No passphrase"
+        return -code error $error
      } else {
-        uplevel #0 [lindex $commands 0] [list error "No passphrase"]
+        uplevel #0 [lindex $commands 0] [list error $error]
          return
      }
  }
=======================================
--- /trunk/tclgpg.test	Sat Aug 15 13:08:28 2009
+++ /trunk/tclgpg.test	Sun Aug 16 11:51:30 2009
@@ -249,6 +249,135 @@
  proc pcb2 {args} {
      return 0987654321
  }
+
+proc pcb3 {args} {
+    return -code break ""
+}
+
+set message "Hello \u041f\u0440\u0438\u0432\u0435\u0442"
+
+test encrypt-decrypt-1.1 {Symmetric cipher (armored)} -body {
+    set c [::gpg::new]
+    $c set -property armor -value true
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    set res [$c decrypt -input [$c encrypt -input $message]]
+    $c free
+    set res
+} -result [list plaintext $message]
+
+test encrypt-decrypt-1.2 {Symmetric cipher (unarmored)} -body {
+    set c [::gpg::new]
+    $c set -property armor -value false
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    set res [$c decrypt -input [$c encrypt -input $message]]
+    $c free
+    set res
+} -result [list plaintext $message]
+
+test encrypt-decrypt-1.3 {Symmetric cipher & incorrect passphrase} -body {
+    set c [::gpg::new]
+    $c set -property armor -value true
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    set msg [$c encrypt -input $message]
+    $c set -property passphrase-callback -value pcb2
+    set code [catch {$c decrypt -input $msg} res]
+    $c free
+    list $code $res
+} -result {1 {Decryption failed}}
+
+test encrypt-decrypt-1.4 {Symmetric cipher & missing passphrase} -body {
+    set c [::gpg::new]
+    $c set -property armor -value true
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    set msg [$c encrypt -input $message]
+    $c set -property passphrase-callback -value pcb3
+    set code [catch {$c decrypt -input $msg} res]
+    $c free
+    list $code $res
+} -result {1 {No passphrase}}
+
+test sign-verify-1.1 {Ordinary sign (armored)} -body {
+    set c [::gpg::new]
+    $c set -property armor -value true
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    $c set -property signers -value  
0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
+    set sig [$c sign -input $message]
+    array set ares [$c verify -signature $sig]
+    $c free
+    list $ares(status) $ares(plaintext)
+} -result [list good $message]
+
+test sign-verify-1.2 {Ordinary sign (unarmored)} -body {
+    set c [::gpg::new]
+    $c set -property armor -value false
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    $c set -property signers -value  
0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
+    set sig [$c sign -input $message]
+    array set ares [$c verify -signature $sig]
+    $c free
+    list $ares(status) $ares(plaintext)
+} -result [list good $message]
+
+test sign-verify-1.3 {Detached sign (armored)} -body {
+    set c [::gpg::new]
+    $c set -property armor -value true
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    $c set -property signers -value  
0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
+    set sig [$c sign -input $message -mode detach]
+    array set ares [$c verify -signature $sig -input $message]
+    $c free
+    list $ares(status) $ares(plaintext)
+} -result [list good $message]
+
+test sign-verify-1.4 {Detached sign (unarmored)} -body {
+    set c [::gpg::new]
+    $c set -property armor -value false
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    $c set -property signers -value  
0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
+    set sig [$c sign -input $message -mode detach]
+    array set ares [$c verify -signature $sig -input $message]
+    $c free
+    list $ares(status) $ares(plaintext)
+} -result [list good $message]
+
+test sign-verify-1.5 {Clear sign} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-callback -value pcb1
+    $c set -property encoding -value utf-8
+    $c set -property signers -value  
0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
+    set sig [$c sign -input $message -mode clear]
+    array set ares [$c verify -signature $sig]
+    $c free
+    list $ares(status) $ares(plaintext)
+} -result [list good $message\n]
+
+test sign-1.1 {Sign with no passphrase} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-callback -value pcb3
+    $c set -property encoding -value utf-8
+    $c set -property signers -value  
0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
+    set code [catch {$c sign -input $message} res]
+    $c free
+    list $code $res
+} -result {1 {No passphrase}}
+
+test sign-1.2 {Sign with incorrect passphrase} -body {
+    set c [::gpg::new]
+    $c set -property passphrase-callback -value pcb2
+    $c set -property encoding -value utf-8
+    $c set -property signers -value  
0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
+    set code [catch {$c sign -input $message} res]
+    $c free
+    list $code $res
+} -result {1 {Bad passphrase}}

  cleanupTests



More information about the Tkabber-dev mailing list