path: root/config/dos.exp

# Copyright (C) 1997 - 2001 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., 675 Mass Ave, Cambridge, MA 02139, USA.  

# Please email any bugs, comments, and/or additions to this file to:
# bug-dejagnu@gnu.org

# This file was written by Bob Manson (manson@cygnus.com)

#
# Open a connection to the remote DOS host.
#
proc dos_open { dest args } {
    global destbat_num

    if ![info exists destbat_num] {
	set destbat_num [pid];
    }
    if { [board_info $dest conninfo] == "" } {
	global board_info;
	set name [board_info $dest name];

	set board_info($name,conninfo) "b${destbat_num}.bat";
	incr destbat_num;
    }

    if [board_info $dest exists fileid] {
	return [board_info $dest fileid];
    }

    verbose "doing a dos_open to $dest"

    set shell_prompt [board_info $dest shell_prompt];

    set shell_id [remote_raw_open $dest];

    if { $shell_id == "" || $shell_id < 0 } {
	return -1;
    }

    if [board_info $dest exists init_command] {
	remote_send $dest "[board_info $dest init_command]\n";
	remote_expect $dest 10 {
	    -re "$shell_prompt" { }
	    default {
		perror "failed connection to DOS on $dest."
		return -1;
	    }
	}
    }

    if [board_info $dest exists ftp_directory] {
	set dir [board_info $dest ftp_directory];
	regsub -all "/" "$dir" "\\" dir;
	remote_send $dest "cd $dir\n";
	remote_expect $dest 10 {
	    -re "$shell_prompt" { }
	    default {
		perror "failed connection to DOS on $dest."
		return -1;
	    }
	}
    }

    if [board_info $dest exists dos_dir] {
	set dos_dir [board_info $dest dos_dir];
	regsub -all "^(\[a-zA-Z]:).*$" "$dos_dir" "\\1" drive;
	regsub -all "^\[a-zA-Z]:" "$dos_dir" "" dos_dir;
	remote_send $dest "${drive}\n";
	remote_expect $dest 10 {
	    -re "$shell_prompt" { }
	    default {
		perror "failed connection to DOS on $dest."
		return -1;
	    }
	}
	remote_send $dest "cd $dos_dir\n";
	remote_expect $dest 10 {
	    -re "$shell_prompt" { }
	    default {
		perror "failed connection to DOS on $dest."
		return -1;
	    }
	}
    }

    global target_alias
    if [info exists target_alias] {
	set talias $target_alias;
    } else {
	set talias "foo-bar"
    }

    global board_info;
    if [board_info $dest exists name] {
	set n [board_info $dest name];
    } else {
	set n $dest;
    }
    set board_info($n,fileid) $shell_id;

    if [board_info $dest exists init_script] {
	remote_exec $dest "[board_info $dest init_script] $talias"
    }

    verbose "Succeeded in connecting to DOS."
    return $shell_id;
}

#
# Close the connection to the remote host. If we're telnetting there, we
# need to exit the connection first (ataman telnetd gets confused otherwise).
#
proc dos_close { dest args } {
    if [board_info $dest exists fileid] {
	if { [board_info $dest connect] == "telnet" } {
	    remote_send $dest "exit\n";
	    sleep 2;
	}
	return [remote_raw_close $dest];
    }
}

proc dos_prep_command { dest cmdline } {
    global board_info;

    set name [board_info $dest name];
    set shell_id [remote_open "$dest"];

    set localbat "/tmp/b[pid].bat";
    set remotebat [board_info $dest conninfo];

    verbose "opened"
    if { $shell_id != "" && $shell_id >= 0 } {
	set fileid [open "$localbat" "w"];
	puts -nonewline $fileid "@echo off\r\n$cmdline\r\nif errorlevel 1 echo *** DOSEXIT code 1\r\nif not errorlevel 1 echo *** DOSEXIT code 0\r\n";
	close $fileid;
	set result [remote_download $dest $localbat $remotebat];
    } else {
	set result ""
    }
    remote_file build delete $localbat;
    return $result;
}

# 
# Run CMDLINE on DESTHOST. We handle two cases; one is where we're at
# a DOS prompt, and the other is where we're in GDB.
# We run CMDLINE by creating a batchfile, downloading it, and then
# executing it; this handles the case where the commandline is too
# long for command.com to deal with.
# 

proc dos_exec { dest program pargs inp outp } {
    set cmdline "$program $pargs"

    set shell_prompt [board_info $dest shell_prompt];

    if { $inp != "" } {
	set inp [remote_download $dest $inp inpfile];
	if { $inp != "" } {
	    set inp " < $inp";
	}
    }

    if { $outp != "" } {
	set outpf " > tempout";
    }  else {
	set outpf "";
    }

    verbose "cmdline is $cmdline$inp." 2

    # Make a DOS batch file; we use @echo off so we don't have to see
    # the DOS command prompts and such.
    for { set i 0; } { $i < 2 } { incr i } {
	set exit_status -1;
	verbose "calling open"
	set batfile [dos_prep_command $dest "$cmdline$inp$outpf"];
	if { $batfile != "" } {
	    if { [dos_start_command $batfile $dest] == "" } {
		# FIXME: The 300 below should be a parameter.
		set result [remote_wait $dest 300];
		set exit_status [lindex $result 0];
		set output [lindex $result 1];
	    }
	}
	if { $exit_status >= 0 } {
	    if { $outp != "" } {
		remote_upload $dest tempout $outp;
		remote_file $dest delete tempout;
	    }
	    return [list $exit_status $output];
	}
	if { $exit_status != -2 } {
	    remote_close $dest;
	    remote_reboot $dest;
	}
    }
    return [list -1 "program execution failed"];
}

# 
# Start CMDLINE executing on DEST.
# There are two cases that we handle, one where we're at a DOS prompt
# and the other is when the remote machine is running GDB.
#

proc dos_start_command { cmdline dest } {
    set shell_prompt [board_info $dest shell_prompt];
    set prefix ""
    set ok 0;
    for {set i 0;} {$i <= 2 && ! $ok} {incr i;} {
	set shell_id [remote_open $dest];
	if { $shell_id != "" && $shell_id > 0 } {
	    remote_send $dest "echo k\r";
	    remote_expect $dest 20 {
		-re "\\(gdb\\)" {
		    set shell_prompt "\\(gdb\\)";
		    # gdb uses 'shell command'.
		    set prefix "shell ";
		    set ok 1;
		}
		-re "$shell_prompt" { 
		    set ok 1; 
		}
		default { }
	    }
	}
	if { ! $ok } {
	    remote_close $dest;
	    remote_reboot $dest;
	}
    }
    if { ! $ok } {
	return "unable to start command"
    } else {
	remote_send $dest "${prefix}${cmdline}\n";
	remote_expect $dest 2 {
	    -re "${cmdline}\[\r\n\]\[\r\n\]?" { }
	    timeout { }
	}
	return "";
    }
}

#
# Send STRING to DEST, translating all LFs to CRs first, and sending one
# line at a time because of strangeness with telnet in some circumstances.
#

proc dos_send { dest string } {
    verbose "Sending '$string' to $dest" 2
    # Convert LFs to CRs, 'cause that is what DOS wants to see.
    set first 1
    set string [string trimright $string "\r\n"]
    foreach line [split $string "\r\n"] {
	if {$first} {
	    set first 0
	} else {
	    # small delay between lines, to keep from
	    # overwhelming the stupid telnet server.
	    sleep 1.0
	}
	remote_raw_send $dest "$line\r"
    }
}

# 
# Spawn PROGRAM on DEST, and return the spawn_id associated with the
# connection; we can only spawn one command at a time.
#

proc dos_spawn { dest program args } {
    verbose "running $program on $dest"
    set remotebat [dos_prep_command $dest $program];

    for { set x 0; } { $x < 3 } { incr x } {
	if { [dos_start_command $remotebat $dest] == "" } {
	    return [board_info $dest fileid];
	}
	remote_close $dest;
	remote_reboot $dest;
    }
    return -1;
}

proc dos_wait { dest timeout } {
    set output "";
    set shell_prompt [board_info $dest shell_prompt];
    set status 1;

    verbose "waiting in dos_wait";
    remote_expect $dest $timeout {
	-re "(.*)\[*\]\[*\]\[*\] DOSEXIT code (\[0-9\]+)\[\r\n\]\[\r\n\]?" {
	    verbose "got exit status";
	    append output $expect_out(1,string);
	    set status $expect_out(2,string);
	    exp_continue;
	}

	-re "(.*)${shell_prompt}" {
	    append output $expect_out(1,string);
	    verbose "output from dos is:'$output'";
	    return [list $status $output];
	}

	-re "(.*)\\(gdb\\)" {
	    append output $expect_out(1,string);
	    return [list $status $output];
	}

	-re "In.*cygwin.*except" {
	    remote_close $dest;
	    remote_reboot $dest;
	    return [list -2 $output];
	}

	-re "\[\r\n\]+" {
	    # This is a bit obscure. We only want to put whole
	    # lines into the output string, because otherwise we
	    # might miss a prompt because we only got 1/2 of it the
	    # first time 'round. The other tricky bit is that
	    # expect_out(buffer) will contain everything before and including
	    # the matched pattern.
	    append output $expect_out(buffer);
	    exp_continue -continue_timer;
	}

	timeout {
	    warning "timeout in dos_wait";
	    if { [dos_interrupt_job $dest] == "" } {
		return [list 1 $output];
	    }
	}

	eof {
	    warning "got EOF from dos host.";
	}
    }

    remote_close $dest;

    return [list -1 $output];
}

proc dos_load { dest prog args } {
    global dos_dll_loaded;
    set progargs "";
    set inpfile "";
    if { [llength $args] > 0 } {
	set progargs [lindex $args 1];
    }
    if { [llength $args] > 1 } {
	set inpfile [lindex $args 1];
    }
    if ![info exists dos_dll_loaded] {
	if ![is_remote host] {
	    global target_alias;

	    set comp [get_multilibs];
	    if [file exists "${comp}/winsup/new-cygwin1.dll"] {
		set dll "${comp}/winsup/new-cygwin1.dll";
		set dll_name "cygwin1.dll";
	    } elseif [file exists "${comp}/winsup/new-cygwin.dll"] {
		set dll "${comp}/winsup/new-cygwin.dll";
		set dll_name "cygwin.dll";
	    } elseif [file exists ${comp}/lib/cygwin1.dll] {
		set dll "${comp}/lib/cygwin1.dll";
		set dll_name "cygwin1.dll";
	    } elseif [file exists ${comp}/lib/cygwin.dll] {
		set dll "${comp}/lib/cygwin.dll";
		set dll_name "cygwin.dll";
	    } else {
		error "couldn't find cygwin.dll:$comp"
		return "fail";
	    }
	    remote_download $dest $dll $dll_name
	}
	set dos_dll_loaded 1;
    }
    set remote_prog [remote_download $dest $prog "aout.exe"];
    set result [remote_exec $dest $remote_prog $progargs $inpfile];
    set status [lindex $result 0];
    set output [lindex $result 1];
    set status2 [check_for_board_status output];
    if { $status2 >= 0 } {
	set status $status2;
    }
    if { $status != 0 } {
	set status "fail";
    } else {
	set status "pass";
    }
    return [list $status $output];
}

proc dos_file { dest op args } {
    switch $op {
	delete {
	    foreach x $args {
		remote_exec $dest "del" "$x";
	    }
	    return;
	    
	}
	default {
	    return [eval standard_file \{$dest\} \{$op\} $args];
	}
    }
}

#
# Interrupt the current spawned command being run; the only tricky
# part is that we have to handle the "Terminate batch job" prompt.
#
proc dos_interrupt_job { host } {
    set shell_prompt [board_info $host shell_prompt];

    remote_send $host "\003";
    remote_expect $host 10 {
	-re "Terminate batch job.*Y/N\[)\]\[?\] *$" {
	    remote_send $host "n\n";
	    exp_continue;
	}
	-re "$shell_prompt" {
	    return "";
	}
	-re ">" {
	    remote_send $host "\n";
	    exp_continue;
	}
    }
    return "fail";
}

proc dos_copy_download { host localfile remotefile } {
    remote_file build delete "[board_info $host local_dir]/$remotefile";
    if [remote_file build exists $localfile] {
	set result [remote_download build $localfile "[board_info $host local_dir]/$remotefile"];
	if { $result != "" } {
	    remote_exec build "chmod" "a+rw $result";
	    return $remotefile;
	}
    } else {
	return ""
    }
}

proc dos_copy_upload { host remotefile localfile } {
    remote_file build delete $localfile;
    if [file exists "[board_info $host local_dir]/$remotefile"] {
	set result [remote_download build "[board_info $host local_dir]/$remotefile" $localfile];
    } else {
	set result "";
    }
    if { $result != "" } {
	remote_exec build "chmod" "a+rw $result";
	return $result;
    }
}

proc dos_copy_file { dest op args } {
    if { $op == "delete" } {
	set file "[board_info $dest local_dir]/[lindex $args 0]";
	remote_file build delete $file;
    }
}

set_board_info protocol  "dos";
set_board_info shell_prompt  "(^|\[\r\n\])\[a-zA-Z\]:\[^\r\n\]*>\[ \t\]*$";
set_board_info needs_status_wrapper 1