tcl_tests/pkcs7.tcl

   1 package require base64
   2 if {[info exists env(TOOLDIR)]} {
   3         lappend auto_path $env(TOOLDIR)
   4 } {
   5         lappend auto_path "[file dirname [info script]]/../../maketool"
   6 }
   7 package require asn 0.7.1
   8
   9 namespace eval pkcs7 {
  10         namespace import ::asn::*
  11         namespace export *
  12
  13         proc asnTag {data_var} {
  14                 upvar $data_var data
  15                 asnPeekByte data b
  16                 return $b
  17         }
  18
  19         proc envelopedData {der} {
  20                 asnGetSequence der seq0
  21                 asnGetObjectIdentifier seq0 id_envelopedData
  22                 if {$id_envelopedData != {1 2 840 113549 1 7 3}} {
  23                         error "Waited id-envelopedData, got $id_envelopedData"
  24                 }
  25                 asnGetContext seq0 n envelopedData
  26                 if {$n != 0} {
  27                         error "Waited context 0, got $n"
  28                 }
  29                 asnGetSequence envelopedData envelopedData
  30                 asnGetInteger envelopedData version
  31                 set originatorInfo {}
  32                 if {[asnTag envelopedData] != 0x31} {
  33                         asnGetContext envelopedData tag originatorInfo
  34                 }
  35                 asnGetSet envelopedData recipientInfos
  36                 asnGetSequence envelopedData encryptedContentInfo
  37                 set unprotectedAttrs {}
  38                 if {[string length $envelopedData]} {
  39                         asnGetContext envelopedData tag unprotectedAttrs
  40                 }
  41                 return [list $version $originatorInfo $recipientInfos $encryptedContentInfo $unprotectedAttrs $envelopedData]
  42         }
  43
  44         proc recipientInfos {rIs} {
  45                 set result {}
  46                 while {[string length $rIs]} {
  47                         asnGetSequence rIs inf
  48                         asnGetInteger inf version
  49                         set tag {}
  50                         if {[asnTag inf] == 0x30} {
  51                                 asnGetSequence inf rid
  52                         } {
  53                                 asnGetContext inf tag rid
  54                         }
  55                         asnGetSequence inf keyEncAlg
  56                         asnGetOctetString inf encryptedKey
  57                         lappend result [list $version [list $tag $rid] $keyEncAlg $encryptedKey]
  58                 }
  59                 return $result
  60         }
  61
  62         proc subjectPublicKeyInfo {spki} {
  63                 asnGetSequence spki algorithmIdentifier
  64                 asnGetBitString spki subjectPublicKey
  65                 list $algorithmIdentifier $subjectPublicKey $spki
  66         }
  67
  68         proc algorithmIdentifier {ai} {
  69                 asnGetObjectIdentifier ai oid
  70                 set param {}
  71                 if {[string length $ai]} {
  72                         asnGetSequence ai param
  73                 }
  74                 return [list $oid $param $ai]
  75         }
  76
  77         proc algorithmParamPKGOST {param} {
  78                 asnGetObjectIdentifier param pubkey_param
  79                 asnGetObjectIdentifier param digest_param
  80                 set cipher_param {}
  81                 if {[string length $param]} {
  82                         asnGetObjectIdentifier param cipher_param
  83                 }
  84                 return [list $pubkey_param $digest_param $cipher_param $param]
  85         }
  86
  87         proc keyTransportGOST {octet_string} {
  88                 asnGetSequence octet_string inf
  89                 asnGetSequence inf encryptedKey
  90                 set transportParams {}
  91                 if {[string length $inf]} {
  92                         asnGetContext inf tag transportParams
  93                 }
  94                 return [list $encryptedKey $transportParams $inf]
  95         }
  96
  97         proc encryptedKeyGOST {encryptedKeyAndMAC} {
  98                 asnGetOctetString encryptedKeyAndMAC encryptedKey
  99                 asnGetOctetString encryptedKeyAndMAC MAC
 100                 list $encryptedKey $MAC $encryptedKeyAndMAC
 101         }
 102
 103         proc transportParameters {transportParams} {
 104                 asnGetObjectIdentifier transportParams encryptionParamSet
 105                 set ephemeralPublicKey {}
 106                 if {[asnTag transportParams] == 0xa0} {
 107                         asnGetContext transportParams tag ephemeralPublicKey
 108                 }
 109                 asnGetOctetString transportParams ukm
 110                 list $encryptionParamSet $ephemeralPublicKey $ukm $transportParams
 111         }
 112
 113         proc encryptedContentInfo {eci} {
 114                 asnGetObjectIdentifier eci oid
 115                 asnGetSequence eci algorithmIdentifier
 116                 set encryptedContent {}
 117                 if {[string length $eci]} {
 118                         asnGetContext eci tag encryptedContent
 119                 }
 120                 list $oid $algorithmIdentifier $encryptedContent $eci
 121         }
 122
 123         proc algorithmParamEncGOST {param} {
 124                 asnGetOctetString param ukm
 125                 asnGetObjectIdentifier param encParam
 126                 list $ukm $encParam $param
 127         }
 128
 129         proc algorithm_oids_from_envelopedData {der} {
 130                 set result {}
 131                 foreach {v oI rIs eCI uAs t} [envelopedData $der] {
 132                         # recipient infos
 133                         set rin 0
 134                         foreach rI [recipientInfos $rIs] {
 135                                 foreach {v rid kEA eK} $rI {
 136                                         # export (pubkey) algorithm identifier
 137                                         foreach {pk_oid param t} [algorithmIdentifier $kEA] {
 138                                                 lappend result ri${rin}:kea=[join $pk_oid .]
 139                                                 foreach {pkp dp cp t} [algorithmParamPKGOST $param] {
 140                                                         lappend result \
 141                                                                 ri${rin}:kea:pkp=[join $pkp .] \
 142                                                                 ri${rin}:kea:dp=[join $dp .] \
 143                                                                 ri${rin}:kea:cp=[join $cp .]
 144                                                 }
 145                                         }
 146                                         # encryptedKey encapsulated structure
 147                                         foreach {eK tPs t} [keyTransportGOST $eK] {
 148                                                 # transport parameters
 149                                                 foreach {ePS ePK ukm t} [transportParameters $tPs] {
 150                                                         # encryption paramset
 151                                                         lappend result ri${rin}:ktcp=[join $ePS .]
 152                                                         # ephemeral public key
 153                                                         if {[string length $ePK]} {
 154                                                                 foreach {aI sPK t} [subjectPublicKeyInfo $ePK] {
 155                                                                         # algorithm identifier
 156                                                                         foreach {pKI param t} [algorithmIdentifier $aI] {
 157                                                                                 lappend result ri${rin}:ktepk=[join $pKI .]
 158                                                                                 foreach {pkp dp cp t} [algorithmParamPKGOST $param] {
 159                                                                                         lappend result \
 160                                                                                                 ri${rin}:ktepk:pkp=[join $pkp .] \
 161                                                                                                 ri${rin}:ktepk:dp=[join $dp .] \
 162                                                                                                 ri${rin}:ktepk:cp=[join $cp .]
 163                                                                                 }
 164                                                                         }
 165                                                                 }
 166                                                         }
 167                                                 }
 168                                         }
 169                                 }
 170                                 incr rin
 171                         }
 172                         foreach {oid aI eC t} [encryptedContentInfo $eCI] {
 173                                 # algorithm identifier
 174                                 foreach {oid param t} [algorithmIdentifier $aI] {
 175                                         lappend result ea=[join $oid .]
 176                                         foreach {ukm oid t} [algorithmParamEncGOST $param] {
 177                                                 lappend result ea:cp=[join $oid .]
 178                                         }
 179                                 }
 180                         }
 181                 }
 182                 return $result
 183         }
 184
 185 }
 186
 187 package provide pkcs7 0.1