tests/autotest

   1 #!/usr/bin/expect -f
   2
   3 # This is part of CGI::Auth::Flexible, a perl CGI authentication module.
   4 #
   5 # Copyright 2012,2013,2015 Ian Jackson.
   6 # Copyright 2012,2013,2015 Citrix.
   7 #
   8 # This program is free software: you can redistribute it and/or modify
   9 # it under the terms of the GNU Affero General Public License as published by
  10 # the Free Software Foundation, either version 3 of the License, or
  11 # (at your option) any later version, with the "CAF Login Exception"
  12 # as published by Ian Jackson (version 1, or at your option any
  13 # later version) as an Additional Permission.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU Affero General Public License for more details.
  19
  20 set testfile [lindex $argv 0]
  21
  22 switch -glob -- $testfile {
  23     tests/*.at {
  24         regsub {^tests/} $testfile {} id
  25         regsub {\.at$} $id {} id
  26         set tt "tests/tmp/$id"
  27     }
  28     * {
  29         set id "\[[info pid]\]"
  30         set tt tests/tmp/[info pid]
  31     }
  32 }
  33
  34 exec rm -rf $tt
  35 file mkdir tests/tmp $tt
  36
  37 set pwd [pwd]
  38
  39 set env(HOME) $tt
  40 set env(CAFTEST_CAF) $pwd
  41 set env(CAFTEST_TMP) $pwd/$tt
  42 set env(TERM) vt100
  43 set env(CAFTEST_NOSRCDUMP) 1
  44 set env(LC_ALL) en_GB.utf-8
  45
  46 log_user 0
  47 log_file -a $tt/expect.log
  48
  49 proc timeout-abort {} {
  50      send_log "\r\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
  51      error "$id: aborting due to timeout"
  52 }
  53 set timeout 10
  54
  55 proc elog {args} {
  56     global id
  57      set m "[list expect [lindex $args end]]"
  58      puts stderr "$id: $m"
  59 #     send_log "\n$m\n"
  60      eval expect $args
  61 }
  62
  63 proc etxt {str} {
  64      regsub -all { } $str {\W{0,3}\w?} str
  65      elog -re $str
  66 }
  67
  68 proc epage {str} {
  69     etxt $str
  70 }
  71
  72 proc dospawn {} {
  73      global pwd spawn_id
  74
  75      spawn -nottycopy \
  76      w3m -config /dev/null -o cgi_bin=$pwd/tests file:///cgi-bin/wrap/Tsuffix
  77
  78      expect_after timeout timeout-abort
  79
  80      epage {You need to log in}
  81 }
  82
  83 proc fillformfield {value} {
  84     send "\t\r$value\r"
  85 }
  86
  87 proc submitform-expect {wanttxt} {
  88     send "\r"
  89     etxt "loading file"
  90     epage $wanttxt
  91 }
  92
  93 proc loginas {user {password sesame} {wanttxt ACCESSGRANTED}} {
  94      fillformfield $user
  95      fillformfield $password
  96      send "\t"
  97      submitform-expect $wanttxt
  98 }
  99
 100 source $testfile
 101
 102 puts "$id: ok"