Posted to tcl by patthoyts at Thu Jun 19 17:09:11 GMT 2008view pretty

# 
# Second, though, and this is where the real problem came in, I wrote
# CryptLib code to read a key from my PGP public key ring and encrypt some
# sample data in PGP format.  Here's the code  (error handling omitted for
# clarity):
#         cryptKeysetOpen(&KeySet,
#                         cryptUser,
#                         CRYPT_KEYSET_FILE,
#                         vm["keyset"].as<string>().c_str(),
#                         CRYPT_KEYOPT_READONLY
#             );
#         strcpy(KeyLabel, vm["label"].as<string>().c_str());
#         cryptGetPublicKey(KeySet, &Pub_Context, CRYPT_KEYID_NAME,
# KeyLabel);
#         cryptCreateEnvelope(&Envelope, cryptUser, CRYPT_FORMAT_PGP);
#         cryptSetAttribute(Envelope, CRYPT_ENVINFO_PUBLICKEY,
# Pub_Context);
#         cryptSetAttribute(Envelope, CRYPT_ENVINFO_DATASIZE,
# MessageSize);
#         cryptPushData(Envelope, Buffer, MessageSize, &Actual);
#         cryptFlushData(Envelope);
#         cryptPopData(Envelope, Buffer, sizeof(Buffer), &Actual); 

#if {[file exists cryptkit.kit]} { source cryptkit.kit}
package require cryptkit
crypt::Init

# GPG encrypt data for recipient.
proc pgpencrypt {recipient message} {
    set file [file normalize ~/.gpg/pubring.gpg]
    set ks [crypt::KeysetOpen CRYPT_KEYSET_FILE \
                    $file CRYPT_KEYOPT_READONLY]
    set k [crypt::GetPublicKey $ks CRYPT_KEYID_EMAIL $recipient]
    
    set e [crypt::CreateEnvelope CRYPT_FORMAT_PGP]
    $e set CRYPT_ENVINFO_PUBLICKEY $k
    $k close
    $ks close

    set m [encoding convertto utf-8 $message]
    $e set CRYPT_ENVINFO_DATASIZE [string length $m]
    set dlen [$e push $m]
    $e flush
    #set data [$e pop]
    set data [crypt::PopData $e $dlen]
    $e destroy
    return $data
}

proc decrypt {id pass data} {
    set file [file normalize ~/.gpg/secring.gpg]
    set keyset [crypt::KeysetOpen CRYPT_KEYSET_FILE \
                    $file CRYPT_KEYOPT_READONLY]
    set skey [crypt::GetPrivateKey $keyset CRYPT_KEYID_EMAIL $id $pass]
    set e [crypt::CreateEnvelope CRYPT_FORMAT_AUTO]
    $e set CRYPT_ENVINFO_KEYSET_DECRYPT $ks
    $e push $data
    $e get CRYPT_ATTRIBUTE_CURRENT
    $e set CRYPT_ENVINFO_PASSWORD $password
    $e flush
    set msg [$e pop]
    $e destroy
    return $msg
}

proc A {} {
    set ctx [crypt::CreateContext CRYPT_ALGO_RSA]
    crypt::GetPublicKey ctx CRYPT_KEYID_NAME "BBK"
    crypt::GetPrivateKey ctx CRYPT_KEYID_NAME "BBK"

}

if {!$tcl_interactive} {
    set r [catch [linsert $argv 0 Main] err]
    if {$r} {puts $::errorInfo} elseif {$err ne {}} { puts $err }
    exit
}