2 # Расширение пакета test для OpenSSL
5 # Путь поиска пакета test
6 if {[info exists env(TOOLDIR)]} {
7 lappend auto_path $env(TOOLDIR)
9 lappend auto_path "[file dirname [info script]]/../../maketool"
13 # outputs specified environment variables into log
15 proc log_vars {args} {
17 if [info exists ::env($var)] {
24 # Проверка наличия необходимых переменных окружения
25 foreach var {OPENSSL_APP} {
26 if {![info exists env($var)]} {
27 puts stderr "Environment variable $var not defined"
30 set $var [file normalize $env($var)]
34 if {[info exists env(OPENSSL_CONF)]} {
35 set OPENSSL_CONF $env(OPENSSL_CONF)
37 if {[regexp {OPENSSLDIR: "([^\"]+)"} [exec $OPENSSL_APP version -d] => openssl_dir]} {
38 set OPENSSL_CONF $openssl_dir/openssl.cnf
40 puts stderr "Cannot find out default openssl config"
45 if {![file exists $OPENSSL_CONF]} {
46 puts "Configuration file $OPENSSL_CONF doesn't exist"
50 if {$::tcl_platform(platform) != "windows"} {
51 proc kill {signal pid} {
52 exec kill -$signal $pid
55 proc kill {signal pid} {
56 exec taskkill /pid $pid /f
62 package require base64
65 # set up test::src variable
68 if {[info exists env(TESTSRC)]} {
69 set ::test::src [file normalize $env(TESTSRC)]
75 # set up test::dir variable
78 if {[info exists env(TESTDIR)]} {
79 set ::test::dir [file normalize $env(TESTDIR)]
81 set ::test::dir [file join [pwd] z]
85 # Фильтрует вывод полученный в виде длинной строки, разбивая на строки
86 # по \n. Возвращает строки, удовлетворяющие регулярному выражениу
90 proc grep {pattern data} {
92 foreach line [split $data "\n"] {
93 if {[regexp $pattern $line]} {
99 proc check_builtin_engine {} {
101 set found [regexp Cryptocom [exec $OPENSSL_APP engine 2> /dev/null]]
103 puts "Using statically compiled engine"
105 puts "Using dynamically loaded engine"
111 # Вызывает команду openssl.
112 # Посылает в лог вывод на stdout и на stderr, возвращает его же.
113 proc openssl {cmdline} {
114 global ENGINE_PATH OPENSSL_APP
115 log_vars OPENSSL_CONF CRYPT_PARAMS RNG RNG_PARAMS CCENGINE_LICENSE
116 if {[info exists ::test::engine]} {
117 set cmdline [concat [lrange $cmdline 0 0] [list -engine $::test::engine] [lrange $cmdline 1 end]]
119 log "OpenSSL cmdline: $OPENSSL_APP $cmdline"
120 set f [open "|$OPENSSL_APP $cmdline" r]
122 if {[catch {close $f} msg]} {
123 append output "STDERR CONTENTS:\n$msg"
125 if {[lindex $::errorCode 0]!="NONE"} {
126 return -code error -errorcode $::errorCode $output
133 proc getConfig {args} {
135 if {![info exists OPENSSL_CONF]} {
136 if {![regexp "OPENSSLDIR: \"\[^\"\]+\"" [openssl version -d] => openssl_dir]} {
137 puts stderr "Cannot find out openssl directory"
140 set OPENSSL_CONF "$openssl_dir/openssl.cnf"
142 set f [open $OPENSSL_CONF r]
145 while {[gets $f line]>=0} {
146 if {[regexp "\\s*\\\[\\s*(\\S+)\\s*\\\]" $line => section]} {
147 if {[lsearch -exact $args $section]!=-1} {
153 if {$mode eq "copy"} {
160 # Создает тестовый CA
161 # Допустимые параметры:
162 # CAname - директория, в которой создается CA (testCA по умолчанию)
163 # алгоритм с параметрами в формате команды req
166 proc makeCA {{CAname {}} {algor_with_par gost2012_512:A}} {
168 if {![string length $CAname]} {
169 set CAname [file rootname [file tail $::argv0]]CA-2012
172 file delete -force $CAname
174 makeFile $CAname/ca.conf "
176 default_ca = CA_default # The default ca section
180 dir = [file join [pwd] $CAname] # top dir
181 database = \$dir/index.txt # index file.
182 new_certs_dir = \$dir/newcerts # new certs dir
184 certificate = \$dir/cacert.pem # The CA cert
185 serial = \$dir/serial # serial no file
186 private_key = \$dir/private/cakey.pem# CA private key
187 RANDFILE = \$dir/private/.rand # random number file
189 default_days = 3650 # how long to certify for
190 default_crl_days= 30 # how long before next CRL
191 default_md = default # use digest corresponding the algorithm
192 default_startdate = 060101000000Z
194 policy = policy_any # default policy
195 email_in_dn = yes # add the email into cert D
198 nameopt = ca_default # Subject name display option
199 certopt = ca_default # Certificate display option
200 copy_extensions = copy # Copy extensions from requ
204 countryName = supplied
205 stateOrProvinceName = optional
206 organizationName = optional
207 organizationalUnitName = optional
208 commonName = supplied
209 emailAddress = supplied
212 makeFile $CAname/req.conf "
215 distinguished_name = req_dn
219 CN=Test CA $algor_with_par
222 emailAddress = openssl@cryptocom.ru
224 # Extensions for a typical CA
225 # PKIX recommendation.
226 subjectKeyIdentifier=hash
227 authorityKeyIdentifier=keyid:always,issuer
228 basicConstraints = critical,CA:true
230 # Key usage: this is typical for a CA certificate. However since it will
231 # prevent it being used as an test self-signed certificate it is best
232 # left out by default.
233 # keyUsage = cRLSign, keyCertSign
235 # Include email address in subject alt name: another PKIX recommendation
236 # subjectAltName=email:copy
237 # Copy issuer details
238 # issuerAltName=issuer:copy
240 # DER hex encoding of an extension: beware experts only!
242 # Where 'obj' is a standard or added object
243 # You can even override a supported extension:
244 # basicConstraints= critical, DER:30:03:01:01:FF
246 file mkdir $CAname/private
247 file mkdir $CAname/newcerts
248 generate_key [keygen_params $algor_with_par] $CAname/private/cakey.pem
249 openssl "req -new -x509 -key $CAname/private/cakey.pem -nodes -out $CAname/cacert.pem -config $CAname/req.conf -reqexts v3_ca -set_serial 0x11E"
250 makeFile ./$CAname/.rand 1234567890
251 makeFile ./$CAname/serial 011E
252 makeFile ./$CAname/index.txt ""
253 return [file isfile $CAname/cacert.pem]
256 proc extract_oids {filename {format PEM} {offset 0}} {
259 set miscargs "-offset $offset "
263 foreach line [split [openssl "asn1parse $miscargs-in $filename -inform $format -oid oidfile"] "\n"] {
264 if {([regexp {Gost\d+} $line]||[regexp "GostR" $line]||[regexp "GOST" $line]||[regexp "sha1" $line]) && ![regexp ^Loaded: $line]} {
265 regsub {[^:]+:[^:]+:} $line "" line
266 append out $line "\n"
272 # Формирует список параметров для openssl req необходимый для формирования
273 # ключа c указанным алгоритмом и параметрами
275 proc keygen_params {alg} {
276 return [split $alg :]
279 proc generate_key {params filename} {
280 set alg [lindex $params 0]
281 set param [lindex $params 1]
283 set keyname [append keyname _ $param .pem]
286 if {![string length $param]} {
288 set keyname "rsa_1024.pem"
290 set optname "-algorithm rsa -pkeyopt rsa_keygen_bits:$param"
292 ec {set optname "-paramfile $param"}
293 dsa {set optname "-paramfile $param" }
294 gost* { set optname "-algorithm $alg -pkeyopt paramset:$param" }
296 if {$::tcl_platform(platform) eq "windows"} {
301 log "Keyname is $keyname"
302 # if {[engine_name] eq "open"} {
303 log "Calling openssl cmd to create private key"
304 openssl "genpkey $optname -out $filename"
305 # } elseif {[info exists ::env(OBJ)] && [file executable ../$::env(OBJ)/keytest$exesuffix]&& $alg eq "gost2001"} {
306 # log "keytest$exesuffix $alg $param $filename"
307 # exec ../$::env(OBJ)/keytest$exesuffix $alg $param $filename >&@ stdout
308 # } elseif {[info exists ::env(OBJ)] && [file executable ../$::env(OBJ)/keytest$exesuffix]&& $alg eq "gost2012_256"} {
309 # log "keytest$exesuffix $alg $param $filename"
310 # exec ../$::env(OBJ)/keytest$exesuffix $alg $param $filename >&@ stdout
311 # } elseif {[info exists ::env(OBJ)] && [file executable ../$::env(OBJ)/keytest$exesuffix]&& $alg eq "gost2012_512"} {
312 # log "keytest$exesuffix $alg $param $filename"
313 # exec ../$::env(OBJ)/keytest$exesuffix $alg $param $filename >&@ stdout
314 # } elseif {[info exists ::env(PRIVATEKEYSDIR)] && [file exists $::env(PRIVATEKEYSDIR)/$keyname]} {
315 # log "Copying file $keyname"
316 # file copy $::env(PRIVATEKEYSDIR)/$keyname $filename
318 # log "Calling openssl cmd to create private key"
319 # openssl "genpkey $optname -out $filename"
324 # Создает тестового пользователя с одним ключом подписи и одной заявкой
327 # username Имя директории, куда складывать файлы этого пользователя
328 # alg Параметр для опции -newkey команды openssl req, задающий алгоритм
329 # ключа и параметры этого алгоритма
330 # Последующие параметры имеют вид списка ключ значение и задают поля
332 # FIXME Процедуру надо поправить, чтобы работала с новой версией openssl
333 proc makeUser {username alg args} {
334 file delete -force $username
336 if {[lsearch $args CN]==-1} {
337 lappend args CN $username
339 makeFile $username/req.conf [eval makeConf $args]
340 log "req.conf --------\n[getFile $username/req.conf]-------------"
342 generate_key [keygen_params $alg] $username/seckey.pem
343 openssl "req -new -key $username/seckey.pem -nodes -out $username/req.pem -config $username/req.conf"
344 return [expr {[file size $username/req.pem] > 0}]
347 proc makeSecretKey {username alg} {
348 file delete -force $username
350 generate_key [keygen_params $alg] $username/seckey.pem
351 return [expr {[file size $username/seckey.pem] > 0}]
355 # Создает пользователя с помощью makeUser и подписывает его сертификат
356 # ключом ранее созданного testCA.
357 # Параметр CAname обрабатывается специальным образом: он не попадает в DN
359 proc makeRegisteredUser {username alg args } {
360 if {![info exists params(CAname)]&&![info exists ::test::ca]} {
361 return -code error "Default CA name is not known. Have you called makeCA earlier in this script?"
364 array set params $args
365 if {[info exist params(CAname)]} {
366 set CAname $params(CAname)
369 if {![file isdirectory $CAname]||![file exists $CAname/cacert.pem]} {
370 return -code error "CA $CAname doesn't exists"
372 eval makeUser [list $username $alg] [array get params]
373 openssl "ca -config $CAname/ca.conf -in $username/req.pem -out $username/cert.pem -batch -notext"
374 return [file isfile $username/cert.pem]
377 proc makeConf {args} {
379 array set dn_attrs [list C RU\
384 emailAddress "openssl@cryptocom.ru"\
386 array set dn_attrs $args
387 if {[info exists dn_attrs(extensions)]} {
388 set extensions $dn_attrs(extensions)
389 unset dn_attrs(extensions)
394 distinguished_name = req_dn
396 if {[info exists extensions]} {
397 append out "req_extensions = req_exts\n\[ req_exts \]\n" $extensions "\n"
399 append out "\[ req_dn \]\n"
400 foreach {key val} [array get dn_attrs] {
401 append out "$key=$val\n"
406 # Выполняет замену регулярного выражения re на строку s в указанном
409 proc hackPem {re pem s} {
411 foreach {whole_pem start_line coded_body end_line} [regexp -inline -all "(-----BEGIN \[^\n\]+-----\n)(.*?)(\n-----END \[^\n\]+-----\n)" $pem] {
412 set der [::base64::decode $coded_body]
413 set der [regsub -all $re $der $s]
414 append out $start_line [::base64::encode $der] $end_line
423 source [file dirname [info script]]/name2oid.tcl
424 foreach {name oid} [array get name2oid] {
425 set oid2name($oid) $name
428 proc long_name_by_id {id} {
431 if {[regexp {^\d+(\.\d+)+$} $id]} {
432 return "GOST $oid2name($id) $id"
434 return "GOST $id $name2oid($id)"
439 gost94cc {return pk_sign94_cc}
440 gost94cc:* {return pk_sign94_cc}
441 gost94:* {return pk_sign94_cp}
442 gost2001cc:* {return pk_sign01_cc}
443 gost2001cc {return pk_sign01_cc}
444 gost2001:* {return pk_sign01_cp}
445 gost2012_256:* {return pk_sign12_256}
446 gost2012_512:* {return pk_sign12_512}
450 proc alg_with_digest {alg} {
453 gost94cc {return hash_with_sign94_cc}
454 gost94cc:* {return hash_with_sign94_cc}
455 gost94:* {return hash_with_sign94_cp}
456 gost2001cc:* {return hash_with_sign01_cc}
457 gost2001cc {return hash_with_sign01_cc}
458 gost2001:* {return hash_with_sign01_cp}
459 gost2012_256:* {return hash_with_sign12_256}
460 gost2012_512:* {return hash_with_sign12_512}
465 proc alg_long_name {alg} {
468 #gost94cc {return hash_with_sign94_cc}
469 #gost94cc:* {return hash_with_sign94_cc}
470 #gost94:* {return hash_with_sign94_cp}
471 #gost2001cc:* {return hash_with_sign01_cc}
472 #gost2001cc {return hash_with_sign01_cc}
473 gost2001:* {return "GOST R 34.10-2001"}
474 gost2012_256:* {return "GOST R 34.10-2012 with 256 bit modulus"}
475 gost2012_512:* {return "GOST R 34.10-2012 with 512 bit modulus"}
479 # Returns hash algorithm corresponded to sign algorithm
480 proc alg_hash {alg} {
482 gost2012_256:* {return hash_12_256}
483 gost2012_512:* {return hash_12_512}
488 # Returns short name of hash algorithm
489 proc hash_short_name {hash_alg} {
490 switch -glob $hash_alg {
491 *hash_94 {return md_gost94}
492 hash_12_256 {return md_gost12_256}
493 hash_12_512 {return md_gost12_512}
494 default {return $hash_alg}
498 proc ts_hash_long_name {hash_alg} {
499 switch -glob $hash_alg {
500 *hash_94 {return md_gost94}
501 hash_12_256 {return md_gost12_256}
502 hash_12_512 {return md_gost12_512}
503 default {return $hash_alg}
507 # Returns long name of hash algorithm
508 proc hash_long_name {hash_alg} {
509 switch -glob $hash_alg {
510 *hash_94* {return "GOST R 34.11-94"}
511 gost2001* {return "GOST R 34.11-94"}
512 *12_256* {return "GOST R 34.11-2012 with 256 bit hash"}
513 *12_512* {return "GOST R 34.11-2012 with 512 bit hash"}
514 default {return $hash_alg}
518 # Returns long name of hash_with_sign algorithm
519 proc hash_with_sign_long_name {alg} {
521 gost2001:* {return "GOST R 34.11-94 with GOST R 34.10-2001"}
522 gost2012_256:* {return "GOST R 34.10-2012 with GOST R 34.11-2012 (256 bit)"}
523 gost2012_512:* {return "GOST R 34.10-2012 with GOST R 34.11-2012 (512 bit)"}
524 default {return $alg}
528 proc smime_hash_with_sign_long_name {alg} {
530 hash_with_sign01_cp {return "GOST R 34.11-94 with GOST R 34.10-2001"}
531 hash_with_sign12_256 {return "GOST R 34.10-2012 with GOST R 34.11-2012 (256 bit)"}
532 hash_with_sign12_512 {return "GOST R 34.10-2012 with GOST R 34.11-2012 (512 bit)"}
533 default {return $alg}
537 proc micalg {hash_alg} {
538 switch -exact $hash_alg {
539 hash_94 {return "gostr3411-94"}
540 hash_12_256 {return "gostr3411-2012-256"}
541 hash_12_512 {return "gostr3411-2012-512"}
545 proc param_pubkey {alg} {
548 gost94cc: {return param_pubkey94_cpa}
549 gost94cc {return param_pubkey94_cpa}
550 gost94:A {return param_pubkey94_cpa}
551 gost94:B {return param_pubkey94_cpb}
552 gost94:C {return param_pubkey94_cpc}
553 gost94:D {return param_pubkey94_cpd}
554 gost94:XA {return param_pubkey94_cpxcha}
555 gost94:XB {return param_pubkey94_cpxchb}
556 gost94:XC {return param_pubkey94_cpxchc}
557 gost2001cc: {return param_pubkey01_cc}
558 gost2001cc {return param_pubkey01_cc}
559 gost2001:0 {return param_pubkey01_cptest}
560 gost2001:A {return param_pubkey01_cpa}
561 gost2001:B {return param_pubkey01_cpb}
562 gost2001:C {return param_pubkey01_cpc}
563 gost2001:XA {return param_pubkey01_cpxcha}
564 gost2001:XB {return param_pubkey01_cpxchb}
565 gost2012_256:0 {return param_pubkey01_cptest}
566 gost2012_256:A {return param_pubkey01_cpa}
567 gost2012_256:B {return param_pubkey01_cpb}
568 gost2012_256:C {return param_pubkey01_cpc}
569 gost2012_256:XA {return param_pubkey01_cpxcha}
570 gost2012_256:XB {return param_pubkey01_cpxchb}
571 gost2012_512:0 {return param_pubkey12_512_0}
572 gost2012_512:A {return param_pubkey12_512_A}
573 gost2012_512:B {return param_pubkey12_512_B}
578 proc param_hash_long_name {hash_alg {pk_alg {}}} {
579 # R 1323565.1.023-2018 (5.2.1.2) not recommends or forbids encoding
580 # hash oid into TC26 (2012) parameters in AlgorithmIdentifier, so
583 # Commit d47b346 reverts this behavior for 512-bit 0,A,B parameters
584 switch -glob $pk_alg {
585 gost2012_256:TC* {return}
586 gost2012_512:C {return}
588 switch -glob $hash_alg {
589 *hash_94 {return "id-GostR3411-94-CryptoProParamSet"}
590 hash_12_256 {return "GOST R 34.11-2012 with 256 bit hash"}
591 hash_12_512 {return "GOST R 34.11-2012 with 512 bit hash"}
595 proc pubkey_long_name {alg} {
599 #gost2001cc: {return param_pubkey01_cc}
600 #gost2001cc {return param_pubkey01_cc}
601 #gost2001:0 {return param_pubkey01_cptest}
602 gost2001:A {return "id-GostR3410-2001-CryptoPro-A-ParamSet"}
603 gost2001:B {return "id-GostR3410-2001-CryptoPro-B-ParamSet"}
604 gost2001:C {return "id-GostR3410-2001-CryptoPro-C-ParamSet"}
605 gost2001:XA {return "id-GostR3410-2001-CryptoPro-XchA-ParamSet"}
606 gost2001:XB {return "id-GostR3410-2001-CryptoPro-XchB-ParamSet"}
607 gost2012_256:0 {return "id-GostR3410-2001-TestParamSet"}
608 gost2012_256:A {return "id-GostR3410-2001-CryptoPro-A-ParamSet"}
609 gost2012_256:B {return "id-GostR3410-2001-CryptoPro-B-ParamSet"}
610 gost2012_256:C {return "id-GostR3410-2001-CryptoPro-C-ParamSet"}
611 gost2012_256:XA {return "id-GostR3410-2001-CryptoPro-XchA-ParamSet"}
612 gost2012_256:XB {return "id-GostR3410-2001-CryptoPro-XchB-ParamSet"}
613 gost2012_256:TCA {return "GOST R 34.10-2012 (256 bit) ParamSet A"}
614 gost2012_256:TCB {return "GOST R 34.10-2012 (256 bit) ParamSet B"}
615 gost2012_256:TCC {return "GOST R 34.10-2012 (256 bit) ParamSet C"}
616 gost2012_256:TCD {return "GOST R 34.10-2012 (256 bit) ParamSet D"}
617 #gost2012_512:0 {return param_pubkey12_512_0}
618 gost2012_512:A {return "GOST R 34.10-2012 (512 bit) ParamSet A"}
619 gost2012_512:B {return "GOST R 34.10-2012 (512 bit) ParamSet B"}
620 gost2012_512:C {return "GOST R 34.10-2012 (512 bit) ParamSet C"}
624 proc mkObjList {args} {
627 if {$name eq {}} continue
628 append out " OBJECT :$name\n"
633 proc structured_obj_list {args} {
636 foreach {path name} $args {
637 if {$name != {}} {set oid $name2oid($name)} {set oid {}}
638 lappend out "$path=$oid"
643 proc param_hash {alg} {
645 gost2012_256:* {return hash_12_256}
646 gost2012_512:* {return hash_12_512}
647 * {return param_hash_94}
652 proc param_encr {short_name} {
654 if {[regexp {^\d+(\.\d+)+$} $short_name]} {
657 switch -exact $short_name {
658 cc_cipher_param {return param_encr_cc}
659 {} {return param_encr_tc}
660 cp_cipher_param_a {return param_encr_cpa}
661 cp_cipher_param_b {return param_encr_cpb}
662 cp_cipher_param_c {return param_encr_cpc}
663 cp_cipher_param_d {return param_encr_cpd}
667 proc encr_long_name {short_name} {
669 switch -exact $short_name {
670 "1.2.643.2.2.31.1" {return "id-Gost28147-89-CryptoPro-A-ParamSet"}
671 "1.2.643.2.2.31.2" {return "id-Gost28147-89-CryptoPro-B-ParamSet"}
672 "1.2.643.2.2.31.3" {return "id-Gost28147-89-CryptoPro-C-ParamSet"}
673 "1.2.643.2.2.31.4" {return "id-Gost28147-89-CryptoPro-D-ParamSet"}
674 "1.2.643.7.1.2.5.1.1" {return "GOST 28147-89 TC26 parameter set"}
675 {} {return "GOST 28147-89 TC26 parameter set"}
682 # Функции для управления клиентом и сервером при тестировании
687 # Список аргументов командной строки клиента
688 # список аргументов командной строки сервера
689 # строка, которую надо передать на stdin клиенту
691 # Запускает openssl s_server и пытается приконнектиться к нему openssl
692 # s_client-ом. Возвращает список stdout клиента, stderr клиента, кода
693 # завершения клиента, stdout
694 # сервера stderr сервера и кода завершения сервера.
696 # Если процесс убит сигналом, возвращает в качестве кода завершения имя
697 # сигнала, иначе - числовое значение кода завершения ОС
699 proc client_server {client_args server_args client_stdin} {
700 log "CLIENT ARGS\n$client_args\n"
701 log "SERVER ARGS\n$server_args\n"
703 set server [open_server $server_args]
704 set client [open_client $client_args $client_stdin]
705 log "server = $server client = $client"
706 log "Both client and server started"
709 log "Waitng for client to termintate"
711 # if {$::tcl_platform(platform) == "windows"} {
712 # exec ../kbstrike [pid $client] 0x20
714 vwait finished($client)
715 catch {stop_server $server}
716 set list [concat [stop $client] [stop $server]]
717 foreach channel {"CLIENT STDOUT" "CLIENT STDERR" "CLIENT EXIT CODE" "SERVER STDOUT"
718 "SERVER STDERR" "SERVER EXIT CODE"} data $list {
719 log "$channel\n$data\n"
724 # Устанавливает командную строку для вызова клиента,
725 # в системный openssl на указанном хосте
727 proc remote_client {host} {
728 if {[info hostname] == "$host"} {
729 set ::test::client_unset {OPENSSL_CONF}
730 set ::test::client_app "openssl s_client"
732 set ::test::client_unset {LD_LIBRARY_PATH OPENSSL_CONF}
733 set ::test::client_app "ssh build@$host openssl s_client"
737 # Устанавливает командную строку для вызова клиента в указанную команду
738 # Необязательный параметр указывает список переменных окружения, которые
739 # НЕ НАДО передавать в эту команду
741 proc custom_client {command {forbidden_vars {}}} {
742 set ::test::client_app $command
743 set ::test::client_unset $forbidden_vars
747 # Восстанавливает станадртую клиентскую команду
750 catch {unset ::test::client_app}
751 catch {unset ::test::client_unset}
755 # Закрывает файл, указанный в соответствующем file_id, возвращает
756 # элемент глобального массива output, содержимое error message от close
757 # и код завершения процесса (имя сигнала)
758 proc stop {file_id} {
760 fconfigure $file_id -blocking yes
761 if {[catch {close $file_id} msg]} {
762 if {[string match CHILD* [lindex $::errorCode 0]]} {
763 set status [lindex $::errorCode 2]
770 return [list $output($file_id) $msg $status]
773 # Завершает работу сервера
775 proc stop_server {file_id} {
776 # puts $file_id "Q\n"
777 # catch {set xx [socket localhost 4433]}
778 log "Interrupting process [pid $file_id]"
780 kill INT [pid $file_id]
781 #puts -nonewline stderr "Waiting for server termination.."
782 vwait finished($file_id)
783 if [info exists xx] {close $xx}
788 # Запускает процесс с указанной командной строкой. Возвращает дескриптор
789 # файла в nonblocking mode с повешенным туда fileevent
790 # Очищает соответствующие элементы массивов output и finished
791 proc start_process {cmd_line read_event {mode "r"}} {
792 set f [open "|$cmd_line" $mode]
793 global output finished
794 catch {unset finished($f)}
795 fconfigure $f -buffering none -blocking n
797 fileevent $f readable [list $read_event $f]
801 # Обработчик fileevent-ов на чтение. Записывает считанные данные в
802 # элемент массива output соответствущий файлхендлу. В случае если
803 # достигнут eof, выставляет элемент массива finished. (элемент output
804 # при этом тоже трогается, чтобы vwait завершился)
806 proc process_read {f} {
810 fconfigure $f -blocking y
815 append output($f) [read $f]
819 # Запускает openssl s_server с указанными аргументами и дожидается пока
820 # он скажет на stdout ACCEPT. Возвращает filehandle, открытый на
823 proc open_server {server_args} {
826 if {[info exists ::test::server_conf]} {
828 set save_conf $env(OPENSSL_CONF)
829 set env(OPENSSL_CONF) $::test::server_conf
831 if {[info exists ::test::server_app]} {
832 set server $::test::server_app
834 set server [list $OPENSSL_APP s_server]
836 if {[info exists ::test::server_unset]} {
837 save_env $::test::server_unset
839 set server [start_process [concat $server $server_args] process_read "r+"]
841 if {[info exists save_conf]} {
842 set env(OPENSSL_CONF) $save_conf
845 global output finished
846 #puts -nonewline stderr "Waiting for server startup..."
847 while {![regexp "\nACCEPT\n" $output($server)]} {
848 vwait output($server)
849 if {[info exists finished($server)]} {
851 return -code error [lindex [stop $server] 1]
859 # Сохраняет указанные переменные среды для последующего восстановления
862 proc save_env {var_list} {
863 catch {array unset ::test::save_env}
864 foreach var $var_list {
865 if {[info exist ::env($var)]} {
866 set ::test::save_env($var) $::env($var)
872 proc restore_env {} {
873 if {[array exists ::test::save_env]} {
874 array set ::env [array get ::test::save_env]
875 array unset ::test::save_env
880 # Сохраняет указанные переменные среды для последующего восстановления
881 # restore_env2. В отличие от save_env, не делает unset сохраненной переменной.
883 proc save_env2 {var_list} {
884 catch {array unset ::test::save_env2}
885 foreach var $var_list {
886 if {[info exist ::env($var)]} {
887 set ::test::save_env2($var) $::env($var)
893 # Восстанавливает переменные среды, ранее сохраненные функцией save_env2
894 # В отличие от функции restore_env, требует списка переменных и
895 # восстанавливает только переменные из данного списка. Второе отличие -
896 # если переменная из списка не была сохранена, делает ей unset.
898 proc restore_env2 {var_list} {
899 foreach var $var_list {
900 if {[info exist ::test::save_env2($var)]} {
901 set ::env($var) $::test::save_env2($var)
903 catch {unset ::env($var)}
906 array unset ::test::save_env2
911 # Запускает s_client с указанными аргументами, передавая на stdin
914 proc open_client {client_args client_stdin} {
916 if [info exists ::test::client_app] {
917 set client $::test::client_app
919 set client [list $OPENSSL_APP s_client]
921 if {[info exists ::test::client_unset]} {
922 save_env $::test::client_unset
924 if {[info exists ::test::client_conf]} {
925 set save_env(OPENSSL_CONF) $::env(OPENSSL_CONF)
926 set ::env(OPENSSL_CONF) $::test::client_conf
928 set client [start_process [concat $client $client_args [list << $client_stdin]] process_read]
933 # Зачитывает список хостов из ../../ssl-ciphers
935 proc get_hosts {file} {
936 set ::test::suffix "-$file"
937 if [file readable $file.ciphers] {
938 set f [open $file.ciphers]
940 set f [open ../../ssl-ciphers/$file.ciphers r]
942 while {[gets $f line]>=0} {
943 if {[regexp {^\s*#} $line]} continue
944 append data "$line\n"
948 array set hosts $data
951 # Регистрирует пользователся (возможно удаленном) тестовом CA, используя
952 # скрипт testca установленный в PATH на CAhost.
955 proc registerUserAtCA {userdir CAhost CAprefix CApath} {
957 log "registerUserAtCA $userdir $CAhost $CAprefix $CApath"
958 set f [open $userdir/req.pem]
959 set request [read $f]
961 set token [::http::geturl http://$CAhost/$CAprefix/$CApath\
962 -query [::http::formatQuery request $request startdate [clock\
963 format [expr [clock seconds]-3600] -format "%y%m%d%H%M%SZ" -gmt y]]]
964 if {[::http::ncode $token]!=200} {
965 return -code error "Error certifying request [::http::data $token]"
967 log "Got a certificate. Saving"
968 saveCertFromPKCS7 $userdir/cert.pem [::http::data $token]
970 proc saveCertFromPKCS7 {file pkcs7} {
973 log "$OPENSSL_APP pkcs7 -print_certs $pkcs7"
974 set f [open "|[list $OPENSSL_APP pkcs7 -print_certs << $pkcs7]" r]
975 set out [open $file w]
977 while {[gets $f line]>=0} {
980 if {$line eq "-----END CERTIFICATE-----"} {
983 } elseif {$mode==0 && $line eq "-----BEGIN CERTIFICATE-----"} {
991 return -code error "Cannot get certificate from PKCS7 output"
995 # Invokes scp and discards stderr output if exit code is 0
998 if {[info exists env(SCP)]} {
1003 if {[catch [concat exec $scp $args] msg]} {
1004 if {[string match CHIDLD* [lindex $::errorCode 0]]} {
1005 return -code error -errorcode $::errorCode $msg
1010 proc getCAAlgParams {CAhost CAprefix alg} {
1011 if {$alg == "ec" || $alg == "dsa"} {
1012 set token [::http::geturl http://$CAhost/$CAprefix/$alg?algparams=1]
1013 if {[::http::ncode $token]!=200} {
1014 return -code error "Error getting algorithm parameters [::http::data $token]"
1016 set f [open ${alg}params.pem w]
1017 puts $f [::http::data $token]
1022 # Copies CA certificate from specified CA into ca_$alg.pem
1023 # Returns name of the ca certificate or empty line if something goes
1024 # wrong and error wasn't properly detected
1026 proc getCAcert {CAhost CApath alg} {
1027 set token [::http::geturl http://$CAhost$CApath/$alg?getroot=1]
1028 if {[::http::ncode $token]!=200} {
1029 return -code error "Error getting root cert for $alg: [::http::data $token]"
1031 saveCertFromPKCS7 ca_$alg.pem [::http::data $token]
1035 # Returns decoded version of first pem object in the given file
1037 proc readpem {filename} {
1038 set f [open $filename]
1039 fconfigure $f -translation binary
1042 if {[regexp -- "-----BEGIN \[^\n\]+-----\r?\n(.*\n)-----END" $data => b64]} {
1043 set data [::base64::decode $b64]
1049 proc der_from_pem {pem} {
1050 if {[regexp -- {^-----BEGIN ([^\n]*)-----\r?\n(.*)\r?\n-----END \1-----} $pem => => base64]} {
1051 ::base64::decode $base64
1053 error "Not a PEM:\n$pem"
1057 proc engine_name {} {
1059 if {[info exists env(ENGINE_NAME)]} {
1060 switch -exact $env(ENGINE_NAME) {
1061 "open" {return "open"}
1062 "gost" {return "open"}
1063 "cryptocom" {return "ccore"}
1064 "ccore" {return "ccore"}
1065 default {error "Unknown engine '$env(ENGINE_NAME)'"}
1072 proc openssl_remote {files host cmdlinex suffix} {
1073 set hostname [exec hostname]
1074 set workpath /tmp/$hostname/$suffix
1075 save_env {LD_LIBRARY_PATH OPENSSL_CONF ENGINE_DIR}
1076 exec ssh build@$host mkdir -p $workpath
1077 foreach file $files {
1078 exec scp -r $file build@$host:$workpath
1080 exec scp ../opnssl.sh build@$host:$workpath
1081 exec ssh build@$host chmod +x $workpath/opnssl.sh
1082 set cmdline [string map "TESTPATH $workpath" $cmdlinex]
1083 log "hstname: $hostname OpenSSL cmdline: $host remote_openssl $cmdline"
1084 set f [open "| ssh build@$host $workpath/opnssl.sh $cmdline" r]
1085 set output [read $f]
1087 if {[catch {close $f} msg]} {
1088 append output "STDERR CONTENTS:\n$msg"
1090 if {[lindex $::errorCode 0]!="NONE"} {
1091 return -code error -errorcode $::errorCode $output
1097 package provide ossltest 0.7