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
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.\
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
# 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\)\
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
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
--- /dev/null
+# 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