Subversion Repositories or1k

# Copyright (C) 97, 98, 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  

# Please email any bugs, comments, and/or additions to this file to:
# DejaGnu@cygnus.com

#
# Connect to hostname using rlogin
#
proc rsh_open { hostname } {
    global spawn_id

    set tries 0
    set result -1

    # get the hostname and port number from the config array
    if [board_info $hostname exists name] {
        set hostname [board_info $hostname name];
    }
    set hostname [lindex [split [board_info ${hostname} netport] ":"] 0]
    if [board_info ${hostname} exists shell_prompt] {
        set shell_prompt [board_info ${hostname} shell_prompt]
    } else {
        set shell_prompt ".*> "
    }

    if [board_info $hostname exists fileid] {
        unset board_info($hostname,fileid);
    }
 
    if ![board_info $hostname exists rsh_prog] {
        if { [which remsh] != 0 } {
            set RSH remsh
        } else {
            set RSH rsh
        }
    } else {
        set RSH [board_info $hostname rsh_prog];
    }

    spawn $RSH $hostname
    if { $spawn_id < 0 } {
        perror "invalid spawn id from rsh"
        return -1
    }

    send "\r\n"
    while { $tries <= 3 } {
        expect {
            -re ".*$shell_prompt.*$" {
                verbose "Got prompt\n"
                set result 0
                break
            }
            -re "TERM = .*$" {
                warning "Setting terminal type to vt100"
                set result 0
                send "vt100\n"
                break
            }
            "unknown host" {
                exp_send "\003"
                perror "telnet: unknown host"
                break
            }
            "has logged on from" {
                exp_continue
            }
            -re "isn't registered for Kerberos.*service.*$" {
                warning "rsh: isn't registered for Kerberos, please kinit"
                catch close
                catch wait
                break
            }
            -re "Kerberos rcmd failed.*$" {
                warning "rsh: Kerberos rcmd failed, please kinit"
                catch close
                catch wait
                break
            }
            -re "You have no Kerberos tickets.*$" {
                warning "rsh: No kerberos Tickets, please kinit"
                catch close
                catch wait
                break
            }
            "Terminal type is" {
                verbose "rsh: connected, got terminal prompt" 2
                set result 0
                break
            }
            -re "trying normal rlogin.*$" {
                warning "rsh: trying normal rlogin."
                catch close
                catch wait
                break
            }
            -re "unencrypted connection.*$" {
                warning "rsh: unencrypted connection, please kinit"
                catch close
                catch wait
                break
            }
            -re "Sorry, shell is locked.*Connection closed.*$" {
                warning "rsh: already connected."
            }
            timeout {
               warning "rsh: timed out trying to connect."
            }
            eof {
                perror "rsh: got EOF while trying to connect."
                break
            }
        }
        incr tries
    }
    
    if { $result < 0 } {
#       perror "rsh: couldn't connect after $tries tries."
        close -i $spawn_id
        set spawn_id -1
    } else {
        set board_info($hostname,fileid) $spawn_id
    }

    return $spawn_id
}

#
# Download $srcfile to $destfile on $desthost.
#

proc rsh_download {desthost srcfile destfile} {
    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 ![board_info $desthost exists rcp_prog] {
        set RCP rcp
    } else {
        set RCP [board_info $desthost rcp_prog];
    }

    set status [catch "exec $RCP $srcfile $desthost:$destfile |& cat" output]
    if { $status == 0 } {
        verbose "Copied $srcfile to $desthost:$destfile" 2
        return $destfile;
    } else {
        verbose "Download to $desthost failed, $output."
        return ""
    }
}

proc rsh_upload {desthost srcfile destfile} {
    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 ![board_info $desthost exists rcp_prog] {
        set RCP rcp
    } else {
        set RCP [board_info $desthost rcp_prog];
    }

    set status [catch "exec $RCP $desthost:$srcfile $destfile" output];
    if { $status == 0 } {
        verbose "Copied $desthost:$srcfile to $destfile" 2
        return $destfile;
    } else {
        verbose "Upload from $desthost failed, $output."
        return ""
    }
}

#
# Execute "$cmd $args[0]" on $boardname.
# 
proc rsh_exec { boardname cmd args } {
    if { [llength $args] > 0 } {
        set pargs [lindex $args 0];
        if { [llength $args] > 1 } {
            set inp [lindex $args 1];
        } else {
            set inp "";
        }
    } else {
        set pargs ""
        set inp ""
    }

    verbose "Executing $boardname:$cmd $pargs < $inp"

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

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

    if ![board_info $hostname exists rsh_prog] {
        if { [which remsh] != 0 } {
            set RSH remsh
        } else {
            set RSH rsh
        }
    } else {
        set RSH [board_info $hostname rsh_prog];
    }
 
    # If CMD sends any output to stderr, exec will think it failed.  More often
    # than not that will be true, but it doesn't catch the case where there is
    # no output but the exit code is non-zero.
    if { $inp == "" } {
        set inp "/dev/null"
    }
    set status [catch "exec cat $inp | $RSH $boardname sh -c '$cmd $pargs \\; echo XYZ\\\${?}ZYX' |& cat" output]
    verbose "rsh output is $output"
    # `status' doesn't mean much here other than rsh worked ok.
    # What we want is whether $cmd ran ok.
    if { $status != 0 } {
        regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
        return [list -1 "rsh to $boardname failed for $cmd, $output"]
    }
    regexp "XYZ(\[0-9\]*)ZYX" $output junk status
    verbose "rsh_exec: status:$status text:$output" 4
    if { $status == "" } {
        return [list -1 "Couldn't parse rsh output, $output."]
    }
    regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
    # Delete one trailing \n because that is what `exec' will do and we want
    # to behave identical to it.
    regsub "\n$" $output "" output
    return [list [expr $status != 0] $output]
}