Subversion Repositories or1k

# 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