#!/usr/bin/expect -f # This is part of CGI::Auth::Flexible, a perl CGI authentication module. # # Copyright 2012,2013,2015 Ian Jackson. # Copyright 2012,2013,2015 Citrix. # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version, with the "CAF Login Exception" # as published by Ian Jackson (version 1, or at your option any # later version) as an Additional Permission. # # 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 Affero General Public License for more details. set testfile [lindex $argv 0] switch -glob -- $testfile { tests/*.at { regsub {^tests/} $testfile {} id regsub {\.at$} $id {} id set tt "tests/tmp/$id" } * { set id "\[[info pid]\]" set tt tests/tmp/[info pid] } } exec rm -rf $tt file mkdir tests/tmp $tt set pwd [pwd] set env(HOME) $tt set env(CAFTEST_CAF) $pwd set env(CAFTEST_TMP) $pwd/$tt set env(TERM) vt100 set env(CAFTEST_NOSRCDUMP) 1 set env(LC_ALL) en_GB.utf-8 log_user 0 log_file -a $tt/expect.log proc timeout-abort {} { global id send_log "\r\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" error "$id: aborting due to timeout" } set timeout 15 proc elog {args} { global id set m "[list expect [lindex $args end]]" puts stderr "$id: $m" # send_log "\n$m\n" eval expect $args } proc etxt {str} { regsub -all { } $str {\W{0,3}\w?} str elog -re $str } proc epage {str} { etxt $str } proc dospawn {} { global pwd spawn_id spawn -nottycopy \ w3m -config /dev/null -o cgi_bin=$pwd/tests file:///cgi-bin/wrap/Tsuffix expect_after timeout timeout-abort epage {You need to log in} } proc fillformfield {value} { send "\t\r$value\r" } proc submitform-expect {wanttxt} { send "\r" etxt "loading file" epage $wanttxt } proc loginas {user {password sesame} {wanttxt ACCESSGRANTED}} { fillformfield $user fillformfield $password send "\t" submitform-expect $wanttxt } proc srcdump-prep {} { global timeout env set env(CAFTEST_NOSRCDUMP) 0 set timeout [expr {$timeout * 3}] } proc srcdump-save-check {} { global tt global outertar sd files set outertar $tt/t-srcdump.tgz set sd $tt/t-srcdump.d send "\x15$outertar\r" etxt "Download complete" exec mkdir $sd set files [exec tar -C $sd -zvxf - < $outertar] foreach f { manifest.txt licence.data cgi-auth-flexible.pm .gitignore } { set got($f) 0 } if {[file exists .git]} { set got(.git/objects/) 0 } foreach f $files { switch -glob -- $f { licence.data - manifest.txt { set got($f) 1 } *.tar { foreach g [exec tar -C $sd -tf - < $sd/$f] { switch -glob -- $g { cgi-auth-flexible.pm - .gitignore - .git/objects/ { set got($g) 1 } *~ { error "file $g inside $f !" } .git/* { } *.db { error "file $g inside $f outside .git !" } } } } } } foreach g [array names got] { if {!$got($g)} { error "file $g missing" } } } source $testfile puts "$id: ok"