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::src variable
  66 #
  67
  68 if {[info exists env(TESTSRC)]} {
  69         set ::test::src [file normalize $env(TESTSRC)]
  70 } else {
  71         set ::test::src [pwd]
  72 }
  73
  74 #
  75 # set  up test::dir variable
  76 #
  77
  78 if {[info exists env(TESTDIR)]} {
  79         set ::test::dir [file normalize $env(TESTDIR)]
  80 } else {
  81         set ::test::dir [file join [pwd] z]
  82 }
  83
  84 #
  85 # Фильтрует вывод полученный в виде длинной строки, разбивая на строки
  86 # по \n. Возвращает строки, удовлетворяющие регулярному выражениу
  87 # pattern
  88 #
  89
  90 proc grep {pattern data} {
  91         set out ""
  92         foreach line [split $data "\n"] {
  93                 if {[regexp $pattern $line]} {
  94                         append out $line "\n"
  95                 }
  96         }
  97         return $out
  98 }
  99 proc check_builtin_engine {} {
 100         global OPENSSL_APP
 101         set found [regexp Cryptocom [exec $OPENSSL_APP engine 2> /dev/null]]
 102         if {$found} {
 103                 puts "Using statically compiled engine"
 104         } else {
 105                 puts "Using dynamically loaded engine"
 106         }
 107         return $found
 108 }
 109
 110
 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]]
 118         }
 119         log "OpenSSL cmdline: $OPENSSL_APP $cmdline"
 120         set f [open "|$OPENSSL_APP $cmdline" r]
 121         set output [read $f]
 122         if {[catch {close $f} msg]} {
 123                 append output "STDERR CONTENTS:\n$msg"
 124                 log $output
 125                 if {[lindex $::errorCode 0]!="NONE"} {
 126                         return -code error -errorcode $::errorCode $output
 127                 }
 128         }
 129         return $output
 130 }
 131
 132
 133 proc getConfig {args} {
 134         global OPENSSL_CONF
 135         if {![info exists OPENSSL_CONF]} {
 136           if {![regexp "OPENSSLDIR: \"\[^\"\]+\"" [openssl version -d] => openssl_dir]} {
 137                 puts stderr "Cannot find out openssl directory"
 138                 exit 1
 139           }
 140          set OPENSSL_CONF  "$openssl_dir/openssl.cnf"
 141         }
 142         set f [open $OPENSSL_CONF r]
 143         set out ""
 144         set mode copy
 145         while {[gets $f line]>=0} {
 146                 if {[regexp     "\\s*\\\[\\s*(\\S+)\\s*\\\]" $line => section]} {
 147                         if {[lsearch -exact $args $section]!=-1} {
 148                                 set mode skip
 149                         } else {
 150                                 set mode copy
 151                         }
 152                 }
 153                 if {$mode eq "copy"} {
 154                         append out $line \n
 155                 }
 156          }
 157          return $out
 158 }
 159 #
 160 # Создает тестовый CA
 161 # Допустимые параметры:
 162 # CAname - директория, в которой создается CA (testCA по умолчанию)
 163 # алгоритм с параметрами в формате команды req
 164 #
 165
 166 proc makeCA {{CAname {}} {algor_with_par gost2012_512:A}} {
 167         global OPENSSL_CONF
 168         if {![string length $CAname]} {
 169                 set CAname [file rootname [file tail $::argv0]]CA-2012
 170         }
 171         set test::ca $CAname
 172         file delete -force $CAname
 173         file mkdir $CAname
 174         makeFile $CAname/ca.conf "
 175 \[ ca \]
 176 default_ca      = CA_default            # The default ca section
 177
 178 \[ CA_default \]
 179
 180 dir            = [file join [pwd] $CAname]              # top dir
 181 database       = \$dir/index.txt        # index file.
 182 new_certs_dir  = \$dir/newcerts         # new certs dir
 183
 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
 188
 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
 193
 194 policy         = policy_any            # default policy
 195 email_in_dn    = yes                   #  add the email into cert D
 196
 197
 198 nameopt        = ca_default            # Subject name display option
 199 certopt        = ca_default            # Certificate display option
 200 copy_extensions = copy                 # Copy extensions from requ
 201
 202
 203 \[ policy_any \]
 204 countryName            = supplied
 205 stateOrProvinceName    = optional
 206 organizationName       = optional
 207 organizationalUnitName = optional
 208 commonName             = supplied
 209 emailAddress           = supplied
 210
 211 "
 212         makeFile $CAname/req.conf "
 213 \[req\]
 214 prompt=no
 215 distinguished_name = req_dn
 216 \[ req_dn \]
 217 C = RU
 218 L = Moscow
 219 CN=Test CA $algor_with_par
 220 O=Cryptocom
 221 OU=OpenSSL CA
 222 emailAddress = openssl@cryptocom.ru
 223 \[ v3_ca \]
 224 # Extensions for a typical CA
 225 # PKIX recommendation.
 226 subjectKeyIdentifier=hash
 227 authorityKeyIdentifier=keyid:always,issuer
 228 basicConstraints = critical,CA:true
 229
 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
 234
 235 # Include email address in subject alt name: another PKIX recommendation
 236 # subjectAltName=email:copy
 237 # Copy issuer details
 238 # issuerAltName=issuer:copy
 239
 240 # DER hex encoding of an extension: beware experts only!
 241 # obj=DER:02:03
 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
 245 "
 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]
 254 }
 255
 256 proc extract_oids {filename {format PEM} {offset 0}} {
 257         set out ""
 258         if {$offset} {
 259                 set miscargs "-offset $offset "
 260         } else {
 261                 set miscargs ""
 262         }
 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"
 267                 }
 268         }
 269         return $out
 270 }
 271 #
 272 # Формирует список параметров для openssl req необходимый для формирования
 273 # ключа c указанным алгоритмом и параметрами
 274 #
 275 proc keygen_params {alg} {
 276         return [split $alg :]
 277 }
 278
 279 proc generate_key {params filename} {
 280         set alg [lindex $params 0]
 281         set param [lindex $params 1]
 282         set keyname $alg
 283         set keyname [append keyname _ $param .pem]
 284         switch -glob $alg {
 285         rsa {
 286                 if {![string length $param]} {
 287                         set param 1024
 288                         set keyname "rsa_1024.pem"
 289                 }
 290                 set optname "-algorithm rsa -pkeyopt rsa_keygen_bits:$param"
 291                 }
 292         ec {set optname "-paramfile $param"}
 293         dsa {set optname "-paramfile $param" }
 294         gost* { set optname "-algorithm $alg -pkeyopt paramset:$param" }
 295         }
 296         if {$::tcl_platform(platform) eq "windows"} {
 297                 set exesuffix ".exe"
 298         } else {
 299                 set exesuffix ""
 300         }
 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
 317 #       } else {
 318 #               log "Calling openssl cmd to create private key"
 319 #               openssl "genpkey  $optname -out $filename"
 320 #       }
 321 }
 322
 323 #
 324 # Создает тестового пользователя с одним ключом подписи и одной заявкой
 325 # на сертификат.
 326 # Параметры
 327 # username Имя директории, куда складывать файлы этого пользователя
 328 # alg Параметр для опции -newkey команды openssl req, задающий алгоритм
 329 #  ключа и параметры этого алгоритма
 330 # Последующие параметры имеют вид списка ключ значение и задают поля
 331 # Distinguished Name
 332 # FIXME Процедуру надо поправить, чтобы работала с новой версией openssl
 333 proc makeUser {username alg args} {
 334         file delete -force $username
 335         file mkdir $username
 336         if {[lsearch $args CN]==-1} {
 337                 lappend args CN $username
 338         }
 339         makeFile $username/req.conf [eval makeConf $args]
 340         log "req.conf --------\n[getFile $username/req.conf]-------------"
 341
 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}]
 345 }
 346
 347 proc makeSecretKey {username alg} {
 348         file delete -force $username
 349         file mkdir $username
 350         generate_key [keygen_params $alg] $username/seckey.pem
 351         return [expr {[file size $username/seckey.pem] > 0}]
 352 }
 353
 354 #
 355 # Создает пользователя с помощью makeUser и подписывает его сертификат
 356 # ключом ранее созданного testCA.
 357 # Параметр CAname обрабатывается специальным образом: он не попадает в DN
 358 #
 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?"
 362         }
 363         set CAname $test::ca
 364         array set params $args
 365         if {[info exist params(CAname)]} {
 366                 set CAname $params(CAname)
 367                 unset params(CAname)
 368         }
 369         if {![file isdirectory $CAname]||![file exists $CAname/cacert.pem]} {
 370                 return -code error "CA $CAname doesn't exists"
 371         }
 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]
 375 }
 376
 377 proc makeConf {args} {
 378         global OPENSSL_CONF
 379         array set dn_attrs [list C  RU\
 380         L  Moscow\
 381         CN "Dummy user"\
 382         O Cryptocom\
 383         OU "OpenSSL Team"\
 384         emailAddress  "openssl@cryptocom.ru"\
 385         ]
 386         array set dn_attrs $args
 387         if {[info exists dn_attrs(extensions)]} {
 388                 set extensions $dn_attrs(extensions)
 389                 unset dn_attrs(extensions)
 390         }
 391         set out ""
 392         append out {[req]
 393 prompt=no
 394 distinguished_name = req_dn
 395 }
 396 if {[info exists extensions]} {
 397         append out "req_extensions = req_exts\n\[ req_exts \]\n" $extensions "\n"
 398 }
 399 append out "\[ req_dn \]\n"
 400         foreach {key val} [array get dn_attrs] {
 401                 append out "$key=$val\n"
 402         }
 403         return $out
 404 }
 405 #
 406 # Выполняет замену регулярного выражения re на строку s в указанном
 407 # PEM-документе.
 408 #
 409 proc hackPem {re pem s} {
 410         set out ""
 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
 415         }
 416         return $out
 417 }
 418
 419 #
 420 # Handling of OIDs
 421 #
 422
 423 source [file dirname  [info script]]/name2oid.tcl
 424 foreach {name oid} [array get name2oid] {
 425         set oid2name($oid) $name
 426 }
 427
 428 proc long_name_by_id {id} {
 429         variable name2oid
 430         variable oid2name
 431         if {[regexp {^\d+(\.\d+)+$} $id]} {
 432         return "GOST $oid2name($id) $id"
 433         }
 434         return "GOST $id $name2oid($id)"
 435 }
 436
 437 proc alg_id {alg} {
 438         switch -glob $alg {
 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}
 447         }
 448 }
 449
 450 proc alg_with_digest {alg} {
 451         variable name2oid
 452         switch -glob $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}
 461
 462         }
 463 }
 464
 465 proc alg_long_name {alg} {
 466         variable name2oid
 467         switch -glob $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"}
 476         }
 477 }
 478
 479 # Returns hash algorithm corresponded to sign algorithm
 480 proc alg_hash {alg} {
 481     switch -glob $alg {
 482         gost2012_256:* {return hash_12_256}
 483         gost2012_512:* {return hash_12_512}
 484         * {return hash_94}
 485    }
 486 }
 487
 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}
 495     }
 496 }
 497
 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}
 504     }
 505 }
 506
 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}
 515     }
 516 }
 517
 518 # Returns long name of hash_with_sign algorithm
 519 proc hash_with_sign_long_name {alg} {
 520     switch -glob $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}
 525     }
 526 }
 527
 528 proc smime_hash_with_sign_long_name {alg} {
 529     switch -glob $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}
 534     }
 535 }
 536
 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"}
 542     }
 543 }
 544
 545 proc param_pubkey {alg} {
 546         variable name2oid
 547         switch -exact $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}
 574         }
 575 }
 576
 577
 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
 581     # this is removed.
 582     # Note:
 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}
 587     }
 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"}
 592     }
 593 }
 594
 595 proc pubkey_long_name {alg} {
 596         variable name2oid
 597         switch -glob $alg {
 598
 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"}
 621         }
 622 }
 623
 624 proc mkObjList {args} {
 625         set out ""
 626         foreach name $args {
 627                 if {$name eq {}} continue
 628                 append out " OBJECT            :$name\n"
 629         }
 630         return $out
 631 }
 632
 633 proc structured_obj_list {args} {
 634         variable name2oid
 635         set out {}
 636         foreach {path name} $args {
 637                 if {$name != {}} {set oid $name2oid($name)} {set oid {}}
 638                 lappend out "$path=$oid"
 639         }
 640         return $out
 641 }
 642
 643 proc param_hash {alg} {
 644     switch -glob $alg {
 645         gost2012_256:* {return hash_12_256}
 646         gost2012_512:* {return hash_12_512}
 647         * {return param_hash_94}
 648     }
 649 }
 650
 651
 652 proc param_encr {short_name} {
 653         variable name2oid
 654         if {[regexp {^\d+(\.\d+)+$} $short_name]} {
 655         return "$short_name"
 656         }
 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}
 664         }
 665 }
 666
 667 proc encr_long_name {short_name} {
 668         variable name2oid
 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"}
 676         }
 677 }
 678
 679
 680
 681 #
 682 # Функции для управления клиентом и сервером при тестировании
 683 # SSL-соединения
 684 #
 685
 686 #  Параметры
 687 #    Список аргументов командной строки клиента
 688 #    список аргументов командной строки сервера
 689 #    строка, которую надо передать на stdin клиенту
 690 #
 691 # Запускает openssl s_server и пытается приконнектиться к нему openssl
 692 # s_client-ом. Возвращает список stdout  клиента, stderr клиента, кода
 693 # завершения клиента, stdout
 694 # сервера stderr сервера и кода завершения сервера.
 695 #
 696 # Если процесс убит сигналом, возвращает в качестве кода завершения имя
 697 # сигнала, иначе - числовое значение кода завершения ОС
 698 #
 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"
 702         flush [test_log]
 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"
 707         flush [test_log]
 708         global finished
 709         log "Waitng for client to termintate"
 710         flush [test_log]
 711 #       if {$::tcl_platform(platform) == "windows"} {
 712 #               exec ../kbstrike [pid $client] 0x20
 713 #       }
 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"
 720         }
 721         return $list
 722 }
 723 #
 724 # Устанавливает командную строку для вызова клиента,
 725 # в системный openssl на указанном хосте
 726 #
 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"
 731         } else {
 732                 set ::test::client_unset {LD_LIBRARY_PATH OPENSSL_CONF}
 733                 set ::test::client_app "ssh build@$host openssl s_client"
 734         }
 735 }
 736 #
 737 # Устанавливает командную строку для вызова клиента в указанную команду
 738 # Необязательный параметр указывает список переменных окружения, которые
 739 # НЕ НАДО передавать в эту команду
 740 #
 741 proc custom_client {command {forbidden_vars {}}} {
 742         set ::test::client_app $command
 743         set ::test::client_unset $forbidden_vars
 744
 745 }
 746 #
 747 # Восстанавливает станадртую клиентскую команду
 748 #
 749 proc our_client {} {
 750         catch {unset ::test::client_app}
 751         catch {unset ::test::client_unset}
 752 }
 753
 754 #
 755 # Закрывает файл, указанный в соответствующем file_id, возвращает
 756 # элемент глобального массива output, содержимое error message от close
 757 # и код завершения процесса (имя сигнала)
 758 proc stop {file_id} {
 759         global output
 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]
 764                 } else {
 765                         set status 0
 766                 }
 767         }  else {
 768                 set status 0
 769         }
 770         return [list $output($file_id) $msg $status]
 771 }
 772 #
 773 # Завершает работу сервера
 774 #
 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]"
 779         flush [test_log]
 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}
 784 #       puts stderr "Ok"
 785 }
 786
 787 #
 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
 796         set output($f) ""
 797         fileevent $f readable [list $read_event $f]
 798         return $f
 799 }
 800 #
 801 # Обработчик fileevent-ов на чтение. Записывает считанные данные в
 802 # элемент массива output соответствущий файлхендлу. В случае если
 803 # достигнут eof, выставляет элемент массива finished. (элемент output
 804 # при этом тоже трогается, чтобы vwait завершился)
 805 #
 806 proc process_read {f} {
 807         global output
 808         if {[eof $f]} {
 809                 global finished
 810                 fconfigure $f -blocking y
 811                 set finished($f) 1
 812                 append output($f) ""
 813                 return
 814         }
 815         append output($f) [read $f]
 816 }
 817
 818 #
 819 #  Запускает openssl s_server с указанными аргументами и дожидается пока
 820 #  он скажет на stdout ACCEPT. Возвращает filehandle, открытый на
 821 #  чтение/запись
 822 #
 823 proc open_server {server_args} {
 824         global OPENSSL_APP
 825         global ENGINE_PATH
 826         if {[info exists ::test::server_conf]} {
 827                 global env
 828                 set save_conf $env(OPENSSL_CONF)
 829                 set env(OPENSSL_CONF) $::test::server_conf
 830         }
 831         if {[info exists ::test::server_app]} {
 832                 set server $::test::server_app
 833         } else {
 834                 set server [list $OPENSSL_APP s_server]
 835         }
 836         if {[info exists ::test::server_unset]} {
 837                 save_env $::test::server_unset
 838         }
 839         set server [start_process [concat $server $server_args] process_read "r+"]
 840         restore_env
 841         if {[info exists save_conf]} {
 842                 set env(OPENSSL_CONF) $save_conf
 843         }
 844
 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)]} {
 850                         #puts stderr "error"
 851                         return -code error [lindex  [stop $server] 1]
 852                 }
 853         }
 854         #puts stderr "Ok"
 855         after 100
 856         return $server
 857 }
 858 #
 859 # Сохраняет указанные переменные среды для последующего восстановления
 860 # restore_env
 861 #
 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)
 867                         unset ::env($var)
 868                 }
 869         }
 870
 871 }
 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
 876         }
 877
 878 }
 879 #
 880 # Сохраняет указанные переменные среды для последующего восстановления
 881 # restore_env2. В отличие от save_env, не делает unset сохраненной переменной.
 882 #
 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)
 888                 }
 889         }
 890
 891 }
 892 #
 893 # Восстанавливает переменные среды, ранее сохраненные функцией save_env2
 894 # В отличие от функции restore_env, требует списка переменных и
 895 # восстанавливает только переменные из данного списка. Второе отличие -
 896 # если переменная из списка не была сохранена, делает ей unset.
 897 #
 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)
 902                 } else {
 903                         catch {unset ::env($var)}
 904                 }
 905         }
 906         array unset ::test::save_env2
 907 }
 908
 909
 910 #
 911 # Запускает s_client с указанными аргументами, передавая на stdin
 912 # указанную строку
 913 #
 914 proc open_client {client_args client_stdin} {
 915         global OPENSSL_APP
 916         if [info exists ::test::client_app] {
 917                 set client $::test::client_app
 918         } else {
 919                 set client [list $OPENSSL_APP s_client]
 920         }
 921         if {[info exists ::test::client_unset]} {
 922                 save_env $::test::client_unset
 923         }
 924         if {[info exists ::test::client_conf]}  {
 925                 set save_env(OPENSSL_CONF) $::env(OPENSSL_CONF)
 926                 set ::env(OPENSSL_CONF) $::test::client_conf
 927         }
 928         set client [start_process [concat $client $client_args [list << $client_stdin]] process_read]
 929         restore_env
 930         return $client
 931 }
 932 #
 933 # Зачитывает список хостов из ../../ssl-ciphers
 934 #
 935 proc get_hosts {file} {
 936         set ::test::suffix "-$file"
 937         if [file readable $file.ciphers] {
 938                 set f [open $file.ciphers]
 939         } else {
 940                 set f [open ../../ssl-ciphers/$file.ciphers r]
 941         }
 942         while {[gets $f line]>=0} {
 943                 if {[regexp {^\s*#} $line]} continue
 944                 append data "$line\n"
 945         }
 946         close $f
 947         global hosts
 948         array set hosts $data
 949 }
 950 #
 951 # Регистрирует пользователся (возможно удаленном) тестовом CA, используя
 952 # скрипт testca установленный в PATH на CAhost.
 953 #
 954
 955 proc registerUserAtCA {userdir CAhost CAprefix CApath} {
 956                 global OPENSSL_APP
 957                 log "registerUserAtCA $userdir $CAhost $CAprefix $CApath"
 958                 set f [open  $userdir/req.pem]
 959                 set request [read $f]
 960                 close $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]"
 966                 }
 967                 log "Got a certificate. Saving"
 968                 saveCertFromPKCS7 $userdir/cert.pem [::http::data $token]
 969 }
 970 proc saveCertFromPKCS7 {file pkcs7} {
 971                 global OPENSSL_APP
 972                 log saveCertFromPCS7
 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]
 976                 set mode 0
 977                 while {[gets $f line]>=0} {
 978                         if {$mode==1} {
 979                                 puts $out $line
 980                                 if {$line eq "-----END CERTIFICATE-----"} {
 981                                         set mode 2
 982                                 }
 983                         } elseif {$mode==0 && $line eq "-----BEGIN CERTIFICATE-----"} {
 984                                 set mode 1
 985                                 puts $out $line
 986                         }
 987                 }
 988                 close $f
 989                 close $out
 990                 if {$mode !=2 } {
 991                         return -code error "Cannot get certificate from PKCS7 output"
 992                 }
 993 }
 994 #
 995 # Invokes scp and discards stderr output if exit code is 0
 996 #
 997 proc scp {args} {
 998         if {[info exists env(SCP)]} {
 999                 set scp $env(SCP)
1000         } else {
1001                 set scp scp
1002         }
1003         if {[catch [concat exec $scp $args] msg]} {
1004                 if {[string match CHIDLD* [lindex $::errorCode 0]]} {
1005                         return -code error -errorcode $::errorCode  $msg
1006                 }
1007         }
1008 }
1009
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]"
1015                 }
1016                 set f [open ${alg}params.pem w]
1017                 puts $f [::http::data $token]
1018                 close $f
1019         }
1020 }
1021 #
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
1025 #
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]"
1030         }
1031         saveCertFromPKCS7 ca_$alg.pem [::http::data $token]
1032         return ca_$alg.pem
1033 }
1034 #
1035 # Returns decoded version of first pem object in the given file
1036 #
1037 proc readpem {filename} {
1038         set f [open $filename]
1039         fconfigure $f -translation binary
1040         set data [read $f]
1041         close $f
1042         if {[regexp -- "-----BEGIN \[^\n\]+-----\r?\n(.*\n)-----END" $data => b64]} {
1043                 set data [::base64::decode $b64]
1044         }
1045         return $data
1046
1047 }
1048
1049 proc der_from_pem {pem} {
1050         if {[regexp -- {^-----BEGIN ([^\n]*)-----\r?\n(.*)\r?\n-----END \1-----} $pem => => base64]} {
1051                 ::base64::decode $base64
1052         } {
1053                 error "Not a PEM:\n$pem"
1054         }
1055 }
1056
1057 proc engine_name {} {
1058         global env
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)'"}
1066                 }
1067         } else {
1068                 return "ccore"
1069         }
1070 }
1071
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
1079                 }
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]
1086                 restore_env
1087                 if {[catch {close $f} msg]} {
1088                         append output "STDERR CONTENTS:\n$msg"
1089                         log $output
1090                         if {[lindex $::errorCode 0]!="NONE"} {
1091                                 return -code error -errorcode $::errorCode $output
1092                         }
1093                 }
1094                 return $output
1095 }
1096
1097 package provide ossltest 0.7