Add tests for basic triplet handling
authorJacob Bachmeyer <jcb@gnu.org>
Sat, 22 Jan 2022 03:33:44 +0000 (21:33 -0600)
committerJacob Bachmeyer <jcb@gnu.org>
Sat, 22 Jan 2022 03:33:44 +0000 (21:33 -0600)
testsuite/lib/upload.exp
testsuite/upload.all/03_triplet.exp [new file with mode: 0644]

index 989125df3a5e7f77822873ab4466eb486d5381f2..4e771fb7a0cab916d6d1d21153d3ffade92bb124 100644 (file)
 
 set UPLOAD_TOOL [file join $srcdir upload-ftp-v1.2.pl]
 
+# Format versions accepted by the script.
+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.
+
 # invoked by DejaGnu framework when a failure is recorded
 proc upload_count_failures { args } {
     global upload_failure_count
@@ -537,6 +542,13 @@ proc analyze_log { base_dir name assess } {
                     set A(consider,$expect_out(1,string)) 1
                     exp_continue
                 }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                processing [[]([^]]+)\]} {
+                    # from scan_incoming, when a triplet is found
+                    set A(found-triplet) 1
+                    set A(found-triplet,$expect_out(1,string)) 1
+                    exp_continue
+                }
        -re {^ftp-upload\[[0-9]+\]: \(Test\)\
                 Found directive file with filename directive \(([^ ]+)\),\
                 but no accompanying files.\
@@ -560,6 +572,32 @@ proc analyze_log { base_dir name assess } {
                     exp_continue
                 }
 
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                invalid directory[^\r\n]+} {
+                    # from parse_directory_line, when the pattern match fails
+                    set A(validate,bad-directory) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                ([0-9]+) slashes is too many, in [^\r\n]+} {
+                    # from parse_directory_line, when the directory is too deep
+                    set A(validate,bad-directory-depth) 1
+                    set A(validate,bad-directory-depth,$expect_out(1,string)) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                Only one directory directive is allowed per [^\r\n]+} {
+                    # from parse_directory_line, if directory repeated
+                    set A(validate,bad-directory-repeat) 1
+                    exp_continue
+                }
+
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                invalid directive 'replace', not supported[^\r\n]+} {
+                    # from read_directive_file, if replace used in v1.1
+                    set A(validate,bad-replace-flag) 1
+                    exp_continue
+                }
        -re {^ftp-upload\[[0-9]+\]: \(Test\)\
                 no directory directive specified in [^\r\n]+} {
                     # from read_directive_file, if no directory key found
@@ -578,10 +616,71 @@ proc analyze_log { base_dir name assess } {
                     # TODO: will be removed with other v1 compatibility code
                     exp_continue
                 }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                invalid version [0-9.]+, not supported} {
+                    # from read_directive_file, if bad version
+                    set A(validate,bad-version) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                invalid second version ([^,]+), have ([^\r\n]+)} {
+                    # from read_directive_file, if version repeated
+                    set A(validate,bad-version-repeat) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                no version directive specified in ([^\r\n]+)} {
+                    # from read_directive_file, if no version given
+                    # This was valid in v1 but v1 is now obsolete.
+                    set A(validate,no-version) 1
+                    set A(validate,no-version,$expect_out(1,string)) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                Only one filename directive is allowed per [^\r\n]+} {
+                    # from read_directive_file, if filename repeated
+                    set A(validate,bad-filename-repeat) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                no filename directive specified in ([^\r\n]+)[.]\
+                Upgrade to the latest version![^\r\n]+} {
+                    # from read_directive_file, if no filename given
+                    # This was valid in v1 but v1 is now obsolete.
+                    set A(validate,no-filename) 1
+                    set A(validate,no-filename,$expect_out(1,string)) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                no configuration directory for package ([^\r\n]+)} {
+                    # from read_directive_file, if package config not found
+                    set A(validate,package-no-config) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                no keyring for package ([^\r\n]+)} {
+                    # from read_directive_file, if package keyring not found
+                    set A(validate,package-no-keys) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                The filename directive does not match name of the\
+                uploaded file.[^\r\n]+} {
+                    # from read_directive_file, on name mismatch
+                    set A(validate,filename-mismatch) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                filename [^\r\n]+ does not match name of directive[^\r\n]+} {
+                    # from read_directive_file, on name mismatch
+                    set A(validate,filename-mismatch-directive) 1
+                    exp_continue
+                }
 
        -re {^ftp-upload\[[0-9]+\]: \(Test\)\
                 DEBUG: [^ ]+ size is [[:digit:]]+} {
                     # from verify_keyring, upon entry
+                    # also from check_files, twice, upon entry
                     exp_continue
                 }
        -re {^ftp-upload\[[0-9]+\]: \(Test\)\
@@ -610,6 +709,47 @@ proc analyze_log { base_dir name assess } {
                     exp_continue
                 }
 
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                gpg verify of upload file [(]([^)]+)\) failed} {
+                    # from check_files, when no keys match
+                    set A(gpgv,upload-verify-failed) 1
+                    set A(gpgv,upload-verify-failed,$expect_out(1,string)) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                DEBUG: tested negative for CVE-[^\r\n]+} {
+                    # from check_files, when checks for known issues pass
+                    exp_continue
+                    # tests are not sensitive to this message because it
+                    # is likely to be revised as part of other refactoring
+                }
+
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                This signature file exists: [^\r\n]+} {
+                    # from install_files, if target exists and replace not set
+                    set A(install,target-signature-exists) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                This file exists: [^\r\n]+} {
+                    # from install_files, if target exists and replace not set
+                    set A(install,target-file-exists) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                archived and overwrote [^\r\n]+} {
+                    # from install_files, if target signature replaced
+                    set A(install,target-signature-replaced) 1
+                    exp_continue
+                }
+       -re {^ftp-upload\[[0-9]+\]: \(Test\)\
+                overwrote [^\r\n]+} {
+                    # from install_files, if target replaced
+                    set A(install,target-file-replaced) 1
+                    exp_continue
+                }
+
+
        -re {^ftp-upload\[[0-9]+\]: \(Test\)\
                 \(in [^()]+\) [^\r\n]+} {
                     # from fatal, just before calling ftp_die which exits
@@ -623,7 +763,7 @@ proc analyze_log { base_dir name assess } {
                     exp_continue
                 }
        -re {^ftp-upload\[[0-9]+\]: \(Test\)\
-                NOMAIL is set - net sending email to [^\r\n]+} {
+                NOMAIL is set - not sending email to [^\r\n]+} {
                     # from mail, when mail is inhibited
                     set A(mail,inhibited) 1
                     exp_continue
diff --git a/testsuite/upload.all/03_triplet.exp b/testsuite/upload.all/03_triplet.exp
new file mode 100644 (file)
index 0000000..32203fd
--- /dev/null
@@ -0,0 +1,1264 @@
+# Tests for processing upload triplets
+
+# Copyright (C) 2021, 2022 Jacob Bachmeyer
+#
+# This file is part of a testsuite for the GNU FTP upload system.
+#
+# 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/>.
+
+proc check_triplet { desc args } {
+    set tenv [new_test_environment [file join test.tmp tenv]]
+
+    array set data { setup {} upload {} check {} }
+    array set data $args
+
+    array set setup {
+       files {} symlinks {} packages {}
+    }
+    array set check {
+       email-to {} log {} file-tree {}
+    }
+    array set setup $data(setup)
+    array set check $data(check)
+
+    set log_items {
+       start "ftp-upload start message"
+       mail,addresses "outgoing mail sent"
+    }
+
+    if { [llength $check(log)] > 0 } { append log_items $check(log) }
+
+    register_test_packages $tenv $setup(packages)
+
+    foreach {zone filelist} $setup(files) {
+       foreach {file sig} $filelist {
+           file mkdir [file dirname [file join $tenv $zone $file]]
+           put_file [file join $tenv $zone $file] "${file}\n"
+           age_file [file join $tenv $zone $file] "10 minutes ago"
+           if { [llength $sig] > 0 } {
+               put_file [file join $tenv $zone "${file}.sig"] \
+                   [sign_test_file [file tail $file] \
+                        [eval [list make_test_signature] $sig]]
+               age_file [file join $tenv $zone "${file}.sig"] "10 minutes ago"
+           }
+       }
+    }
+    foreach {zone linklist} $setup(symlinks) {
+       foreach {target link} $linklist {
+           # The Tcl [file link] command refuses to create dangling symlinks.
+           # file link -symbolic [file join $tenv $zone $link] $target
+           verbose -log [exec ln -sv $target [file join $tenv $zone $link]]
+       }
+    }
+
+    foreach {tag case} $data(upload) { make_test_case $tenv [list $tag $case] }
+
+    start_test_services $tenv
+    run_upload_batch_test
+    stop_test_services
+
+    analyze_log $tenv "triplet: $desc" $log_items
+    analyze_mail $tenv "triplet: $desc" to $check(email-to)
+    if { [llength $check(file-tree)] > 0 } {
+       foreach {zones mode items} $check(file-tree) {
+           analyze_file_tree $tenv "triplet: $desc" \
+               $zones $mode $items
+       }
+    }
+
+    close_test_environment $tenv
+}
+
+# ----------------------------------------
+
+check_triplet "bogus: signature from unknown key in directive" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.tar.gz {
+       directive {
+           version 1.2
+           directory foo
+           filename foo.tar.gz
+       } dsig { good 01 2000 }
+       tar-file {
+           README README
+           foo.bin contents
+       } fsig { good 02 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.tar.gz.directive.asc foo.tar.gz.sig foo.tar.gz
+       }
+    } log {
+       found,foo.tar.gz.directive.asc "found directive in triplet"
+       found-triplet,foo.tar.gz.directive.asc:foo.tar.gz.sig:foo.tar.gz \
+           "found triplet"
+       gpgv,directive-verify-failed "incorrect signature rejected"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.org foo@example.net
+    }
+}
+
+check_triplet "bogus: signature from unknown key on file" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.tar.gz {
+       directive {
+           version 1.2
+           directory foo
+           filename foo.tar.gz
+       } dsig { good 03 1000 }
+       tar-file {
+           README README
+           foo.bin contents
+       } fsig { good 04 2000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.tar.gz.directive.asc foo.tar.gz.sig foo.tar.gz
+       }
+    } log {
+       found,foo.tar.gz.directive.asc "found directive in triplet"
+       found-triplet,foo.tar.gz.directive.asc:foo.tar.gz.sig:foo.tar.gz \
+           "found triplet"
+       gpgv,upload-verify-failed,foo.tar.gz "incorrect signature rejected"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.org foo@example.net
+       ftp-upload-report@gnu.org foo@example.gnu.org
+    }
+}
+
+# ----------------------------------------
+
+check_triplet "bogus: bad signature in directive" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.tar.gz {
+       directive {
+           version 1.2
+           directory foo
+       filename foo.tar.gz
+       } dsig { bad X1 1000 }
+       tar-file {
+           README README
+           foo.bin contents
+       } fsig { good 02 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.tar.gz.directive.asc foo.tar.gz.sig foo.tar.gz
+       }
+    } log {
+       found,foo.tar.gz.directive.asc "found directive in triplet"
+       found-triplet,foo.tar.gz.directive.asc:foo.tar.gz.sig:foo.tar.gz \
+           "found triplet"
+       gpgv,directive-verify-failed "incorrect signature rejected"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.org foo@example.net
+    }
+}
+
+check_triplet "bogus: bad signature on file" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.tar.gz {
+       directive {
+           version 1.2
+           directory foo
+       filename foo.tar.gz
+       } dsig { good 03 1000 }
+       tar-file {
+           README README
+           foo.bin contents
+       } fsig { bad X2 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.tar.gz.directive.asc foo.tar.gz.sig foo.tar.gz
+       }
+    } log {
+       found,foo.tar.gz.directive.asc "found directive in triplet"
+       found-triplet,foo.tar.gz.directive.asc:foo.tar.gz.sig:foo.tar.gz \
+           "found triplet"
+       gpgv,upload-verify-failed "incorrect signature rejected"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.org foo@example.net
+       ftp-upload-report@gnu.org foo@example.gnu.org
+    }
+}
+
+# ----------------------------------------
+
+check_triplet "bogus: empty directive" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.bin {
+       directive { } dsig { good 02 1000 }
+       file { test } fsig { good 03 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.bin foo.bin.sig foo.bin.directive.asc
+       }
+    } log {
+       found,foo.bin.directive.asc "found directive in triplet"
+       found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.gnu.org
+       ftp-upload-report@gnu.org
+    }
+}
+
+check_triplet "bogus: signed for unknown package" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    bar.tar.gz {
+       directive {
+           version 1.2
+           directory bar
+           filename bar.tar.gz
+       } dsig { good 05 1000 }
+       tar-file {
+           README README
+           bar.bin contents
+       } fsig { good 06 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           bar.tar.gz.directive.asc bar.tar.gz.sig bar.tar.gz
+       }
+    } log {
+       found,bar.tar.gz.directive.asc "found directive in triplet"
+       found-triplet,bar.tar.gz.directive.asc:bar.tar.gz.sig:bar.tar.gz \
+           "found triplet"
+       unknown-package "unknown package from directive"
+    } email-to {
+       ftp-upload-script@gnu.org
+       foo@example.gnu.org
+    }
+}
+
+check_triplet "bogus: signed with wrong key" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+       bar {
+           email { "bar@example.org" }
+           keys { { id 1001 name "bar <bar@example.gnu.org>" } }
+           maintainers { "bar <bar@example.net>" }
+       }
+    }
+} upload {
+    bar.tar.gz {
+       directive {
+           version 1.2
+           directory bar
+           filename bar.tar.gz
+       } dsig { good 05 1000 }
+       tar-file {
+           README README
+           bar.bin contents
+       } fsig { good 06 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           bar.tar.gz.directive.asc bar.tar.gz.sig bar.tar.gz
+       }
+    } log {
+       found,bar.tar.gz.directive.asc "found directive in triplet"
+       found-triplet,bar.tar.gz.directive.asc:bar.tar.gz.sig:bar.tar.gz \
+           "found triplet"
+       gpgv,directive-verify-failed "incorrect signature rejected"
+    } email-to {
+       ftp-upload-script@gnu.org bar@example.org bar@example.net
+       ftp-upload-report@gnu.org foo@example.gnu.org
+    }
+}
+
+check_triplet "bogus: signed with wrong key in directive" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+       bar {
+           email { "bar@example.org" }
+           keys { { id 1001 name "bar <bar@example.gnu.org>" } }
+           maintainers { "bar <bar@example.net>" }
+       }
+    }
+} upload {
+    bar.tar.gz {
+       directive {
+           version 1.2
+           directory bar
+           filename bar.tar.gz
+       } dsig { good 05 1000 }
+       tar-file {
+           README README
+           bar.bin contents
+       } fsig { good 06 1001 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           bar.tar.gz.directive.asc bar.tar.gz.sig bar.tar.gz
+       }
+    } log {
+       found,bar.tar.gz.directive.asc "found directive in triplet"
+       found-triplet,bar.tar.gz.directive.asc:bar.tar.gz.sig:bar.tar.gz \
+           "found triplet"
+       gpgv,directive-verify-failed "incorrect signature rejected"
+    } email-to {
+       ftp-upload-script@gnu.org bar@example.org bar@example.net
+       ftp-upload-report@gnu.org foo@example.gnu.org
+    }
+}
+# TODO: recognize signature for file and send email to "bar" key address?
+
+check_triplet "bogus: signed with wrong key on file" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+       bar {
+           email { "bar@example.org" }
+           keys { { id 1001 name "bar <bar@example.gnu.org>" } }
+           maintainers { "bar <bar@example.net>" }
+       }
+    }
+} upload {
+    bar.tar.gz {
+       directive {
+           version 1.2
+           directory bar
+           filename bar.tar.gz
+       } dsig { good 05 1001 }
+       tar-file {
+           README README
+           bar.bin contents
+       } fsig { good 06 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           bar.tar.gz.directive.asc bar.tar.gz.sig bar.tar.gz
+       }
+    } log {
+       found,bar.tar.gz.directive.asc "found directive in triplet"
+       found-triplet,bar.tar.gz.directive.asc:bar.tar.gz.sig:bar.tar.gz \
+           "found triplet"
+       gpgv,upload-verify-failed "incorrect signature rejected"
+    } email-to {
+       ftp-upload-script@gnu.org bar@example.org bar@example.net
+       ftp-upload-report@gnu.org bar@example.gnu.org
+    }
+}
+# TODO: send email to "foo" key address -- the upload was rejected but
+#      carried a signature from that key!
+
+# TODO: store a database of all signatures somewhere and only emit a mail
+#      if a "new" signature is seen; copying an existing signature cannot
+#      indicate a compromised key, but a new-to-us signature might!  There
+#      was some discussion about storing copies of signatures in a Git
+#      repository to prevent signature-replacement attacks; this would
+#      also provide a means to check easily if a new signature has been
+#      seen before.  We could also store a list of GPG SIG_ID values.
+
+# ----------------------------------------
+
+# version 1.0 did not use the version field at all
+check_triplet "bogus: invalid v1.0 format directive" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.bin {
+       directive {
+           version 1.0
+           directory foo/v1
+       } dsig { good 02 1000 }
+       file { test } fsig { good 03 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.bin.directive.asc foo.bin.sig foo.bin
+       }
+    } log {
+       found,foo.bin.directive.asc "found directive in triplet"
+       found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+           "found triplet"
+       validate,bad-version "invalid version rejected"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.gnu.org
+    }
+}
+
+check_triplet "obsolete: v1.0 format directive" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.bin {
+       directive {
+           directory foo
+       } dsig { good 02 1000 }
+       file { test } fsig { good 03 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.bin.directive.asc foo.bin.sig foo.bin
+       }
+    } log {
+       found,foo.bin.directive.asc "found directive in triplet"
+       found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+           "found triplet"
+       validate,no-filename "directive file lacking version rejected"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.gnu.org
+       ftp-upload-report@gnu.org foo@example.org foo@example.net
+    }
+}
+# TODO:  The above "validate,no-filename" should be "validate,no-version"
+#       but the script currently does not check these in the proper order.
+
+check_triplet "bogus: duplicated version key" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.bin {
+       directive {
+           version 1.2
+           version 1.2
+           directory foo
+           filename foo.bin
+       } dsig { good 04 1000 }
+       file { test } fsig { good 05 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.bin.directive.asc foo.bin.sig foo.bin
+       }
+    } log {
+       found,foo.bin.directive.asc "found directive in triplet"
+       found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+           "found triplet"
+       validate,bad-version-repeat "version key repeated"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.gnu.org
+    }
+}
+
+check_triplet "bogus: ambiguous version declaration" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+} upload {
+    foo.bin {
+       directive {
+           version 1.2
+           version 1.1
+           directory foo
+           filename foo.bin
+       } dsig { good 06 1000 }
+       file { test } fsig { good 07 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage pub archive } empty {}
+       { in-stage } files {
+           foo.bin.directive.asc foo.bin.sig foo.bin
+       }
+    } log {
+       found,foo.bin.directive.asc "found directive in triplet"
+       found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+           "found triplet"
+       validate,bad-version-repeat "version key repeated"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.gnu.org
+    }
+}
+
+# ----------------------------------------
+
+foreach FVER $DIRECTIVE_FORMAT_VERSIONS {
+
+    check_triplet "bogus: v$FVER format directive without filename" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               directory foo
+           } dsig { good 02 1000 }
+           file { test } fsig { good 03 1000 }
+       }
+    }] check {
+       file-tree {
+           { incoming stage pub archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           validate,no-filename "directive file lacking filename rejected"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+           ftp-upload-report@gnu.org foo@example.org foo@example.net
+       }
+    }
+
+    check_triplet "bogus: v$FVER format directive with repeated filename" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               filename foo.bin
+               directory foo/v$FVER
+           } dsig { good 04 1000 }
+           file { test } fsig { good 05 1000 }
+       }
+    }] check {
+       file-tree {
+           { incoming stage pub archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           validate,bad-filename-repeat \
+               "directive file with repeated filename rejected"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+       }
+    }
+
+    check_triplet "bogus: v$FVER format directive with unclear filename" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               filename foobar.bin
+               directory foo/v$FVER
+           } dsig { good 06 1000 }
+           file { test } fsig { good 07 1000 }
+       }
+    }] check {
+       file-tree {
+           { incoming stage pub archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           validate,bad-filename-repeat \
+               "directive file with ambiguous filename rejected"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+       }
+    }
+
+    check_triplet "bogus: v$FVER format directive with wrong filename" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foobar.bin
+               directory foo/v$FVER
+           } dsig { good 08 1000 }
+           file { test } fsig { good 09 1000 }
+       }
+    }] check {
+       file-tree {
+           { incoming stage pub archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           validate,filename-mismatch \
+               "directive file with wrong filename rejected"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+           ftp-upload-report@gnu.org foo@example.org foo@example.net
+       }
+    }
+
+    check_triplet "bogus: v$FVER format directive with missing directory" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+           } dsig { good 0A 1000 }
+           file { test } fsig { good 0B 1000 }
+       }
+    }] check {
+       file-tree {
+           { incoming stage pub archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           validate,no-directory-given \
+               "directive file with no directory key rejected"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+           ftp-upload-report@gnu.org
+       }
+    }
+
+    check_triplet "bogus: v$FVER format directive with empty directory" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               directory
+           } dsig { good 0A 1000 }
+           file { test } fsig { good 0B 1000 }
+       }
+    }] check {
+       file-tree {
+           { incoming stage pub archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           validate,bad-directory \
+               "directive file with empty directory key rejected"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+       }
+    }
+
+    foreach BDIR {
+       foo/bar/../baz
+       /foo/bar/baz
+       foo/-bar
+       foo/.bar
+    } {
+       check_triplet "bogus: v$FVER format directive\
+                       with bad directory $BDIR" \
+           setup {
+               packages {
+                   foo {
+                       email { "foo@example.org" }
+                       keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+                       maintainers { "foo <foo@example.net>" }
+                   }
+               }
+           } upload [subst {
+               foo.bin {
+                   directive {
+                       version $FVER
+                       filename foo.bin
+                       directory $BDIR
+                   } dsig { good 0C 1000 }
+                   file { test } fsig { good 0D 1000 }
+               }
+           }] check {
+               file-tree {
+                   { incoming stage pub archive } empty {}
+                   { in-stage } files {
+                       foo.bin.directive.asc foo.bin.sig foo.bin
+                   }
+               } log {
+                   found,foo.bin.directive.asc "found directive in triplet"
+                   found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+                       "found triplet"
+                   validate,bad-directory \
+                       "directive file with invalid directory $BDIR rejected"
+               } email-to {
+                   ftp-upload-script@gnu.org foo@example.gnu.org
+               }
+           }
+    }
+
+    check_triplet "bogus: v$FVER format directive with directory too deep" \
+       setup {
+           packages {
+               foo {
+                   email { "foo@example.org" }
+                   keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+                   maintainers { "foo <foo@example.net>" }
+               }
+           }
+       } upload [subst {
+           foo.bin {
+               directive {
+                   version $FVER
+                   filename foo.bin
+                   directory foo/foo/foo/bar/bar/bar/baz/baz/baz
+               } dsig { good 0E 1000 }
+               file { test } fsig { good 0F 1000 }
+           }
+       }] check {
+           file-tree {
+               { incoming stage pub archive } empty {}
+               { in-stage } files {
+                   foo.bin.directive.asc foo.bin.sig foo.bin
+               }
+           } log {
+               found,foo.bin.directive.asc "found directive in triplet"
+               found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+                   "found triplet"
+               validate,bad-directory-depth \
+                   "directive file with excessively deep directory rejected"
+           } email-to {
+               ftp-upload-script@gnu.org foo@example.gnu.org
+           }
+       }
+
+    check_triplet "bogus: v$FVER format directive with repeated directory" \
+       setup {
+           packages {
+               foo {
+                   email { "foo@example.org" }
+                   keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+                   maintainers { "foo <foo@example.net>" }
+               }
+           }
+       } upload [subst {
+           foo.bin {
+               directive {
+                   version $FVER
+                   filename foo.bin
+                   directory foo/v$FVER
+                   directory foo/v$FVER
+               } dsig { good 0G 1000 }
+               file { test } fsig { good 0H 1000 }
+           }
+       }] check {
+           file-tree {
+               { incoming stage pub archive } empty {}
+               { in-stage } files {
+                   foo.bin.directive.asc foo.bin.sig foo.bin
+               }
+           } log {
+               found,foo.bin.directive.asc "found directive in triplet"
+               found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+                   "found triplet"
+               validate,bad-directory-repeat \
+                   "directive file with repeated directory key rejected"
+           } email-to {
+               ftp-upload-script@gnu.org foo@example.gnu.org
+               foo@example.org foo@example.net
+           }
+       }
+
+    check_triplet "bogus: v$FVER format directive with unclear directory" \
+       setup {
+           packages {
+               foo {
+                   email { "foo@example.org" }
+                   keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+                   maintainers { "foo <foo@example.net>" }
+               }
+           }
+       } upload [subst {
+           foo.bin {
+               directive {
+                   version $FVER
+                   filename foo.bin
+                   directory foo/v$FVER
+                   directory foo/bar/v$FVER
+               } dsig { good 0I 1000 }
+               file { test } fsig { good 0J 1000 }
+           }
+       }] check {
+           file-tree {
+               { incoming stage pub archive } empty {}
+               { in-stage } files {
+                   foo.bin.directive.asc foo.bin.sig foo.bin
+               }
+           } log {
+               found,foo.bin.directive.asc "found directive in triplet"
+               found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+                   "found triplet"
+               validate,bad-directory-repeat \
+                   "directive file with ambiguous directory key rejected"
+           } email-to {
+               ftp-upload-script@gnu.org foo@example.gnu.org
+               foo@example.org foo@example.net
+           }
+       }
+
+}
+
+# ----------------------------------------
+
+foreach FVER $DIRECTIVE_FORMAT_VERSIONS {
+
+    check_triplet "v$FVER format directive with new file at top" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+           foo/bar {
+               keys { { id 2000 name "foobar <foobar@example.gnu.org>" } }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               directory foo/v$FVER
+           } dsig { good 02 1000 }
+           file { test } fsig { good 03 1000 }
+       }
+    }] check [subst {
+       file-tree {
+           { incoming in-stage stage archive } empty {}
+           { pub } files {
+               foo/v$FVER/foo.bin.sig foo/v$FVER/foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           workdone,1 "1 upload processed"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+           ftp-upload-report@gnu.org foo@example.org foo@example.net
+       }
+    }]
+
+    check_triplet "v$FVER format directive with new file in subtree" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+           foo/bar {
+               keys { { id 2000 name "foobar <foobar@example.gnu.org>" } }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               directory foo/bar/v$FVER
+           } dsig { good 04 1000 }
+           file { test } fsig { good 05 1000 }
+       }
+    }] check [subst {
+       file-tree {
+           { incoming in-stage stage archive } empty {}
+           { pub } files {
+               foo/bar/v$FVER/foo.bin.sig foo/bar/v$FVER/foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           workdone,1 "1 upload processed"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+           ftp-upload-report@gnu.org foo@example.org foo@example.net
+       }
+    }]
+
+
+    check_triplet "v$FVER format directive with subtree key at top" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+           foo/bar {
+               keys { { id 2000 name "foobar <foobar@example.gnu.org>" } }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               directory foo/v$FVER
+           } dsig { good 06 2000 }
+           file { test } fsig { good 07 2000 }
+       }
+    }] check [subst {
+       file-tree {
+           { incoming stage pub archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           gpgv,directive-verify-failed "directive signature rejected"
+       } email-to {
+           ftp-upload-script@gnu.org foobar@example.gnu.org
+           ftp-upload-report@gnu.org foo@example.org foo@example.net
+       }
+    }]
+
+    check_triplet "v$FVER format directive with subtree key in subtree" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+           foo/bar {
+               keys { { id 2000 name "foobar <foobar@example.gnu.org>" } }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               directory foo/bar/v$FVER
+           } dsig { good 08 2000 }
+           file { test } fsig { good 09 2000 }
+       }
+    }] check [subst {
+       file-tree {
+           { incoming in-stage stage archive } empty {}
+           { pub } files {
+               foo/bar/v$FVER/foo.bin.sig foo/bar/v$FVER/foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           workdone,1 "1 upload processed"
+       } email-to {
+           ftp-upload-script@gnu.org foobar@example.gnu.org
+           ftp-upload-report@gnu.org foo@example.org foo@example.net
+       }
+    }]
+
+    check_triplet "v$FVER format directive with existing file" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+       }
+       files {
+           pub {
+               foo/foo.bin { good 02 1000 }
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               directory foo
+           } dsig { good 0A 1000 }
+           file { test } fsig { good 0B 1000 }
+       }
+    }] check {
+       file-tree {
+           { incoming stage archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+           { pub } files {
+               foo/foo.bin foo/foo.bin.sig
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           install,target-signature-exists \
+               "existing signature not replaced"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+           ftp-upload-report@gnu.org foo@example.org foo@example.net
+       }
+    }
+
+    check_triplet "v$FVER format directive with unsigned file" setup {
+       packages {
+           foo {
+               email { "foo@example.org" }
+               keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+               maintainers { "foo <foo@example.net>" }
+           }
+       }
+       files {
+           pub {
+               foo/foo.bin {}
+           }
+       }
+    } upload [subst {
+       foo.bin {
+           directive {
+               version $FVER
+               filename foo.bin
+               directory foo
+           } dsig { good 0A 1000 }
+           file { test } fsig { good 0B 1000 }
+       }
+    }] check {
+       file-tree {
+           { incoming stage archive } empty {}
+           { in-stage } files {
+               foo.bin.directive.asc foo.bin.sig foo.bin
+           }
+           { pub } files {
+               foo/foo.bin
+           }
+       } log {
+           found,foo.bin.directive.asc "found directive in triplet"
+           found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+               "found triplet"
+           install,target-file-exists \
+               "existing file not replaced"
+       } email-to {
+           ftp-upload-script@gnu.org foo@example.gnu.org
+           ftp-upload-report@gnu.org foo@example.org foo@example.net
+       }
+    }
+
+}
+
+check_triplet "bogus: v1.1 format directive to replace file" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+    files {
+       pub { foo/foo.bin { good 01 1000 } }
+    }
+} upload {
+    foo.bin {
+       directive {
+           version 1.1
+           replace true
+           filename foo.bin
+           directory foo
+       } dsig { good 0C 1000 }
+       file { test } fsig { good 0D 1000 }
+    }
+} check {
+    file-tree {
+       { incoming stage archive } empty {}
+       { in-stage } files {
+           foo.bin.directive.asc foo.bin.sig foo.bin
+       }
+       { pub } files {
+           foo/foo.bin foo/foo.bin.sig
+       }
+    } log {
+       found,foo.bin.directive.asc "found directive in triplet"
+       found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+           "found triplet"
+       validate,bad-replace-flag \
+           "replace flag rejected in v1.1"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.gnu.org
+       foo@example.org foo@example.net
+    }
+}
+
+check_triplet "v1.2 format directive to replace file" setup {
+    packages {
+       foo {
+           email { "foo@example.org" }
+           keys { { id 1000 name "foo <foo@example.gnu.org>" } }
+           maintainers { "foo <foo@example.net>" }
+       }
+    }
+    files {
+       pub { foo/foo.bin { good 01 1000 } }
+    }
+} upload {
+    foo.bin {
+       directive {
+           version 1.2
+           replace true
+           filename foo.bin
+           directory foo
+       } dsig { good 0E 1000 }
+       file { test } fsig { good 0F 1000 }
+    }
+} check {
+    file-tree {
+       { incoming in-stage stage } empty {}
+       { pub } files {
+           foo/foo.bin foo/foo.bin.sig
+       }
+       { archive } archived-files { foo/foo.bin }
+    } log {
+       found,foo.bin.directive.asc "found directive in triplet"
+       found-triplet,foo.bin.directive.asc:foo.bin.sig:foo.bin \
+           "found triplet"
+       install,target-signature-replaced "signature replaced using v1.2"
+       install,target-file-replaced "file replaced using v1.2"
+    } email-to {
+       ftp-upload-script@gnu.org foo@example.gnu.org
+       ftp-upload-report@gnu.org foo@example.org foo@example.net
+    }
+}
+
+# ----------------------------------------
+
+#EOF