From 4e09b9383bfd5d98f21bb06a83f75bf719589cbe Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Fri, 28 Apr 2023 18:15:57 -0500 Subject: [PATCH] Combine shared testsuite infrastructure code --- testsuite/lib/envutils.exp | 140 ++++++++++++++++++++++++++++++ testsuite/lib/tool/gatekeeper.exp | 116 +------------------------ testsuite/lib/tool/keymaster.exp | 116 +------------------------ 3 files changed, 142 insertions(+), 230 deletions(-) create mode 100644 testsuite/lib/envutils.exp diff --git a/testsuite/lib/envutils.exp b/testsuite/lib/envutils.exp new file mode 100644 index 0000000..6779941 --- /dev/null +++ b/testsuite/lib/envutils.exp @@ -0,0 +1,140 @@ +# DejaGnu library file for test environment utilities + +# Copyright (C) 2021, 2022, 2023 Jacob Bachmeyer +# +# This file is part of a testsuite for the GNU Secure Software Gatekeeper. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# The tool init file must provide a make_test_environment +# procedure that prepares a test environment directory for use. + +set TEST_BASE [file join \ + [file dirname [testsuite file -object -top]] test.tmp] +set TENV_STEM [file join $TEST_BASE tenv] + +# invoked by DejaGnu framework when a failure is recorded +proc envutils_count_failures { args } { + global total_failure_count local_failure_count + incr total_failure_count + incr local_failure_count +} +set local_record_procs(fail) envutils_count_failures + +proc get_file { file } { + set chan [open $file r] + set ret [read -nonewline $chan] + close $chan + return $ret +} +proc put_file { file string } { + set chan [open $file w] + puts -nonewline $chan $string + close $chan +} +proc age_file { file to } { + file mtime $file [clock scan $to] +} + +proc new_work_area { stem } { + set count 1 + set name "${stem}.1" + while { [file exists $name] } { + incr count + set name "${stem}.${count}" + } + + return $name +} + +set total_failure_count 0 +proc new_test_environment { } { + global TENV_STEM + set name [new_work_area $TENV_STEM] + + global local_failure_count + set local_failure_count 0 + + make_test_environment $name + return $name +} +proc close_test_environment { name } { + global local_failure_count + # delete the environment iff no tests failed + if { $local_failure_count == 0 } { + file delete -force -- $name + } +} + +# make_test_keyrings /some/dir/some/where { +# some-package-name { +# { id +# name [is ] +# subkey-of +# expires }... +# } +# some-package-name/po { +# +# } +# } +proc make_test_keyrings { base_dir keylist } { + # file names could be properly split, instead of relying on passed in + # slashes being correct for writing the file, but this is unlikely to + # ever run on a non-POSIX system, and they are correct on POSIX + foreach { package keys } $keylist { + file mkdir [file join $base_dir packages $package] + write_test_keyring \ + [file join $base_dir packages $package pubring.gpg] $keys + } +} + +# register_test_packages /some/dir/some/where { +# some-package-name { +# email { ... } +# keys { +# +# } +# maintainers { ">... } +# } +# ... +# } +proc register_test_packages { base_dir packlist } { + set havekeys no + foreach { package info } $packlist { + file mkdir [file join $base_dir packages $package] + foreach { element value } $info { switch $element { + email { + set c [open [file join $base_dir packages $package email] w] + foreach address $value { puts $c $address } + close $c + } + keys { + write_test_keyring \ + [file join $base_dir packages $package pubring.gpg] $value + set havekeys yes + } + maintainers { + set c [open [file join $base_dir m.bypkg] a] + puts -nonewline $c [format "%s - " $package] + puts $c [join $value ", "] + close $c + } + } } + } + if { $havekeys } { + write_key_index [file join $base_dir packages keyindex] $packlist + } +} + +# EOF diff --git a/testsuite/lib/tool/gatekeeper.exp b/testsuite/lib/tool/gatekeeper.exp index f563c14..a096320 100644 --- a/testsuite/lib/tool/gatekeeper.exp +++ b/testsuite/lib/tool/gatekeeper.exp @@ -26,61 +26,6 @@ set DIRECTIVE_FORMAT_VERSIONS { 1.1 1.2 } # Make sure to add a test in 03_triplet.exp whenever one of these is # removed to confirm that it is considered invalid. -set TEST_BASE [file join \ - [file dirname [testsuite file -object -top]] test.tmp] -set TENV_STEM [file join $TEST_BASE tenv] - -# invoked by DejaGnu framework when a failure is recorded -proc gatekeeper_count_failures { args } { - global gatekeeper_failure_count - incr gatekeeper_failure_count -} -set local_record_procs(fail) gatekeeper_count_failures - -proc get_file { file } { - set chan [open $file r] - set ret [read -nonewline $chan] - close $chan - return $ret -} -proc put_file { file string } { - set chan [open $file w] - puts -nonewline $chan $string - close $chan -} -proc age_file { file to } { - file mtime $file [clock scan $to] -} - -proc new_work_area { stem } { - set count 1 - set name "${stem}.1" - while { [file exists $name] } { - incr count - set name "${stem}.${count}" - } - - return $name -} - -proc new_test_environment { } { - global TENV_STEM - set name [new_work_area $TENV_STEM] - - global gatekeeper_failure_count - set gatekeeper_failure_count 0 - - make_test_environment $name - return $name -} -proc close_test_environment { name } { - global gatekeeper_failure_count - # delete the environment iff no tests failed - if { $gatekeeper_failure_count == 0 } { - file delete -force -- $name - } -} - proc make_test_environment { base_dir } { file mkdir $base_dir file mkdir [file join $base_dir packages] @@ -96,68 +41,9 @@ proc make_test_environment { base_dir } { } load_lib mockgpg.exp +load_lib envutils.exp load_lib keyindex.exp -# make_test_keyrings /some/dir/some/where { -# some-package-name { -# { id -# name [is ] -# subkey-of -# expires }... -# } -# some-package-name/po { -# -# } -# } -proc make_test_keyrings { base_dir keylist } { - # file names could be properly split, instead of relying on passed in - # slashes being correct for writing the file, but this is unlikely to - # ever run on a non-POSIX system, and they are correct on POSIX - foreach { package keys } $keylist { - file mkdir [file join $base_dir packages $package] - write_test_keyring \ - [file join $base_dir packages $package pubring.gpg] $keys - } -} - -# register_test_packages /some/dir/some/where { -# some-package-name { -# email { ... } -# keys { -# -# } -# maintainers { ">... } -# } -# ... -# } -proc register_test_packages { base_dir packlist } { - set havekeys no - foreach { package info } $packlist { - file mkdir [file join $base_dir packages $package] - foreach { element value } $info { switch $element { - email { - set c [open [file join $base_dir packages $package email] w] - foreach address $value { puts $c $address } - close $c - } - keys { - write_test_keyring \ - [file join $base_dir packages $package pubring.gpg] $value - set havekeys yes - } - maintainers { - set c [open [file join $base_dir m.bypkg] a] - puts -nonewline $c [format "%s - " $package] - puts $c [join $value ", "] - close $c - } - } } - } - if { $havekeys } { - write_key_index [file join $base_dir packages keyindex] $packlist - } -} - # make_test_case /some/dir/some/where { # some-package-name-1.2.3.bin { # directive { diff --git a/testsuite/lib/tool/keymaster.exp b/testsuite/lib/tool/keymaster.exp index 4c7a398..bf12086 100644 --- a/testsuite/lib/tool/keymaster.exp +++ b/testsuite/lib/tool/keymaster.exp @@ -21,61 +21,6 @@ set KEYMASTER_TOOL [file join $srcdir keymaster.pl] if { ! [info exists PERL] } { set PERL perl } if { ! [info exists CHECK_COVERAGE] } { set CHECK_COVERAGE no } -set TEST_BASE [file join \ - [file dirname [testsuite file -object -top]] test.tmp] -set TENV_STEM [file join $TEST_BASE tenv] - -# invoked by DejaGnu framework when a failure is recorded -proc keymaster_count_failures { args } { - global keymaster_failure_count - incr keymaster_failure_count -} -set local_record_procs(fail) keymaster_count_failures - -proc get_file { file } { - set chan [open $file r] - set ret [read -nonewline $chan] - close $chan - return $ret -} -proc put_file { file string } { - set chan [open $file w] - puts -nonewline $chan $string - close $chan -} -proc age_file { file to } { - file mtime $file [clock scan $to] -} - -proc new_work_area { stem } { - set count 1 - set name "${stem}.1" - while { [file exists $name] } { - incr count - set name "${stem}.${count}" - } - - return $name -} - -proc new_test_environment { } { - global TENV_STEM - set name [new_work_area $TENV_STEM] - - global keymaster_failure_count - set keymaster_failure_count 0 - - make_test_environment $name - return $name -} -proc close_test_environment { name } { - global keymaster_failure_count - # delete the environment iff no tests failed - if { $keymaster_failure_count == 0 } { - file delete -force -- $name - } -} - proc write_test_config { base_dir config } { put_file [file join $base_dir test.conf] \ [regsub -all -line -- {^[ \t]+} [uplevel 1 subst [list $config]] ""] @@ -101,68 +46,9 @@ proc with_test_environment { env_name config body } { } load_lib mockgpg.exp +load_lib envutils.exp load_lib keyindex.exp -# make_test_keyrings /some/dir/some/where { -# some-package-name { -# { id -# name [is ] -# subkey-of -# expires }... -# } -# some-package-name/po { -# -# } -# } -proc make_test_keyrings { base_dir keylist } { - # file names could be properly split, instead of relying on passed in - # slashes being correct for writing the file, but this is unlikely to - # ever run on a non-POSIX system, and they are correct on POSIX - foreach { package keys } $keylist { - file mkdir [file join $base_dir packages $package] - write_test_keyring \ - [file join $base_dir packages $package pubring.gpg] $keys - } -} - -# register_test_packages /some/dir/some/where { -# some-package-name { -# email { ... } -# keys { -# -# } -# maintainers { ">... } -# } -# ... -# } -proc register_test_packages { base_dir packlist } { - set havekeys no - foreach { package info } $packlist { - file mkdir [file join $base_dir packages $package] - foreach { element value } $info { switch $element { - email { - set c [open [file join $base_dir packages $package email] w] - foreach address $value { puts $c $address } - close $c - } - keys { - write_test_keyring \ - [file join $base_dir packages $package pubring.gpg] $value - set havekeys yes - } - maintainers { - set c [open [file join $base_dir m.bypkg] a] - puts -nonewline $c [format "%s - " $package] - puts $c [join $value ", "] - close $c - } - } } - } - if { $havekeys } { - write_key_index [file join $base_dir packages keyindex] $packlist - } -} - proc run_keymaster { test expected base_dir args } { global KEYMASTER_TOOL PERL CHECK_COVERAGE -- 2.25.1