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

  1. #
  2. # Second, though, and this is where the real problem came in, I wrote
  3. # CryptLib code to read a key from my PGP public key ring and encrypt some
  4. # sample data in PGP format. Here's the code (error handling omitted for
  5. # clarity):
  6. # cryptKeysetOpen(&KeySet,
  7. # cryptUser,
  8. # CRYPT_KEYSET_FILE,
  9. # vm["keyset"].as<string>().c_str(),
  10. # CRYPT_KEYOPT_READONLY
  11. # );
  12. # strcpy(KeyLabel, vm["label"].as<string>().c_str());
  13. # cryptGetPublicKey(KeySet, &Pub_Context, CRYPT_KEYID_NAME,
  14. # KeyLabel);
  15. # cryptCreateEnvelope(&Envelope, cryptUser, CRYPT_FORMAT_PGP);
  16. # cryptSetAttribute(Envelope, CRYPT_ENVINFO_PUBLICKEY,
  17. # Pub_Context);
  18. # cryptSetAttribute(Envelope, CRYPT_ENVINFO_DATASIZE,
  19. # MessageSize);
  20. # cryptPushData(Envelope, Buffer, MessageSize, &Actual);
  21. # cryptFlushData(Envelope);
  22. # cryptPopData(Envelope, Buffer, sizeof(Buffer), &Actual);
  23.  
  24. #if {[file exists cryptkit.kit]} { source cryptkit.kit}
  25. package require cryptkit
  26. crypt::Init
  27.  
  28. # GPG encrypt data for recipient.
  29. proc pgpencrypt {recipient message} {
  30. set file [file normalize ~/.gpg/pubring.gpg]
  31. set ks [crypt::KeysetOpen CRYPT_KEYSET_FILE \
  32. $file CRYPT_KEYOPT_READONLY]
  33. set k [crypt::GetPublicKey $ks CRYPT_KEYID_EMAIL $recipient]
  34.  
  35. set e [crypt::CreateEnvelope CRYPT_FORMAT_PGP]
  36. $e set CRYPT_ENVINFO_PUBLICKEY $k
  37. $k close
  38. $ks close
  39.  
  40. set m [encoding convertto utf-8 $message]
  41. $e set CRYPT_ENVINFO_DATASIZE [string length $m]
  42. set dlen [$e push $m]
  43. $e flush
  44. #set data [$e pop]
  45. set data [crypt::PopData $e $dlen]
  46. $e destroy
  47. return $data
  48. }
  49.  
  50. proc decrypt {id pass data} {
  51. set file [file normalize ~/.gpg/secring.gpg]
  52. set keyset [crypt::KeysetOpen CRYPT_KEYSET_FILE \
  53. $file CRYPT_KEYOPT_READONLY]
  54. set skey [crypt::GetPrivateKey $keyset CRYPT_KEYID_EMAIL $id $pass]
  55. set e [crypt::CreateEnvelope CRYPT_FORMAT_AUTO]
  56. $e set CRYPT_ENVINFO_KEYSET_DECRYPT $ks
  57. $e push $data
  58. $e get CRYPT_ATTRIBUTE_CURRENT
  59. $e set CRYPT_ENVINFO_PASSWORD $password
  60. $e flush
  61. set msg [$e pop]
  62. $e destroy
  63. return $msg
  64. }
  65.  
  66. proc A {} {
  67. set ctx [crypt::CreateContext CRYPT_ALGO_RSA]
  68. crypt::GetPublicKey ctx CRYPT_KEYID_NAME "BBK"
  69. crypt::GetPrivateKey ctx CRYPT_KEYID_NAME "BBK"
  70.  
  71. }
  72.  
  73. if {!$tcl_interactive} {
  74. set r [catch [linsert $argv 0 Main] err]
  75. if {$r} {puts $::errorInfo} elseif {$err ne {}} { puts $err }
  76. exit
  77. }