testsuite/network.all/network.exp

   1 # Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  16
  17 load_lib "dejagnu.exp"
  18
  19 # If tracing has been enabled at the top level, then turn it on here
  20 # too.
  21 if $tracelevel {
  22     strace $tracelevel
  23 }
  24
  25 # After these many seconds of execution the test script is aborted with a failure.
  26 # This is to handle deadlocks. We don't reset the timeout when a match is
  27 # found to avoid hanging in case of a testcase sending matches in an infinite loops.
  28 # (not unlikely as it seems, think about flash movies...)
  29 #
  30 # Expressed in seconds.
  31 #
  32 set timeout 100
  33 set file all
  34 set params ""
  35
  36 # specify a default name and port for the RTMPT (AMF over HTTP) tests
  37 set http_hostname ""
  38 set http_portnum ""
  39 set http_dead false
  40
  41 # specify a default name and port for the RTMP  tests
  42 set rtmp_hostname ""
  43 set rtmp_portnum ""
  44 set rtmp_dead false
  45
  46 #
  47 # These are lists of hostname and port combinations 'probed'
  48 # to see if there is a service for that connection. Later each
  49 # is probed to see if there is a functioning service for that
  50 # port on the specified host
  51 #
  52
  53 array set http_targets {
  54     {0} {localhost    4080}
  55     {1} {localhost    5080}
  56     {2} {gnashdev.org 5080}
  57     {3} {gnashdev.org 4080}
  58 }
  59
  60 array set rtmp_targets {
  61     {0} {localhost    1935}
  62     {1} {localhost    5935}
  63     {2} {gnashdev.org 1935}
  64     {3} {gnashdev.org 5935}
  65 }
  66
  67 #
  68 # Probe a hostname:port usig netcat to see if there is a service available
  69 #
  70 proc probe { host port } {
  71     verbose "Trying to probe $host:$port to see if there is an available service"
  72     global server_dead
  73     spawn -noecho nc -zv $host $port
  74     set nid $spawn_id
  75     global timeout
  76
  77     expect {
  78         "$host * open" {
  79             verbose "Got probe response, $host is alive on port $port..." 2
  80             set targets(host.name) $host
  81             set targets(host.port) $port
  82         }
  83         "Connection to *port * succeeded" {
  84             verbose "Got probe response, $host is alive on port $port..." 2
  85             set targets(host.name) $host
  86             set targets(host.port) $port
  87         }
  88         "packets transmitted, 1 received" {
  89             verbose "Got probe response, $host is alive on port $port..." 2
  90         }
  91         eof {
  92             verbose "Probe all done, no service..." 2
  93             return false
  94         }
  95         timeout {
  96             verbose "Probe still running after ${timeout} seconds, killing it (deadlock?)" 2
  97             catch close
  98             return false
  99         }
 100     }
 101
 102     return true
 103 }
 104
 105
 106 proc checkhosts { targets } {
 107     global http_hostname
 108     global http_portnum
 109     global rtmp_hostname
 110     global rtmp_portnum
 111
 112     # Make sure we can access the resource on the specified host, which won't always
 113     # be default.
 114     foreach {host port} targets {
 115         if { [probe $host $port] != true } {
 116             verbose "$x is Dead!"
 117         }
 118     }
 119 }
 120
 121 # See if the specified hosts are alive
 122 #checkhosts [array get http_targets]
 123 #checkhosts rtmp_targets
 124 foreach {index target} [array get http_targets] {
 125     set host [lindex $target 0]
 126     set port [lindex $target 1]
 127      if { [probe $host $port] == true } {
 128         set http_hostname $host
 129         set http_portnum $port
 130         verbose "$host:$port has HTTP service"
 131         break
 132      } else {
 133         verbose "$host:$port has no HTTP service attached!"
 134      }
 135 }
 136
 137 # Make sure somebody responded, or we can't run the tests
 138 if {[string length $http_hostname] == 0} {
 139     perror "No HTTP servers appear to be alive"
 140     set http_dead true
 141     exit
 142 }
 143
 144 foreach {index target} [array get rtmp_targets] {
 145     set host [lindex $target 0]
 146     set port [lindex $target 1]
 147      if { [probe $host $port] == true } {
 148         set rtmp_hostname $host
 149         set rtmp_portnum $port
 150         verbose "$host:$port has RTMP service"
 151         break
 152      } else {
 153         verbose "$host:$port has no RTMP service attached!"
 154      }
 155 }
 156 if {[string length $rtmp_hostname] == 0} {
 157     perror "No RTMP servers appear to be alive"
 158     set rtmp_dead true
 159     exit
 160 }
 161
 162 global env
 163 set env(LANG) en_US.UTF-8
 164 set env(LANGUAGE) en_US.UTF-8
 165 set env(LC_ALL) en_US.UTF-8
 166
 167 # Look fo rthe gprocess utility we in this build tree
 168 set gproc [lookfor_file $objdir utilities/gprocessor]
 169 set goptions "-vv"
 170 verbose "Starting gprocessor \"$gproc $goptions\" for testing"
 171
 172 set test_targets(http.swf) [list $http_hostname $http_portnum]
 173 set test_targets(rtmp.swf) [list $rtmp_hostname $rtmp_portnum]
 174
 175 # testcases is set by the Makefile in the site.exp data file.
 176 foreach file $testcases {
 177
 178     verbose "Running test $file"
 179
 180     # spawn the executable and look for the DejaGnu output messages from the
 181     # test case.
 182
 183     # this version of the call allows use of 'wait' to check return code
 184     # -open [open "|cmd" "r"] doesn't work for that
 185
 186     set host [lindex $test_targets($file) 0]
 187     set port [lindex $test_targets($file) 1]
 188     set params "-P flashVars=\"hostname=$host,port=$port\""
 189
 190     # Ignore SIGHUP or we'd get a lot of them on Debian stable
 191     verbose "Starting gprocessor $gproc $goptions $file $params for testing"
 192     spawn -noecho -ignore SIGHUP $gproc $goptions $file $params
 193
 194     expect {
 195         -re "^\[^\n]*NOTE:\[^\n]*\n" {
 196             regsub ".*NOTE: " $expect_out(0,string) "" output
 197             set output [string range $output 0 end-2]
 198             verbose "${file} $output"
 199             # notes tipically come from the test runner, so we'll trust it to mean
 200             # things are someone not too bad...
 201             # -continue_timer
 202             exp_continue
 203         }
 204         -re "^\[^\n]*XPASSED:\[^\n]*\n" {
 205             regsub ".*XPASSED: " $expect_out(0,string) "" output
 206             set output [string range $output 0 end-2]
 207             xpass "${file}: $output"
 208             exp_continue -continue_timer
 209         }
 210         -re "^\[^\n]*PASSED:\[^\n]*\n" {
 211             regsub ".*PASSED: " $expect_out(0,string) "" output
 212             set output [string range $output 0 end-2]
 213             pass "${file}: $output"
 214             exp_continue -continue_timer
 215         }
 216         -re "^\[^\n]*XFAILED:\[^\n]*\n" {
 217             regsub ".*XFAILED: " $expect_out(0,string) "" output
 218             set output [string range $output 0 end-2]
 219             xfail "${file}: $output"
 220             exp_continue -continue_timer
 221         }
 222         -re "^\[^\n]*FAILED:\[^\n]*\n" {
 223             regsub ".*FAILED: " $expect_out(0,string) "" output
 224             set output [string range $output 0 end-2]
 225             fail "${file}: $output"
 226             exp_continue -continue_timer
 227         }
 228         -re "^\[^\n]*UNTESTED:\[^\n]*\n" {
 229             regsub ".*UNTESTED: " $expect_out(0,string) "" output
 230             set output [string range $output 0 end-2]
 231             untested "${file}: $output"
 232             exp_continue -continue_timer
 233         }
 234         -re "^\[^\n]*UNRESOLVED:\[^\n]*\n" {
 235             regsub ".*UNRESOLVED: " $expect_out(0,string) "" output
 236             set output [string range $output 0 end-2]
 237             unresolved "${file}: $output"
 238             exp_continue -continue_timer
 239         }
 240         -re "^\[^\n]*\n" {
 241             # just remove non-matching lines!
 242             exp_continue -continue_timer
 243         }
 244         eof {
 245             #       unresolved "${file} died prematurely"
 246             #       catch close
 247             #       return "${file} died prematurely"
 248         }
 249         timeout {
 250                 fail "Test case ${file} still running after ${timeout} seconds, killing it (deadlock?)"
 251                 catch close
 252                 continue;
 253         }
 254    }
 255
 256         # wait for the process to coplete to
 257         # check return code
 258         set retcode [wait]
 259
 260         # debugging
 261         #set i 0; foreach j $retcode { print "${file} wait($i) $j"; incr i }
 262
 263         # This snippet catches segfaults and aborts.
 264         # Would also catch SIGHUP, but we're ignoring them
 265         # as on Debian Stable we unexpectedly get them for no apparent reason
 266         #
 267         if { [ llength $retcode ] > 5 } {
 268                 fail "${file} died prematurely ([lindex $retcode 6])"
 269         }
 270
 271         # This snippet catches non-zero returns
 272         if { [ lindex $retcode 3 ] != 0 } {
 273                 fail "${file} exited with non-zero code ([lindex $retcode 3])"
 274         }
 275
 276
 277     # force a close of the executable to be safe.
 278 #    catch close
 279 }
 280
 281