TclGPG  Check-in [cc12c7dc06]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added new property pinentry-mode. It can be used with gpg 2.1 to use custom passphrase callbacks. Also, allowed the input message to sign and the passphrase to be supplied to gpg in any order (doesn't work without C helper). Added a few tests for pinentry-mode and documented it shortly in the manual page.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: cc12c7dc067b9d1c728f22972ba630d1f4c28b5e
User & Date: sgolovan 2015-12-26 13:32:54
Context
2015-12-27
15:13
Return the 'bad passphrase' error for the case of failure after incorrectly entered passphrase via the pinentry. check-in: 772fd164a7 user: sgolovan tags: trunk
2015-12-26
13:32
Added new property pinentry-mode. It can be used with gpg 2.1 to use custom passphrase callbacks. Also, allowed the input message to sign and the passphrase to be supplied to gpg in any order (doesn't work without C helper). Added a few tests for pinentry-mode and documented it shortly in the manual page. check-in: cc12c7dc06 user: sgolovan tags: trunk
10:13
Fixed a harmless but annoying warning with integer to pointer conversion. check-in: 9a3ebdb085 user: sgolovan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1
2
3
4
5
6
7







8
9
10
11
12
13
14
2015-12-26  Sergei Golovan  <sgolovan@nes.ru>

	* doc/gpg.man, tclgpg.tcl: Take the name of GnuPG executable from
	  the $GPG_EXECUTABLE environment variable if it's set.

	* tclgpg.c: Fixed a harmless but annoying warning with integer to
	  pointer conversion.








2015-10-08  Sergei Golovan  <sgolovan@nes.ru>

	* tclgpg.tcl: Fixed work with GnuPG 2.1 which doesn't require the
	  GPG_AGENT_INFO environment variable to be defined.

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







>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
2015-12-26  Sergei Golovan  <sgolovan@nes.ru>

	* doc/gpg.man, tclgpg.tcl: Take the name of GnuPG executable from
	  the $GPG_EXECUTABLE environment variable if it's set.

	* tclgpg.c: Fixed a harmless but annoying warning with integer to
	  pointer conversion.

	* tclgpg.tcl, tclgpg.test, doc/gpg.man: Added new property
	  pinentry-mode. It can be used with gpg 2.1 to use custom passphrase
	  callbacks. Also, allowed the input message to sign and the
	  passphrase to be supplied to gpg in any order (doesn't work without
	  C helper). Added a few tests for pinentry-mode and documented it
	  shortly in the manual page.

2015-10-08  Sergei Golovan  <sgolovan@nes.ru>

	* tclgpg.tcl: Fixed work with GnuPG 2.1 which doesn't require the
	  GPG_AGENT_INFO environment variable to be defined.

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

Changes to doc/gpg.man.

35
36
37
38
39
40
41




















42
43
44
45
46
47
48
[list_begin definitions]

[def "[cmd armor] [arg boolean]"]

[def "[cmd textmode] [arg boolean]"]

[def "[cmd passphrase-callback] [arg command]"]





















[def [cmd "encoding"]]

[def [cmd "passphrase-encoding"]]

[list_end]








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
[list_begin definitions]

[def "[cmd armor] [arg boolean]"]

[def "[cmd textmode] [arg boolean]"]

[def "[cmd passphrase-callback] [arg command]"]

The [cmd passphrase-callback] property sets the command which returns the
user's GPG passphrase to the signing or encrypting/decrypting routine.

Note that currently GPG commonly uses [cmd gpg-agent] to ask user for and
cache passphrases, in this case this [cmd passphrase-callback] property
will be ignored. There are two cases when it isn't:

First, [cmd gpg] 1.4 (called 'classic' at the GnuPG website) without
gpg-agent enabled.

Second, [cmd gpg] 2.1 (called 'modern' at the GnuPG website) with gpg-agent
which allows one to use loopback pinentry (essentially asking the calling
application for a passphrase) and the [cmd pinentry-mode] property set
to [arg loopback].

[def "[cmd pinentry-mode] [arg mode]"]

This property makes sense only for [cmd gpg] 2.1. See the gpg2 manual
for details.

[def [cmd "encoding"]]

[def [cmd "passphrase-encoding"]]

[list_end]

155
156
157
158
159
160
161




162

163
164
165
166
167

[def [var \$GPG_AGENT_INFO]]

This variable is required for the [package gpg] packge to work with GnuPG 2.0.

[list_end]





[section "AUTHORS"]

Sergei Golovan

[keywords Tcl GnuPG]
[comment { vim: set ft=tcl ts=8 sw=4 sts=4 et: }]
[manpage_end]







>
>
>
>

>





175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192

[def [var \$GPG_AGENT_INFO]]

This variable is required for the [package gpg] packge to work with GnuPG 2.0.

[list_end]

[section "SEE ALSO"]

https://www.gnupg.org

[section "AUTHORS"]

Sergei Golovan

[keywords Tcl GnuPG]
[comment { vim: set ft=tcl ts=8 sw=4 sts=4 et: }]
[manpage_end]

Changes to tclgpg.tcl.

230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
                                                               -value}]]
            }
        }
    }

    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" [JoinOptions $properties]]
    } elseif {[lsearch -exact $properties $prop] >= 0} {
        if {![info exists value]} {







|







230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
                                                               -value}]]
            }
        }
    }

    variable properties [list armor textmode passphrase-callback \
                              signers encoding passphrase-encoding \
                              last-op-info pinentry-mode]

    if {![info exists prop]} {
        return -code error \
               [format "missing property:\
                        must be %s" [JoinOptions $properties]]
    } elseif {[lsearch -exact $properties $prop] >= 0} {
        if {![info exists value]} {
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
                       [format "unknown option \"%s\":\
                                must be %s" $key [JoinOptions {-property}]]
            }
        }
    }

    set properties [list armor textmode passphrase-callback \
                         signers encoding passphrase-encoding]


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







|
>







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
                       [format "unknown option \"%s\":\
                                must be %s" $key [JoinOptions {-property}]]
            }
        }
    }

    set properties [list armor textmode passphrase-callback \
                         signers encoding passphrase-encoding \
                         pinentry-mode]

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


1101
1102
1103
1104
1105
1106
1107

















1108
1109
1110
1111
1112
1113
1114
#       doesn't exist).
#
# Side effects:
#       A new gpg process is spawned. Also, if --decrypt or --verify options
#       are present in arguments list then a temporary file is created.

proc ::gpg::ExecGPG {token operation args} {


    Debug 1 $args

    # Add common --use-agent --no-tty, --quiet, --output -, --charset utf-8
    # arguments

    set args [linsert $args 0 --use-agent --no-tty --quiet --output - \
                              --charset utf-8]


















    # Set --armor option before calling CExecGPG

    set armor [Set $token -property armor]

    switch -- $operation {
        encrypt -







>
>







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
#       doesn't exist).
#
# Side effects:
#       A new gpg process is spawned. Also, if --decrypt or --verify options
#       are present in arguments list then a temporary file is created.

proc ::gpg::ExecGPG {token operation args} {
    variable Version

    Debug 1 $args

    # Add common --use-agent --no-tty, --quiet, --output -, --charset utf-8
    # arguments

    set args [linsert $args 0 --use-agent --no-tty --quiet --output - \
                              --charset utf-8]

    # Set the --pinentry-mode if the pinentry-mode property is set
    #
    # Use pinentry-mode loopback if you want to supply the passphrase
    # in passphrase-callback instead of using gpg-agent (which is safer)
    #
    # 0. It doesn't work without C helper
    # 1. It works only for gpg 2.1.
    # 2. It also requires adding allow-loopback-pinentry to the
    #    ~/.gnupg/gpg-agent.conf config file. Without this setting the
    #    --pinentry-mode loopbak is just ignored, so we don't break much.

    if {[info commands [namespace current]::CExecGPG] ne "" && \
            [package vsatisfies $Version 2.1] && \
            ![catch {Set $token -property pinentry-mode} mode]} {
        set args [linsert $args 0 --pinentry-mode $mode]
    }

    # Set --armor option before calling CExecGPG

    set armor [Set $token -property armor]

    switch -- $operation {
        encrypt -
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406

1407
1408
1409
1410
1411

1412
1413
1414
1415
1416
1417







1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435








1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447

    # Collect signatures if any (if operation is decrypt-check or verify)

    if {![info exists state(signatures)]} {
        set state(signatures) {}
    }

    set state(decryption_started) 0

    # Parse gpg status output

    set eof 0

    while {[gets $status_fd line] >= 0} {
        Debug 2 $line
        set fields [split $line]

        if {[lindex $fields 0] ne "\[GNUPG:\]"} continue


        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]]
            }
            NEED_PASSPHRASE {
                set state(badpassphrase) 0
                if {![info exists state(hint)]} {
                    set state(hint) enter
                } else {
                    set state(hint) try_again
                }








                set state(arglist) [list token $token \
                                         hint $state(hint) \
                                         userid $state(userid_hint) \
                                         keyid [lindex $fields 2] \
                                         subkeyid [lindex $fields 3]]
                Debug 2 $state(arglist)
            }
            NEED_PASSPHRASE_SYM {
                set state(badpassphrase) 0
                set state(hint) enter
                set state(arglist) [list token $token \
                                         hint $state(hint)]







<
<



>





>






>
>
>
>
>
>
>






<











>
>
>
>
>
>
>
>



|
|







1415
1416
1417
1418
1419
1420
1421


1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450

1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481

    # Collect signatures if any (if operation is decrypt-check or verify)

    if {![info exists state(signatures)]} {
        set state(signatures) {}
    }



    # Parse gpg status output

    set eof 0
    set output 0
    while {[gets $status_fd line] >= 0} {
        Debug 2 $line
        set fields [split $line]

        if {[lindex $fields 0] ne "\[GNUPG:\]"} continue
        set output 1

        switch -- [lindex $fields 1] {
            BEGIN_ENCRYPTION -
            BEGIN_SIGNING {
                set state(keyexpired) 0
                set state(keyrevoked) 0
                if {![SupplyMessage $channels $input]} {
                    FinishWithError $channels $commands "Key is unusable"
                    return
                }
            }
            SIG_CREATED -
            END_ENCRYPTION {
                set eof 1
                break
            }
            BEGIN_DECRYPTION {
                set state(keyexpired) 0
                set state(keyrevoked) 0

            }
            USERID_HINT {
                set state(userid_hint) [join [lrange $fields 3 end]]
            }
            NEED_PASSPHRASE {
                set state(badpassphrase) 0
                if {![info exists state(hint)]} {
                    set state(hint) enter
                } else {
                    set state(hint) try_again
                }

                # Documentation says:
                # NEED_PASSPHRASE <long main keyid> <long keyid> etc...
                #
                # But what really happens is:
                # NEED_PASSPHRASE F6834B35D07FD0F0 21C747D36A461052 16 0
                # where the second keyid is the main keyid.

                set state(arglist) [list token $token \
                                         hint $state(hint) \
                                         userid $state(userid_hint) \
                                         keyid [lindex $fields 3] \
                                         subkeyid [lindex $fields 2]]
                Debug 2 $state(arglist)
            }
            NEED_PASSPHRASE_SYM {
                set state(badpassphrase) 0
                set state(hint) enter
                set state(arglist) [list token $token \
                                         hint $state(hint)]
1585
1586
1587
1588
1589
1590
1591






1592


1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604



















1605
1606
1607
1608
1609
1610
1611
                    expiredkey {
                        lappend state(sig:summary) green
                    }
                }
            }
            NODATA -
            UNEXPECTED {






                set state(sig:status) nosig


            }
            INV_RECP {
                switch -- [lindex $fields 2] {
                    0 - 1 - 2 {
                        FinishWithError $channels $commands "Public key not found"
                        return
                    }
                    default {
                        FinishWithError $channels $commands "Unusable public key"
                        return
                    }
                }



















            }
        }
    }

    if {$eof || [eof $status_fd] || [llength $commands] == 0} {
        if {[info exists state(badpassphrase)] && $state(badpassphrase)} {
            FinishWithError $channels $commands "Bad passphrase"







>
>
>
>
>
>
|
>
>












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
                    expiredkey {
                        lappend state(sig:summary) green
                    }
                }
            }
            NODATA -
            UNEXPECTED {
                switch -- $operation {
                    decrypt {
                        set output 0
                        break
                    }
                    default {
                        set state(sig:status) nosig
                    }
                }
            }
            INV_RECP {
                switch -- [lindex $fields 2] {
                    0 - 1 - 2 {
                        FinishWithError $channels $commands "Public key not found"
                        return
                    }
                    default {
                        FinishWithError $channels $commands "Unusable public key"
                        return
                    }
                }
            }
            INV_SGNR {
                set output 0
                break
            }
        }
    }

    if {!$output} {
        # If gpg didn't say anything then it's a fault

        switch -- $operation {
            decrypt {
                FinishWithError $channels $commands "Encrypted message is corrupted"
                return
            }
            default {
                FinishWithError $channels $commands "Key is unusable"
                return
            }
        }
    }

    if {$eof || [eof $status_fd] || [llength $commands] == 0} {
        if {[info exists state(badpassphrase)] && $state(badpassphrase)} {
            FinishWithError $channels $commands "Bad passphrase"
1631
1632
1633
1634
1635
1636
1637
























1638
1639
1640
1641
1642
1643
1644
        } else {
            uplevel #0 [lindex $commands 0] [list ok $data]
        }
    }

    return
}

























proc ::gpg::FinishWithError {channels commands error} {
    CleanupGPG $channels
    if {[llength $commands] == 0} {
        return -code error $error
    } else {
        uplevel #0 [lindex $commands 0] [list error $error]







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
        } else {
            uplevel #0 [lindex $commands 0] [list ok $data]
        }
    }

    return
}

proc ::gpg::SupplyMessage {channels input} {
    Debug 2 "$channels $input"

    foreach {filename stdin_fd stdout_fd stderr_fd status_fd command_fd} \
            $channels break

    # Supply message for encryption or signing

    if {[catch {puts -nonewline $stdin_fd $input}]} {
        return 0
    }

    # Since we can't signal EOF without actually closing the channel, the
    # things break for the case when GPG asks for the passphrase AFTER
    # the message for signing/decrypting, which is known to happen when
    # GPG 2.1 is used in loopback pinentry mode, and there's no C helper
    # which separates input and control channels, so it's safe to close
    # either one.

    catch {close $stdin_fd}

    return 1
}

proc ::gpg::FinishWithError {channels commands error} {
    CleanupGPG $channels
    if {[llength $commands] == 0} {
        return -code error $error
    } else {
        uplevel #0 [lindex $commands 0] [list error $error]
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
            set status diff
        }
    }

    switch -- $operation {
        encrypt -
        sign {
            # Supply message for encryption or signing

            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]
        }
        decrypt-check -
        "" {
            # "" means verifying non-detached signature, so gpg reports
            # the signed message to stdout.







<
<
<
<
<
<
<
<



<
<
<
<







1778
1779
1780
1781
1782
1783
1784








1785
1786
1787




1788
1789
1790
1791
1792
1793
1794
            set status diff
        }
    }

    switch -- $operation {
        encrypt -
        sign {








            set data [read $stdout_fd]
        }
        decrypt {




            set plaintext [read $stdout_fd]
            set data [list plaintext $plaintext]
        }
        decrypt-check -
        "" {
            # "" means verifying non-detached signature, so gpg reports
            # the signed message to stdout.

Changes to tclgpg.test.

63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

test set-1.6 {Set unknown property} -body {
    set c [::gpg::new]
    $c set -property unknown -value val
} -returnCodes error \
    -result {unknown property "unknown":\
        must be armor, textmode, passphrase-callback,\
        signers, encoding, passphrase-encoding, or last-op-info} \

    -cleanup {$c free}

test set-1.7 {Query unknown property} -body {
    set c [::gpg::new]
    $c set -property unknown
} -returnCodes error \
    -result {unknown property "unknown":\
        must be armor, textmode, passphrase-callback, signers,\
        encoding, passphrase-encoding, or last-op-info} \
    -cleanup {$c free}

test set-1.8 {Set armor property to invalid value} -body {
    set c [::gpg::new]
    $c set -property armor -value v
} -returnCodes error \
    -result {invalid armor value "v": must be boolean} \







|
>








|







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

test set-1.6 {Set unknown property} -body {
    set c [::gpg::new]
    $c set -property unknown -value val
} -returnCodes error \
    -result {unknown property "unknown":\
        must be armor, textmode, passphrase-callback,\
        signers, encoding, passphrase-encoding, last-op-info,\
        or pinentry-mode} \
    -cleanup {$c free}

test set-1.7 {Query unknown property} -body {
    set c [::gpg::new]
    $c set -property unknown
} -returnCodes error \
    -result {unknown property "unknown":\
        must be armor, textmode, passphrase-callback, signers,\
        encoding, passphrase-encoding, last-op-info, or pinentry-mode} \
    -cleanup {$c free}

test set-1.8 {Set armor property to invalid value} -body {
    set c [::gpg::new]
    $c set -property armor -value v
} -returnCodes error \
    -result {invalid armor value "v": must be boolean} \
111
112
113
114
115
116
117






118
119
120
121
122
123
124
test set-1.12 {Set with extraneous arguments} -body {
    set c [::gpg::new]
    $c set -property textmode -value true -property armor -value true
} -returnCodes error \
    -result {wrong # args: should be set -property propertyName\
        ?-value value?} \
    -cleanup {$c free}







test unset-1.1 {Unset armor property} -body {
    set c [::gpg::new]
    $c unset -property armor
    $c set -property armor
} -result false -cleanup {$c free}








>
>
>
>
>
>







112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
test set-1.12 {Set with extraneous arguments} -body {
    set c [::gpg::new]
    $c set -property textmode -value true -property armor -value true
} -returnCodes error \
    -result {wrong # args: should be set -property propertyName\
        ?-value value?} \
    -cleanup {$c free}

test set-1.13 {Set pinentry-mode property} -body {
    set c [::gpg::new]
    $c set -property pinentry-mode -value loopback
    $c set -property pinentry-mode
} -result loopback -cleanup {$c free}

test unset-1.1 {Unset armor property} -body {
    set c [::gpg::new]
    $c unset -property armor
    $c set -property armor
} -result false -cleanup {$c free}

150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172








173
174
175
176
177
178
179

test unset-1.6 {Unset unknown property} -body {
    set c [::gpg::new]
    $c unset -property unknown
} -returnCodes error \
    -result {unknown property "unknown": must be armor,\
        textmode, passphrase-callback, signers, encoding,\
        or passphrase-encoding} \
    -cleanup {$c free}

test unset-1.7 {Unset without a property} -body {
    set c [::gpg::new]
    $c unset
} -returnCodes error \
    -result {wrong # args: should be unset -property propertyName} \
    -cleanup {$c free}

test unset-1.8 {Unset with an incorrect option} -body {
    set c [::gpg::new]
    $c unset -prop armor
} -returnCodes error \
    -result {unknown option "-prop": must be -property} \
    -cleanup {$c free}









set keylist {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712\
             2F97ECD7444AB86A649A2138DBD996EC2D5BBFDB\
             61F33F648D8D47DC21F5CE1F1FC8896DFEA3B10D\
             6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
             CC13143A088AEECCB99AF05778E9B5C778DC9112\
             E815CCABAEF4BBEA0DDD654D137F583FA1E4655D}







|















>
>
>
>
>
>
>
>







157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194

test unset-1.6 {Unset unknown property} -body {
    set c [::gpg::new]
    $c unset -property unknown
} -returnCodes error \
    -result {unknown property "unknown": must be armor,\
        textmode, passphrase-callback, signers, encoding,\
        passphrase-encoding, or pinentry-mode} \
    -cleanup {$c free}

test unset-1.7 {Unset without a property} -body {
    set c [::gpg::new]
    $c unset
} -returnCodes error \
    -result {wrong # args: should be unset -property propertyName} \
    -cleanup {$c free}

test unset-1.8 {Unset with an incorrect option} -body {
    set c [::gpg::new]
    $c unset -prop armor
} -returnCodes error \
    -result {unknown option "-prop": must be -property} \
    -cleanup {$c free}

test unset-1.9 {Unset pinentry-mode property} -body {
    set c [::gpg::new]
    $c unset -property pinentry-mode
    $c set -property pinentry-mode
} -returnCodes error \
    -result {property "pinentry-mode" is not set} \
    -cleanup {$c free}

set keylist {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712\
             2F97ECD7444AB86A649A2138DBD996EC2D5BBFDB\
             61F33F648D8D47DC21F5CE1F1FC8896DFEA3B10D\
             6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
             CC13143A088AEECCB99AF05778E9B5C778DC9112\
             E815CCABAEF4BBEA0DDD654D137F583FA1E4655D}
255
256
257
258
259
260
261

262
263
264
265
266
267
268
269

270
271
272
273
274
275
276
277

278
279
280
281
282
283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
311
312
313
314
315
316

317
318
319
320
321
322
323
324
325
326
327
328
329
330

331
332
333
334
335
336
337
338
339
340
341
342
343
344

345
346
347
348
349
350
351
352
353
354
355
356
357
358

359
360
361
362
363
364
365
366
367
368
369
370
371

372
373
374
375
376
377
378
379
380
381
382
383
384

385
386
387
388
389
390
391
392

393
394
395
396
397
398
399
400

401
402
403
404
405
406
407

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
    $c decrypt -input [$c encrypt -input $message]
} -result [list plaintext $message] -cleanup {$c free}

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
    $c decrypt -input [$c encrypt -input $message]
} -result [list plaintext $message] -cleanup {$c free}

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
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {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
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {No passphrase}

test encrypt-decrypt-1.5 {Symmetric cipher & missing passphrase callback} -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 unset -property passphrase-callback
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {No passphrase callback}

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]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -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]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -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]
    set ares(status)
} -cleanup {
    $c free
    unset sig ares
} -result good

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]
    set ares(status)
} -cleanup {
    $c free
    unset sig ares
} -result good

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]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -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
    $c sign -input $message
} -returnCodes error -result {No passphrase} -cleanup {$c free}

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
    $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]







>








>








>













>













>













>














>














>














>













>













>








>








>







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435

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 pinentry-mode -value loopback
    $c set -property encoding -value utf-8
    $c decrypt -input [$c encrypt -input $message]
} -result [list plaintext $message] -cleanup {$c free}

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 pinentry-mode -value loopback
    $c set -property encoding -value utf-8
    $c decrypt -input [$c encrypt -input $message]
} -result [list plaintext $message] -cleanup {$c free}

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 pinentry-mode -value loopback
    $c set -property encoding -value utf-8
    set msg [$c encrypt -input $message]
    $c set -property passphrase-callback -value pcb2
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {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 pinentry-mode -value loopback
    $c set -property encoding -value utf-8
    set msg [$c encrypt -input $message]
    $c set -property passphrase-callback -value pcb3
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {No passphrase}

test encrypt-decrypt-1.5 {Symmetric cipher & missing passphrase callback} -body {
    set c [::gpg::new]
    $c set -property armor -value true
    $c set -property passphrase-callback -value pcb1
    $c set -property pinentry-mode -value loopback
    $c set -property encoding -value utf-8
    set msg [$c encrypt -input $message]
    $c unset -property passphrase-callback
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {No passphrase callback}

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 pinentry-mode -value loopback
    $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]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -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 pinentry-mode -value loopback
    $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]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -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 pinentry-mode -value loopback
    $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]
    set ares(status)
} -cleanup {
    $c free
    unset sig ares
} -result good

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 pinentry-mode -value loopback
    $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]
    set ares(status)
} -cleanup {
    $c free
    unset sig ares
} -result good

test sign-verify-1.5 {Clear sign} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb1
    $c set -property pinentry-mode -value loopback
    $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]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -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 pinentry-mode -value loopback
    $c set -property encoding -value utf-8
    $c set -property signers -value 0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
    $c sign -input $message
} -returnCodes error -result {No passphrase} -cleanup {$c free}

test sign-1.2 {Sign with incorrect passphrase} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb2
    $c set -property pinentry-mode -value loopback
    $c set -property encoding -value utf-8
    $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 pinentry-mode -value loopback
    $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]
443
444
445
446
447
448
449

450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468

469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484

485
486
487
488
489
490
491
    $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 set -property encoding -value utf-8
    $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







>



















>
















>







471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
    $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 set -property pinentry-mode -value loopback
    $c set -property encoding -value utf-8
    $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 set -property pinentry-mode -value loopback
    $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 set -property pinentry-mode -value loopback
    $c decrypt -input \
"-----BEGIN PGP MESSAGE-----
Version: GnuPG v1.4.6 (GNU/Linux)

hIwDH92Qmdvb5zoBA/0ZuZSuX/t7mybydfWfgiAuWttcvMKbT71MgyMlI9JJHK5/
D2qq0bISQAClMBYuFmv12TM5ar3jp/ixbOfXsTLbWtim4asHdZYQ0Adm9Z8umHjm
38GZo7NWg/kEnPGyElmmBqvBHbgdpV1ToswQY+yxYRibpCuCCgZbFr4ml9IFBdJO