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