From 85e0700ba243d4dac4c7c3d7cdecd3e6572cc368 Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Wed, 7 Apr 2021 20:22:34 -0500 Subject: [PATCH] Add initial partial testsuite This does not yet check actual upload handling, but the testsuite infrastructure seems to be sufficiently developed at this point that no major changes should be needed to support further tests. --- testsuite/lib/upload.exp | 693 +++++++++++++++++++++++++++++- testsuite/upload.all/00_idle.exp | 278 ++++++++++++ testsuite/upload.all/01_loose.exp | 400 +++++++++++++++++ 3 files changed, 1369 insertions(+), 2 deletions(-) create mode 100644 testsuite/upload.all/00_idle.exp create mode 100644 testsuite/upload.all/01_loose.exp diff --git a/testsuite/lib/upload.exp b/testsuite/lib/upload.exp index b566d23..6f270d4 100644 --- a/testsuite/lib/upload.exp +++ b/testsuite/lib/upload.exp @@ -19,11 +19,700 @@ set UPLOAD_TOOL [file join $srcdir upload-ftp-v1.2.pl] -proc upload_exit {} {} +# invoked by DejaGnu framework when a failure is recorded +proc upload_count_failures { args } { + global upload_failure_count + incr upload_failure_count +} +set local_record_procs(fail) upload_count_failures + +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_test_environment { stem } { + set count 1 + set name "${stem}.1" + while { [file exists $name] } { + incr count + set name "${stem}.${count}" + } + + global upload_failure_count + set upload_failure_count 0 + + make_test_environment $name + return $name +} +proc close_test_environment { name } { + global upload_failure_count + # delete the environment iff no tests failed + if { $upload_failure_count == 0 } { + file delete -force -- $name + } +} + +proc make_test_environment { base_dir } { + file mkdir $base_dir + file mkdir [file join $base_dir packages] + file mkdir [file join $base_dir incoming] + file mkdir [file join $base_dir in-stage] + file mkdir [file join $base_dir stage] + file mkdir [file join $base_dir pub] + file mkdir [file join $base_dir archive] + + # default of no open files for other tests to override if needed + put_file [file join $base_dir mocks] ":^ lsof -Fn .*\n? 1\n" +} + +load_lib mockgpg.exp + +# make_test_keyrings /some/dir/some/where { +# some-package-name { +# { id +# name [is ] +# subkey-of +# expires }... +# } +# some-package-name/po { +# +# } +# } +proc make_test_keyrings { base_dir keylist } { + # file names could be properly split, instead of relying on passed in + # slashes being correct for writing the file, but this is unlikely to + # ever run on a non-POSIX system, and they are correct on POSIX + foreach { package keys } $keylist { + file mkdir [file join $base_dir packages $package] + write_test_keyring \ + [file join $base_dir packages $package pubring.gpg] $keys + } +} + +# register_test_packages /some/dir/some/where { +# some-package-name { +# email { ... } +# keys { +# +# } +# maintainers { ">... } +# } +# ... +# } +proc register_test_packages { base_dir packlist } { + 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 + } + maintainers { + set c [open [file join $base_dir m.bypkg] a] + puts -nonewline $c [format "%s - " $package] + puts $c [join $value ", "] + close $c + } + } } + } +} + +# make_test_case /some/dir/some/where { +# some-package-name-1.2.3.tar.gz { +# directive { +# version 1.2 +# filename some-package-name-1.2.3.tar.gz +# ... +# } +# dsig { good|bad +# [] [expires ] } +# file { ... } +# fsig { ... } +# [directive-mtime ] +# [file-mtime ] +# [fsig-mtime ] +# } +# other-package-name-4.5.6.tar.bz2 { +# directive { ... } +# dsig { } +# file { ... } +# fsig { ... } +# } +# } +proc make_test_case { base_dir packlist } { + foreach { stem triplet } $packlist { + array unset parts + foreach part {directive file fsig} { + set "parts(${part}-mtime)" "3 minutes ago" + } + array set parts $triplet + if { [info exists parts(directive)] } { + set directive {} + foreach {key value} $parts(directive) { + append directive [format "%s: %s\n" $key $value] + } + if { [info exists parts(dsig)] } { # add signature + set directive \ + [sign_test_message $directive \ + [eval make_test_signature $parts(dsig)]] + } + put_file [file join $base_dir incoming "${stem}.directive.asc"] \ + $directive + age_file [file join $base_dir incoming "${stem}.directive.asc"] \ + $parts(directive-mtime) + } + if { [info exists parts(file)] } { # write file + put_file [file join $base_dir incoming "${stem}"] \ + [string trimleft $parts(file)] + age_file [file join $base_dir incoming "${stem}"] \ + $parts(file-mtime) + } + if { [info exists parts(fsig)] } { # write detached signature + put_file [file join $base_dir incoming "${stem}.sig"] \ + [sign_test_file $stem \ + [eval make_test_signature $parts(fsig)]] + age_file [file join $base_dir incoming "${stem}.sig"] \ + $parts(fsig-mtime) + } + } +} + +proc start_test_services { base_dir } { + global spawn_id + upvar 1 minlog_id minlog_id minsmtp_id minsmtp_id + + set ::env(TEST_BASE_DIR) [file normalize $base_dir] + verbose -log "running test in ${base_dir}" + + # start minlogd + set logsock [format "testlog%d" [pid]] + spawn [testsuite file -source -top lib exec minlogd.pl] \ + -s $logsock \ + -o [file join $base_dir syslog] + set minlog_id $spawn_id + expect { + -re {listening on [^\n]+\n} {} + timeout { error "minlogd did not start" } + } + set ::env(TEST_SYSLOG_SOCKET) $logsock + + # start minsmtpd + spawn [testsuite file -source -top lib exec minsmtpd.tcl] \ + -o [file join $base_dir mbox] + set minsmtp_id $spawn_id + expect { + -re {listening on local port ([0-9]+)[^\n]*\n} { + set ::env(TEST_SMTP_PORT) $expect_out(1,string) + } + timeout { error "minsmtpd did not start" } + } +} +proc stop_test_services {} { + global spawn_id + upvar 1 minlog_id minlog_id minsmtp_id minsmtp_id + + # stop minsmtpd + set spawn_id $minsmtp_id + send "exit\n" + wait + + # stop minlogd + set spawn_id $minlog_id + send "exit\n" + wait + + # cleanup + unset ::env(TEST_BASE_DIR) ::env(TEST_SMTP_PORT) ::env(TEST_SYSLOG_SOCKET) +} + +proc run_upload_batch_test {} { + global spawn_id + global UPLOAD_TOOL + + # run test case + spawn $UPLOAD_TOOL --testing-this-script -s ftp + wait +} + +proc analyze_file_tree { base_dir name zones mode {itemlist {}} } { + verbose -log "scanning { [string trim $zones] } for ${mode}:" + + foreach zone $zones { + set zone_base [file normalize [file join $base_dir $zone]] + + set result pass + switch -- $mode { + + empty { + set desc "empty $zone tree" + spawn find $zone_base -print + expect { + -ex $zone_base { exp_continue } + -re {^[\r\n]+} { exp_continue } + -re {.+} { set result fail } + } + } + + files { + set desc "expected files in $zone tree" + foreach file $itemlist { + set filemap_want($file) $file + set "filemap_sig(${file}.sig)" $file + } + spawn find $zone_base ( -type f -o -type l ) -print + expect { + -re {^[\r\n]+} { exp_continue } + -re "^$zone_base" { exp_continue } + -re {^/([^\r\n]+)[\r\n]+} { + if { [info exists \ + filemap_want($expect_out(1,string))] } { + unset filemap_want($expect_out(1,string)) + } elseif { [info exists \ + filemap_sig($expect_out(1,string))] } { + unset filemap_sig($expect_out(1,string)) + } else { + verbose -log "unexpected: $expect_out(1,string)" + set result fail + } + exp_continue + } + } + if { [llength [array get filemap_want]] } { + set result fail + foreach file [array names filemap_want] { + verbose -log "missing: $file" + } + } + } + + archived-files { + # Archiving an upload inserts a timestamp and nonce; this + # handling for matching such files will work provided that + # the original file name begins with a letter. + set desc "expected archived files in $zone tree" + foreach file $itemlist { + set filemap_want($file) $file + set "filemap_sig(${file}.sig)" $file + } + spawn find $zone_base ( -type f -o -type l ) -print + expect { + -re {^[\r\n]+} { exp_continue } + -re "^$zone_base" { exp_continue } + -re {^/([^\r\n]+)[\r\n]+} { + regsub -- {/[-0-9_]+} $expect_out(1,string) / file + if { [info exists filemap_want($file)] } { + set filemap_have($file) 1 + } elseif { [info exists filemap_sig($file)] } { + set filemap_havesig($file) 1 + } else { + verbose -log "unexpected: $expect_out(1,string)" + verbose -log " match as: $file" + set result fail + } + exp_continue + } + } + # The handling here is more complex because the same file + # could be archived multiple times. + foreach file [array names filemap_have] { + unset filemap_want($file) + } + if { [llength [array get filemap_want]] } { + set result fail + foreach file [array names filemap_want] { + verbose -log "missing: $file" + } + } + } + + symlink-targets { + set desc "expected link targets in $zone tree" + foreach { target link } $itemlist { + set linkmap_want($link) $target + } + spawn find $zone_base -type l -printf {%p\037%l\n} + expect { + -re {^[\r\n]+} { exp_continue } + -re "^$zone_base" { exp_continue } + -re {^/([^\037]+)\037([^\r\n]+)} { + if { [info exists \ + linkmap_want($expect_out(1,string))] } { + if { $linkmap_want($expect_out(1,string)) \ + ne $expect_out(2,string) } { + verbose -log "unexpected symlink target:\ + $expect_out(1,string)\ + -> $expect_out(2,string)" + set result fail + } + unset linkmap_want($expect_out(1,string)) + } else { + verbose -log "unexpected symlink:\ + $expect_out(1,string) -> $expect_out(2,string)" + set result fail + } + exp_continue + } + } + if { [llength [array get linkmap_want]] } { + set result fail + foreach link [array names linkmap_want] { + verbose -log "missing symlink:\ + $link -> $linkmap_want($link)" + } + } + } + } + $result "$name: $desc" + wait + } +} + +proc analyze_log { base_dir name assess } { + verbose -log "reading log for \"$name\" tests:" + + foreach {key desc} $assess { + regexp {^!(.*)$} $key -> key + set A($key) 0 + } + + verbose -log "begin: [string repeat - 60]" + spawn -open [open [file join $base_dir syslog]] + expect { + -re {^[\r\n]+} { exp_continue } + -re {^<[0-9]+>1 [-0-9]+T[0-9:]+ localhost - - - - } { exp_continue } + -re {^minlogd\[[0-9]+\]: begin logging} { exp_continue } + -re {^minlogd\[[0-9]+\]: shutting down} { exp_continue } + + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + Beginning upload processing run.} { + # from main script, upon opening syslog channel + set A(start) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + found directive: ([^\r\n]+)} { + # from main script, top of file processing loop + set A(found,$expect_out(1,string)) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + No files found for processing.} { + # from main script, exiting when nothing was done + set A(nowork) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + Processing complete: ([[:digit:]]+) uploads processed.} { + # from main script, exiting after processing directives + set A(workdone) 1 + set A(workdone,$expect_out(1,string)) 1 + # set both to allow tests to check or ignore the number + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + Updated ftpindex} { + # from main script, exiting after processing directives + exp_continue + # in testing, redundant with "workdone" message above; + # in production, timestamp difference with same gives + # running time for the generate-ftpindex tool + } + + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + archived [^ ]+ to [^\r\n]+} { + # from archive, upon success + set A(action,archive-item) 1 + # will need to revise log messages to make this + # include a file name relative to the test base + exp_continue + } + + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + added symlink [^ ]+ pointing to [^\r\n]+} { + # from execute_commands, creating a symlink + set A(action,make-symlink) 1 + # will need to revise log messages to make this + # include a file name relative to the test base + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + creation of symlink [^ ]+ to [^ ]+ in [^ ]+ failed[^\r\n]+} { + # from execute_commands, when the symlink builtin fails + set A(action,make-symlink-failure) 1 + # will need to revise log messages to make this + # include a file name relative to the test base + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + removed symlink [^\r\n]+} { + # from execute_commands, removing a symlink + set A(action,rm-symlink) 1 + # will need to revise log messages to make this + # include a file name relative to the test base + exp_continue + } + + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: uploaded file to check: ([^\r\n]+)} { + # from scan_incoming readdir loop + set A(scan,$expect_out(1,string)) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: lsof command line: [^\r\n]*} { + # from scan_incoming, tracing lsof call + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: lsof output: [^\r\n]*} { + # from scan_incoming, tracing lsof output + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: upload in progress for ([^,]+),\ + ignoring during this run} { + # from scan_incoming, when lsof reports file still open + set A(open,$expect_out(1,string)) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: ([^ ]+) has[^,]+, skipping} { + # from scan_incoming, when recent mtime excludes a file + set A(recent,$expect_out(1,string)) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: considering ([^ ]+) for processing.} { + # from scan_incoming, top of triplet checking loop + set A(consider,$expect_out(1,string)) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + Found directive file with filename directive \(([^ ]+)\),\ + but no accompanying files.\ + Ignoring directive file in this run.} { + # from scan_incoming, on finding a loose triplet directive + set A(skip-loose,$expect_out(1,string)) 1 + exp_continue + } + + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: found keyring [^\r\n]+} { + # from keyring_file, while searching for keyrings + exp_continue + } + + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + The directory line should start with the name of the package\ + for which you are trying to upload a file[^\r\n]+} { + # from email_addresses, when the list cannot be opened + set A(unknown-package) 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 + set A(validate,no-directory-given) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + nothing to do - no commands in directive file} { + # from read_directive_file, if no action specified + set A(validate,no-op) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + not running in legacy v1 mode} { + # from read_directive_file, after determining mode + # TODO: will be removed with other v1 compatibility code + exp_continue + } + + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: [^ ]+ size is [[:digit:]]+} { + # from verify_keyring, upon entry + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + DEBUG: gpgv command line: [^\r\n]+} { + # from verify_keyring, tracing gpgv call + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + gpgv exited ([[:digit:]]+)} { + # from verify_keyring, when closing pipe from gpgv + set A(gpgv,exitcode,$expect_out(1,string)) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + verified against ([^\r\n]+)} { + # from verify_keyring, upon success + exp_continue + # tests are not sensitive to this message because it + # is likely to be removed when gpgv is given multiple + # keyrings instead of being run repeatedly + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + gpg verify of directive file failed} { + # from verify_keyring, when no keys match + set A(gpgv,directive-verify-failed) 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\)\ + No uploader e-mail address\(es\) to report this error to!} { + # from mail, when no email address is provided + set A(mail,no-known-address) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + NOMAIL is set - net sending email to [^\r\n]+} { + # from mail, when mail is inhibited + set A(mail,inhibited) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + Sending email to [^\r\n]+} { + # from mail, recording address list + set A(mail,addresses) 1 + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + Subject: [^\r\n]+} { + # from mail, outgoing Subject line + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + Error uploading package: [^\r\n]+} { + # from mail, when a generic failure is reported + exp_continue + } + -re {^ftp-upload\[[0-9]+\]: \(Test\)\ + Body: [^\r\n]+} { + # from mail, recording outgoing message body + exp_continue + } + } +# -re {^ftp-upload\[[0-9]+\]: \(Test\)\ +# } { +# exp_continue +# } + verbose -log " done: [string repeat - 60]" + + foreach {key desc} $assess { + if { [regexp {^!(.*)$} $key -> key] } { + if { ! $A($key) } { + pass "$name: $desc" + } else { + fail "$name: $desc" + } + } else { + if { $A($key) } { + pass "$name: $desc" + } else { + fail "$name: $desc" + } + } + } +} + +proc analyze_no_mail { base_dir name } { + verbose -log "checking mail from \"$name\" tests:" + + if { [file size [file join $base_dir mbox]] == 0 } { + pass "$name: no mail produced" + } else { + fail "$name: no mail produced" + } +} + +# analyze_mail []... +# keywords: +# to
+proc analyze_mail { base_dir name args } { + verbose -log "checking mail from \"$name\" tests:" + + array set opt { to {} } + array set opt $args + + foreach address $opt(to) { set expected_address($address) $address } + + verbose -log "begin: [string repeat - 60]" + set messages_remain 1 + spawn -open [open [file join $base_dir mbox]] + while { $messages_remain } { + expect { + -re {^From } { + # at beginning of message + } + -re {^[^\r\n]*[\r\n]+} { exp_continue } + eof { + set $messages_remain 0 + break + } + } + expect { + -re {^Received: From [^ ]+ \([.[:xdigit:]:]+\)\ + via TCP with SMTP for } { + # at envelope addresses + } + -re {^[^\r\n]*[\r\n]+} { exp_continue } + } + expect { + -re {^<([^>]+)> *} { + set env_address($expect_out(1,string)) $expect_out(1,string) + exp_continue + } + -re {^[\r\n]+} { + # end of line + } + } + } + verbose -log " done: [string repeat - 60]" + + set result pass + foreach address [array names expected_address] { + if { [info exists env_address($address)] } { + unset env_address($address) + } else { + verbose -log "expected mail not sent to <$address>" 0 + set result fail + } + } + if { [llength [array names env_address]] > 0 } { + verbose -log "unexpected addresses received mail: \ + [array names env_address]" 0 + set result fail + } + + $result "$name: expected mail produced to expected addresses" +} + +proc upload_exit {} { + # clean up test environment tree + catch {file delete -- test.tmp} +} proc upload_version {} { global UPLOAD_TOOL - exec -- $UPLOAD_TOOL --version >@ stdout + exec -- $UPLOAD_TOOL --testing-this-script --version >@ stdout } #EOF diff --git a/testsuite/upload.all/00_idle.exp b/testsuite/upload.all/00_idle.exp new file mode 100644 index 0000000..a699845 --- /dev/null +++ b/testsuite/upload.all/00_idle.exp @@ -0,0 +1,278 @@ +# Tests for processing with nothing to do + +# Copyright (C) 2021 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 . + +set tenv [new_test_environment [file join test.tmp tenv]] + +start_test_services $tenv +run_upload_batch_test +stop_test_services + +analyze_file_tree $tenv "idle processing: no files" { + incoming in-stage stage pub archive +} empty + +analyze_log $tenv "idle processing: no files" { + start "ftp-upload start message" + nowork "ftp-upload 'nothing to do' message" +} + +analyze_no_mail $tenv "idle processing: no files" + +close_test_environment $tenv + +# ---------------------------------------- + +set tenv [new_test_environment [file join test.tmp tenv]] + +# files which are to be found in the scan but not processed +put_file [file join $tenv incoming bogus1] "bogus file 1\n" +put_file [file join $tenv incoming bogus2] "bogus file 2\n" +put_file [file join $tenv incoming bogus3] "bogus file 3\n" + +age_file [file join $tenv incoming bogus1] "3 minutes ago" +age_file [file join $tenv incoming bogus2] "2 minutes 15 seconds ago" +age_file [file join $tenv incoming bogus3] "1 minute ago" + +foreach file { + _bogus +bogus __bogus _+bogus _-bogus _~bogus _.bogus +} { + put_file [file join $tenv incoming ${file}] "bogus file $file\n" + age_file [file join $tenv incoming ${file}] "3 minutes ago" +} + +# files which are to be rejected and ignored +foreach file { + x=x .abcfoobar -abcfoobar x;x \\~xax x*x x:x x?x ;xax +} { + put_file [file join $tenv incoming ${file}] "bogus input $file\n" + age_file [file join $tenv incoming ${file}] "3 minutes ago" +} + +start_test_services $tenv +run_upload_batch_test +stop_test_services + +analyze_file_tree $tenv "idle processing: bogus files" { + incoming +} files { + bogus1 bogus2 bogus3 + _bogus +bogus __bogus _+bogus _-bogus _~bogus _.bogus + x=x .abcfoobar -abcfoobar x;x \\~xax x*x x:x x?x ;xax +} +analyze_file_tree $tenv "idle processing: bogus files" { + in-stage stage pub archive +} empty + +analyze_log $tenv "idle processing: bogus files" { + start "ftp-upload start message" + nowork "ftp-upload 'nothing to do' message" + + scan,bogus1 "scan found file: bogus1" + scan,bogus2 "scan found file: bogus2" + scan,bogus3 "scan found file: bogus3" + + scan,_bogus "scan found file: _bogus" + scan,+bogus "scan found file: +bogus" + scan,__bogus "scan found file: __bogus" + scan,_+bogus "scan found file: _+bogus" + scan,_-bogus "scan found file: _-bogus" + scan,_~bogus "scan found file: _~bogus" + scan,_.bogus "scan found file: _.bogus" + + !scan,x=x "ignored file: x=x" + !scan,.abcfoobar "ignored file: .abcfoobar" + !scan,-abcfoobar "ignored file: -abcfoobar" + !scan,x;x "ignored file: x;x" + !scan,~xax "ignored file: ~xax " + !scan,x*x "ignored file: x*x " + !scan,x:x "ignored file: x:x " + !scan,x?x "ignored file: x?x" + !scan,;xax "ignored file: ;xax" + + recent,bogus3 "skipped recent file: bogus3" + + consider,bogus1 "considered file: bogus1" + consider,bogus2 "considered file: bogus2" +} + +analyze_no_mail $tenv "idle processing: bogus files" + +close_test_environment $tenv + +# ---------------------------------------- + +proc check_incomplete_upload { has_directive has_main has_signature } { + set tenv [new_test_environment [file join test.tmp tenv]] + + put_file [file join $tenv mocks] ":^ lsof -Fn .*\n? 1\n" + + set msglist { + start "ftp-upload start message" + nowork "ftp-upload 'nothing to do' message" + } + + set filelist [list] + set testcase [list] + if { $has_directive } { + lappend filelist partial.bin.directive.asc + lappend testcase directive { + version 1.2 + filename partial.bin + } dsig { good 00 0000 } + lappend msglist \ + scan,partial.bin.directive.asc "scan found directive file" \ + consider,partial.bin.directive.asc "considered directive file" + } + if { $has_main } { + lappend filelist partial.bin + lappend testcase file { + incomplete upload main file + } + lappend msglist \ + scan,partial.bin "scan found main file" \ + consider,partial.bin "considered main file" + } + if { $has_signature } { + lappend filelist partial.bin.sig + lappend testcase fsig { good 01 0000 } + lappend msglist \ + scan,partial.bin.sig "scan found signature file" \ + consider,partial.bin.sig "considered signature file" + } + if { $has_directive && ! ( $has_main || $has_signature ) } { + lappend msglist skip-loose,partial.bin.directive.asc \ + "skip directive file due to missing main file" + } + make_test_case $tenv [list partial.bin $testcase] + + start_test_services $tenv + run_upload_batch_test + stop_test_services + + set Name "idle processing: incomplete upload\ + \[${has_directive}${has_main}${has_signature}\]" + + analyze_file_tree $tenv $Name { + incoming + } files $filelist + analyze_file_tree $tenv $Name { + in-stage stage pub archive + } empty + analyze_log $tenv $Name $msglist + analyze_no_mail $tenv $Name + + close_test_environment $tenv +} + +check_incomplete_upload 0 1 0 +check_incomplete_upload 0 1 1 +check_incomplete_upload 0 0 1 +check_incomplete_upload 1 0 1 +check_incomplete_upload 1 0 0 +check_incomplete_upload 1 1 0 + +# ---------------------------------------- + +proc check_ongoing_upload { open_directive open_main open_signature } { + set tenv [new_test_environment [file join test.tmp tenv]] + + set msglist { + start "ftp-upload start message" + nowork "ftp-upload 'nothing to do' message" + + scan,partial.bin "scan found main file" + scan,partial.bin.sig "scan found signature file" + scan,partial.bin.directive.asc "scan found directive file" + } + + set mockfile [open [file join $tenv mocks] w] + puts $mockfile {:^ lsof -Fn .*} + set lsofstem [file normalize [file join $tenv incoming]] + if { $open_directive } { + puts $mockfile "> n${lsofstem}/partial.bin.directive.asc" + lappend msglist \ + open,partial.bin.directive.asc "directive file still open" + } else { + lappend msglist \ + consider,partial.bin.directive.asc "considered directive file" + } + if { $open_main } { + puts $mockfile "> n${lsofstem}/partial.bin" + lappend msglist \ + open,partial.bin "main file still open" + } else { + lappend msglist \ + consider,partial.bin "considered main file" + } + if { $open_signature } { + puts $mockfile "> n${lsofstem}/partial.bin.sig" + lappend msglist \ + open,partial.bin.sig "signature file still open" + } else { + lappend msglist \ + consider,partial.bin.sig "considered signature file" + } + if { $open_directive || $open_main || $open_signature } { + puts $mockfile "? 0" + } else { + puts $mockfile "? 1" + } + close $mockfile + + make_test_case $tenv { + partial.bin { + directive { + version 1.2 + filename partial.bin + } dsig { good 02 0000 } + file { ongoing upload main file } + fsig { good 03 0000 } + } + } + + start_test_services $tenv + run_upload_batch_test + stop_test_services + + set Name "idle processing: ongoing upload\ + \[${open_directive}${open_main}${open_signature}\]" + + analyze_file_tree $tenv $Name { + incoming + } files { + partial.bin partial.bin.sig partial.bin.directive.asc + } + analyze_file_tree $tenv $Name { + in-stage stage pub archive + } empty + analyze_log $tenv $Name $msglist + analyze_no_mail $tenv $Name + + close_test_environment $tenv +} + +check_ongoing_upload 1 1 1 +check_ongoing_upload 1 0 1 +check_ongoing_upload 1 0 0 +check_ongoing_upload 1 1 0 +check_ongoing_upload 0 1 0 +check_ongoing_upload 0 1 1 +check_ongoing_upload 0 0 1 + +#EOF diff --git a/testsuite/upload.all/01_loose.exp b/testsuite/upload.all/01_loose.exp new file mode 100644 index 0000000..e93aaf7 --- /dev/null +++ b/testsuite/upload.all/01_loose.exp @@ -0,0 +1,400 @@ +# Tests for processing standalone directives + +# Copyright (C) 2021 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 . + +proc check_loose_directive { desc case args } { + set tenv [new_test_environment [file join test.tmp tenv]] + + array set opt { + initial-files {} initial-symlinks {} + email-to {} log {} file-tree {} + } + array set opt $args + + set log_items { + start "ftp-upload start message" + + scan,foo.directive.asc "scan found directive file" + consider,foo.directive.asc "considered directive file" + found,foo.directive.asc "found directive file for processing" + } + + if { [llength $opt(log)] > 0 } { append log_items $opt(log) } + + if { [llength $opt(email-to)] > 0 } { + lappend log_items mail,addresses "outgoing mail sent" + } else { + lappend log_items mail,no-known-address "no uploader address known" + lappend log_items mail,addresses "outgoing mail sent to admin" + } + + register_test_packages $tenv { + foo { + email { "foo@example.org" } + keys { { id 1000 name "foo " } } + maintainers { "foo " } + } + baz { + email { } + keys { { id 1001 name "baz" } } + } + } + + foreach {zone filelist} $opt(initial-files) { + foreach {file sig} $filelist { + file mkdir [file dirname [file join $tenv $zone $file]] + put_file [file join $tenv $zone $file] "${file}\n" + 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] "10 minutes ago" + age_file [file join $tenv $zone "${file}.sig"] "10 minutes ago" + } + } + foreach {zone linklist} $opt(initial-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]] + } + } + + make_test_case $tenv [list foo $case] + + start_test_services $tenv + run_upload_batch_test + stop_test_services + + analyze_log $tenv "loose directive: $desc" $log_items + analyze_mail $tenv "loose directive: $desc" to $opt(email-to) + if { [llength $opt(file-tree)] > 0 } { + foreach {zones mode items} $opt(file-tree) { + analyze_file_tree $tenv "loose directive: $desc" \ + $zones $mode $items + } + } + + close_test_environment $tenv +} + +# ---------------------------------------- + +# TODO: All of the unsigned directive tests should probably produce a +# message about the lack of a signature or a failed signature check +# at the least; currently, they do not consistently do so. + +check_loose_directive "bogus: unsigned with no directory specified" { + directive { + version 1.2 + no-op "" + comment "do nothing" + } +} file-tree { + { incoming stage pub archive } empty {} + { in-stage } files { foo.directive.asc } +} email-to { + ftp-upload-script@gnu.org +} + +check_loose_directive "bogus: unsigned for bogus package" { + directive { + version 1.2 + directory bar + no-op "" + comment "do nothing" + } +} file-tree { + { incoming stage pub archive } empty {} + { in-stage } files { foo.directive.asc } +} log { + unknown-package "unknown package from directive" +} email-to { + ftp-upload-script@gnu.org +} + +check_loose_directive "bogus: unsigned for package with no email address" { + directive { + version 1.2 + directory baz + no-op "" + comment "do nothing" + } +} file-tree { + { incoming stage pub archive } empty {} + { in-stage } files { foo.directive.asc } +} email-to { + ftp-upload-script@gnu.org +} + +check_loose_directive "bogus: unsigned for valid package" { + directive { + version 1.2 + directory foo + no-op "" + comment "do nothing" + } +} file-tree { + { incoming stage pub archive } empty {} + { in-stage } files { foo.directive.asc } +} email-to { + ftp-upload-script@gnu.org foo@example.org foo@example.net +} + +check_loose_directive "bogus: signed with no directory specified" { + directive { + version 1.2 + no-op "" + comment "do nothing" + } dsig { good 00 1000 } +} file-tree { + { incoming stage pub archive } empty {} + { in-stage } files { foo.directive.asc } +} log { + validate,no-directory-given "directive rejected: no directory specified" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.gnu.org +} + +check_loose_directive "bogus: signed with wrong key" { + directive { + version 1.2 + directory baz + no-op "" + comment "do nothing" + } dsig { good 01 1000 } +} file-tree { + { incoming stage pub archive } empty {} + { in-stage } files { foo.directive.asc } +} log { + gpgv,directive-verify-failed "incorrect signature rejected" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.gnu.org +} + +check_loose_directive "bogus: signed for bogus package" { + directive { + version 1.2 + directory bar + no-op "" + comment "do nothing" + } dsig { good 02 1000 } +} file-tree { + { incoming stage pub archive } empty {} + { in-stage } files { foo.directive.asc } +} log { + unknown-package "unknown package from directive" +} email-to { + ftp-upload-script@gnu.org foo@example.gnu.org +} + +check_loose_directive "bogus: signed for package with no email address" { + directive { + version 1.2 + directory baz + no-op "" + comment "do nothing" + } dsig { good 03 1001 } +} file-tree { + { incoming in-stage stage pub archive } empty {} +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org +} + +# ---------------------------------------- + +check_loose_directive "create symlink" { + directive { + version 1.2 + directory foo + symlink "foo-1.2.bin foo-latest.bin" + } dsig { good 10 1000 } +} initial-files { + pub { foo/foo-1.2.bin { good 06 1000 } } +} file-tree { + { incoming in-stage stage archive } empty {} + { pub } files { foo/foo-1.2.bin foo/foo-latest.bin } + { pub } symlink-targets { foo-1.2.bin foo/foo-latest.bin } +} log { + action,make-symlink "recorded adding symlink" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.org foo@example.gnu.org foo@example.net +} + +check_loose_directive "create dangling symlink" { + directive { + version 1.2 + directory foo + symlink "foo-1.2.bin foo-latest.bin" + } dsig { good 11 1000 } +} initial-files { + pub { foo/foo-1.0.bin { good 05 1000 } } +} file-tree { + { incoming in-stage stage archive } empty {} + { pub } files { foo/foo-1.0.bin foo/foo-latest.bin } + { pub } symlink-targets { foo-1.2.bin foo/foo-latest.bin } +} log { + action,make-symlink "recorded adding symlink" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.org foo@example.gnu.org foo@example.net +} + +check_loose_directive "replace symlink" { + directive { + version 1.2 + directory foo + symlink "foo-1.2.bin foo-latest.bin" + } dsig { good 12 1000 } +} initial-files { + pub { + foo/foo-1.0.bin { good 05 1000 } + foo/foo-1.2.bin { good 06 1000 } + } +} initial-symlinks { + pub { foo-1.0.bin foo/foo-latest.bin } +} file-tree { + { incoming in-stage stage archive } empty {} + { pub } files { foo/foo-1.0.bin foo/foo-1.2.bin foo/foo-latest.bin } + { pub } symlink-targets { foo-1.2.bin foo/foo-latest.bin } +} log { + action,make-symlink "recorded adding symlink" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.org foo@example.gnu.org foo@example.net +} + +check_loose_directive "remove symlink" { + directive { + version 1.2 + directory foo + rmsymlink foo-latest.bin + } dsig { good 13 1000 } +} initial-files { + pub { foo/foo-1.2.bin { good 06 1000 } } +} initial-symlinks { + pub { foo-1.2.bin foo/foo-latest.bin } +} file-tree { + { incoming in-stage stage archive } empty {} + { pub } files { foo/foo-1.2.bin } +} log { + action,rm-symlink "recorded removal of symlink" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.org foo@example.gnu.org foo@example.net +} + +check_loose_directive "error: replace file with symlink" { + directive { + version 1.2 + directory foo + symlink "foo-1.2.bin foo-1.0.bin" + } dsig { good 14 1000 } +} initial-files { + pub { + foo/foo-1.0.bin { good 05 1000 } + foo/foo-1.2.bin { good 06 1000 } + } +} file-tree { + { incoming stage archive } empty {} + { in-stage } files { foo.directive.asc } + { pub } files { foo/foo-1.0.bin foo/foo-1.2.bin } +} log { + action,make-symlink-failure "overwrite with symlink fails" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.org foo@example.gnu.org foo@example.net +} +# TODO: The in-stage tree should be empty after this test. + +check_loose_directive "archive file" { + directive { + version 1.2 + directory foo + archive foo-1.0.bin + } dsig { good 15 1000 } +} initial-files { + pub { + foo/foo-1.0.bin { good 05 1000 } + foo/foo-1.2.bin { good 06 1000 } + } +} file-tree { + { incoming in-stage stage } empty {} + { pub } files { foo/foo-1.2.bin } + { archive } archived-files { foo/foo-1.0.bin } +} log { + action,archive-item "archived file" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.org foo@example.gnu.org foo@example.net +} + +check_loose_directive "archive directory" { + directive { + version 1.2 + directory foo + archive bar + } dsig { good 16 1000 } +} initial-files { + pub { + foo/foo-1.0.bin { good 05 1000 } + foo/foo-1.2.bin { good 06 1000 } + foo/bar/bar-1.bin { good 07 1000 } + foo/bar/bar-2.bin { good 08 1000 } + } +} file-tree { + { incoming in-stage stage } empty {} + { pub } files { foo/foo-1.0.bin foo/foo-1.2.bin } + { archive } archived-files { foo/bar/bar-1.bin foo/bar/bar-2.bin } +} log { + action,archive-item "archived directory" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.org foo@example.gnu.org foo@example.net +} + +check_loose_directive "archive symlink" { + directive { + version 1.2 + directory foo + archive foo-latest.bin + } dsig { good 17 1000 } +} initial-files { + pub { + foo/foo-1.0.bin { good 05 1000 } + foo/foo-1.2.bin { good 06 1000 } + } +} initial-symlinks { + pub { + foo-1.2.bin foo/foo-latest.bin + foo-1.2.bin.sig foo/foo-latest.bin.sig + } +} file-tree { + { incoming in-stage stage } empty {} + { pub } files { foo/foo-1.0.bin foo/foo-1.2.bin } + { archive } archived-files { foo/foo-latest.bin } +} log { + action,archive-item "archived symlink" +} email-to { + ftp-upload-script@gnu.org ftp-upload-report@gnu.org + foo@example.org foo@example.gnu.org foo@example.net +} + +#EOF -- 2.25.1