# Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
#
# This program 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, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

load_lib "dejagnu.exp"

# If tracing has been enabled at the top level, then turn it on here
# too.
if $tracelevel {
    strace $tracelevel
}

# After these many seconds of execution the test script is aborted with a failure.
# This is to handle deadlocks. We don't reset the timeout when a match is
# found to avoid hanging in case of a testcase sending matches in an infinite loops.
# (not unlikely as it seems, think about flash movies...)
#
# Expressed in seconds.
#
set timeout 100
set file all
set params ""

# specify a default name and port for the RTMPT (AMF over HTTP) tests
set http_hostname ""
set http_portnum ""
set http_dead false

# specify a default name and port for the RTMP  tests
set rtmp_hostname ""
set rtmp_portnum ""
set rtmp_dead false

#
# These are lists of hostname and port combinations 'probed'
# to see if there is a service for that connection. Later each
# is probed to see if there is a functioning service for that
# port on the specified host
#

array set http_targets {
    {0} {localhost    4080}
    {1} {localhost    5080}
    {2} {gnashdev.org 5080}
    {3} {gnashdev.org 4080}
}

array set rtmp_targets {
    {0} {localhost    1935}
    {1} {localhost    5935}
    {2} {gnashdev.org 1935}
    {3} {gnashdev.org 5935}
}

#
# Probe a hostname:port usig netcat to see if there is a service available
#
proc probe { host port } {
    verbose "Trying to probe $host:$port to see if there is an available service"
    global server_dead 
    spawn -noecho nc -zv $host $port
    set nid $spawn_id
    global timeout

    expect {
	"$host * open" {
	    verbose "Got probe response, $host is alive on port $port..." 2
	    set targets(host.name) $host
	    set targets(host.port) $port
	}
	"Connection to *port * succeeded" {
	    verbose "Got probe response, $host is alive on port $port..." 2
	    set targets(host.name) $host
	    set targets(host.port) $port
	}
	"packets transmitted, 1 received" {
	    verbose "Got probe response, $host is alive on port $port..." 2
	}
	eof {
	    verbose "Probe all done, no service..." 2
	    return false
	}
	timeout {
	    verbose "Probe still running after ${timeout} seconds, killing it (deadlock?)" 2
	    catch close
	    return false
	}
    }

    return true
}


proc checkhosts { targets } {
    global http_hostname
    global http_portnum
    global rtmp_hostname
    global rtmp_portnum

    # Make sure we can access the resource on the specified host, which won't always
    # be default.
    foreach {host port} targets {
	if { [probe $host $port] != true } {
	    verbose "$x is Dead!"
	}
    }
}

# See if the specified hosts are alive
#checkhosts [array get http_targets]
#checkhosts rtmp_targets
foreach {index target} [array get http_targets] {
    set host [lindex $target 0]
    set port [lindex $target 1]
     if { [probe $host $port] == true } {
 	set http_hostname $host
 	set http_portnum $port
 	verbose "$host:$port has HTTP service"
 	break
     } else {
 	verbose "$host:$port has no HTTP service attached!"
     }
}

# Make sure somebody responded, or we can't run the tests
if {[string length $http_hostname] == 0} {
    perror "No HTTP servers appear to be alive"
    set http_dead true
    exit
}

foreach {index target} [array get rtmp_targets] {
    set host [lindex $target 0]
    set port [lindex $target 1]
     if { [probe $host $port] == true } {
 	set rtmp_hostname $host
 	set rtmp_portnum $port
 	verbose "$host:$port has RTMP service"
 	break
     } else {
 	verbose "$host:$port has no RTMP service attached!"
     }
}
if {[string length $rtmp_hostname] == 0} {
    perror "No RTMP servers appear to be alive"
    set rtmp_dead true
    exit
}

global env
set env(LANG) en_US.UTF-8
set env(LANGUAGE) en_US.UTF-8
set env(LC_ALL) en_US.UTF-8

# Look fo rthe gprocess utility we in this build tree
set gproc [lookfor_file $objdir utilities/gprocessor]
set goptions "-vv"
verbose "Starting gprocessor \"$gproc $goptions\" for testing"

set test_targets(http.swf) [list $http_hostname $http_portnum]
set test_targets(rtmp.swf) [list $rtmp_hostname $rtmp_portnum]

# testcases is set by the Makefile in the site.exp data file.
foreach file $testcases {

    verbose "Running test $file"

    # spawn the executable and look for the DejaGnu output messages from the
    # test case.

    # this version of the call allows use of 'wait' to check return code
    # -open [open "|cmd" "r"] doesn't work for that
  
    set host [lindex $test_targets($file) 0]
    set port [lindex $test_targets($file) 1]
    set params "-P flashVars=\"hostname=$host,port=$port\""

    # Ignore SIGHUP or we'd get a lot of them on Debian stable
    verbose "Starting gprocessor $gproc $goptions $file $params for testing"
    spawn -noecho -ignore SIGHUP $gproc $goptions $file $params

    expect {
	-re "^\[^\n]*NOTE:\[^\n]*\n" {
	    regsub ".*NOTE: " $expect_out(0,string) "" output
	    set output [string range $output 0 end-2]
	    verbose "${file} $output" 
            # notes tipically come from the test runner, so we'll trust it to mean 
            # things are someone not too bad...
	    # -continue_timer
	    exp_continue
	}
	-re "^\[^\n]*XPASSED:\[^\n]*\n" {
	    regsub ".*XPASSED: " $expect_out(0,string) "" output
	    set output [string range $output 0 end-2]
	    xpass "${file}: $output"
	    exp_continue -continue_timer
	}
	-re "^\[^\n]*PASSED:\[^\n]*\n" {
	    regsub ".*PASSED: " $expect_out(0,string) "" output
	    set output [string range $output 0 end-2]
	    pass "${file}: $output"
	    exp_continue -continue_timer
	}
	-re "^\[^\n]*XFAILED:\[^\n]*\n" {
	    regsub ".*XFAILED: " $expect_out(0,string) "" output
	    set output [string range $output 0 end-2] 
	    xfail "${file}: $output"
	    exp_continue -continue_timer
	}
	-re "^\[^\n]*FAILED:\[^\n]*\n" {
	    regsub ".*FAILED: " $expect_out(0,string) "" output
	    set output [string range $output 0 end-2] 
	    fail "${file}: $output"
	    exp_continue -continue_timer
	}
	-re "^\[^\n]*UNTESTED:\[^\n]*\n" {
	    regsub ".*UNTESTED: " $expect_out(0,string) "" output
	    set output [string range $output 0 end-2]
	    untested "${file}: $output"
	    exp_continue -continue_timer
	}
	-re "^\[^\n]*UNRESOLVED:\[^\n]*\n" {
	    regsub ".*UNRESOLVED: " $expect_out(0,string) "" output
	    set output [string range $output 0 end-2]
	    unresolved "${file}: $output"
	    exp_continue -continue_timer
	}
	-re "^\[^\n]*\n" {
            # just remove non-matching lines!
            exp_continue -continue_timer
	}
	eof {
	    #	    unresolved "${file} died prematurely"
	    #	    catch close
	    #	    return "${file} died prematurely"
	}
	timeout {
		fail "Test case ${file} still running after ${timeout} seconds, killing it (deadlock?)"
		catch close
		continue;
	}
   }

	# wait for the process to coplete to
	# check return code
	set retcode [wait]

	# debugging
	#set i 0; foreach j $retcode { print "${file} wait($i) $j"; incr i }

	# This snippet catches segfaults and aborts.
	# Would also catch SIGHUP, but we're ignoring them
	# as on Debian Stable we unexpectedly get them for no apparent reason
	#
	if { [ llength $retcode ] > 5 } {
		fail "${file} died prematurely ([lindex $retcode 6])"
	}

	# This snippet catches non-zero returns
	if { [ lindex $retcode 3 ] != 0 } {
		fail "${file} exited with non-zero code ([lindex $retcode 3])"
	}


    # force a close of the executable to be safe.
#    catch close
}


