--- /dev/null
+# 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 <http://www.gnu.org/licenses/>.
+
+# The tool init file must provide a make_test_environment <base_dir>
+# 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 <subkey-long-ID>
+# name <user> [is <state>]
+# subkey-of <prikey-long-ID>
+# expires <expiration> }...
+# }
+# some-package-name/po {
+# <keylist for mockgpg.exp:write_test_keyring>
+# }
+# }
+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 { <email address>... }
+# keys {
+# <keylist for mockgpg.exp:write_test_keyring>
+# }
+# maintainers { <PGP "Name <email>">... }
+# }
+# ...
+# }
+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
# 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]
}
load_lib mockgpg.exp
+load_lib envutils.exp
load_lib keyindex.exp
-# make_test_keyrings /some/dir/some/where {
-# some-package-name {
-# { id <subkey-long-ID>
-# name <user> [is <state>]
-# subkey-of <prikey-long-ID>
-# expires <expiration> }...
-# }
-# some-package-name/po {
-# <keylist for mockgpg.exp:write_test_keyring>
-# }
-# }
-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 { <email address>... }
-# keys {
-# <keylist for mockgpg.exp:write_test_keyring>
-# }
-# maintainers { <PGP "Name <email>">... }
-# }
-# ...
-# }
-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 {
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]] ""]
}
load_lib mockgpg.exp
+load_lib envutils.exp
load_lib keyindex.exp
-# make_test_keyrings /some/dir/some/where {
-# some-package-name {
-# { id <subkey-long-ID>
-# name <user> [is <state>]
-# subkey-of <prikey-long-ID>
-# expires <expiration> }...
-# }
-# some-package-name/po {
-# <keylist for mockgpg.exp:write_test_keyring>
-# }
-# }
-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 { <email address>... }
-# keys {
-# <keylist for mockgpg.exp:write_test_keyring>
-# }
-# maintainers { <PGP "Name <email>">... }
-# }
-# ...
-# }
-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
projects / gatekeeper.git / commitdiff