diff options
Diffstat (limited to 'dejagnu/config/dos.exp')
-rw-r--r-- | dejagnu/config/dos.exp | 484 |
1 files changed, 484 insertions, 0 deletions
diff --git a/dejagnu/config/dos.exp b/dejagnu/config/dos.exp new file mode 100644 index 00000000000..d1b440da76d --- /dev/null +++ b/dejagnu/config/dos.exp @@ -0,0 +1,484 @@ +# Copyright (C) 1997, 1998, 1999 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: +# DejaGnu@cygnus.com + +# 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 |