]> wagner.pp.ru Git - openssl-gost/engine.git/blob - tcl_tests/ossltest.tcl
Update Copyright lines after registration rework
[openssl-gost/engine.git] / tcl_tests / ossltest.tcl
1 #
2 # Расширение пакета test для OpenSSL
3 #
4 package require http
5 # Путь поиска пакета test
6 if {[info exists env(TOOLDIR)]} {
7         lappend auto_path $env(TOOLDIR)
8 } {
9         lappend auto_path "[file dirname [info script]]/../../maketool"
10 }
11
12
13 # outputs specified environment variables into log
14
15 proc log_vars {args} {
16         foreach var $args {
17                 if [info exists ::env($var)] {
18                         log $var=$::env($var)
19                 } else {
20                         log "$var is not set"
21                 }       
22         }
23 }       
24 # Проверка наличия необходимых переменных окружения
25 foreach var {OPENSSL_APP} {
26 if {![info exists env($var)]} {
27         puts stderr "Environment variable $var not defined"
28         exit 100
29 } else {
30         set $var [file normalize $env($var)]
31 }
32 }
33
34 if {[info exists env(OPENSSL_CONF)]} {
35         set OPENSSL_CONF $env(OPENSSL_CONF)
36 } else {
37         if {[regexp {OPENSSLDIR: "([^\"]+)"} [exec $OPENSSL_APP version -d] => openssl_dir]} {
38                 set OPENSSL_CONF $openssl_dir/openssl.cnf
39         } else {        
40                 puts stderr "Cannot find out default openssl config"
41                 exit 100
42         }
43 }       
44
45 if {![file exists $OPENSSL_CONF]} {
46         puts "Configuration file $OPENSSL_CONF doesn't exist"
47         exit 100
48 }       
49
50 if {$::tcl_platform(platform) != "windows"} {
51   proc kill {signal pid} {
52   exec kill -$signal $pid
53   }
54 } else {
55   proc kill {signal pid} {
56   exec taskkill /pid $pid /f
57   }
58 }
59         
60 package require test
61 set test::suffix ""
62 package require base64
63
64 #
65 # set  up test::dir variable
66 #
67
68 if {[info exists env(TESTDIR)]} {
69         set ::test::dir [file normalize $env(TESTDIR)]
70 } else {
71         set ::test::dir [file join [pwd] z]
72 }       
73
74 #
75 # Фильтрует вывод полученный в виде длинной строки, разбивая на строки
76 # по \n. Возвращает строки, удовлетворяющие регулярному выражениу
77 # pattern
78 #
79
80 proc grep {pattern data} {
81         set out ""
82         foreach line [split $data "\n"] {
83                 if {[regexp $pattern $line]} {
84                         append out $line "\n"
85                 }
86         }       
87         return $out
88 }       
89 proc check_builtin_engine {} {
90         global OPENSSL_APP
91         set found [regexp Cryptocom [exec $OPENSSL_APP engine 2> /dev/null]]
92         if {$found} {
93                 puts "Using statically compiled engine"
94         } else {
95                 puts "Using dynamically loaded engine"
96         }
97         return $found
98 }       
99         
100
101 # Вызывает команду openssl.
102 # Посылает в лог вывод на stdout и на stderr, возвращает его же.
103 proc openssl {cmdline} {
104         global ENGINE_PATH OPENSSL_APP
105         log_vars OPENSSL_CONF CRYPT_PARAMS RNG RNG_PARAMS CCENGINE_LICENSE
106         if {[info exists ::test::engine]} {
107                 set cmdline [concat [lrange $cmdline 0 0] [list -engine $::test::engine] [lrange $cmdline 1 end]]
108         }       
109         log "OpenSSL cmdline: $OPENSSL_APP $cmdline"
110         set f [open "|$OPENSSL_APP $cmdline" r]
111         set output [read $f]
112         if {[catch {close $f} msg]} {
113                 append output "STDERR CONTENTS:\n$msg"
114                 log $output
115                 if {[lindex $::errorCode 0]!="NONE"} {
116                         return -code error -errorcode $::errorCode $output
117                 }
118         }       
119         return $output
120 }       
121
122
123 proc getConfig {args} {
124         global OPENSSL_CONF
125         if {![info exists OPENSSL_CONF]} {
126           if {![regexp "OPENSSLDIR: \"\[^\"\]+\"" [openssl version -d] => openssl_dir]} {
127                 puts stderr "Cannot find out openssl directory"
128                 exit 1
129           }
130          set OPENSSL_CONF  "$openssl_dir/openssl.cnf"
131         }
132         set f [open $OPENSSL_CONF r]
133         set out ""
134         set mode copy
135         while {[gets $f line]>=0} {
136                 if {[regexp     "\\s*\\\[\\s*(\\S+)\\s*\\\]" $line => section]} {
137                         if {[lsearch -exact $args $section]!=-1} {
138                                 set mode skip
139                         } else {
140                                 set mode copy
141                         }
142                 }
143                 if {$mode eq "copy"} {
144                         append out $line \n
145                 }       
146          }      
147          return $out
148 }        
149 #
150 # Создает тестовый CA
151 # Допустимые параметры: 
152 # CAname - директория, в которой создается CA (testCA по умолчанию)
153 # алгоритм с параметрами в формате команды req
154 #
155
156 proc makeCA {{CAname {}} {algor_with_par gost2012_512:A}} {
157         global OPENSSL_CONF
158         if {![string length $CAname]} {
159                 set CAname [file rootname [file tail $::argv0]]CA-2012
160         }       
161         set test::ca $CAname
162         file delete -force $CAname
163         file mkdir $CAname
164         makeFile $CAname/ca.conf "
165 \[ ca \]
166 default_ca      = CA_default            # The default ca section
167
168 \[ CA_default \]
169
170 dir            = [file join [pwd] $CAname]              # top dir
171 database       = \$dir/index.txt        # index file.
172 new_certs_dir  = \$dir/newcerts         # new certs dir
173
174 certificate    = \$dir/cacert.pem       # The CA cert
175 serial         = \$dir/serial           # serial no file
176 private_key    = \$dir/private/cakey.pem# CA private key
177 RANDFILE       = \$dir/private/.rand    # random number file
178
179 default_days   = 3650                  # how long to certify for
180 default_crl_days= 30                   # how long before next CRL
181 default_md     = default               # use digest corresponding the algorithm
182 default_startdate = 060101000000Z
183
184 policy         = policy_any            # default policy
185 email_in_dn    = yes                   #  add the email into cert D
186
187
188 nameopt        = ca_default            # Subject name display option
189 certopt        = ca_default            # Certificate display option
190 copy_extensions = copy                 # Copy extensions from requ
191
192
193 \[ policy_any \]
194 countryName            = supplied
195 stateOrProvinceName    = optional
196 organizationName       = optional
197 organizationalUnitName = optional
198 commonName             = supplied
199 emailAddress           = supplied
200
201 "       
202         makeFile $CAname/req.conf "
203 \[req\]
204 prompt=no
205 distinguished_name = req_dn
206 \[ req_dn \]
207 C = RU
208 L = Moscow
209 CN=Test CA $algor_with_par
210 O=Cryptocom
211 OU=OpenSSL CA
212 emailAddress = openssl@cryptocom.ru
213 "
214         file mkdir $CAname/private
215         file mkdir $CAname/newcerts
216         generate_key [keygen_params $algor_with_par] $CAname/private/cakey.pem
217         openssl "req -new  -x509 -key $CAname/private/cakey.pem -nodes -out $CAname/cacert.pem -config $CAname/req.conf -set_serial 0x11E"
218         makeFile ./$CAname/.rand 1234567890
219         makeFile ./$CAname/serial 011E
220         makeFile ./$CAname/index.txt ""
221         return [file isfile $CAname/cacert.pem]
222 }
223
224 proc extract_oids {filename {format PEM} {offset 0}} {
225         set out ""
226         if {$offset} {
227                 set miscargs "-offset $offset "
228         } else {
229                 set miscargs ""
230         }       
231         foreach line [split [openssl "asn1parse $miscargs-in $filename -inform $format -oid oidfile"] "\n"] {
232                 if {([regexp {Gost\d+} $line]||[regexp "GostR" $line]||[regexp "GOST" $line]||[regexp "sha1" $line]) && ![regexp ^Loaded: $line]} {
233                         regsub {[^:]+:[^:]+:} $line "" line
234                         append out $line "\n"
235                 }
236         }
237         return $out
238 }
239
240 # Формирует список параметров для openssl req необходимый для формирования 
241 # ключа c указанным алгоритмом и параметрами
242 #  
243 proc keygen_params {alg} {      
244         return [split $alg :] 
245 }       
246
247 proc generate_key {params filename} {
248         set alg [lindex $params 0]
249         set param [lindex $params 1]
250         set keyname $alg
251         set keyname [append keyname _ $param .pem] 
252         switch -glob $alg {
253         rsa { 
254                 if {![string length $param]} {
255                         set param 1024
256                         set keyname "rsa_1024.pem"
257                 }
258                 set optname "-algorithm rsa -pkeyopt rsa_keygen_bits:$param"
259                 }
260         ec {set optname "-paramfile $param"}
261         dsa {set optname "-paramfile $param" }
262         gost* { set optname "-algorithm $alg -pkeyopt paramset:$param" }
263         }       
264         if {$::tcl_platform(platform) eq "windows"} {
265                 set exesuffix ".exe"
266         } else {
267                 set exesuffix ""
268         }
269         log "Keyname is $keyname"
270 #       if {[engine_name] eq "open"} {
271                 log "Calling openssl cmd to create private key"
272                 openssl "genpkey  $optname -out $filename"
273 #       } elseif {[info exists ::env(OBJ)] && [file executable ../$::env(OBJ)/keytest$exesuffix]&& $alg eq "gost2001"} {
274 #               log "keytest$exesuffix $alg $param $filename"
275 #               exec ../$::env(OBJ)/keytest$exesuffix $alg $param $filename >&@ stdout
276 #       } elseif {[info exists ::env(OBJ)] && [file executable ../$::env(OBJ)/keytest$exesuffix]&& $alg eq "gost2012_256"} {
277 #               log "keytest$exesuffix $alg $param $filename"
278 #               exec ../$::env(OBJ)/keytest$exesuffix $alg $param $filename >&@ stdout
279 #       } elseif {[info exists ::env(OBJ)] && [file executable ../$::env(OBJ)/keytest$exesuffix]&& $alg eq "gost2012_512"} {
280 #               log "keytest$exesuffix $alg $param $filename"
281 #               exec ../$::env(OBJ)/keytest$exesuffix $alg $param $filename >&@ stdout
282 #       } elseif {[info exists ::env(PRIVATEKEYSDIR)] && [file exists $::env(PRIVATEKEYSDIR)/$keyname]} {
283 #               log "Copying file $keyname"
284 #               file copy $::env(PRIVATEKEYSDIR)/$keyname $filename
285 #       } else {
286 #               log "Calling openssl cmd to create private key"
287 #               openssl "genpkey  $optname -out $filename"
288 #       }
289 }
290
291 #
292 # Создает тестового пользователя с одним ключом подписи и одной заявкой
293 # на сертификат. 
294 # Параметры 
295 # username Имя директории, куда складывать файлы этого пользователя
296 # alg Параметр для опции -newkey команды openssl req, задающий алгоритм
297 #  ключа и параметры этого алгоритма
298 # Последующие параметры имеют вид списка ключ значение и задают поля
299 # Distinguished Name 
300 # FIXME Процедуру надо поправить, чтобы работала с новой версией openssl
301 proc makeUser {username alg args} {
302         file delete -force $username
303         file mkdir $username
304         if {[lsearch $args CN]==-1} {
305                 lappend args CN $username
306         }       
307         makeFile $username/req.conf [eval makeConf $args]
308         log "req.conf --------\n[getFile $username/req.conf]-------------"
309         
310         generate_key [keygen_params $alg] $username/seckey.pem
311         openssl "req -new -key $username/seckey.pem -nodes -out $username/req.pem -config $username/req.conf"
312         return [expr {[file size $username/req.pem] > 0}]
313 }
314
315 proc makeSecretKey {username alg} {
316         file delete -force $username
317         file mkdir $username
318         generate_key [keygen_params $alg] $username/seckey.pem  
319         return [expr {[file size $username/seckey.pem] > 0}]
320 }
321
322 #
323 # Создает пользователя с помощью makeUser и подписывает его сертификат
324 # ключом ранее созданного testCA. 
325 # Параметр CAname обрабатывается специальным образом: он не попадает в DN
326 #
327 proc makeRegisteredUser {username alg args } {
328         if {![info exists params(CAname)]&&![info exists ::test::ca]} {
329                 return -code error "Default CA name is not known. Have you called makeCA earlier in this script?"
330         }       
331         set CAname $test::ca
332         array set params $args
333         if {[info exist params(CAname)]} {
334                 set CAname $params(CAname)
335                 unset params(CAname)
336         }
337         if {![file isdirectory $CAname]||![file exists $CAname/cacert.pem]} {
338                 return -code error "CA $CAname doesn't exists"
339         }       
340         eval makeUser [list $username $alg] [array get params]
341         openssl "ca -config $CAname/ca.conf -in $username/req.pem -out $username/cert.pem -batch -notext" 
342         return [file isfile $username/cert.pem]
343 }
344
345 proc makeConf {args} {
346         global OPENSSL_CONF
347         array set dn_attrs [list C  RU\
348         L  Moscow\
349         CN "Dummy user"\
350         O Cryptocom\
351         OU "OpenSSL Team"\
352         emailAddress  "openssl@cryptocom.ru"\
353         ]
354         array set dn_attrs $args
355         if {[info exists dn_attrs(extensions)]} {
356                 set extensions $dn_attrs(extensions)
357                 unset dn_attrs(extensions)
358         }       
359         set out ""
360         append out {[req]
361 prompt=no
362 distinguished_name = req_dn
363 }
364 if {[info exists extensions]} {
365         append out "req_extensions = req_exts\n\[ req_exts \]\n" $extensions "\n"
366 }       
367 append out "\[ req_dn \]\n"
368         foreach {key val} [array get dn_attrs] {
369                 append out "$key=$val\n"
370         }
371         return $out
372 }       
373 #
374 # Выполняет замену регулярного выражения re на строку s в указанном
375 # PEM-документе.
376 #
377 proc hackPem {re pem s} {
378         set out ""
379         foreach {whole_pem start_line coded_body end_line} [regexp -inline -all "(-----BEGIN \[^\n\]+-----\n)(.*?)(\n-----END \[^\n\]+-----\n)" $pem] {
380                 set der [::base64::decode $coded_body]
381                 set der [regsub -all $re $der $s]
382                 append out $start_line [::base64::encode $der] $end_line
383         }
384         return $out
385 }       
386
387 #
388 # Handling of OIDs
389 #
390
391 source [file dirname  [info script]]/name2oid.tcl
392 foreach {name oid} [array get name2oid] {
393         set oid2name($oid) $name
394 }
395
396 proc long_name_by_id {id} {
397         variable name2oid
398         variable oid2name
399         if {[regexp {^\d+(\.\d+)+$} $id]} {
400         return "GOST $oid2name($id) $id"
401         }
402         return "GOST $id $name2oid($id)"
403 }
404
405 proc alg_id {alg} {
406         switch -glob $alg {
407                 gost94cc {return pk_sign94_cc}
408                 gost94cc:* {return pk_sign94_cc}
409                 gost94:* {return pk_sign94_cp}
410                 gost2001cc:* {return pk_sign01_cc}
411                 gost2001cc {return pk_sign01_cc}
412                 gost2001:* {return pk_sign01_cp}
413                 gost2012_256:* {return pk_sign12_256}
414                 gost2012_512:* {return pk_sign12_512}
415         }
416 }
417
418 proc alg_with_digest {alg} {
419         variable name2oid
420         switch -glob $alg {
421                 gost94cc {return hash_with_sign94_cc}
422                 gost94cc:* {return hash_with_sign94_cc}
423                 gost94:* {return hash_with_sign94_cp}
424                 gost2001cc:* {return hash_with_sign01_cc}
425                 gost2001cc {return hash_with_sign01_cc}
426                 gost2001:* {return hash_with_sign01_cp}
427                 gost2012_256:* {return hash_with_sign12_256}
428                 gost2012_512:* {return hash_with_sign12_512}
429                 
430         }
431 }
432
433 proc alg_long_name {alg} {
434         variable name2oid
435         switch -glob $alg {
436                 #gost94cc {return hash_with_sign94_cc}
437                 #gost94cc:* {return hash_with_sign94_cc}
438                 #gost94:* {return hash_with_sign94_cp}
439                 #gost2001cc:* {return hash_with_sign01_cc}
440                 #gost2001cc {return hash_with_sign01_cc}
441                 gost2001:* {return "GOST R 34.10-2001"}
442                 gost2012_256:* {return "GOST R 34.10-2012 with 256 bit modulus"}
443                 gost2012_512:* {return "GOST R 34.10-2012 with 512 bit modulus"}
444         }
445 }
446
447 # Returns hash algorithm corresponded to sign algorithm
448 proc alg_hash {alg} {
449     switch -glob $alg {
450         gost2012_256:* {return hash_12_256}
451         gost2012_512:* {return hash_12_512}
452         * {return hash_94}
453    }
454 }
455
456 # Returns short name of hash algorithm
457 proc hash_short_name {hash_alg} {
458     switch -glob $hash_alg {
459         *hash_94 {return md_gost94}
460         hash_12_256 {return md_gost12_256}
461         hash_12_512 {return md_gost12_512}
462         default {return $hash_alg}
463     }
464 }
465
466 proc ts_hash_long_name {hash_alg} {
467     switch -glob $hash_alg {
468         *hash_94 {return md_gost94}
469         hash_12_256 {return md_gost12_256}
470         hash_12_512 {return md_gost12_512}
471         default {return $hash_alg}
472     }
473 }
474
475 # Returns long name of hash algorithm
476 proc hash_long_name {hash_alg} {
477     switch -glob $hash_alg {
478                 *hash_94* {return "GOST R 34.11-94"}
479                 gost2001* {return "GOST R 34.11-94"}
480         *12_256* {return "GOST R 34.11-2012 with 256 bit hash"}
481         *12_512* {return "GOST R 34.11-2012 with 512 bit hash"}
482         default {return $hash_alg}
483     }
484 }
485
486 # Returns long name of hash_with_sign algorithm
487 proc hash_with_sign_long_name {alg} {
488     switch -glob $alg {
489         gost2001:* {return "GOST R 34.11-94 with GOST R 34.10-2001"}
490         gost2012_256:* {return "GOST R 34.10-2012 with GOST R 34.11-2012 (256 bit)"}
491         gost2012_512:* {return "GOST R 34.10-2012 with GOST R 34.11-2012 (512 bit)"}
492         default {return $alg}
493     }
494 }
495
496 proc smime_hash_with_sign_long_name {alg} {
497     switch -glob $alg {
498         hash_with_sign01_cp {return "GOST R 34.11-94 with GOST R 34.10-2001"}
499         hash_with_sign12_256 {return "GOST R 34.10-2012 with GOST R 34.11-2012 (256 bit)"}
500         hash_with_sign12_512 {return "GOST R 34.10-2012 with GOST R 34.11-2012 (512 bit)"}
501         default {return $alg}
502     }
503 }
504
505 proc micalg {hash_alg} {
506     switch -exact $hash_alg {
507         hash_94 {return "gostr3411-94"}
508         hash_12_256 {return "gostr3411-2012-256"}
509         hash_12_512 {return "gostr3411-2012-512"}
510     }
511 }
512
513 proc param_pubkey {alg} {
514         variable name2oid
515         switch -exact $alg {
516                 gost94cc: {return param_pubkey94_cpa}
517                 gost94cc {return param_pubkey94_cpa}
518                 gost94:A {return param_pubkey94_cpa}
519                 gost94:B {return param_pubkey94_cpb}
520                 gost94:C {return param_pubkey94_cpc}
521                 gost94:D {return param_pubkey94_cpd}
522                 gost94:XA {return param_pubkey94_cpxcha}
523                 gost94:XB {return param_pubkey94_cpxchb}
524                 gost94:XC {return param_pubkey94_cpxchc}
525                 gost2001cc: {return param_pubkey01_cc}
526                 gost2001cc {return param_pubkey01_cc}
527                 gost2001:0 {return param_pubkey01_cptest}
528                 gost2001:A {return param_pubkey01_cpa}
529                 gost2001:B {return param_pubkey01_cpb}
530                 gost2001:C {return param_pubkey01_cpc}
531                 gost2001:XA {return param_pubkey01_cpxcha}
532                 gost2001:XB {return param_pubkey01_cpxchb}
533                 gost2012_256:0 {return param_pubkey01_cptest}
534                 gost2012_256:A {return param_pubkey01_cpa}
535                 gost2012_256:B {return param_pubkey01_cpb}
536                 gost2012_256:C {return param_pubkey01_cpc}
537                 gost2012_256:XA {return param_pubkey01_cpxcha}
538                 gost2012_256:XB {return param_pubkey01_cpxchb}
539                 gost2012_512:0 {return param_pubkey12_512_0}
540                 gost2012_512:A {return param_pubkey12_512_A}
541                 gost2012_512:B {return param_pubkey12_512_B}
542         }
543 }
544
545
546 proc param_hash_long_name {hash_alg {pk_alg {}}} {
547     # R 1323565.1.023-2018 (5.2.1.2) not recommends or forbids encoding
548     # hash oid into TC26 (2012) parameters in AlgorithmIdentifier, so
549     # this is removed.
550     # Note:
551     # Commit d47b346 reverts this behavior for 512-bit 0,A,B parameters
552     switch -glob $pk_alg {
553         gost2012_256:TC* {return}
554         gost2012_512:C {return}
555     }
556     switch -glob $hash_alg {
557         *hash_94 {return "id-GostR3411-94-CryptoProParamSet"}
558         hash_12_256 {return "GOST R 34.11-2012 with 256 bit hash"}
559         hash_12_512 {return "GOST R 34.11-2012 with 512 bit hash"}
560     }
561 }
562
563 proc pubkey_long_name {alg} {
564         variable name2oid
565         switch -glob $alg {
566                 
567                 #gost2001cc: {return param_pubkey01_cc}
568                 #gost2001cc {return param_pubkey01_cc}
569                 #gost2001:0 {return param_pubkey01_cptest}
570                 gost2001:A {return "id-GostR3410-2001-CryptoPro-A-ParamSet"}
571                 gost2001:B {return "id-GostR3410-2001-CryptoPro-B-ParamSet"}
572                 gost2001:C {return "id-GostR3410-2001-CryptoPro-C-ParamSet"}
573                 gost2001:XA {return "id-GostR3410-2001-CryptoPro-XchA-ParamSet"}
574                 gost2001:XB {return "id-GostR3410-2001-CryptoPro-XchB-ParamSet"}
575                 gost2012_256:0 {return "id-GostR3410-2001-TestParamSet"}
576                 gost2012_256:A {return "id-GostR3410-2001-CryptoPro-A-ParamSet"}
577                 gost2012_256:B {return "id-GostR3410-2001-CryptoPro-B-ParamSet"}
578                 gost2012_256:C {return "id-GostR3410-2001-CryptoPro-C-ParamSet"}
579                 gost2012_256:XA {return "id-GostR3410-2001-CryptoPro-XchA-ParamSet"}
580                 gost2012_256:XB {return "id-GostR3410-2001-CryptoPro-XchB-ParamSet"}
581                 gost2012_256:TCA {return "GOST R 34.10-2012 (256 bit) ParamSet A"}
582                 gost2012_256:TCB {return "GOST R 34.10-2012 (256 bit) ParamSet B"}
583                 gost2012_256:TCC {return "GOST R 34.10-2012 (256 bit) ParamSet C"}
584                 gost2012_256:TCD {return "GOST R 34.10-2012 (256 bit) ParamSet D"}
585                 #gost2012_512:0 {return param_pubkey12_512_0}
586                 gost2012_512:A {return  "GOST R 34.10-2012 (512 bit) ParamSet A"}
587                 gost2012_512:B {return  "GOST R 34.10-2012 (512 bit) ParamSet B"}
588                 gost2012_512:C {return  "GOST R 34.10-2012 (512 bit) ParamSet C"}
589         }
590 }
591
592 proc mkObjList {args} {
593         set out ""
594         foreach name $args {
595                 if {$name eq {}} continue
596                 append out " OBJECT            :$name\n"
597         }
598         return $out
599 }
600
601 proc structured_obj_list {args} {
602         variable name2oid
603         set out {}
604         foreach {path name} $args {
605                 if {$name != {}} {set oid $name2oid($name)} {set oid {}}
606                 lappend out "$path=$oid"
607         }
608         return $out
609 }
610
611 proc param_hash {alg} {
612     switch -glob $alg {
613         gost2012_256:* {return hash_12_256}
614         gost2012_512:* {return hash_12_512}
615         * {return param_hash_94}
616     }
617 }
618
619
620 proc param_encr {short_name} {
621         variable name2oid
622         if {[regexp {^\d+(\.\d+)+$} $short_name]} {
623         return "$short_name"
624         }
625         switch -exact $short_name {
626                 cc_cipher_param {return param_encr_cc}
627                 {} {return param_encr_tc}
628                 cp_cipher_param_a {return param_encr_cpa}
629                 cp_cipher_param_b {return param_encr_cpb}
630                 cp_cipher_param_c {return param_encr_cpc}
631                 cp_cipher_param_d {return param_encr_cpd}
632         }
633 }
634
635 proc encr_long_name {short_name} {
636         variable name2oid
637         switch -exact $short_name {
638                 "1.2.643.2.2.31.1" {return "id-Gost28147-89-CryptoPro-A-ParamSet"}
639                 "1.2.643.2.2.31.2" {return "id-Gost28147-89-CryptoPro-B-ParamSet"}
640                 "1.2.643.2.2.31.3" {return "id-Gost28147-89-CryptoPro-C-ParamSet"}
641                 "1.2.643.2.2.31.4" {return "id-Gost28147-89-CryptoPro-D-ParamSet"}
642                 "1.2.643.7.1.2.5.1.1" {return "GOST 28147-89 TC26 parameter set"}
643                 {} {return "GOST 28147-89 TC26 parameter set"}
644         }
645 }
646
647
648
649 #
650 # Функции для управления клиентом и сервером при тестировании
651 # SSL-соединения
652 #
653
654 #  Параметры
655 #    Список аргументов командной строки клиента
656 #    список аргументов командной строки сервера
657 #    строка, которую надо передать на stdin клиенту
658 #
659 # Запускает openssl s_server и пытается приконнектиться к нему openssl
660 # s_client-ом. Возвращает список stdout  клиента, stderr клиента, кода
661 # завершения клиента, stdout
662 # сервера stderr сервера и кода завершения сервера.
663
664 # Если процесс убит сигналом, возвращает в качестве кода завершения имя
665 # сигнала, иначе - числовое значение кода завершения ОС
666
667 proc client_server {client_args server_args client_stdin} {
668         log "CLIENT ARGS\n$client_args\n"
669         log "SERVER ARGS\n$server_args\n"
670         flush [test_log]
671         set server [open_server $server_args]
672         set client [open_client $client_args $client_stdin]
673         log "server = $server client = $client"
674         log "Both client and server started"
675         flush [test_log]
676         global finished
677         log "Waitng for client to termintate"
678         flush [test_log]
679 #       if {$::tcl_platform(platform) == "windows"} {
680 #               exec ../kbstrike [pid $client] 0x20
681 #       }
682         vwait finished($client) 
683         catch {stop_server $server}
684         set list [concat [stop $client] [stop $server]]
685         foreach channel {"CLIENT STDOUT" "CLIENT STDERR" "CLIENT EXIT CODE"  "SERVER STDOUT"
686         "SERVER STDERR" "SERVER EXIT CODE"} data $list {
687                 log "$channel\n$data\n"
688         }
689         return $list
690 }
691 #
692 # Устанавливает командную строку для вызова клиента,
693 # в системный openssl на указанном хосте
694 #
695 proc remote_client {host} {
696         if {[info hostname] == "$host"} {
697                 set ::test::client_unset {OPENSSL_CONF}
698                 set ::test::client_app "openssl s_client"
699         } else {
700                 set ::test::client_unset {LD_LIBRARY_PATH OPENSSL_CONF}
701                 set ::test::client_app "ssh build@$host openssl s_client"
702         }
703 }       
704 #
705 # Устанавливает командную строку для вызова клиента в указанную команду
706 # Необязательный параметр указывает список переменных окружения, которые
707 # НЕ НАДО передавать в эту команду
708 #
709 proc custom_client {command {forbidden_vars {}}} {
710         set ::test::client_app $command
711         set ::test::client_unset $forbidden_vars
712
713 }
714 #
715 # Восстанавливает станадртую клиентскую команду
716 #
717 proc our_client {} {
718         catch {unset ::test::client_app}
719         catch {unset ::test::client_unset}
720 }       
721
722 #
723 # Закрывает файл, указанный в соответствующем file_id, возвращает
724 # элемент глобального массива output, содержимое error message от close
725 # и код завершения процесса (имя сигнала)
726 proc stop {file_id} {
727         global output
728         fconfigure $file_id -blocking yes
729         if {[catch {close $file_id} msg]} {
730                 if {[string match CHILD* [lindex $::errorCode 0]]} {
731                         set status [lindex $::errorCode 2]
732                 } else {
733                         set status 0
734                 }       
735         }  else {
736                 set status 0
737         }       
738         return [list $output($file_id) $msg $status]
739 }       
740 #
741 # Завершает работу сервера
742 #
743 proc stop_server {file_id} {
744 #       puts $file_id "Q\n" 
745 #       catch {set xx [socket localhost 4433]}
746         log "Interrupting process [pid $file_id]"
747         flush [test_log]
748         kill INT [pid $file_id]
749         #puts -nonewline stderr "Waiting for server termination.."
750         vwait finished($file_id)
751         if [info exists xx] {close $xx}
752 #       puts stderr "Ok"
753 }       
754
755 #
756 # Запускает процесс с указанной командной строкой. Возвращает дескриптор
757 # файла в nonblocking mode с повешенным туда fileevent
758 # Очищает соответствующие элементы массивов output и finished
759 proc start_process {cmd_line read_event {mode "r"}} {
760         set f [open "|$cmd_line" $mode]
761         global output finished
762         catch {unset finished($f)}
763         fconfigure $f -buffering none -blocking n
764         set output($f) ""
765         fileevent $f readable [list $read_event $f]
766         return $f
767 }       
768 #
769 # Обработчик fileevent-ов на чтение. Записывает считанные данные в
770 # элемент массива output соответствущий файлхендлу. В случае если
771 # достигнут eof, выставляет элемент массива finished. (элемент output
772 # при этом тоже трогается, чтобы vwait завершился)
773 #
774 proc process_read {f} {
775         global output
776         if {[eof $f]} {
777                 global finished
778                 fconfigure $f -blocking y
779                 set finished($f) 1
780                 append output($f) ""
781                 return
782         }       
783         append output($f) [read $f]
784 }       
785
786 #
787 #  Запускает openssl s_server с указанными аргументами и дожидается пока
788 #  он скажет на stdout ACCEPT. Возвращает filehandle, открытый на
789 #  чтение/запись
790 #
791 proc open_server {server_args} {
792         global OPENSSL_APP
793         global ENGINE_PATH
794         if {[info exists ::test::server_conf]} {
795                 global env
796                 set save_conf $env(OPENSSL_CONF)
797                 set env(OPENSSL_CONF) $::test::server_conf
798         }
799         if {[info exists ::test::server_app]} {
800                 set server $::test::server_app
801         } else {
802                 set server [list $OPENSSL_APP s_server]
803         }
804         if {[info exists ::test::server_unset]} {
805                 save_env $::test::server_unset
806         }       
807         set server [start_process [concat $server $server_args] process_read "r+"]
808         restore_env
809         if {[info exists save_conf]} {
810                 set env(OPENSSL_CONF) $save_conf
811         }       
812
813         global output finished
814         #puts -nonewline stderr  "Waiting for server startup..."
815         while {![regexp "\nACCEPT\n" $output($server)]} {
816                 vwait output($server)
817                 if {[info exists finished($server)]} {
818                         #puts stderr "error"
819                         return -code error [lindex  [stop $server] 1]
820                 }       
821         }               
822         #puts stderr "Ok"
823         after 100
824         return $server
825 }
826 #
827 # Сохраняет указанные переменные среды для последующего восстановления
828 # restore_env
829 #
830 proc save_env {var_list} {
831         catch {array unset ::test::save_env}
832         foreach var $var_list {
833                 if {[info exist ::env($var)]} {
834                         set ::test::save_env($var) $::env($var)
835                         unset ::env($var)
836                 }       
837         }
838
839 }
840 proc restore_env {} {
841         if {[array exists ::test::save_env]} {
842                 array set ::env [array get ::test::save_env]
843                 array unset ::test::save_env
844         }       
845         
846 }
847 #
848 # Сохраняет указанные переменные среды для последующего восстановления
849 # restore_env2. В отличие от save_env, не делает unset сохраненной переменной.
850 #
851 proc save_env2 {var_list} {
852         catch {array unset ::test::save_env2}
853         foreach var $var_list {
854                 if {[info exist ::env($var)]} {
855                         set ::test::save_env2($var) $::env($var)
856                 }       
857         }
858
859 }
860 #
861 # Восстанавливает переменные среды, ранее сохраненные функцией save_env2 
862 # В отличие от функции restore_env, требует списка переменных и 
863 # восстанавливает только переменные из данного списка. Второе отличие -
864 # если переменная из списка не была сохранена, делает ей unset.
865 #
866 proc restore_env2 {var_list} {
867         foreach var $var_list {
868                 if {[info exist ::test::save_env2($var)]} {
869                         set ::env($var) $::test::save_env2($var)
870                 } else {
871                         catch {unset ::env($var)}
872                 }
873         }
874         array unset ::test::save_env2
875 }
876
877
878 #
879 # Запускает s_client с указанными аргументами, передавая на stdin
880 # указанную строку
881 #
882 proc open_client {client_args client_stdin} {
883         global OPENSSL_APP
884         if [info exists ::test::client_app] {
885                 set client $::test::client_app
886         } else {
887                 set client [list $OPENSSL_APP s_client]
888         }
889         if {[info exists ::test::client_unset]} {
890                 save_env $::test::client_unset
891         }       
892         if {[info exists ::test::client_conf]}  {
893                 set save_env(OPENSSL_CONF) $::env(OPENSSL_CONF)
894                 set ::env(OPENSSL_CONF) $::test::client_conf
895         }
896         set client [start_process [concat $client $client_args [list << $client_stdin]] process_read]
897         restore_env
898         return $client
899 }       
900 #
901 # Зачитывает список хостов из ../../ssl-ciphers
902 #
903 proc get_hosts {file} {
904         set ::test::suffix "-$file"
905         if [file readable $file.ciphers] {
906                 set f [open $file.ciphers]
907         } else {        
908                 set f [open ../../ssl-ciphers/$file.ciphers r]
909         }
910         while {[gets $f line]>=0} {
911                 if {[regexp {^\s*#} $line]} continue
912                 append data "$line\n"
913         }
914         close $f
915         global hosts
916         array set hosts $data
917 }       
918 #
919 # Регистрирует пользователся (возможно удаленном) тестовом CA, используя
920 # скрипт testca установленный в PATH на CAhost.
921 #
922
923 proc registerUserAtCA {userdir CAhost CAprefix CApath} {
924                 global OPENSSL_APP
925                 log "registerUserAtCA $userdir $CAhost $CAprefix $CApath"
926                 set f [open  $userdir/req.pem]
927                 set request [read $f]
928                 close $f
929                 set token [::http::geturl http://$CAhost/$CAprefix/$CApath\
930                 -query [::http::formatQuery request $request startdate [clock\
931                 format [expr [clock seconds]-3600] -format "%y%m%d%H%M%SZ" -gmt y]]]
932                 if {[::http::ncode $token]!=200} {
933                         return -code error "Error certifying request [::http::data $token]"
934                 }
935                 log "Got a certificate. Saving"
936                 saveCertFromPKCS7 $userdir/cert.pem [::http::data $token]
937 }
938 proc saveCertFromPKCS7 {file pkcs7} {
939                 global OPENSSL_APP
940                 log saveCertFromPCS7
941                 log "$OPENSSL_APP pkcs7 -print_certs $pkcs7"
942                 set f [open "|[list $OPENSSL_APP pkcs7 -print_certs << $pkcs7]" r]
943                 set out [open $file w]
944                 set mode 0
945                 while {[gets $f line]>=0} {
946                         if {$mode==1} {
947                                 puts $out $line
948                                 if {$line eq "-----END CERTIFICATE-----"} {
949                                         set mode 2
950                                 }
951                         } elseif {$mode==0 && $line eq "-----BEGIN CERTIFICATE-----"} {
952                                 set mode 1
953                                 puts $out $line
954                         }
955                 }       
956                 close $f
957                 close $out
958                 if {$mode !=2 } {
959                         return -code error "Cannot get certificate from PKCS7 output"
960                 }       
961 }
962 #
963 # Invokes scp and discards stderr output if exit code is 0
964 #
965 proc scp {args} {
966         if {[info exists env(SCP)]} {
967                 set scp $env(SCP)
968         } else {
969                 set scp scp
970         }       
971         if {[catch [concat exec $scp $args] msg]} {
972                 if {[string match CHIDLD* [lindex $::errorCode 0]]} {
973                         return -code error -errorcode $::errorCode  $msg
974                 }
975         }
976 }       
977
978 proc getCAAlgParams {CAhost CAprefix alg} {
979         if {$alg == "ec" || $alg == "dsa"} {
980                 set token [::http::geturl http://$CAhost/$CAprefix/$alg?algparams=1]
981                 if {[::http::ncode $token]!=200} {
982                         return -code error "Error getting algorithm parameters [::http::data $token]"
983                 }
984                 set f [open ${alg}params.pem w]
985                 puts $f [::http::data $token]
986                 close $f
987         }
988 }       
989 #
990 # Copies CA certificate from specified CA into ca_$alg.pem
991 # Returns name of the ca certificate or empty line if something goes
992 # wrong and error wasn't properly detected
993 #
994 proc getCAcert {CAhost CApath alg} {
995         set token [::http::geturl http://$CAhost$CApath/$alg?getroot=1]
996         if {[::http::ncode $token]!=200} {
997                 return -code error "Error getting root cert for $alg: [::http::data $token]"
998         }
999         saveCertFromPKCS7 ca_$alg.pem [::http::data $token]     
1000         return ca_$alg.pem
1001 }
1002 #
1003 # Returns decoded version of first pem object in the given file
1004 #
1005 proc readpem {filename} {
1006         set f [open $filename]
1007         fconfigure $f -translation binary
1008         set data [read $f]
1009         close $f
1010         if {[regexp -- "-----BEGIN \[^\n\]+-----\r?\n(.*\n)-----END" $data => b64]} {
1011                 set data [::base64::decode $b64]
1012         }  
1013         return $data
1014
1015 }
1016         
1017 proc der_from_pem {pem} {
1018         if {[regexp -- {^-----BEGIN ([^\n]*)-----\r?\n(.*)\r?\n-----END \1-----} $pem => => base64]} {
1019                 ::base64::decode $base64
1020         } {
1021                 error "Not a PEM:\n$pem"
1022         }
1023 }
1024
1025 proc engine_name {} {
1026         global env
1027         if {[info exists env(ENGINE_NAME)]} {
1028                 switch -exact $env(ENGINE_NAME) {
1029                         "open" {return "open"}
1030                         "gost" {return "open"}
1031                         "cryptocom" {return "ccore"}
1032                         "ccore" {return "ccore"}
1033                         default {error "Unknown engine '$env(ENGINE_NAME)'"}
1034                 }
1035         } else {
1036                 return "ccore"
1037         }
1038 }
1039
1040 proc openssl_remote {files host cmdlinex suffix} {
1041                 set hostname [exec hostname]
1042                 set workpath /tmp/$hostname/$suffix
1043                 save_env {LD_LIBRARY_PATH OPENSSL_CONF ENGINE_DIR}
1044                 exec ssh build@$host mkdir -p $workpath
1045                 foreach file $files {
1046                         exec scp -r $file build@$host:$workpath
1047                 }
1048                 exec scp ../opnssl.sh build@$host:$workpath
1049                 exec ssh build@$host chmod +x $workpath/opnssl.sh
1050                 set cmdline [string map "TESTPATH $workpath" $cmdlinex]
1051                 log "hstname: $hostname OpenSSL cmdline: $host remote_openssl $cmdline"
1052                 set f [open "| ssh build@$host $workpath/opnssl.sh $cmdline" r]
1053                 set output [read $f]
1054                 restore_env
1055                 if {[catch {close $f} msg]} {
1056                         append output "STDERR CONTENTS:\n$msg"
1057                         log $output
1058                         if {[lindex $::errorCode 0]!="NONE"} {
1059                                 return -code error -errorcode $::errorCode $output
1060                         }
1061                 }
1062                 return $output
1063 }
1064
1065 package provide ossltest 0.7