# Test framework for GDB (remote protocol) using a "gdbserver",
# ie. a debug agent running as a native process on the same or
# a different host.

# Copyright 2000, 2001, 2003 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 2 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  

# Please email any bugs, comments, and/or additions to this file to:
# bug-gdb@prep.ai.mit.edu

# This file was written by Michael Snyder. (msnyder@redhat.com)

#
# This module to be used for testing gdb with a "gdbserver" 
# built either from libremote or from gdb/gdbserver.
#

# Load the basic testing library, and the remote stuff.
load_lib ../config/monitor.exp
load_lib telnet.exp
#
# To be addressed or set in your baseboard config file:
#
#   set_board_info gdb_protocol "remote"
#	Unles you have a gdbserver that uses a different protocol...
#
#   set_board_info use_gdb_stub 1
#	This tells the rest of the test suite not to do things
#	like "run" which don't work well on remote targets.
#
#   set_board_info gdb,do_reload_on_run 1
#	Unles you have a gdbserver that can handle multiple sessions.
#
#   set_board_info noargs 1
#	At present there is no provision in the remote protocol
#	for passing arguments.  This test framework does not
#	address the issue, so it's best to set this variable
#	in your baseboard configuration file.  
#	FIXME: there's no reason why the test harness couldn't
#	pass commandline args when it spawns gdbserver.
#
#   set_board_info gdb,noinferiorio 1
#	Neither the traditional gdbserver nor the one in libremote
#	can presently capture stdout and relay it to GDB via the
#	'O' packet.  This means that tests involving printf will
#	fail unles you set this varibale in your baseboard
#	configuration file.
#   
#   set_board_info gdb,no_hardware_watchpoints 1
#	Unles you have a gdbserver that supports hardware watchpoints.
#	FIXME: gdb should detect if the target doesn't support them,
#	and fall back to using software watchpoints.
#
#   set_board_info gdb_server_prog
#	This will be the path to the gdbserver program you want to test.
#	Defaults to "gdbserver".
#
#   set_board_info sockethost
#	The name of the host computer whose socket is being used.
#	Defaults to "localhost".  Note: old gdbserver requires 
#	that you define this, but libremote/gdbserver does not.
#
#   set_board_info socketport
#	Port id to use for socket connection.  If not set explicitly,
#	it will start at "2345" and increment for each use.
#
#   set_board_info rsh_prog
#	The program to use to spawn executables on the remote board.
#	Default: "rsh"
#
#   set_board_info rcp_prog
#	The program to use to copy test executables to the remote board.
#	Default: "rcp"
#
#   set_board_info nfsdir
#	If rcp_prog is set to "cp", specify the local directory name that
#	is NFS mounted by the board.

#
# gdb_load -- load a file into the debugger.
#             return a -1 if anything goes wrong.
#

global server_exec;
global portnum;
set portnum "2000";

proc gdb_load { args } {
    global server_exec;
    global portnum;
    global verbose;
    global gdb_prompt;

    # Port id -- either specified in baseboard file, or managed here.
    if [target_info exists gdb,socketport] {
	set portnum [target_info gdb,socketport];
    } else {
	# Bump the port number to avoid conflicts with hung ports.
	incr portnum;
    }

    # Extract the local and remote host ids from the target board struct.

    if [target_info exists sockethost] {
	set debughost  [target_info sockethost];
    } else {
	set debughost "localhost:";
    }
    # Extract the protocol
    if [target_info exists gdb_protocol] {
	set protocol [target_info gdb_protocol];
    } else {
	set protocol "remote";
    }

    # Extract the name of the gdbserver, if known (default 'gdbserver').
    if [target_info exists gdb_server_prog] {
	set gdbserver [target_info gdb_server_prog];
    } else {
	set gdbserver "gdbserver";
    }
    # Extract the socket hostname
    if [target_info exists sockethost] {
	set sockethost [target_info sockethost];
    } else {
	set sockethost ""
    }

    # Get target name
    if [target_info exists hostname] {
	set target_address [target_info hostname];
    } else {
	set target_address "localhost"
    }

    # Get the username on the target
    if [target_info exists "username"] {
	set username [target_info username];
    } else {
	set username "";
    }

    # Get download dir
    if [target_info exists download_dir] {
	set download_dir [target_info download_dir];
    } else {
	set download_dir "/tmp"
    }

    # Get tests dir
    if [target_info exists tests_dir] {
	set tests_dir [target_info tests_dir];
    } else {
	set tests_dir $download_dir
    }

    # Export the host:port pair.
    set gdbport $debughost$portnum;

    if { $args == "" || $args == "{}" } {
	if [info exists server_exec] {
	    set args $server_exec;
	} else {
	    send_gdb "info files\n";
	    gdb_expect 30 {
		-re "Symbols from \"(\[^\"\]+)\"" {
		    set args $expect_out(1,string);
		    exp_continue;
		}
		-re "Local exec file:\[\r\n\]+\[ \t\]*`(\[^'\]+)'," {
		    set args $expect_out(1,string);
		    exp_continue;
		}
		-re "$gdb_prompt $" { }
	    }
	}
    }

    # remember new exec file 
    set server_exec $args;

    # Download the test files into the test_board
    gdbserver_download $target_address $username $server_exec \
	$download_dir/a-$portnum.out

    # tell gdb what file we are debugging
    if [gdb_file_cmd $args] {
	return -1;
    }

    if [target_info exists solib_path] {
	send_gdb "set solib-absolute-prefix [target_info solib_path]\n"
	gdb_expect 30 {
	    -re "$gdb_prompt $" {
		if $verbose>1 then {
		    send_user "set library path\n"
		}
	    }
	    default { 
		perror "Couldn't set library path\n"
		return -1
	    }
	}
    }

    for {set i 1} {$i <= 3} {incr i} {
	# Fire off the debug agent
	set server_spawn_id [gdbserver_spawn $target_address $username \
				 "$gdbserver $target_address:$portnum $tests_dir/a-$portnum.out 2>&1"]
	
	if { $server_spawn_id <= 0 } { return -1 }

	# Wait for the server to produce at least one line and an additional
	# character of output.  This will wait until any TCP socket has been
	# created, so that GDB can connect.
	expect {
	    # expect output from $server_spawn_id
	    -i $server_spawn_id
	    -re ".*\n." { }
	}
    
	# We can't just call close, because if gdbserver is local then that means
	# that it will get a SIGHUP.  Doing it this way could also allow us to
	# get at the inferior's input or output if necessary, and means that we
	# don't need to redirect output.
	expect_background {
	   -i $server_spawn_id
	   -re "." { }
	   eof {
	       # The spawn ID is already closed now (but not yet waited for).
	       wait -nowait -i $expect_out(spawn_id)
	   }
	}
	
	# attach to the "serial port"
	if {[gdb_target_cmd $protocol $gdbport] == 0 } {
	    break
	}
	verbose -log "Unable to connect to target. Re-trying.."
    }	

    # do the real load if needed
    if [target_info exists gdb_server_do_load] {
        send_gdb "load\n"
        set timeout 2400
        verbose "Timeout is now $timeout seconds" 2
        gdb_expect {
            -re ".*$gdb_prompt $" {
                if $verbose>1 then {
                    send_user "Loaded $arg into $GDB\n"
                }
                set timeout 30
                verbose "Timeout is now $timeout seconds" 2
                return 1
            }
            -re "$gdb_prompt $"     {
                if $verbose>1 then {
                    perror "GDB couldn't load."
                }
            }
            timeout {
                if $verbose>1 then {
                    perror "Timed out trying to load $arg."
                }
            }
        }
    }

    return 0;
}


# Use RSH or telnet depending on the program chosen
# by the board file. 
# Return spawn_id
proc gdbserver_spawn { dest username commandline } {
    global board_info 
    if ![target_info exists rsh_prog] {
        if { [which remsh] != 0 } {
            set RSH remsh
        } else {
            set RSH rsh
        }
    } else {
        set RSH [target_info rsh_prog];
    }

    if { $RSH == "rsh" } {
	return [rsh_gdbserver_spawn $dest $username $commandline]
    } else {

	if { $RSH == "telnet" } {
	    # Spawn the shell
	    return [telnet_gdbserver_spawn $dest $username $commandline]
	    
	    # expect the shell prompt obtained from 
	    # the board description.
	    # Now spawn gdbserver with its parameters
	    # and dont expect any output from the gdbserver
	    # other than the shell prompt
	    # FIXME ?? Where do I close the telnet
	    # session ( could use gdb_finish for closing the telnet session)

	    
	} else {
	    verbose "Unknown rsh program "
	    return -1
	}
    }
}

proc mynewtelnet_open_and_exec {  dest port shell_prompt commandline } {
    global board_info
    
    spawn "telnet-exec.exp" $dest $commandline
    set board_info($dest,fileid) $spawn_id;
    return $spawn_id;
}


proc mytelnet_open_and_exec {  dest port shell_prompt commandline } {
    set tries 0
    set result -1
    set need_respawn 1
    
    verbose "Starting a telnet connection to $dest:$port $shell_prompt " 2
    while { $result < 0 && $tries <= 3 } {
	if { $need_respawn } {
	    set need_respawn 0
	    spawn "telnet" $dest $port
	}
	expect {
	    "Trying " {
		exp_continue
	    }
	    -re "$shell_prompt.*$" {
		verbose "Got prompt $shell_prompt\n"
		set result 0
		exp_send $commandline
	   
	    }
	    -re "nt Name:|ogin:" {
		if [board_info $connhost exists telnet_username] {
		    exp_send "[board_info $connhost telnet_username]\n"
		    exp_continue
		}
		if [board_info $connhost exists username] {
		    exp_send "[board_info $connhost username]\n"
		    exp_continue
		}
		perror "telnet: need to login"
		break
	    }
	    "assword:" {
		if [board_info $connhost exists telnet_password] {
		    exp_send "[board_info $connhost telnet_password]\n"
		    exp_continue
		}
		if [board_info $connhost exists password] {
		    exp_send "[board_info $connhost password]\n"
		    exp_continue
		}
		perror "telnet: need a password"
		break
	    }
	    -re "advance.*y/n.*\\?" {
		exp_send "n\n"
		exp_continue
	    }
	    -re {([Aa]dvanced|[Ss]imple) or ([Ss]imple|[Aa]dvanced)} {
		exp_send "simple\n"
		exp_continue
	    }
	    "Connected to" {
		exp_continue
	    }
	    "unknown host" {
		exp_send "\003"
		perror "telnet: unknown host"
		break
	    }
	    "VxWorks Boot" {
		exp_send "@\n"
		sleep 20
		exp_continue
	    }
	    -re "Escape character is.*\\.\[\r\n\]" {
		    exp_continue
	    }
	    "has logged on from" {
		exp_continue
	    }
	    "You have no Kerberos tickets" {
		warning "telnet: no kerberos Tickets, please kinit"
		break
	    }
	    -re "Connection refused.*$" {
		catch "exp_send \"\003\"" foo
		sleep 5
		warning "telnet: connection refused."
	    }
	    -re "Sorry, this system is engaged.*" {
		exp_send "\003"
		warning "telnet: already connected."
	    }
	    "Connection closed by foreign host.*$" {
		warning "telnet: connection closed by foreign host."
		break
	    }
	    -re "\[\r\n\]+" {
		exp_continue
	    }
	    timeout {
		exp_send "\n"
	    }
	    eof {
		warning "telnet: got unexpected EOF from telnet."
		catch close
		catch wait
		set need_respawn 1
		sleep 5
	    }
	}
	incr tries
    }

    
    verbose "spawn id is $spawn_id"
    set board_info($dest,fileid) $spawn_id;
    return $spawn_id
}

# Use telnet to spawn a session 
proc telnet_gdbserver_spawn { dest username commandline } {
    global board_info
    set remote $dest
    set telnet_prog "telnet"
    set prompt [target_info shell_prompt]
    set mport 23 
    verbose "commandline is $commandline"
    return [mynewtelnet_open_and_exec $remote $mport $prompt $commandline]
}


#
# Use $RSH to spawn $commandline on remote machine $dest as user $username.
# (Note $username on $dest will have to have appropriate .rhost entries.)
#
proc rsh_gdbserver_spawn { dest username commandline } {
    global board_info

    if [target_info exists rsh_prog] {
	set RSH [target_info rsh_prog];
    } else {
        set RSH rsh
    }

    if [board_info $dest exists hostname] {
	set remote [board_info $dest hostname];
    } else {
	set remote $dest;
    }

    if { $username == "" } {
	set rsh_useropts ""
    } else {
	set rsh_useropts "-l"
    }

    verbose "spawn $RSH $rsh_useropts $username $remote $commandline";
    spawn $RSH $rsh_useropts $username $remote $commandline;
    set board_info($dest,fileid) $spawn_id;

    set timeout 60
    expect {
	# expect output from $spawn_id
	-i $spawn_id
	-re "(.*No route to host)|(poll: protocol failure in circuit setup)|(.*Unknown host)|(.*Connection refused)|(Login incorrect)|(Permission denied)" {
	    verbose -log "$RSH to $remote failed, output \"$expect_out(buffer)\""
	    return -1
	}
	-re ".*\r" { }
	timeout {
	    verbose -log "$RSH to $remote timedout (timeout=$timeout)"
	    return -1
	}
	eof {
	    verbose -log "$RSH to $remote failed"	    
	    return -1
	}
    }

    return $spawn_id;
}

#
# Download $srcfile to $destfile on $desthost as user $username using rcp.
#

proc gdbserver_download {desthost username srcfile destfile} {
    if [target_info exists rsh_prog] {
	set RSH [target_info rsh_prog];
    } else {
        set RSH rsh
    }

    if ![target_info exists rcp_prog] {
        set RCP rcp
    } else {
	set RCP [target_info rcp_prog];
    }

    if [board_info $desthost exists name] {
	set desthost [board_info $desthost name];
    }

    if [board_info $desthost exists hostname] {
	set desthost [board_info $desthost hostname];
    }

    if { $username == "" } {
	set rsh_useropts ""
	set rcp_dest $desthost
    } else {
	set rsh_useropts "-l $username"
	set rcp_dest "$username@$desthost"
    }

    # Delete the output file
    # set status [catch "exec $RSH $rsh_useropts $desthost rm -f $destfile |& cat" output] 

    if { $RCP != "cp" } {
	set status [catch "exec $RCP $srcfile $rcp_dest:$destfile |& cat" output]
    } else {
	if [target_info exists nfsdir] {
	    set nfsdir [target_info nfsdir];
	    verbose -log "nfsdir is  $nfsdir"
	    set status [catch "exec cp $srcfile $nfsdir/$destfile |& cat" output]
	} else {
	    verbose "\nnfsdir not set\n"
	    set status 1
	}
    }
    if { $status == 0 } {
	if [target_info exists nfsdir] {
	    verbose "Copied $srcfile to $nfsdir/$destfile" 2
	    return $destfile;
	} else {
	    verbose "Copied $srcfile to $desthost:$destfile" 2
	    return $destfile;
	}
    } else {
	verbose "Download to $desthost failed, $output."
	return ""
    }
}