# Copyright (C) 1992-2016 Free Software Foundation, Inc.

#

# This file is part of DejaGnu.

#

# DejaGnu 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 3 of the License, or

# (at your option) any later version.

#

# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,

# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.

# This file was written by Rob Savoye <rob@welcomehome.org>.

# Load various protocol support modules.

load_lib "telnet.exp"

load_lib "rlogin.exp"

load_lib "kermit.exp"

load_lib "tip.exp"

load_lib "rsh.exp"

load_lib "ssh.exp"

load_lib "ftp.exp"

# Open a connection to a remote host or target. This requires the target_info

# array be filled in with the proper info to work.

#

# type is either "build", "host", "target", or the name of a board loaded

# into the board_info array. The default is target if no name is supplied.

# It returns the spawn id of the process that is the connection.

#

proc remote_open { args } {

    global reboot

    if { [llength $args] == 0 } {

	set type "target"

    } else {

	set type $args

    }

    # Shudder...

    if { $reboot && $type == "target" } {

	reboot_target

    }

    return [call_remote "" open $type]

}

proc remote_raw_open { args } {

    return [eval call_remote raw open $args]

}

# Close a spawn ID, and wait for the process to die.  If PID is not

# -1, then the process is killed if it doesn't exit gracefully.

#

proc close_wait_program { program_id pid {wres_varname ""} } {

    if {$wres_varname != "" } {

	upvar 1 $wres_varname wres

    }

    set exec_pid -1

    if { $pid > 0 } {

	# Tcl has no kill primitive, so we have to execute an external

	# command in order to kill the process.

	verbose "doing kill, pid is $pid"

	# Prepend "-" to generate the "process group ID" needed by

	# kill.

	set pgid "-$pid"

	# Send SIGINT to give the program a better chance to interrupt

	# whatever it might be doing and react to stdin closing.

	# eg, in case of GDB, this should get it back to the prompt.

	exec sh -c "exec > /dev/null 2>&1 && (kill -2 $pgid || kill -2 $pid)"

	# If the program doesn't exit gracefully when stdin closes,

	# we'll need to kill it.  But only do this after 'wait'ing a

	# bit, to avoid killing the wrong process in case of a

	# PID-reuse race.  The extra sleep at the end is there to give

	# time to kill $exec_pid without having _that_ be subject to a

	# PID reuse race.

	set secs 5

	set sh_cmd "exec > /dev/null 2>&1"

	append sh_cmd " && sleep $secs && (kill -15 $pgid || kill -15 $pid)"

	append sh_cmd " && sleep $secs && (kill -9 $pgid || kill -9 $pid)"

	append sh_cmd " && sleep $secs"

	set exec_pid [exec sh -c "$sh_cmd" &]

    }

    verbose "pid is $pid"

    # This closes the program's stdin.  This should cause well behaved

    # interactive programs to exit.  This will hang if the kill

    # doesn't work.  Nothin' to do, and it's not OK.

    catch "close -i $program_id"

    # Reap it.

    set res [catch "wait -i $program_id" wres]

    if {$exec_pid != -1} {

	# We reaped the process, so cancel the pending force-kills, as

	# otherwise if the PID is reused for some other unrelated

	# process, we'd kill the wrong process.

	exec sh -c "exec > /dev/null 2>&1 && kill -9 $exec_pid"

    }

    return $res

}

# Run the specified COMMANDLINE on the local machine, redirecting

# input from file INP (if non-empty), redirecting output to file OUTP

# (if non-empty), and waiting TIMEOUT seconds for the command to

# complete before killing it. A list of two elements is returned: the

# first member is the exit status of the command, the second is any

# output produced from the command (if output is redirected, this may

# or may not be empty). If output is redirected, both stdout and

# stderr will appear in the specified file.

#

# Caveats: A pipeline is used if input or output is redirected. There

# will be problems with killing the program if a pipeline is used. Either

# the "tee" command or the "cat" command is used in the pipeline if input

# or output is redirected. If the program needs to be killed, /bin/sh and

# the kill command will be invoked.

#

proc local_exec { commandline inp outp timeout } {

    # Tcl's exec is a pile of crap. It does two very inappropriate things.

    # Firstly, it has no business returning an error if the program being

    # executed happens to write to stderr. Secondly, it appends its own

    # error messages to the output of the command if the process exits with

    # non-zero status.

    #

    # So, ok, we do this funny stuff with using spawn sometimes and

    # open others because of spawn's inability to invoke commands with

    # redirected I/O. We also hope that nobody passes in a command that's

    # a pipeline, because spawn can't handle it.

    #

    # We want to use spawn in most cases, because Tcl's pipe mechanism

    # doesn't assign process groups correctly and we can't reliably kill

    # programs that bear children. We can't use Tcl's exec because it has

    # no way to timeout programs that hang.

    #

    # The expect command will close the connection when it sees

    # EOF. Closing the connection may send SIGHUP to the child and

    # cause it to exit before it can exit normally.  The child should

    # ignore SIGHUP.

    global errorInfo

    if { "$inp" == "" && "$outp" == "" } {

	set id -1

	set result [catch "eval spawn -ignore SIGHUP \{${commandline}\}" pid]

	if { $result == 0 } {

	    set result2 0

	} else {

	    set pid 0

	    set result2 5

	}

    } else {

	# Use a command pipeline with open.

	if { $inp != "" } {

	    set inp "< $inp"

	    set mode "r"

	} else {

	    set mode "w"

	}

	set use_tee 0

	# We add |& cat so that Tcl exec doesn't freak out if the

	# program writes to stderr.

	if { $outp == "" } {

	    set outp "|& cat"

	} else {

	    set outpf "$outp"

	    set outp "> $outp"

	    if { $inp != "" } {

		set use_tee 1

	    }

	}

	# Why do we use tee? Because open can't redirect both input and output.

	if { $use_tee } {

	    set result [catch {open "| ${commandline} $inp |& tee $outpf" RDONLY} id]

	} else {

	    set result [catch {open "| ${commandline} $inp $outp" $mode} id]

	}

	if { $result != 0 } {

	    return [list -1 "open of $commandline $inp $outp failed: $errorInfo"]

	}

	set pid [pid $id]

	set result [catch "spawn -ignore SIGHUP -leaveopen $id" result2]

    }

    # Prepend "-" to each pid, to generate the "process group IDs" needed by

    # kill.

    set pgid "-[join $pid { -}]"

    verbose "pid is $pid $pgid"

    if { $result != 0 || $result2 != 0 } {

	# This shouldn't happen.

	if {[info exists errorInfo]} {

	    set foo $errorInfo

	} else {

	    set foo ""

	}

	verbose "spawn -open $id failed, $result $result2, $foo"

	catch "close $id"

	return [list -1 "spawn failed"]

    }

    set got_eof 0

    set output ""

    # Wait for either $timeout seconds to elapse, or for the program to

    # exit.

    expect {

	-i $spawn_id -timeout $timeout -re ".+" {

	    append output $expect_out(buffer)

	    exp_continue -continue_timer

	}

	timeout {

	    warning "program timed out"

	}

	eof {

	    set got_eof 1

	}

    }

    # If we didn't get EOF, we have to kill the poor defenseless program.

    if { $got_eof } {

	set pid -1

    }

    set r2 [close_wait_program $spawn_id $pid wres]

    if { $id > 0 } {

	set r2 [catch "close $id" res]

    } else {

	verbose "waitres is $wres" 2

	if { $r2 == 0 } {

	    set r2 [lindex $wres 3]

	    if { [llength $wres] > 4 } {

		if { [lindex $wres 4] == "CHILDKILLED" } {

		    set r2 1

		}

	    }

	    if { $r2 != 0 } {

		set res "$wres"

	    } else {

		set res ""

	    }

	} else {

	    set res "wait failed"

	}

    }

    if { $r2 != 0 || $res != "" || ! $got_eof } {

	verbose "close result is $res"

	set status 1

    } else {

	set status 0

    }

    verbose "output is $output status $status"

    if { $outp == "" || $outp == "|& cat" } {

	return [list $status $output]

    } else {

	return [list $status ""]

    }

}

#

# Execute the supplied program on HOSTNAME. There are four optional arguments

# the first is a set of arguments to pass to PROGRAM, the second is an

# input file to feed to stdin of PROGRAM, the third is the name of an

# output file where the output from PROGRAM should be written, and

# the fourth is a timeout value (we give up after the specified # of seconds

# has elapsed).

#

# A two-element list is returned. The first value is the exit status of the

# program (-1 if the exec failed). The second is any output produced by

# the program (which may or may not be empty if output from the program was

# redirected).

#

proc remote_exec { hostname program args } {

    if { [llength $args] > 0 } {

	set pargs [lindex $args 0]

    } else {

	set pargs ""

    }

    if { [llength $args] > 1 } {

	set inp "[lindex $args 1]"

    } else {

	set inp ""

    }

    if { [llength $args] > 2 } {

	set outp "[lindex $args 2]"

    } else {

	set outp ""

    }

    # call_remote below gets its timeout from global variable, so set

    # it here.

    global timeout

    set old_timeout $timeout

    # 300 is probably a lame default.

    if { [llength $args] > 3 } {

	set timeout "[lindex $args 3]"

    } else {

	set timeout 300

    }

    verbose -log "Executing on $hostname: $program $pargs $inp $outp (timeout = $timeout)" 2

    # Run it locally if appropriate.

    if { ![is_remote $hostname] } {

	set result [local_exec "$program $pargs" $inp $outp $timeout]

    } else {

        if { [board_info $hostname exists remotedir] } {

            set remotedir [board_info $hostname remotedir]

	    # This is a bit too clever. Join cd $remotedir and

	    # $program on the command line with ';' and not '&&'. When

	    # called, $program may be mkdir to initially create the

	    # remote directory, in which case cd would fail.

            set program "test -d $remotedir && cd $remotedir; $program"

        }

	set result [call_remote "" exec $hostname $program $pargs $inp $outp]

    }

    # Restore timeout.

    set timeout $old_timeout

    return $result

}

proc standard_exec { hostname args } {

    return [eval rsh_exec \"$hostname\" $args]

}

# Close the remote connection.

#	arg - This is the name of the machine whose connection we're closing,

#	      or target, host or build.

#

proc remote_close { host } {

    while { 1 } {

	set result [call_remote "" close "$host"]

	if { [remote_pop_conn $host] != "pass" } {

	    break

	}

    }

    return $result

}

proc remote_raw_close { host } {

    return [call_remote raw close "$host"]

}

proc standard_close { host } {

    global board_info

    if {[board_info ${host} exists fileid]} {

	set shell_id [board_info ${host} fileid]

	set pid -1

	verbose "Closing the remote shell $shell_id" 2

	if {[board_info ${host} exists fileid_origid]} {

	    set oid [board_info ${host} fileid_origid]

	    set pid [pid $oid]

	    unset board_info(${host},fileid_origid)

	} else {

	    set result [catch "exp_pid -i $shell_id" pid]

	    if { $result != 0 || $pid <= 0 } {

		set result [catch "pid $shell_id" pid]

		if { $result != 0 } {

		    set pid -1

		}

	    }

	}

	close_wait_program $shell_id $pid

	if {[info exists oid]} {

	    catch "close $oid"

	}

	unset board_info(${host},fileid)

	verbose "Shell closed."

    }

    return 0

}

# Set the connection into "binary" mode, a.k.a. no processing of input

# characters.

#

proc remote_binary { host } {

    return [call_remote "" binary "$host"]

}

proc remote_raw_binary { host } {

    return [call_remote raw binary "$host"]

}

# Return value of this function depends on actual implementation of reboot that

# will be used, in practice it is expected that remote_reboot returns 1 on

# success and 0 on failure.

#

proc remote_reboot { host } {

    clone_output "\nRebooting ${host}\n"

    # FIXME: don't close the host connection, or all the remote

    # procedures will fail.

    # remote_close $host

    set status [call_remote "" reboot "$host"]

    if {[board_info $host exists name]} {

	set host [board_info $host name]

    }

    if { [info procs ${host}_init] != "" } {

	${host}_init $host

    }

    return $status

}

# It looks like that this proc is never called, instead ${board}_reboot defined

# in base-config.exp will be used because it has higher priority and

# base-config.exp is always imported by runtest.

#

proc standard_reboot { host } {

    return 1

}

#

# Download file FILE to DEST. If the optional DESTFILE is specified,

# that file will be used on the destination board. It returns either

# "" (indicating that the download failed), or the name of the file on

# the destination machine.

#

proc remote_download { dest file args } {

    if { [llength $args] > 0 } {

	set destfile [lindex $args 0]

    } else {

	set destfile [file tail $file]

    }

    if { ![is_remote $dest] } {

	if { $destfile == "" || $destfile == $file } {

	    return $file

	} else {

	    verbose -log "Downloading on $dest to $destfile: $file" 2

	    set result [catch "exec cp -p $file $destfile" output]

	    if {[regexp "same file|are identical" $output]} {

		set result 0

		set output ""

	    } else {

		# try to make sure we can read it

		# and write it (in case we copy onto it again)

		catch {exec chmod u+rw $destfile}

	    }

	    if { $result != 0 || $output != "" } {

		perror "remote_download to $dest of $file to $destfile: $output"

		return ""

	    } else {

		return $destfile

	    }

	}

    }

    if { [board_info $dest exists remotedir] } {

        set remotedir [board_info $dest remotedir]

        set status [remote_exec $dest mkdir "-p $remotedir"]

        if { [lindex $status 0] != 0 } {

            perror "Couldn't create remote directory $remotedir on $dest"

	    return ""

        }

        set destfile "$remotedir/$destfile"

    }

    return [call_remote "" download $dest $file $destfile]

}

# The default download procedure. Uses rcp to download to $dest.

#

proc standard_download {dest file destfile} {

    set orig_destfile $destfile

    if {[board_info $dest exists nfsdir]} {

	set destdir [board_info $dest nfsdir]

	if {[board_info $dest exists nfsroot_server]} {

	    set dest [board_info $dest nfsroot_server]

	} else {

	    set dest ""

	}

	set destfile "$destdir/$destfile"

    }

    if { "$dest" != "" } {

	set result [rsh_download $dest $file $destfile]

	if { $result == $destfile } {

	    return $orig_destfile

	} else {

	    return $result

	}

    }

    set result [catch "exec cp -p $file $destfile" output]

    if {[regexp "same file|are identical" $output]} {

	set result 0

	set output ""

    } else {

	# try to make sure we can read it

	# and write it (in case we copy onto it again)

	catch {exec chmod u+rw $destfile}

    }

    if { $result != 0 || $output != "" } {

	perror "remote_download to $dest of $file to $destfile: $output"

	return ""

    } else {

	return $orig_destfile

    }

}

proc remote_upload {dest srcfile args} {

    if { [llength $args] > 0 } {

	set destfile [lindex $args 0]

    } else {

	set destfile [file tail $srcfile]

    }

    if { ![is_remote $dest] } {

	if { $destfile == "" || $srcfile == $destfile } {

	    return $srcfile

	}

	set result [catch "exec cp -p $srcfile $destfile" output]

	return $destfile

    }

    return [call_remote "" upload $dest $srcfile $destfile]

}

proc standard_upload { dest srcfile destfile } {

    set orig_srcfile $srcfile

    if {[board_info $dest exists nfsdir]} {

	set destdir [board_info $dest nfsdir]

	if {[board_info $dest exists nfsroot_server]} {

	    set dest [board_info $dest nfsroot_server]

	} else {

	    set dest ""

	}

	set srcfile "$destdir/$srcfile"

    }

    if { "$dest" != "" } {

	return [rsh_upload $dest $srcfile $destfile]

    }

    set result [catch "exec cp -p $srcfile $destfile" output]

    if {[regexp "same file|are identical" $output]} {

	set result 0

	set output ""

    } else {

	# try to make sure we can read it

	# and write it (in case we copy onto it again)

	catch {exec chmod u+rw $destfile}

    }

    if { $result != 0 || $output != "" } {

	perror "remote_upload to $dest of $srcfile to $destfile: $output"

	return ""

    } else {

	return $destfile

    }

}

# A standard procedure to call the appropriate function. It first looks

# for a board-specific version, then a version specific to the protocol,

# and then finally it will call standard_$proc.

#

proc call_remote { type proc dest args } {

    if {[board_info $dest exists name]} {

	set dest [board_info $dest name]

    }

    if { $proc == "reboot" } {

	regsub {/.*} "$dest" "" dest

	verbose "Changed dest to $dest"

    }

    if { $dest != "host" && $dest != "build" && $dest != "target" } {

	if { ![board_info $dest exists name] } {

	    global board

	    if {[info exists board]} {

		error "board exists"

	    }

	    load_board_description $dest

	    if { $proc == "reboot" } {

		regsub {/.*} "$dest" "" dest

		verbose "Changed dest to $dest"

	    }

	}

    }

    set high_prot ""

    if { $type != "raw" } {

	if {[board_info $dest exists protocol]} {

	    set high_prot "${dest} [board_info $dest protocol]"

	} else {

	    set high_prot "${dest} [board_info $dest generic_name]"

	}

    }

    verbose "call_remote $type $proc $dest $args " 3

    # Close has to be handled specially.

    if { $proc == "close" || $proc == "open" } {

	foreach try "$high_prot [board_info $dest connect] telnet standard" {

	    if { $try != "" } {

		if { [info procs "${try}_${proc}"] != "" } {

		    verbose "call_remote calling ${try}_${proc}" 3

		    set result [eval ${try}_${proc} \"$dest\" $args]

		    break

		}

	    }

	}

	set ft "[board_info $dest file_transfer]"

	if { [info procs "${ft}_${proc}"] != "" } {

	    verbose "calling ${ft}_${proc} $dest $args" 3

	    set result2 [eval ${ft}_${proc} \"$dest\" $args]

	}

	if {![info exists result]} {

	    if {[info exists result2]} {

		set result $result2

	    } else {

		set result ""

	    }

	}

	return $result

    }

    foreach try "${high_prot} [board_info $dest file_transfer] [board_info $dest connect] telnet standard" {

	verbose "looking for ${try}_${proc}" 4

	if { $try != "" } {

	    if { [info procs "${try}_${proc}"] != "" } {

		verbose "call_remote calling ${try}_${proc}" 3

		return [eval ${try}_${proc} \"$dest\" $args]

	    }

	}

    }

    if { $proc == "close" } {

	return ""

    }

    error "No procedure for '$proc' in call_remote"

}

# Send FILE through the existing session established to DEST.

#

proc remote_transmit { dest file } {

    return [call_remote "" transmit "$dest" "$file"]

}

proc remote_raw_transmit { dest file } {

    return [call_remote raw transmit "$dest" "$file"]

}

# The default transmit procedure if no other exists. This feeds the

# supplied file directly into the connection.

#

proc standard_transmit {dest file} {

    if {[board_info ${dest} exists name]} {

	set dest [board_info ${dest} name]

    }

    if {[board_info ${dest} exists baud]} {

	set baud [board_info ${dest} baud]

    } else {

	set baud 9600

    }

    set shell_id [board_info ${dest} fileid]

    set lines 0

    set chars 0

    set fd [open $file r]

    while { [gets $fd cur_line] >= 0 } {

	set errmess ""

	catch "send -i $shell_id \"$cur_line\r\"" errmess

	if {[string match "write\(spawn_id=\[0-9\]+\):" $errmess]} {

	    perror "sent \"$cur_line\" got expect error \"$errmess\""

	    catch "close $fd"

	    return -1

	}

	set chars [expr {$chars + ([string length $cur_line] * 10)}]

	if { $chars > $baud } {

	    sleep 1

	    set chars 0

	}

	verbose "." 3

	verbose "Sent $cur_line" 4

	incr lines

    }

    verbose "$lines lines transmitted" 2

    close $fd

    return 0

}

proc remote_send { dest string } {

    return [call_remote "" send "$dest" "$string"]

}

proc remote_raw_send { dest string } {

    return [call_remote raw send "$dest" "$string"]

}

proc standard_send { dest string } {

    if {![board_info $dest exists fileid]} {

	perror "no fileid for $dest"

	return "no fileid for $dest"

    } else {

	set shell_id [board_info $dest fileid]

	verbose "shell_id in standard_send is $shell_id" 3

	verbose "send -i [board_info $dest fileid] -- $string" 3

	if {[catch "send -i [board_info $dest fileid] -- \$string" errorInfo]} {

	    return "$errorInfo"

	} else {

	    return ""

	}

    }

}

proc file_on_host { op file args } {

    return [eval remote_file host \"$op\" \"$file\" $args]

}

proc file_on_build { op file args } {

    return [eval remote_file build \"$op\" \"$file\" $args]

}

proc remote_file { dest args } {

    return [eval call_remote \"\" file \"$dest\" $args]

}

proc remote_raw_file { dest args } {

    return [eval call_remote raw file \"$dest\" $args]

}

# Perform the specified file op on a remote Unix board.

#

proc standard_file { dest op args } {

    set file [lindex $args 0]

    verbose "dest in proc standard_file is $dest" 3

    if { ![is_remote $dest] } {

	switch -- $op {

	    cmp {

		set otherfile [lindex $args 1]

		if { [file exists $file] && [file exists $otherfile]

		     && [file size $file] == [file size $otherfile] } {

		    set r [remote_exec build cmp "$file $otherfile"]

		    if { [lindex $r 0] == 0 } {

			return 0

		    }

		}

		return 1

	    }

	    tail {

		return [file tail $file]

	    }

	    dirname {

		if { [file pathtype $file] == "relative" } {

		    set file [remote_file $dest absolute $file]

		}

		set result [file dirname $file]

		if { $result == "" } {

		    return "/"

		}

		return $result

	    }

	    join {

		return [file join [lindex $args 0] [lindex $args 1]]

	    }

	    absolute {

		return [unix_clean_filename $dest $file]

	    }

	    exists {

		return [file exists $file]

	    }

	    delete {

		foreach x $args {

		    if { [file exists $x] && [file isfile $x] } {

			file delete -force -- $x

		    }

		}

		return {}

	    }

	}

    } else {

	switch -- $op {

	    exists {

		set status [remote_exec $dest "test -f $file"]

		return [expr {[lindex $status 0] == 0}]

	    }

	    delete {

		set file ""

		# Allow multiple files to be deleted at once.

		foreach x $args {

		    append file " $x"

		}

		verbose "remote_file deleting $file"

		set status [remote_exec $dest "rm -f $file"]

		return [lindex $status 0]

	    }

	}

    }

}

# Return an absolute version of the filename in $file, with . and ..

# removed.

#

proc unix_clean_filename { dest file } {

    if { [file pathtype $file] == "relative" } {

	set file [remote_file $dest join [pwd] $file]

    }

    set result ""

    foreach x [split $file "/"] {

	if { $x == "." || $x == "" } {

	    continue

	}

	if { $x == ".." } {

	    set rlen [expr {[llength $result] - 2}]

	    if { $rlen >= 0 } {

		set result [lrange $result 0 $rlen]

	    } else {

		set result ""

	    }

	    continue

	}

	lappend result $x

    }

    return "/[join $result /]"

}

#

# Start COMMANDLINE running on DEST. By default it is not possible to

# redirect I/O. If the optional keyword "readonly" is specified, input

# to the command may be redirected. If the optional keyword

# "writeonly" is specified, output from the command may be redirected.

#

# If the command is successfully started, a positive "spawn id" is returned.

# If the spawn fails, a negative value will be returned.

#

# Once the command is spawned, you can interact with it via the remote_expect

# and remote_wait functions.

#

proc remote_spawn { dest commandline args } {

    global board_info

    if {![is_remote $dest]} {

	if {[info exists board_info($dest,fileid)]} {

	    unset board_info($dest,fileid)

	}

	verbose "remote_spawn is local" 3

	if {[board_info $dest exists name]} {

	    set dest [board_info $dest name]

	}

	verbose "spawning command $commandline"

	if { [llength $args] > 0 } {

	    if { [lindex $args 0] == "readonly" } {

		set result [catch { open "| ${commandline} |& cat" "r" } id]

		if { $result != 0 } {

		    return -1

		}

	    } else {

		set result [catch {open "| ${commandline}" "w"} id]

		if { $result != 0 } {

		    return -1

		}

	    }

	    set result [catch "spawn -leaveopen $id" result2]

	    if { $result == 0 && $result2 == 0} {

		verbose "setting board_info($dest,fileid) to $spawn_id" 3

		set board_info($dest,fileid) $spawn_id

		set board_info($dest,fileid_origid) $id

		return $spawn_id

	    } else {

		# This shouldn't happen.

		global errorInfo

		if {[info exists errorInfo]} {

		    set foo $errorInfo

		} else {

		    set foo ""