#! /bin/sh
# Apart from these three lines, it is actually a -*- tcl -*- script \
exec expect "$0" -- "$@"
# This is rex - a remote execution utility
# Copyright (C) 2012-2022 Sergey Poznyakoff
#
# Rex 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, or (at your option)
# any later version.
#
# Rex 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 Rex.  If not, see <http://www.gnu.org/licenses/>.

set version "4.1"
set sysconfdir "/usr/local/etc"
set usrconfdir "$env(HOME)/.rex"
set defaultfile "$usrconfdir/default"
set confpath [list $usrconfdir $sysconfdir]
set libpath [list $usrconfdir/script $sysconfdir/script]

array set config {
    mode                 command
    sudo                 ""
    prompt               "(%|#|\\$) $"
    debug                0
    option,jobs          1
    option,resolve       1
}
array set rexdb {}

catch { set config(prompt) $env(EXPECT_PROMPT) }
if {[info exists env(EXPECT_DEBUG)]} {
    exp_internal -f $env(EXPECT_DEBUG) 1
}

set ssh_options {-oStrictHostKeyChecking=yes -oLogLevel=VERBOSE}

# Option definitions for the option_set command.
# Keys are formed as follows: OPTNAME,PROP , where OPTNAME is the name
# of the option and PROP is the property name.  The following option
# properties are defined:
#   nargs
#     Allowed number of arguments.
#     If the value is an integer, then the option must take exactly that
#     number of arguments.  If it is a two-element list, element 0 gives
#     minimum number of arguments and element 1 gives maximum number.  An
#     empty list is equivalent to 0.
#   name
#     Name of the corresponding option in the global ::config array.  If
#     that property is set, and the 'lambda' property is not defined, the
#     option value will be assigned to ::config(option,NAME), where NAME is
#     the value of that property.
#   lambda
#     If present, supplies a lambda-expression to apply(n) in order to
#     process the option.  The expression is variadic, the arguments to
#     the option_set command will be passed to it.
#     If both name and lambda are present, lambda is given preference.
#   rx
#     Regular expression a validoption  argument must match.
#   translate
#     A variadic lambda-expression which translates the actual arguments
#     to the form acceptable for the option.
#   type
#     A short-cut property to define some most commonly used types.  So far
#     the only meaningful value is bool, which defines a boolean option.
#     Option arguments can be: on, true, yes, 1 - meaning True, and
#     off, false, no, 0 - meaning False.
#
array set optiondef {
    group,nargs       1
    group,name        hostgroup

    buffer-output,type    bool
    
    confirm,type          bool
    
    copy,type             bool
    
    data-file,nargs       1
    data-file,lambda      { arg {
	if {[file exists $arg] && [file readable $arg]} {
	    lappend ::config(data) $arg
	} else {
	    if {[info exists locus]} {
		append locus ": "
	    } else {
		set locus ""
	    }
	    return -code error "file $arg doesn't exist or is unreadable"
	}
    }}

    host,lambda { args {
	foreach a $args {
	    lappend ::config(hosts) {*}[split $arg ","]
	}
    } }
    exclude-host,lambda { args {
	foreach a $args {
	    lappend ::config(exclude_hosts) {*}[split $a ","]
	}
    } }
    
    ignore-hosts,type bool
    
    interactive,type bool

    interpreter,nargs 1
    interpreter,lambda { arg {
	set ::config(option,copy) 1
	set ::config(option,interpreter) $arg
    }}

    jobs,rx     {^[[:digit:]]+$}
    jobs,name   jobs
    
    no-host-header,type  bool
    
    password,nargs 1
    password,lambda { arg { set ::config(pass) $arg }}
    
    prefix,type    bool
    
    source,nargs   1
    source,type    bool
    
    sudo,type      bool
    sudo,lambda    { arg setsudo }

    tcl-trace,type bool
    
    user,nargs     1
    user,lambda    { arg { set ::config(user) $arg }}
    
    zsh-quirk,type bool
}

proc throw_config_error {locus text} {
    return -code error -errorcode [list REX $locus] $text
}

proc catch_config_error {prog code} {
    switch -- [catch [list uplevel $prog] result options] {
	0 { return $result }
	1 {
	    set errorcode [dict get $options -errorcode]
	    if {[lindex $errorcode 0] == "REX"} {
		terror "[lindex $errorcode 1]: $result"
		exit $code
	    } else {
		return -code 1 -options $options
	    }
	}
	default {
	    return -code [dict get $options -code] -options $options
	}
    }
}

proc option_set {args} {
    global optiondef
    global config

    if {[llength $args] < 2 || [llength $args] > 3} {
	return -code error "bad # args"
    }
    set opt [lindex $args 0]
    set arg [lindex $args 1]
    if {[llength $args] == 3} {
	set locus [lindex $args 2]
    } else {
	set locus $opt
    }

    if {[info exists optiondef($opt,type)]} {
	switch -- $optiondef($opt,type) {
	    bool {
		set optiondef($opt,nargs) { 0 1 }
		set optiondef($opt,translate) { args
		    { if {[llength $args] == 0} {
			return 1
		      } else {
			  switch -- [string tolower [lindex $args 0]] {
			      on -
			      true -
			      yes -
			      1       { return 1 }
			      off -
			      false -
			      no -
			      0       { return 0 }
			      default { return -code error }
			  }
		      }
		    }
		}
		if {![info exist optiondef($opt,name)]} {
		    set optiondef($opt,name) $opt
		}
		unset optiondef($opt,type)
	    }
	    default {
		return -code error "bad value for optiondef($opt,type)"
	    }
	}
    }
    
    if {[info exists optiondef($opt,nargs)]} {
	# Check number of arguments
	if {![info exists arg]} {
	    set nargs 0
	} else {
	    set nargs [llength $arg]
	}
	set lim $optiondef($opt,nargs)
	switch -- [llength $lim] {
	    2 {
		if {$nargs < [lindex $lim 0]} {
		    throw_config_error $locus "too few arguments (at least [lindex $lim 0] required)"
		}
		if {$nargs > [lindex $lim 1]} {
		    throw_config_error $locus "too many arguments (max. [lindex $lim 1]"
		}
	    }
	    1 {
		if {$nargs != $lim} {
		    throw_config_error $locus "option takes exactly $lim arguments, but passed $nargs"
		}
	    }
	    0 {
		if {$nargs > 0} {
		    throw_config_error $locus "option takes no arguments"
		}
	    }
	    default {
		return -code error "bad value for optiondef($opt,nargs)"
	    }
	}
    }
    
    if {[info exists optiondef($opt,rx)]} {
	if {![regexp -- $optiondef($opt,rx) $arg]} {
	    throw_config_error $locus "bad argument for $opt"
	}
    }

    if {[info exists optiondef($opt,translate)]} {
	if {[catch {apply $optiondef($opt,translate) $arg} trans]} {
	    throw_config_error $locus "bad argument for $opt"
	} else {
	    set arg $trans
	}
    }
    
    if {[info exists optiondef($opt,lambda)]} {
	set lambda $optiondef($opt,lambda)
	if {[catch {apply $lambda {*}$arg} result]} {
	    throw_config_error $locus $result
	}
    } elseif {[info exists optiondef($opt,name)]} {
	set config(option,$optiondef($opt,name)) $arg
    } else {
	throw_config_error $locus "no such option $opt"
    }
}

# FIXME: Rename to option_get?    
# config_option KEY [VAR]
# Return the value of the configuration option KEY, or "" if not
# defined.
# If VAR is supplied, return boolean indicating whether the option
# is set and store the value in VAR, if it is.
proc config_option args {
    global config
    set key [lshift args]
    switch -- [llength $args] {
	0 {}
	1 {set retname [lshift args]}
	default { return -code error "bad number of arguments" }
    }
    if {![info exists config(option,$key)]} {
	return 0
    } elseif {[info exists retname]} {
	upvar $retname x
	set x $config(option,$key)
	return 1
    } else {
	return $config(option,$key)
    }
}

# #######################################################################
# A poor man's resolver.  Given the requirement of being as minimalistic
# as possible, I cannot use any external libraries.  Therefore the task
# of resolving host names and IP addresses is handled by calling "host"
# and parsing its return.
# #######################################################################

namespace eval ::pmres {
    variable host_order_cache
    
    proc hostorder {} {
	variable host_order_cache
	if {![info exists host_order_cache]} {
	    set host_order_cache {files dns}
	    if {[catch {open "/etc/nsswitch.conf" "r"} fd] == 0} {
		while {[gets $fd line] >= 0} {
		    if {[regexp {[^[:space:]]*hosts:} "$line"]} {
			set host_order_cache [lrange [regexp -all -inline {[^[:space:]]+} $line] 1 end]
			break
		    }
		}
		close $fd
	    }
	}
	return $host_order_cache
    }

    proc files_match {mode arg var} {
	upvar $var res

	if {[catch {open "/etc/hosts" "r"} fd] == 0} {
	    while {[gets $fd line] >= 0} {
		regsub "#.*" $line "" rec
		if {$rec == ""} {
		    continue
		}
		if {$mode == "-ip"} {
		    if {[lindex $rec 0] == $arg} {
			lappend res {*}[lrange $rec 1 end]
		    }
		} else {
		    if {[lsearch -exact [lrange $rec 1 end] $arg] != -1} {
			lappend res [lindex $rec 0]
		    }
		}
	    }
	    close $fd
	}
    }
    
    proc dns_match {mode arg var} {
	upvar $var res

	if {[catch [list exec host $arg] ans] == 0} {
	    foreach line [split $ans "\n"] {
		if {$mode == "-ip"} {
		    if {[regexp "domain name pointer" $line]} {
			regsub {\.$} [lindex $line 4] "" t
			lappend res $t
		    }
		} else {
		    if {[regexp "has address" $line]} {
			lappend res [lindex $line 3]
		    } elseif {[regexp "has IPv6 address" $line]} {
			lappend res [lindex $line 4]
		    }
		}
	    }
	}
    }

    variable dnscache
    array set dnscache {}

    proc resolve {args} {
	variable dnscache
	
	set mode [lindex $args 0]
	if {$mode == "-host" || $mode == "-ip"} {
	    set arg [lindex $args 1]
	} else {
	    set arg [lindex $args 0]
	    if {[regexp {\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}} $arg]} {
		set mode "-ip"
	    } elseif {[regexp -nocase {(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.in-addr.arpa} $arg o4 o3 o2 o1]} {
		set mode "-ip"
		set arg "$o1.$o2.$o3.$o4"
	    } else {
		set mode "-host"
	    }
	}
	if {[info exists dnscache($mode,$arg)]} {
	    return $dnscache($mode,$arg)
	}
    
	foreach x [hostorder] {
	    set name "${x}_match"
	    if {[info procs "$name"] == "$name"} {
		eval $name $mode $arg res
	    }
	}
	if {![info exist res]} {
	    lappend res $arg
	}
	set dnscache($mode,$arg) $res
	return $res
    }

    proc setname {mode arg val} {
	variable dnscache
	set dnscache($mode,$arg) $val
    }
}

proc hostname {arg} {
    if {[config_option resolve] &&
	[regexp {\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}} $arg]} {
	return [lindex [::pmres::resolve -ip $arg] 0]
    }
    return $arg
}

# #######################################################################
# A parser for GNU-style command line syntax.
# Almost compatible with getopt_long(3), excepting several quirks.
# #######################################################################
namespace eval ::getopt {
    namespace export getopt optarg optind opterr optchar optopt

    variable optarg
    variable optind
    variable opterr 1
    variable optchar
    variable optopt
    
    proc init {} {
	variable optarg
	set optarg ""
	
	variable optind
	set optind 0
	
	variable optchar
	set optchar ""
	
	variable optopt
	set optopt ""
    }

    # getopt [-progname name] [-longopts list] argc argv shortopts script
    proc getopt {args} {
	while 1 {
	    if {[llength args] == 0} {
		error "getopt: bad number of arguments"
	    }
	    switch -- [lindex $args 0] {
		"-longopts" {
		    array set longopts [lindex $args 1]
		    set longnames [lsort [array names longopts]]
		    set args [lreplace $args 0 1]
		}
		"-progname" {
		    set progname "[lindex $args 1]: "
		    set args [lreplace $args 0 1]
		}
		default {
		    break
		}
	    }
	}

	if {![info exists progname]} {
	    set progname ""
	}
	
	if {[llength $args] != 4} {
	    error "getopt: bad number of arguments"
	}
	
	set argc [lindex $args 0]
	set argv [lindex $args 1]
	set shortopts [lindex $args 2]
	set script [lindex $args 3]
	
	variable optarg
	variable optind
	variable opterr
	variable optchar
	variable optopt
    
	for { set optind 0 } { $optind < $argc } { incr optind } {
	    set arg [lindex $argv $optind]
	    set chl [split $arg ""]
	    set j 0
	    set optarg ""

	    if {[lindex $chl 0] != "-"} {
		return 0
	    }
	    set chl [lreplace $chl 0 0]
	    incr j
	    
	    if {[lindex $chl 0] == "-"} {
		set chl [lreplace $chl 0 0]
		incr j
		
		if {[llength $chl] == 0} {
		    incr optind
		    return 0
		}
		if {[info exists longopts]} {
		    set k [string first "=" $arg]
		    if {$k == -1} {
			set name [string range $arg 2 end]
		    } else {
			set name [string range $arg 2 [expr $k - 1]]
		    }

		    set namelen [string length $name]
		    
		    unset -nocomplain found ambig
		    foreach s $longnames {
			if {$s == $name} {
			    set found $s
			    break
			}
			
			if {[string equal -length $namelen $s $name]} {
			    if {[info exists ambig]} {
				puts stderr "${progname}  --$s"
			    } elseif {[info exists found]} {
				if {$opterr} {
				    puts stderr "${progname}ambiguous option $arg; possible candidates:"
				    puts stderr "${progname}  --$found"
				    puts stderr "${progname}  --$s"
				    set ambig 1
				}
				set optchar "?"
				set optopt $arg
				eval $script
				if {!$opterr} {
				    return -1
				}
			    } else {
				set found $s
			    }
			} elseif {[info exists ambig]} {
			    return -1
			}
		    }
		    
		    if {![info exists found]} {
			if {$opterr} {
			    puts stderr "${progname}unknown option '$arg'"
			}
			set optopt $arg
			set optchar "?"
			eval $script
			return -1
		    }
		    
		    set optchar $longopts($found)
		    switch -- $optchar {
			- { set argument 0
			    set optchar $found
			}
			= { set argument 1
			    set optchar $found
			}
			default {
			    set pos [string first $optchar $shortopts]
			    if {$pos == -1} {
				error "longopt $found refers to undeclared short option $optchar"
			    }
			    if {[string index $shortopts [expr $pos + 1]] == ":"} {
				set argument 1
			    } else {
				set argument 0
			    }
			}
		    }
		    if {$argument} {
			# FIXME: Handle optional arguments (::)
			if {$k == -1} {
			    incr optind
			    if {$optind < [llength $argv]} {
				set optarg [lindex $argv $optind]
			    } else {
				if {$opterr} {
				    puts stderr "${progname}option '--$found' requires argument"
				}
				set optopt $optchar
				set optchar "?"
				eval $script
				return -1
			    }
			} else {
			    set optarg [string range $arg [expr $k + 1] end]
			}
		    }
		    eval $script
		} else {
		    if {$opterr} {
			puts stderr "${progname}unknown option '$arg'"
		    }
		    set optopt $arg
		    set optchar "?"
		    eval $script
		    return -1
		}
	    } else {
		foreach optchar $chl {
		    #	    puts "looking for $ch in $shortopts"
		    set pos [string first $optchar $shortopts]
		    if {$pos == -1} {
			if {$opterr} {
			    puts stderr "${progname}unknown option '-$optchar'"
			}
			set optopt $optchar
			set optchar "?"
			eval $script
			return -1
		    }
		    incr j
		    if {[string index $shortopts [expr $pos + 1]] == ":"} {
			# Rest of chars are arguments
			# FIXME: Handle optional arguments (::)
			if {$j < [string length $arg]} {
			    set optarg [string range $arg $j end]
			} else {
			    incr optind
			    if {$optind < [llength $argv]} {
				set optarg [lindex $argv $optind]
			    } else {
				if {$opterr} {
				    puts stderr "${progname}option '-$optchar' requires argument"
				}
				set optopt $optchar
				set optchar "?"
				eval $script
				return -1
			    }
			}
		    }
		    eval $script
		    if {$optarg != ""} {
			break
		    }
		}
	    }
	}
	return 0
    }

    proc getncol {} {
	variable columns
	if {![info exists columns]} {
	    global env
	    if {[info exists env(COLUMNS)]} {
		set columns $env(COLUMNS)
	    } else {
		spawn -noecho stty -a
		expect {
		    # GNU/Linux
		    -re {columns ([[:digit:]]+);} {
			set columns $expect_out(1,string)
		    }
		    # BSD
		    -re {([[:digit:]]+) columns;} {
			set columns $expect_out(1,string)
		    }
		    default {
			set columns 80
		    }
		}
	    }
	}
	return $columns
    }

    # Column in which short options start.
    variable short_opt_col 2
    # Column in which long options start.
    variable long_opt_col 6
    # Column in which option description starts.
    variable opt_doc_col 29
    # Right margin of the text output.
    variable rmargin 76

    proc format_line {text} {
	variable rmargin

	foreach word [split $text " "] {
	    if {![info exists line]} {
		set line $word
	    } elseif {[expr [string length $line] + \
			    [string length $word] + 1] > $rmargin} {
		puts $line
		set line $word
	    } else {
		append line " $word"
	    }
	}
	if {[info exists line] && [string length $line] > 0} {
	    puts $line
	}
    }
    
    proc format_para {text} {
	puts ""
	foreach line [split $text "\n"] {
	    if {[regexp {^[[:space:]]} $line]} {
		if {[info exists acc]} {
		    format_line [regsub -all {[[:space:]]+} $acc " "] 
		    unset acc
		}
		format_line $line
	    } else {
		if {[info exists acc]} {
		    append acc " "
		}
		append acc $line
	    }
	}
	if {[info exists acc]} {
	    format_line [regsub -all {[[:space:]]+} $acc " "] 
	}
    }
    
    proc format_text {text} {
	while {[string length $text] > 0} {
	    if {[regexp {^(.*?)\n\n(.*)$} $text dummy para text]} {
		format_para $para
	    } else {
		format_para $text
		break
	    }
	}
    }

    # Sort alternative versions of the same option
    proc optaltcmp {a b} {
	set la [string length $a]
	set lb [string length $b]
	if {$la > 1 && $lb == 1} {
	    return 1
	}
	return [string compare $a $b]
    }

    proc first_short {optlist retvar} {
	upvar 1 $retvar word
	return [regexp {^-([^-])$} [lindex $optlist 0] dummy word]
    }

    proc first_long {optlist retvar} {
	upvar 1 $retvar word
	foreach opt $optlist {
	    if {[regexp {^--(.+)$} $opt dummy word]} {
		return 1
	    }
	}
	return 0
    }
	    
    proc optlistcmp {a b} {
	set la [lindex $a 0]
	set lb [lindex $b 0]
	first_short $la shorta
	first_short $lb shortb
	first_long $la longa
	first_long $lb longb

	if {![info exists shorta] && ![info exists shortb] \
		&& [info exists longa] && [info exists longb]} {
	    return [string compare -nocase $longa $longb]
	}

	if {![info exists shorta]} {
	    set shorta [string range $longa 0 0]
	}
	if {![info exists shortb]} {
	    set shortb [string range $longb 0 0]
	}
	
	return [string compare -nocase $shorta $shortb]
    }

    proc help {} {
	upvar 2 docdict dict

	variable short_opt_col
	variable long_opt_col
	variable opt_doc_col
	variable rmargin

	puts stdout "usage: $dict(usage)"
	if {[info exists dict(alias)]} {
	    foreach t $dict(alias) {
		puts stdout "   or: [join $t]"
	    }
	}
	if {[info exists dict(docstring)]} {
	    puts stdout $dict(docstring)
	}

	if {[info exists dict(description)]} {
	    format_text $dict(description)
	}
	
	puts ""

	foreach entry $dict(optdoc) {
	    set opt [lindex $entry 0]

	    if {[regexp {^--} [lindex $opt 0]]} {
		set fill $long_opt_col
	    } else {
		set fill $short_opt_col
	    }
	    set line [string repeat { } $fill]
	    append line [lindex $opt 0]
	    foreach x [lreplace $opt 0 0] {
		append line ","
		if {[regexp {^--} $x]} {
		    set l [expr [string length $line] + 1]
		    if {$l < $long_opt_col} {
			append line [string repeat { } \ 
				     [expr $long_opt_col - $l]]
		    }
		}
		append line " $x"
	    }
	
	    # append argument
	    append line [lindex $entry 1]

	    # process description
	    set opt [lindex $entry 2]
	    set l [string length $line]
	    if {$l >= $opt_doc_col} {
		puts $line
		unset line
		set l 0
	    } 
	    append line [string repeat { } [expr $opt_doc_col - $l]]
	    regsub -all "\n" $opt " " opt
	    regsub -all {[[:space:]]+} $opt " " opt
	    foreach word [split $opt " "] {
		if {[expr [string length $line] + \
			 [string length $word] + 1] > $rmargin} {
		    puts $line
		    set line [string repeat { } $opt_doc_col]
		}
		append line " $word"
	    }
	    if {[string length $line] != 0} {
		puts $line
	    }
	}

	if {[info exists dict(footer)]} {
	    format_text $dict(footer)
	}
	exit 0
    }

    proc parse {args} {
#	puts "ARGS [llength $args] $args"
        set group_id {}
        set group_def {} 
	while {[llength $args] > 0} {
	    set arg [lindex $args 0]
	    switch -- $arg {
		-progname {
		    set progname [lindex $args 1]
		    set args [lreplace $args [set args 0] 1]
		}
		-docstring {
		    set docdict(docstring) [lindex $args 1]
		    set args [lreplace $args [set args 0] 1]
		}
		-usage {
		    set docdict(usage) [lindex $args 1]
		    set args [lreplace $args [set args 0] 1]
		}
		-alias {
		    lappend docdict(alias) [lindex $args 1]
		    set args [lreplace $args [set args 0] 1]
		}
		-description {
		    set docdict(description) [lindex $args 1]
		    set args [lreplace $args [set args 0] 1]
		}
		-footer {
		    set docdict(footer) [lindex $args 1]
		    set args [lreplace $args [set args 0] 1]
		}
		-commit {
		    set commit 1
		    set args [lreplace $args [set args 0] 0]
		}
		-group {
		    lappend group_id [lindex $args 1]
		    lappend group_def [lindex $args 2]
		    set args [lreplace $args [set args 0] 2]
		}
		default { break }
	    }
	}

	if {[llength $args] != 2} {
	    return -code error "bad # args"
	}
	
	upvar [lindex $args 0] argc
	upvar [lindex $args 1] argv

	set groupidx -1
	set defidx 0
	set defcnt 0
	
	set parsedict [dict create]
	dict set parsedict group {}

	# Variables:
	#  shortopts - list of short options
	set shortopts "h"
	#  longopts  - list of long options
	set longopts {help h}
	#  docs - list of documentation strings; format:
	#         optlist argname docstr
	#  select - list of code
	while 1 {
	    if {$defidx == $defcnt} {
		incr groupidx
		if {$groupidx >= [llength $group_id]} {
		    break
		}
		set group_name [lindex $group_id $groupidx]
		set defs [lindex $group_def $groupidx]
		set defcnt [llength $defs]
		if {$defcnt == 0} {
		    continue
		}
		dict lappend parsedict id $group_name
#		puts "DEFS $defcnt $defs"
		set defidx 0
	    }

	    unset -nocomplain argname repr optlist
	    set longacc {}

	    set optstr [lindex $defs $defidx]
	    incr defidx
	    
	    set n [string last "=" $optstr]
	    if {$n > 0} {
		set argname [string range $optstr [expr $n + 1] end]
		set optstr [string range $optstr 0 [expr $n - 1]]
	    } 

	    foreach opt [lsort -command optaltcmp [split $optstr ","]] {
		if {[string length $opt] == 1} {
		    lappend optlist "-$opt"
		    if {![info exists repr]} {
			set repr $opt
		    }
		    set shortopts "$shortopts$opt"
		    if {[info exists argname]} {
			set shortopts "$shortopts:"
		    }
		} else {
		    lappend optlist "--$opt"
		    lappend longacc $opt
		}
	    }

	    foreach opt $longacc {
		lappend longopts $opt
		if {[info exists repr]} {
		    lappend longopts $repr
		} else {
		    set repr $opt
		    if {[info exists argname]} {
			lappend longopts "="
		    } else {
			lappend longopts "-"
		    }
		}
	    }

	    set entry [list $optlist]
	    if {[info exists argname]} {
		if {[llength $longacc] > 0} {
		    lappend entry "=$argname"
		} else {
		    lappend entry " $argname"
		}
	    } else {
		lappend entry {}
	    }
	    lappend entry [lindex $defs $defidx]
	    incr defidx
	    
	    lappend docdict(optdoc) $entry
	    set cmd [lindex $defs $defidx]
	    incr defidx
	    lappend select $repr [subst -nocommand {
		upvar 1 parsedict parser
		set lambda {{optchar optarg} {$cmd}}
		if {[dict exists \$parser code $group_name]} {
		    set lst [dict get \$parser code $group_name]
                } else {
                    set lst {}
                }
	        lappend lst [list \$lambda \$optchar \$optarg]
		dict set parser code $group_name \$lst
	    }]
	}
	
	if {[info exists docdict(optdoc)]} {
	    set docdict(optdoc) [lsort -command optlistcmp $docdict(optdoc)]
	}
	lappend docdict(optdoc) {{-h --help} {} {display this help}}
	lappend select h help
	
	# puts "shortopts=$shortopts"
	# puts "longopts=$longopts"
	# puts "docs=$docdict(optdoc)"
        # puts "select=$select"
	# exit

	if {[info exists progname]} {
	    lappend param -progname $progname
	}
	if {[info exists longopts]} {
	    lappend param -longopts $longopts
	}
	lappend param $argc $argv
	lappend param $shortopts

	getopt {*}$param {
	    upvar select select
	    switch -- $optchar {*}$select \
		h parsehelp \
		? { exit 1 } \
		default {
		    return -code error "option should have been recognized: $optchar"
		}
	}

	# puts $parsedict

	variable optind
	set argv [lrange $argv $optind end]
	set argc [expr $argc - $optind]

	if {[info exists commit]} {
	    foreach rl $group_id {
		run $parsedict $rl
	    }
	} else {
	    return $parsedict
	}
    }

    proc run {d id} {
	global config
	if {[dict exists $d code $id]} {
	    #	puts "[llength [dict get $d code $id]]"
	    foreach item [dict get $d code $id] {
		# Each list element is: {lambda optchar optarg}
		# FIXME
		#puts "run [llength $item] $item"
		apply {*}$item
	    }
	}
    }
}
# #######################################################################
# Database access functions
# #######################################################################
# rexdbget [-return VARNAME] [-host HOSTNAME] KEY [KEY...]
#
# Find first of KEYs that is defined in the database and return its value.
# 
# If VARNAME is supplied, return a boolean indicating whether the key was
# found. If found, store the value in the variable VARNAME.  Otherwise,
# don't modify that variable.
#
# Keys are qualified by HOSTNAME (and its IP addresses), and host group
# name.  The most qualified match is preferred, therefore the lookup is
# done in four iterations over each KEY:
#
#   1. HOSTGROUP:HOST:KEY  (for each HOST)
#   2. HOST:KEY            
#   3. HOSTGROUP::KEY        
#   4. KEY

proc rexdbget {args} {
    global rexdb config
    set qlist {}

    debug 3 "rexdbget: $args"
    while {[llength args] > 0} {
	switch -- [lindex $args 0] {
	    "-return" {
		lshift args
		set varname [lshift args]
	    }
	    "-host" {
		lshift args
		set h [lshift args]
		set host $h
		lappend host {*}[::pmres::resolve $h]
	    }
	    default { break }
	}
    }
    lappend keylist {*}$args

    if {[info exist config(option,hostgroup)]} {
	if {[info exist host]} {
	    foreach key $keylist {
		foreach h $host {
		    lappend qlist "$config(option,hostgroup):$h:$key"
		}
	    }
	}
    }
    
    if {[info exist host]} {
	foreach key $keylist {
	    foreach h $host {
		lappend qlist "$h:$key"
	    }
	}
    }

    if {[info exist config(option,hostgroup)]} {
	foreach key $keylist {
	    lappend qlist "$config(option,hostgroup)::$key"
	}	
    }

    lappend qlist {*}$keylist
    debug 3 "db: qlist=$qlist"
    foreach key $qlist {
#	debug 4 "trying key $key"
	if {[info exist rexdb($key)]} {
	    set retval $rexdb($key)
	    debug 3 "db: found $key=$retval"
	    break
	}
    }

    if {[info exists varname]} {
	if {[info exists retval]} {
	    upvar $varname var
	    set var $retval
	    return 1
	} else {
	    return 0
	}
    }
	
    return $retval
}

# rexdbput KEY VALUE [KEY VALUE...]
proc rexdbput {args} {
    global rexdb config

    if {[llength $args] % 2} {
	error "odd number of arguments"
    }

    for {set i 0} {$i < [llength $args]} {} {
	set key [lindex $args $i]
	incr i
	set val [lindex $args $i]
	incr i
	if {[info exist config(option,hostgroup)]} {
	    if {[string first ":" $key] == -1} {
		set key ":$key"
	    }
	    set rexdb($config(option,hostgroup):$key) $val
	} else {
	    set rexdb($key) $val
	}
    }
    set rexdb(updated) 1
}   

# rexdbclr KEY...
proc rexdbclr {args} {
    global rexdb config

    foreach key $args {
	if {[info exist config(option,hostgroup)]} {
            array unset rexdb $config(option,hostgroup):$key
	} 
	array unset rexdb $key
    }
    set rexdb(updated) 1
}   

# #######################################################################
# Debugging and error reporting
# #######################################################################
proc debug {args} {
    global config

    if {[lindex $args 0] <= $config(debug)} {
	puts stderr "DEBUG: [join [lrange $args 1 end]]"
    }
}

proc terror {args} {
    global argv0
    set save 1
    while {[llength $args] > 0} {
	switch -- [lindex $args 0] {
	    -nosave {
		set args [lreplace $args 0 0]
		set save 0
	    }
	    -- {
		set args [lreplace $args 0 0]
		break
	    }
	    default { break }
	}
    }
    
    set msg [join $args]
    if {$save} {
	global errors
	lappend errors $msg
    }
    send_error "$argv0: $msg\n"
}

proc warning {args} {
    if {[config_option verbose]} {
	terror -nosave "warning:" {*}$args
    }
}


# #######################################################################
# Various utility functions.
# #######################################################################

# Compare two version numbers. Return 0 if they are the same, a negative
# value if "a" is older than "b", and a positive value otherwise.
proc vercmp {va vb} {
    foreach a [split $va "."] b [split $vb "."] {
	set n [expr $a - $b]
	if {$n != 0} {
	    return $n
	}
    }
    return 0
}

# The command "stty echo" triggered buffer overflow in expect versions
# prior to 5.44.1.13.  This function works over it.
proc echo {a} {
    switch $a {
	"on"  { set opt "echo" }
	"off" { set opt "-echo" }
	default { error "echo usage error: $a" }
    }
    if {[vercmp [exp_version] "5.44.1.13"] < 0} {
	system stty $opt
    } else {
	stty $opt
    }
}

# tempfile ?options?
#   Creates and opens a temporary file and returns a channel ID for
#   accessing it.
# options:
#   -directory DIR
#      Directory where to create the file.  Defaults to CWD.
#   -template STRING
#      Template for creating the file.  STRING must contain one or more
#      consecutive X characters (at least 6 are recommended, see mktemp(3)),
#      which will be replaced by a string that makes the resulting filename
#      unique.  Default is XXXXXX.
#   -mode MODE
#      File mode (permissions).  Default is 0600
#   -name VARNAME
#      If supplied, the name of the created file will be stored in the
#      variable VARNAME.
#   -alphabet STRING
#      Characters to use when creating a unique string from the template.
#
proc tempfile {args} {
    array set opt {
	-alphabet 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz
	-template XXXXXX
	-mode 0600
    }
    for {set i 0} {$i < [llength $args]} {incr i} {
	set o [lindex $args $i]
	switch -regexp -- $o {
	    {^-(directory|mode|name|template|alphabet)$} {
		if {[incr i] == [llength $args]} {
		    return -code error "$opt requires argument"
		}
		set opt($o) [lindex $args $i]
	    }
	    default {
		return -code error "unknown option $opt"
	    }
	}
    }

    if {[info exist opt(-name)]} {
	upvar $opt(-name) filename
    }
		
    set alphabet_len [string length $opt(-alphabet)]
    
    if {[info exist opt(-directory)]} {
	if {![file exists $opt(-directory)]} {
	    return -code error "$opt(-directory) does not exist"
	} elseif {![file isdirectory $opt(-directory)]} {
	    return -code error "$opt(-directory) is not a directory"
	}
	set template [file join $opt(-directory) $opt(-template)]
    } else {
	set template $opt(-template)
    }
    
    if {![regexp -- {^(.*?)(X+)(.*)$} $template x prefix xstr suffix]} {
	return -code error "invalid template: $template"
    }

    set uniqlen [string length $xstr]
    for {set i 0} {$i < $uniqlen} {incr i} {
	lappend uniqind [expr {int(rand() * $alphabet_len)}]
    }

    set initial $uniqind
    
    while 1 {
	set unique {}

	for {set i 0} {$i < $uniqlen} {incr i} {
	    lappend unique [string index $opt(-alphabet) [lindex $uniqind $i]]
	}
	set filename "$prefix[join $unique {}]$suffix"
#	puts "TRY $filename"
	if {[catch {open $filename {RDWR CREAT EXCL} 0600} result options]} {
	    set errorcode [dict get $options -errorcode]
	    if {!{[string equal [lindex $errorcode 0] "POSIX"] &&
		[string equal [lindex $errorcode 1] "EEXIST"]}} {
		return -options $options $result
	    }
	} else {
	    file attributes $filename -permissions $opt(-mode)
	    return $result
	}

	set i $uniqlen
	while 1 {
	    incr i -1
	    set n [expr ([lindex $uniqind $i] + 1) % $alphabet_len]
	    lset uniqind $i $n
	    if {$n != [lindex $initial $i]} {
		break
	    } elseif {$i == 0} {
		return -code error "can't create unique file name: all alternatives exhausted"
	    }
	}
    }
}

proc maketempfile {namevar} {
    global cleanup_files
    upvar $namevar name
    if {[catch {tempfile -name name -directory /tmp -template "rex.XXXXXX"} fd]} {
	terror "can't create temporary file: $fd"
	exit 2
    }
    lappend cleanup_files $name
    return $fd
}

proc forgettempfile {file} {
    global cleanup_files
    if {[info exist cleanup_files]} {
	set n [lsearch $cleanup_files $file]
	if {$n != -1} {
	    set cleanup_files [lreplace $cleanup_files $n $n]
	}
    }
}

# Print program version and copyleft info.
proc prversion {} {
    global version
    
    puts "rex $version"
    puts {Copyright (C) 2012-2022 Sergey Poznyakoff
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>.
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
}
    exit 0
}

# getans [-echo] WORDS...
# Concat WORDS into a prompt, display it, read the user's input from stdin
# and return it.  The -echo option turns echo off (for inputting passwords).
proc getans {args} {
    if {[lindex $args 0] == "-echo"} {
	set noecho 1
	set args [lreplace $args 0 0]
    } else {
	set noecho 0
    }
    puts -nonewline [join $args]
    puts -nonewline " "
    flush stdout
    if {$noecho} {
        echo off
    }
    set retval [gets stdin]
    if {$noecho} {
        echo on
        puts ""
    }
    return $retval
}

# getyn WORDS
# Same as getans, but restrict user input to Y, N, and <CR>.  Return true
# if the user replied Y (or <CR>), and false otherwise.
proc getyn {args} {
    lappend args { [Y/n]?}
    switch -glob [string trimleft [getans {*}$args] " \t"] {
	"[yY]*" - 
	""        { return 1 }
	default   { return 0 }
    }
}

# #######################################################################
# Program-specific database functions.
# #######################################################################

# Encrypt password
proc passenc {pass} {
    binary scan [encoding convertto ebcdic $pass] H* enc
    return $enc
}

# Decrypt password
proc passdec {code} {
    encoding convertfrom ebcdic [binary format H* $code]
}

proc ispasswd {key} {
    if {$key == "pass" ||
            ([string last ":pass" $key] > 0 &&
             [string last ":pass" $key] == [expr [string length $key] - 5])} {
	return 1
    } else {
	return 0
    }
}

# Read rex database FILE into VAR
proc readdb {file var} {
    upvar $var x

    debug 2 reading database file $file
    set fd [open $file "r"]
    set lnum 0
    while {[gets $fd line] >= 0} {
	incr lnum
	regsub {[ \t]*#.*} [string trimright $line] "" line
        if {[regexp {([^[:space:]]+)[[:space:]]+(.*)} "$line" dummy key val]} {
	    set x($key) $val
	}
    }
    close $fd
}

# Auxiliary function to compare two keys
proc keycmp {a b} {
    foreach ka [split $a ":"] kb [split $b ":"] {
	set x [string compare $ka $kb]
	if {$x != 0} {
	    return $x
	}
    }
    return 0
}

# Write rex database from variable VAR into FILE.
proc writedb {file var} {
    upvar $var x

    debug 2 writing database file $file
    set fd [maketempfile tempname]
    foreach key [lsort -command keycmp [array names x]] {
	puts $fd "$key $x($key)"
    }
    close $fd
    file rename -force $tempname $file
    forgettempfile $tempname
}

# Update rexdb if it has been modified.
proc updatedb {} {
    global rexdb confpath

    if {[info exists rexdb(updated)]} {
        debug 1 "storing database modifications"
        array unset rexdb updated
        writedb "[lindex $confpath 0]/db" rexdb
    }
}

# Prepare a temporary "database view" file.
#  dbname   - name of the original file
#  dbvar    - array variable to get key/value pairs from.
proc mkdbview {dbname dbvar} {
    upvar $dbvar db
    set fd [maketempfile tempname]
    puts $fd "# You are editing file $dbname"
    puts $fd [format "# %-30.30s\t%s" "Key" "Value"]
    foreach key [lsort -command keycmp [array names db]] {
	if {[ispasswd $key]} {
	    puts $fd [format "%-32.32s\t%s" $key [passdec $db($key)]]
	} else {
	    puts $fd [format "%-32.32s\t%s" $key $db($key)]
	}
    }
    close $fd
    return $tempname
}    

# Save modified dbview from tempfile into outfile
proc svdbview {tempfile outfile} {
    array set x {}
    readdb $tempfile x
    foreach key [array names x] {
        if {[ispasswd $key]} {
	    set x($key) [passenc $x($key)]
	}
    }
    writedb $outfile x
}

# Ask user about his further intentions.
proc whatnow {} {
    while true {
	set reply [getans {What now ([s]ave, [q]uit, [e]dit again)?}]
	switch -nocase $reply {
	    s -
	    sa -
	    sav -
	    save  { return "s" }
	    q -
	    qu -
	    qui -
	    quit  { return "q" }
	    e -
	    ed -
	    edi -
	    edit  { return "e" }
	}
    }
}

proc dbchanged {filename var} {
    global env
    upvar $var olddb

    readdb $filename newdb
    foreach newkey [lsort -command keycmp [array names newdb]] \
	    oldkey [lsort -command keycmp [array names olddb]] {
	if {$oldkey != $newkey} {
	    return 1
	}
	if {[ispasswd $newkey]} {
	    set newdb($newkey) [passenc $newdb($newkey)]
	}

	if {$olddb($newkey) != $newdb($newkey)} {
	    return 1
	}
    }
    return 0
}

# Edit database file dbname.  The file is formatted in a more or less
# human-readable way, stored in a temporary file and an editor is started
# on that file. 
proc editdb {dbname} {
    global env

    array set rexdb {}

    if {[file exists $dbname]} {
	readdb $dbname rexdb
    }
    
    if {[info exist env(VISUAL)]} {
	set ed $env(VISUAL)
    } elseif {[info exist env(EDITOR)]} {
	set ed $env(EDITOR)
    } else {
	set ed "vi"
    }

    set tempname [mkdbview $dbname rexdb]
    
    while 1 {
	exec $ed $tempname <@stdin >@stdout 2>@stderr
	if {![dbchanged $tempname rexdb]} {
	    break
	}

	switch [whatnow] {
	    e continue
	    q break
	    s {
		svdbview $tempname $dbname
		break
	    }
	}
    }
}

# Return user name for the given host.
proc hostuser {host} {
    global config
    global env

    if {[rexdbget -return val -host $host user]} {
	return $val
    }
    
    if {[config_option interactive]} {
	set x [getans "Username on [hostname $host]:"]
	if {$x == ""} {
	    set x [getans "Default username:"]
	    if { $x == "" } {
		exit 0
	    }
	    rexdbput user $x
	    return $x
	} else {
	    rexdbput "$host:user" $x
	    return $x
	}
    }

    if {![info exists config(user)]} {
	if {![info exists env(USER)]} {
	    error "no default username (looking for $host:user)"
	}
	set config(user) $env(USER)
	debug 1 "assuming user $config(user)"
    }
    return $config(user)
}

# Return user password for the given host
proc hostpass {host} {
    global rexdb config

    if {[rexdbget -return val -host $host pass]} {
	return [passdec $val]
    }
    
    if {[config_option interactive]} {
	set x [getans -echo "Password on [hostname $host]:"]
	if {$x == ""} {
	    set x [getans -echo "Default password:"]
	    if { $x == "" } {
		return -code error "No password for $host"
	    }
	    rexdbput pass [passenc $x]
	    return $x
	} else {
	    rexdbput "$host:pass" [passenc $x]
	    return $x
	}
    }

    if {[info exist config(pass)]} {
	return [passdec $config(pass)]
    }
    return -code error "No password for $host"
}

# add_host_key_list JOB SID KEY CONFVAL
proc add_host_key_list {batchvar sid key confval} {
    global config
    upvar $batchvar batch
    
    if {[rexdbget -return val -host [job get $batch $sid host] $key]} {
	if {[catch {job lappend batch $sid $key {*}$val} result options]} {
            if {[config_option tcl-trace]} {
                return -code error -options $options
            }
            terror "failed to save value: $key=$val: $result"
            terror "value obtained from rexdb for host [job get $batch $sid host]"
        }
	return
    }
    if {[info exist config($confval)]} {
	if {[catch {job lappend batch $sid $key {*}$config($confval)} result options]} {
            if {[config_option tcl-trace]} {
                return -code error -options $options
            }
            terror "failed to save value: $key=$val: $result"
            terror "value obtained from rc"
        }
    }
}

namespace eval ::description {
    proc get {group} {
	set filename "$group/description"
	if {[file exists $filename]} {
	    catch {
		set fd [open $filename "r"]
		gets $fd retval
	    }
	}

	if {![info exists retval]} {
	    set filename "$group/rc"
	    catch {
		source $filename
		set retval $description
	    }
	}
	if {[info exists retval]} {
	    return $retval
	}
    }
}

proc groupcomp {a b} {
    string compare [lindex $a 1] [lindex $b 1]
}

# List available host groups.
proc listgroups {} {
    global confpath argv0
    set first 1
    
    foreach dir $confpath {
	foreach file [glob -nocomplain -directory "$dir/hostgroup" -types f "*/rc"] {
	    set dir [file dirname $file]
	    lappend grouplist [list [file tail $dir] $dir]
	}
    }

    if {![info exists grouplist]} {
	puts "$argv0: no hostgroups defined"
	return
    }
    
    foreach grp [lsort -command groupcomp $grouplist] {
	if {$first} {
	    puts "$argv0: use '$argv0 -g GROUP' to select a host group."
	    puts "$argv0: available host groups are:"
	    set first 0
	}
	puts [format "%-16.16s %s" \
		  [lindex $grp 0] \
		  [::description::get [lindex $grp 1]]]
    }
}

proc argcvshift {} {
    global argc
    global argv
    
    if {$argc == 0} {
	error "out of argv"
    }
    incr argc -1
    return [lshift argv]
}

# #######################################################################
# The 'job' ensemble provides functions for keeping track of the created
# ssh/scp jobs.
# #######################################################################

namespace eval ::job {
    namespace ensemble create \
	-subcommands {create count
	              register deregister registered sidlist
	              set get
	              lappend lshift
	              exists unset
	              transition set_trans_hook
	              start close id} \
	-map [dict create set setval get getval lappend list_append] 

    # Creates a new job batch
    proc create {} {
	return [dict create]
    }

    # Returns the number of active jobs
    proc count {batch} {
	if {[dict exist $batch spawn_id]} {
	    dict size [dict get $batch spawn_id]
	} else {
	    return 0
	}
    }

    # Registers a new job in batchVar (name of a variable that must have
    # been created by a call to [job create]).  Parameters are:
    #  sid   - spawn ID of the job
    #  host  - host it is running on
    #  cmd   - command that is to be run
    proc register {batchVar sid host cmd} {
	upvar $batchVar batch
	dict set batch spawn_id $sid host $host
	dict set batch spawn_id $sid cmd $cmd
	dict set batch spawn_id $sid hostname [::hostname $host]
	transition batch $sid INIT
    }

    # Deregisters (removes) the job with the given SID (spawn ID)
    proc deregister {batchVar sid} {
	upvar $batchVar batch
	dict unset batch spawn_id $sid
    }

    # Returns true if the gven SID is registered as a job in this batch
    proc registered {batch sid} {
	dict exists $batch spawn_id $sid
    }

    # start batchVar host command args...
    # Starts the command on host and registers it as a new job in batchVar
    proc start {args} {
	upvar [lindex $args 0] batch
	set host [lindex $args 1]
	set cmd [lrange $args 2 end]
	spawn -noecho {*}$cmd
	register batch $spawn_id $host [join $cmd]
	return $spawn_id
    }

    # Returns a list if spawn IDs of all jobs registered in batch
    proc sidlist {batch} {
	dict keys [dict get $batch spawn_id] "*"
    }

    # Sets the given key for the SID
    proc setval {batchVar sid key value} {
	upvar $batchVar batch
	if {[registered $batch $sid]} {
	    dict set batch spawn_id $sid $key $value
	} else {
	    return -code error "no such spawn_id in job: $sid"
	}
    }

    # Looks up the key in the records for SID.
    proc getval {batch sid key} {
	if {![registered $batch $sid]} {
	    return -code error "no such spawn_id in job: $sid"
	}

	dict get $batch spawn_id $sid $key
    }

    # job lappend batchVar SID KEY VALUE ?VALUE...?
    # Appends values to the SID KEY's record.
    proc list_append {args} {
	if {[llength $args] < 4} {
	    return -code error "bad # args"
	}
	upvar [lindex $args 0] batch
	set sid [lindex $args 1]

	if {![registered $batch $sid]} {
	    return -code error "no such spawn_id in job: $sid"
	}
	
	set key [lindex $args 2]
	if {[exists $batch $sid $key]} {
	    set lst [getval $batch $sid $key]
	}
	lappend lst {*}[lrange $args 3 end]
	setval batch $sid $key $lst
    }

    # job lshift batchVar SID KEY
    # Returns the first element of the list identified by SID and KEY in
    # batchVar, and removes it from the list.
    proc lshift {batchVar sid key} {
	upvar $batchVar batch
	if {![registered $batch $sid]} {
	    return -code error "no such spawn_id in job: $sid"
	}
	set lst [getval $batch $sid $key]
	set retval [lindex $lst 0]
	set lst [lreplace $lst 0 0]
	if {[llength $lst] > 0} {
	    setval batch $sid $key $lst
	} else {
	    unset batch $sid $key
	}
	return $retval
    }

    # Returns true if batch contains entry for (SID,KEY)
    proc exists {batch sid key} {
	if {![registered $batch $sid]} {
	    return -code error "no such spawn_id in job: $sid"
	}
	dict exists $batch spawn_id $sid $key
    }

    # Unsets the (SID,KEY)
    proc unset {batchVar sid key} {
	upvar $batchVar batch
	if {![registered $batch $sid]} {
	    return -code error "no such spawn_id in job: $sid"
	}
	dict unset batch spawn_id $sid $key
    }

    # Switches the internal state of SID to STATE.
    proc transition {batchVar sid state} {
	upvar $batchVar batch
	if {[exists $batch $sid state]} {
	    ::debug 2 "[id $batch $sid]: transition [getval $batch $sid state] => $state"
	} else {
	    ::debug 2 "[id $batch $sid]: setting state $state"
	}
	setval batch $sid state $state
	if {[dict exists $batch transition]} {
	    eval [dict get $batch transition] [getval $batch $sid host] $state
	}
    }

    # Returns a unique identifier for the spawn_id
    proc id {batch sid} {
	getval $batch $sid hostname
    }

    # Sets transition hook proc.  PROCNAME will be called each time a SID
    # changes state.  
    proc set_trans_hook {batchVar procname} {
	upvar $batchVar batch
	dict set batch transition $procname
    }

    # Close spawn ID SID and run the necessary housekeeping.
    proc close {batchVar sid} {
	upvar $batchVar batch
	
	catch {
	    close -i $sid
	}
	transition batch $sid CLOSED
	deregister batch $sid
    }
}    

# #######################################################################
# Copying to and from remote hosts and running remote commands
# #######################################################################
proc runcp {args} {
    global config argv0 ssh_options

    set hosts [lindex $args 0]
    set cmd_stub [lrange $args 1 end-1]

    debug 2 "copying: \"$cmd_stub\" to $hosts"

    log_user [config_option log] 

    set batch [job create]
    foreach host $hosts {
	set cmd $cmd_stub
	lappend cmd [hostuser $host]@$host:[lindex $args end]
	job start batch $host scp {*}$ssh_options {*}$cmd
    }

    while {[job count $batch] > 0} {
	expect {
            -i [job sidlist $batch]

	    -re {^Authenticated to} {
		set sid $expect_out(spawn_id)
		job transition batch $sid AUTHENTICATED
	    }

	    -re {assword:|assword for .*:} {
		set sid $expect_out(spawn_id)
		set host [job get $batch $sid host]
		debug 3 "[job id $batch $sid]: prompted for password in state [job get $batch $sid state]"
		switch -- [job get $batch $sid state] {
		    {INIT} {
			if {[catch {hostpass $host} result] == 0} {
			    send -i $sid "$result\r"
			    job transition batch $sid PASS_SENT
			} else {
			    terror "[job id $batch $sid]: requires password, but none is given"
			    job close batch $sid
			}
		    }   
		    {PASS_SENT} {
			terror "bad password for user [hostuser $host] on [job id $batch $sid]"
			job close batch $sid
		    }
		    default {
			terror "unexpected password prompt from [job id $batch $sid] in state [job get $batch $sid state]"
			job close batch $sid
		    }
		}
	    }

	    -re {^[^\n]*\n} {
		set sid $expect_out(spawn_id)
		set text [regsub -all {[\r\n]} $expect_out(0,string) {}]
		if {[job get $batch $sid state] == "INIT"} {
		    terror -nosave "[job id $batch $sid]: $text"
		} elseif {[regexp {^scp: (.*)$} $text x msg]} {
		    terror "[job id $batch $sid]: $msg"
		}
	    }
	    
	    denied {
		set sid $expect_out(spawn_id)
		set host [job get $batch $sid host]
		terror "[hostuser $host]@[job get $batch $sid hostname]: $expect_out(buffer)"
		job close batch $sid
		continue
	    }
	    
	    timeout {
		expect -i [job sidlist $batch] *
		set sid $expect_out(spawn_id)
	        terror "connection to [job get $batch $sid hostname] timed out"
		job close batch $sid
	    }
	    
	    eof {
		set sid $expect_out(spawn_id)
		set host [job get $batch $sid host]
		set hostname [job get $batch $sid hostname]
		set state [job get $batch $sid state]
		job close batch $sid
		set res [wait -i $sid]
		if {[lindex $res 2] == -1} {
		    terror "$hostname: operating system error: [lindex $res 3]"
		} elseif {[lindex $res 3] != 0} {
		    terror "$hostname: copy failed: cp exit status [lindex $res 3]"
		} elseif {$state != "AUTHENTICATED"} {
		    terror "$hostname: copy failed (in state $state)"
		}
	    }
        }
    }
}

proc runcprev {args} {
    global config argv0 ssh_options

    set host [lindex $args 0] 
    set source [lindex $args 1]
    if {[llength $args] == 3} {
	set dest [lindex $args 2]
    } else {
	set dest $source
    }

    log_user [config_option log] 

    set batch [job create]
    set spawn_id [job start batch $host scp {*}$ssh_options [hostuser $host]@$host:$source $dest]

    while {[job count $batch] > 0} {
	expect {
            -i [job sidlist $batch]
    
	    -re {^Authenticated to} {
		job transition batch $spawn_id AUTHENTICATED
	    }
	    
	    -re {assword:|assword for .*:} {
		debug 3 "[job id $batch $spawn_id]: prompted for password in state [job get $batch $spawn_id state]"
		switch -- [job get $batch $spawn_id state] {
		    {INIT} {
			if {[catch {hostpass $host} result] == 0} {
			    send "$result\r"
			    job transition batch $spawn_id PASS_SENT
			} else {
			    terror "[job id $batch $spawn_id]: requires password, but none is given"
			    job close batch $spawn_id
			}
		    }   
		    {PASS_SENT} {
			terror "bad password for user [hostuser $host] on [job get $batch $spawn_id hostname]"
			job close batch $spawn_id
		    }
		    default {
			terror "unexpected password prompt from [job get $batch $spawn_id hostname] in state [job get $batch $spawn_id state]"
			job close batch $spawn_id
		    }
		}
	    }

	    -re {^[^\n]*\n} {
		set text [regsub -all {[\r\n]} $expect_out(0,string) {}]
		if {[job get $batch $spawn_id state] == "INIT"} {
		    terror -nosave "[job id $batch $spawn_id]: $text"
		} elseif {[regexp {^scp: (.*)$} $text x msg]} {
		    terror "[job id $batch $spawn_id]: $msg"
		}
	    }

	    denied {
		terror "[hostuser $host]@[job get $batch $spawn_id hostname]: $expect_out(buffer)"
		job close batch $spawn_id
	    }

	    timeout {
		terror "connection to [job get $batch $spawn_id hostname] timed out"
		job close batch $spawn_id
	    }

	    eof {
		set hostname [job get $batch $spawn_id hostname]
		set state [job get $batch $spawn_id state]
		job close batch $spawn_id
		set res [wait -i $spawn_id]
		if {[lindex $res 2] == -1} {
		    terror "$hostname: operating system error: [lindex $res 3]"
		    return 1
		} elseif {[lindex $res 3] != 0} {
		    terror "$hostname: copy failed: cp exit status [lindex $res 3]"
		    return 1
		} elseif {$state != "AUTHENTICATED"} {
		    terror "$hostname: copy failed (in state $state)"
		    return 1
		}
	    }
	}
    }
    return 0
}

proc lshift listVar {
    upvar 1 $listVar l
    set r [lindex $l 0]
    set l [lreplace $l [set l 0] 0]
    return $r
}

proc runcmd {hosts command} {
    global config ssh_options
    
    debug 2 "running $command on $hosts"

    log_user [config_option log]
    set batch [job create]
    job set_trans_hook batch ::hostproc::transition
    
    foreach host $hosts {
	set sid [job start batch $host ssh {*}$ssh_options [hostuser $host]@$host]
	job set batch $sid zsh-quirk [config_option zsh-quirk]
	add_host_key_list batch $sid earlycmd earlycmd
	job lappend batch $sid cmdlist "stty -echo"
	add_host_key_list batch $sid cmdlist shrc
	if {[info exists config(data)]} {
	    job lappend batch $sid cmdlist \
		{set -e} \
		{umask 077} \
		{REXDIR=/tmp/.rexwd.$$} \
		{mkdir $REXDIR} \
		{cd $REXDIR} \
		{echo REXDIR=$REXDIR} \
		{set +e}
	}
    }

    while {[job count $batch] > 0} {
	expect {
	    -i [job sidlist $batch]
	
	    -re {^Authenticated to} {
		set sid $expect_out(spawn_id)
		switch -- [job get $batch $sid state] {
		    {COPY_INIT} -
		    {COPY_PASS_SENT} {
			job transition batch $sid COPY
		    }
		    {default} {
			job transition batch $sid AUTHENTICATED
			while {[job exists $batch $sid earlycmd]} {
			    set cmd [job lshift batch $sid earlycmd]
			    debug 3 "[job id $batch $sid]: sending early $cmd"
			    send -i $sid "$cmd\r"
			}
		    }
		}
	    }
	    -re {assword:|assword for .*:} {
		set sid $expect_out(spawn_id)
		set host [job get $batch $sid host]
		debug 3 "[job id $batch $sid]: prompted for password in state [job get $batch $sid state]"
		switch -- [job get $batch $sid state] {
		    {INIT} {
			if {[catch {hostpass $host} result] == 0} {
			    send -i $sid "$result\r"
			    job transition batch $sid PASS_SENT
			} else {
			    terror "[job id $batch $sid]: requires password, but none is given"
			    job close batch $sid
			}
		    }
		    {COPY_INIT} {
			if {[catch {hostpass $host} result] == 0} {
			    send -i $sid "$result\r"
			    job transition batch $sid COPY_PASS_SENT
			}
		    }
		    {COMMAND} {
			if {$config(sudo) != ""} {
			    if {[catch {hostpass $host} result] == 0} {
				send -i $sid "$result\r"
				job transition batch $sid SUDO
			    } else {
				terror "[job id $batch $sid]: sudo requires password, but none is given"
				job close batch $sid
			    }			    
			} else {
			    # FIXME
			    job close batch $sid
			}
		    }
		    {SUDO2} {
			if {[catch {hostpass $host} result] == 0} {
			    send -i $sid "$result\r"
			    job transition batch $sid CLEANUP
			    exp_continue
			} else {
			    terror "[job id $batch $sid]: requires password for cleanup, but none is given"
			    job close batch $sid
			}
		    }
		    default {
			# FIXME
			terror "unexpected password prompt from [job get $batch $sid hostname] in state [job get $batch $sid state]"
			job close batch $sid
		    }
		}
	    }
	    
	    -re {^[^\n]*\n} {
		set sid $expect_out(spawn_id)
		switch -- [job get $batch $sid state] {
		    {INIT} {
			set text [regsub -all {[\r\n]} $expect_out(0,string) {}]
			terror -nosave "ssh [job id $batch $sid]: $text"
		    }
		    {COMMAND} -
		    {SUDO} {
			set host [job get $batch $sid host]
			set text [regsub -all {\r} $expect_out(0,string) {}]

			if {[config_option buffer-output]} {
			    lappend output($host) $text
			}
		    
			::hostproc::getline $host $text
		    }
		    {STATUS} {
			if {[regexp -- {([0-9]+)\r} $expect_out(0,string) x status]} {
			    job set batch $sid status $status
			}
		    }
		    {STTY} {
			if {[regexp -- {REXDIR=(.+)\r} $expect_out(0,string) x dir]} {
			    job set batch $sid wd $dir
			}
		    }
		}
	    }
	    
	    -re $config(prompt) {
		set sid $expect_out(spawn_id)
		set host [job get $batch $sid host]
		debug 3 "[job id $batch $sid]: prompt seen in state [job get $batch $sid state]"
		switch -- [job get $batch $sid state] {
		    {AUTHENTICATED} {
			set cmd [job lshift batch $sid cmdlist]
			debug 3 "[job id $batch $sid]: sending $cmd"
			send -i $sid "$cmd\r"
			job transition batch $sid STTY
		    }
		    {STTY} {
			if {[job exists $batch $sid cmdlist]} {
			    set cmd [job lshift batch $sid cmdlist]
			    debug 3 "[job id $batch $sid]: sending $cmd"
			    send -i $sid "$cmd\r"
			} elseif {[info exists config(data)]} {
			    set host [job get $batch $sid host]
			    set cmd $config(data)
			    lappend cmd "[hostuser $host]@$host:[job get $batch $sid wd]"
			    debug 3 "[job id $batch $sid]: starting scp $cmd"
			    set subsid [job start batch $host scp {*}$ssh_options {*}$cmd]
			    job transition batch $subsid COPY_INIT
			    job set batch $subsid master $sid
			} else {
			    debug 3 "[job id $batch $sid]: sending $command"
			    send -i $sid "$command\r"
			    job transition batch $sid COMMAND
			}
		    }
		    {COMMAND} {
			send -i $sid "echo $?\r"
			job transition batch $sid STATUS
		    }
		    {STATUS} {
			if {[job exists $batch $sid wd]} {
			    set host [job get $batch $sid host]
			    debug 3 "[job id $batch $sid]: removing $host:[job get $batch $sid wd]"
			    send -i $sid "$config(sudo)rm -f -r [job get $batch $sid wd]\r"
			    if {$config(sudo) != ""} {
				job transition batch $sid SUDO2
			    } else {
				job transition batch $sid CLEANUP
			    }
			} else {
			    send -i $sid "exit\r"
			    job transition batch $sid LOGOUT
			}
		    }
		    default {
			send -i $sid "exit\r"
			job transition batch $sid LOGOUT
		    }
		}
	    }

	    timeout {
		expect -i [job sidlist $batch] *
		set sid $expect_out(spawn_id)
		if {[job get $batch $sid state] == "AUTHENTICATED"} {
		    if {[job get $batch $sid zsh-quirk]} {
			debug 1 "[job id $batch $sid]: timed out waiting for prompt; retrying in zsh-quirk mode"
			send -i $sid "unsetopt ZLE\r"
			send -i $sid "PS1='$ '\r"
			job unset batch $sid zsh-quirk
			exp_continue
		    } else {
			terror "timed out waiting for prompt from [job get $batch $sid hostname]"
		    }
		} else {
		    terror "connection to [job get $batch $sid hostname] timed out"
		}
		job close batch $sid
	    }

	    denied {
		set sid $expect_out(spawn_id)
		terror "bad password for [hostuser $host] on [job get $batch $sid hostname]"
		job close batch $sid
	    }

	    eof {
		set sid $expect_out(spawn_id)
		switch -- [job get $batch $sid state] {
		    {LOGOUT} {
			set hostname [job get $batch $sid hostname]
			debug 2 "EOF from $hostname, waiting for $sid"
			set res [job get $batch $sid status]
			job close batch $sid
			wait -i $sid

			::hostproc::finish $hostname output($host) $res
		    }
		    {COPY} {
			debug 3 "[job get $batch $sid cmd] finished"
			set master [job get $batch $sid master]
			debug 3 "sending $command to [job get $batch $master hostname]"
			send -i $master "$command\r"
			job transition batch $master COMMAND

			job close batch $sid
			wait -i $sid
		    }

		    default {
			terror "connection to [job get $batch $sid hostname] failed: $expect_out(buffer) [job get $batch $sid state]"
			job close batch $sid
		    }
		}
	    }
	}
    }
    debug 2 "finished $command on $hosts"
}    

proc setsudo {args} {
    if {[llength $args] == 0 || [lindex $args 0] != 0} {
	set ::config(sudo) "sudo "
    } else {
	set ::config(sudo) ""
    }
}

# The hostproc namespace provides functions for processing output
# from hosts.
namespace eval ::hostproc {
    proc load {name} {
	source $name
    }
    
    # A prologue function. Called before processing the first batch of hosts.
    proc prologue {} {}
    
    # Epilogue function is called when all hosts have been processed.
    proc epilogue {} {}

    proc transition {host state} {
	if {$state == "COMMAND" &&\
            ![config_option no-host-header] &&\
            ![config_option buffer-output]} {
	    puts "[hostname $host]:"
	}
    }
    
    # Getline is invoked when next line of output has been received from the
    # host.  The default implementation provides basic output capability.
    proc getline {host line} {
	if {[config_option buffer-output]} {
	    return
	}
	
	if {[config_option prefix]} {
	    puts -nonewline "[hostname $host]> "
	}
	puts -nonewline $line
    }

    proc logout {host ref status} {}
    
    # The finish function is called when EOF has been received from a host.
    # The REF argument is the name of the variable which, if exists, contains
    # full text received from the host.
    # STATUS is the return status as received from wait.
    proc finish {host ref status} {
	upvar $ref text
	logout $host $ref $status
	if {[info exists text]} {
	    if {![config_option no-host-header]} {
		puts "$host:"
	    }
	    foreach line $text {
		if {[config_option prefix]} {
		    puts -nonewline "$host> "
		}
		puts -nonewline $line
	    }
	}
    }
}

# #######################################################################
#
# #######################################################################
namespace eval ::config {
    variable initialized 0
    variable cfgvars {sudo hosts user password command}
    variable update_hint
    variable hostgroup_stack
    array set update_hint {
	hosts {var { return "host $var" }}
	sudo  {var { if {$var} {
	                 return "sudo on"
	             } else {
			 return "sudo off"
		     }
	}}
	user  {var { return "user $var" }}
	password {var { return "password $var" }}
    }
    
    proc host {args} {
	variable hostlist
	lappend hostlist {*}$args
    }

    proc hostname {ip name} {
	::pmres::setname -ip $ip $name
    }

    proc ifmode {args} {
	switch -- $::config(mode) {*}$args
    }
    
    proc locus {{dfl {}}} {
	variable source_file
	set locus $dfl
	if {[info exists source_file]} {
	    for {set i 1} {$i <= [info level]} {incr i} {
		set frame [info frame [expr - $i]]
		# if {[dict get $frame type] == "source"} {
		#     puts "$i: [dict get $frame file]:[dict get $frame line]"
		# }
		
		if {[dict get $frame type] == "source" &&
		    [dict get $frame file] == $source_file} {
		    set locus "[dict get $frame file]:[dict get $frame line]"
		    break
		}
	    }
	}
	return $locus
    }
    
    proc option {args} {
	option_set [lindex $args 0] [lrange $args 1 end] [locus [lindex $args 0]]
    }

    proc timeout {args} {
	switch -- [llength $args] {
	    0 { return $::timeout }
	    1 { set ::timeout $args }
	    default {		
		terror "[locus timeout]: usage: timeout ?value?"
	    }
	}
    }

    proc environ {args} {
	global env
	set mode set
	foreach a $args {
	    switch -- $mode {
		{set} {
		    switch -regexp -matchvar match -- $a {
			{^-set$} {}
			{^-unset$} {
			    set mode unset
			}
			{^(.+?)=(.*)$} {
			    set env([lindex $match 1]) [lindex $match 2]
			}
			default {
			    terror "[locus environ]: that doesn't look like a variable assignment: $a"
			}
		    }
		}
		{unset} {
		    switch -- $a {
			{-set} {
			    set mode set
			}
			{-unset} {}
			default {
			    unset -nocomplain env($a)
			}
		    }
		} 
	    }
	}
    }

    # set_config_list NAME [-clear] list
    proc set_config_list {name arglist} {
	global config

	if {[llength $arglist] == 0} {
	    terror "[locus $name]: usage: $name ?-clear? list"
	    return
	}

	if {[lindex $arglist 1] == "-clear" || [lindex $arglist 1] == "-i"} {
	    unset -nocomplain config($name)
	    set arglist [lrange $arglist 1 end]
	}
		
	if {[llength $arglist] > 0} {
	    lappend config($name) {*}$arglist
	}
    }

    # earlycmd [-clear] list
    proc earlycmd {args} {
	set_config_list earlycmd $args
    }
    # shrc [-clear] list
    proc shrc {args} {
	set_config_list shrc $args
    }
    proc run-commands {args} {
	set_config_list shrc $args
    }

    # sudo on|off
    proc sudo {args} {
	if {[llength $args] != 1} {
	    terror "[locus sudo]: usage: sudo on|off"
	    return
	}
	switch -nocase -- [lindex $args 0] {
	    on setsudo
	    off { unset -nocomplain ::config(sudo) }
	    default {
		terror "[locus sudo]: usage: sudo on|off"
	    }
	}
    }

    proc user {name} {
	set ::config(user) $user
    }

    proc password {text} {
	set ::config(pass) [::passenc $text]
    }
    
    proc read {file} {
	variable cfgvars 
	variable initialized
	variable source_file
	
	foreach var $cfgvars {
	    variable $var
	}

	set source_file $file
	if {[catch {source $file} result options] == 0} {
	    set initialized 1
	    unset source_file
	} else {
	    unset source_file
	    set locus "$file"
	    if {[dict get $options -code] == 1} {
		set errorcode [dict get $options -errorcode]
		if {[lindex $errorcode 0] == "REX"} {
		    # FIXME
		    terror "[lindex $errorcode 1]: $result"
		    exit 1
		} 
		append locus ":" [dict get $options -errorline]
	    }
	    terror "$locus: $result"
	    if {[config_option tcl-trace]} {
		return -code error -options $options
	    } elseif {![dict exists $options -errorstack]} {
		puts [dict get $options -errorinfo]
	    } else {
		foreach {tok prm} [dict get $options -errorstack] {
		    switch -- $tok {
			{CALL} {
			    if {[lindex $prm 0] == "::config::read"} {
				break
			    }
			    if {[info exists prevcall]} {
				if {$prevcall == "prm"} {
				    continue
				}
			    }
			    terror "called from:"
			    puts stderr "$prm"
			    set prevcall prm
			}
		    }
		}
	    }
	    exit 1
	}
    }

    proc exists {name} {
	variable $name
	info exists $name
    }
    proc valueof {name} {
	variable $name
	eval { return [set $name] }
    }
    proc export {} {
	global config
	variable cfgvars
	variable initialized
	variable update_hint

	foreach var $cfgvars {
	    if {[exists $var]} {
		terror -nosave "warning: your rc file sets obsolete variable \"$var\""
		if {[info exists update_hint($var)]} {
		    terror -nosave "warning: please change this to \"[apply $update_hint($var) [valueof $var]]\""
		}
		if {[info exists config($var)]} {
		    if {$var == "hosts"} {
			if {![info exists config(option,ignore-hosts)]} {
			    set hosts [valueof hosts]
			    lappend hosts {*}$config(hosts)
			    set config(hosts) $hosts
			    debug 3 "config(hosts) = $config(hosts)"
			}
		    }
		} else {
		    set config($var) [valueof $var]
		    debug 3 "config($var) = $config($var)"
		}
	    }
	}

	variable hostlist
	if {[info exists hostlist] &&
	    ![info exists config(option,ignore-hosts)]} {
	    lappend config(hosts) {*}$hostlist
	    debug 3 "config(hosts) = $config(hosts)"
	}
    }

    proc push {} {
	global config
	array set cv {}
	foreach key { option,hostgroup default,selected default,predicate } {
	    if [info exists config($key)] {
		set cv($key) $config($key)
	    }
	}

	lappend config(default,hostgroup_stack) [array get cv]
    }

    proc pop {} {
	global config
	unset -nocomplain config(option,hostgroup)
	unset -nocomplain config(default,selected)
	if [info exists config(default,hostgroup_stack)] {
	    array set config [lindex $config(default,hostgroup_stack) end]
	    set config(default,hostgroup_stack) \
		[lreplace $config(default,hostgroup_stack) end end]
	}
    }
}

proc scanlibpath {file} {
    global libpath
    
    foreach dir $libpath {
	set name "$dir/$file"
	debug 2 "looking for $name"
	if {[file exists $name]} {
	    debug 1 "found $name"
	    return $name
	}
    }
    return ""
}

proc mainloop {command args} {
    global config

    if {[config_option jobs] > 1} {
	if {![config_option buffer-output]} {
	    set config(option,prefix) 1
	    set config(option,no-host-header) 1
	}
    }

    debug 2 "entering main loop"

    while {[llength $config(hosts)] > 0} {
	set last [expr $config(option,jobs) - 1]
	set bunch [lrange $config(hosts) 0 $last]
	set config(hosts) [lreplace $config(hosts) 0 $last]

	if {[config_option confirm] && ![getyn Proceed on $bunch]} {
	    continue
	}
	$command $bunch {*}$args
    }
    debug 2 "leaving main loop"
}

proc hostlist_setup {} {
    global config
    global libpath
    global sysconfdir
    global usrconfdir

    if {[info exists config(hosts)] \
	    && [info exists config(exclude_hosts)] \
	    && [llength $config(exclude_hosts)] > 0} {
	foreach h $config(exclude_hosts) {
	    set x [lsearch -all -inline -not -exact $config(hosts) $h]
	    if {[llength $x] < [llength $config(hosts)]} {
		set config(hosts) $x
	    } else {
		foreach r [::pmres::resolve $h] {
		    set x [lsearch -all -inline -not -exact $config(hosts) $r]
		    if {[llength $x] < [llength $config(hosts)]} {
			set config(hosts) $x
		    }
		}
	    } 
	}
    }

    if {![info exists config(hosts)] || [llength $config(hosts)] == 0} {
	if {![info exists config(option,hostgroup)]} {
	    terror "no host list"
	    listgroups
	} else {
	    terror "no hosts defined in group $config(option,hostgroup)"
	}
	exit 1
    }

    if {[config_option zsh-quirk]} {
	set env(TERM) dumb
    }

    if {[info exists config(option,hostgroup)]} {
	debug 1 "using hostgroup $config(option,hostgroup)"
	set libpath [linsert $libpath 0 \
			 "$sysconfdir/$config(option,hostgroup)/script"]
	set dir "$usrconfdir/$config(option,hostgroup)"
	if {[file isdirectory $dir]} {
	    set config(home) [file normalize $dir]
	    set libpath [linsert $libpath 0 "$config(home)/script"]
	    debug 1 "group home is $config(home)"
	}
    } else {
	set config(home) $usrconfdir
    }
}

proc cleanup {} {
    global argv0
    global errors
    global cleanup_files
    
    debug 1 "cleaning up"
    updatedb

    if {[info exist cleanup_files]} {
	foreach fname $cleanup_files {
	    file delete $fname
	}
	unset cleanup_files
    }
    
    if {[info exist errors]} {
	send_error "$argv0: there were [llength $errors] errors:\n"
	foreach err $errors {
	    send_error "$argv0: $err\n"
	}
	exit 2
    }
}

proc getinterpreter {name} {
    set retval "/bin/sh"
    if {![config_option interpreter retval]} {
	if {[catch {open $name "r"} fd] == 0} {
	    if {[gets $fd line] >= 0} {
		regexp {^#![[:space:]]*(.+?)[[:space:]]*$} $line dummy retval
	    }
	    close $fd
	} else {
	    terror "can't open file $name: $fd"
	    exit 2
	}
    }
    return $retval
}

proc regsub-eval {args} {
    set optlist {}
    while {[llength $args] > 0} {
	set opt [lshift args]
	switch -regexp -- $opt {
	    {^--$} {
		set opt [lshift args]
		break
	    }
	    {^-.+}  { lappend optlist $opt }
	    default { break }

	}
    }
    if {[llength $args] != 2} {
	return -code error "bad # args"
    }
    set re $opt
    set string [lshift args]
    set cmd [lshift args]
    
    subst [regsub {*}$optlist -- $re [regsub -all {[][$\\]} $string {\\&}] \
	       \[[regsub -all {&} $cmd {\\&}]\]]
}

# Return true, if cmd looks like a pipeline or shell construct.
proc ispipeline {cmd} {
    if {[llength $cmd] != 1} {
	return 0
    }
    regexp -- {(^(if|case|for|while|time|function|select)[[:space:]])|[|&><;]} $cmd
}

proc read_hostgroup {groupname} {
    global confpath
    
    unset -nocomplain cfg
    foreach dir $confpath {
	set groupdir "$dir/hostgroup"
	if {![file exists $groupdir]} {
	    lappend missing $groupdir
	    continue
	}
	set cfg "$groupdir/$groupname/rc"
	if {[file exists $cfg]} {
	    debug 2 "reading configuration file $cfg"
	    ::config::read $cfg
	    break
	}
	unset -nocomplain cfg
    }
    if {![info exists cfg]} {
	terror "no such hostgroup: $groupname"
	if {[info exists missing]} {
	    if {[llength $missing] == [llength $confpath]} {
		terror "at least one of the following directories must exist:"
		foreach dir $missing {
		    terror "  $dir"
		}
	    } elseif {[config_option verbose]} {
		warning "the following directories don't exist:"
		foreach dir $missing {
		    terror "  $dir"
		}
	    }
	}
	exit 1
    }
}

proc rex_parse_cmdline {args} {
    global argc argv argv0

    set arglist {}
    set nodefault false
    while {[llength $args] > 0} {
	switch -- [lindex $args 0] {
	    -usage -
	    -alias -
	    -description -
	    -footer -
	    -docstring {
		set opt [lshift args]
		lappend arglist $opt [lshift args]
	    }
	    -nodefault {
		lshift args
		set nodefault true
	    }
	    default { break }
	}
    }

    set parser [catch_config_error {::getopt::parse {*}$arglist {*}$args argc argv} 1]

    catch_config_error {::getopt::run $parser initial} 1

    # Read databases
    global rexdb
    global confpath
    global config
    global defaultfile
    
    foreach dir $confpath {
	set db "$dir/db"
	if {[file exists $db]} {
	    readdb $db rexdb
	}
    }
    array unset rexdb updated

    # Read configuration
    if {![info exists config(option,no-init-file)]} {
	if {[file exists config(file)]} {
	    debug 2 "reading configuration file $config(file)"
	    ::config::read $config(file)
	} else {
	    foreach dir [lreverse $confpath] {
		set cfg "$dir/rc"
		if {[file exists $cfg]} {
		    debug 2 "reading configuration file $cfg"
		    ::config::read $cfg
		}
	    }
	}
	if !$nodefault {
	    readdefault
	}
    }
    
    catch_config_error {::getopt::run $parser global } 1

    # Read hostgroup config
    if {[info exists config(default,hostgroup_stack)] && \
	    [llength $config(default,hostgroup_stack)] > 0} {
        unset -nocomplain config(option,hostgroup)
        unset -nocomplain config(hosts)
	array set config [lindex $config(default,hostgroup_stack) end]
	if [info exists config(default,selected)] {
	    set config(hosts) $config(default,selected)
	}
    }
	 
    if {[info exists config(option,hostgroup)]} {
	read_hostgroup [config_option hostgroup]
    }

    # Read in additional source file
    if {[info exists config(option,source)]} {
	set sourcebase $config(option,source)
	set name [scanlibpath ${sourcebase}.tcl]
	if {$name == ""} {
	    terror "the script ${sourcebase}.tcl not found"
	    exit 1
	}
	debug 2 "reading script file $name"
	::hostproc::load $name
    }

    debug 2 "importing configuration settings"
    ::config::export
    
    # Process level 2 options
    catch_config_error {::getopt::run $parser mode } 1

    if {[config_option noop]} {
	exit 0
    }
}

proc rex_command_common args {
    global argv0
    global argc
    global argv
    global config
    global env

    set group {}
    
    while {[llength $args] > 0} {
	switch -- [lshift args] {
	    -copy { set config(option,copy) 1 }
	    -usage { set usage [lshift args] }
	    -docstring { set docstring [lshift args] }
	    -group { lappend group {-group} [lshift args] [lshift args] }
	    default { error "bad arguments to rex_command: $args" }
	}
    }

    rex_parse_cmdline \
	-usage $usage \
	-docstring $docstring \
	-group global {
	    group,g=NAME
	      {select host group}
	      { option_set group $optarg }
	    ignore-hosts,i
	      {ignore the list of hosts read from the hostgroup file}
	      { option_set ignore-hosts true }
	} \
	-group mode {
	    buffer-output,b
	      {buffer output from servers}
	      { option_set buffer-output true }
	    confirm,w
	      {prompt and wait for confirmation before each host}
	      { option_set confirm true }
	    copy
	      {copy PROGRAM to each host before executing}
	      { option_set copy true}
	    data-file,D=FILE
	      {copy FILE to each host before running command}
	      { option_set data-file $optarg }
	    host,H=HOST
	      {add HOST to the host list}
	      { lappend ::config(hosts) {*}[split $optarg ","] }
	    exclude-host,X=HOST
	      {remove HOST from the host list}
	      { lappend ::config(exclude_hosts) {*}[split $optarg ","] }
	    interactive,I
	      {interactively ask for missing usernames and passwords}
	      { option_set interactive true }	
	    interpreter=PROGRAM
	      {use COMMAND as interpreter for running PROGRAM; implies --copy}
	      { option_set interpreter $optarg }
	    jobs,j=N
	      {run N jobs at once}
	      { option_set jobs $optarg }
	    no-host-header
	      {don't print hostname before output from the host}
	      { option_set no-host-header true }
	    password,p=PASS
	      {set password (unsafe!)}
	      { set ::config(pass) $optarg }
	    prefix,P
	      {prefix each output line with the server name or IP}
	      { option_set prefix true }
	    source,s=NAME
	      {source .rex/NAME.tcl}
	      { option_set source $optarg }
	    sudo
	      {run PROGRAM via sudo}
	      { option_set sudo true }
	    user,u=NAME
	      {log in as user NAME}
	      { set ::config(user) $optarg }
	    zsh-quirk,Z
	      {try to cope with hosts running zsh}
	      { option_set zsh-quirk true }
	} \
	{*}$group

    debug 2 "running prologue script"
    ::hostproc::prologue
	
    if {[info exists config(argv)]} {
	debug 2 "command mode (from script)"
    } else {
	debug 2 "command mode (from command line)"
	set config(argv) $argv
    }

    if {[llength $config(argv)] == 0} {
	terror "no command"
	exit 1
    }
    
    if {[llength $config(argv)] == 1} {
	if {[regexp {sudo[ \t][ \t]*} "$config(argv)" config(argv)]} {
	    setsudo
	}
    } elseif {[lindex $config(argv) 0] == "sudo"} {
	lshift config(argv)
	setsudo
    }
    debug 2 "sudo=$config(sudo), argv=[join $config(argv)]"
    
    # Expand command line arguments
    set newcom {}
    foreach c $config(argv) {
	if {[string equal $c "{}"]} {
	    if {![info exists config(data)]} {
		terror "{} used in the absence of -D"
		exit 1
	    }
	    foreach d $config(data) {
		lappend newcom [file tail $d]
	    }
	} else {
	    lappend newcom \
		[regsub-eval -all "{(\[0-9\]+)?}" $c {
		    global config

		    if {![info exists config(data)]} {
			terror "{\1} used in the absence of -D"
			exit 1
		    }

		    if {[string equal {\1} {}]} {
			set arg {}
			foreach d $config(data) {
			    lappend arg [file tail $d]
			}
			return [join $arg]
		    } else {
			if {\1 > 0 && \1 <= [llength $config(data)]} {
			    return [lindex $config(data) [expr {\1 - 1}]]
			} else {
			    terror "{\1} out of range"
			    exit 1
			}
		    }
		}]
	}
    }
    set config(argv) $newcom
    set config(command) [join $config(argv)]
    
    if {$config(sudo) != "" && [ispipeline $config(argv)]} {
	set fd [maketempfile tempname]
	debug 1 "creating temporary script file $tempname"
        puts $fd $config(command)
        close $fd
	set config(command) $tempname
	set config(argv) $config(command)
	set config(option,copy) 1
    }
    
    if {[llength $config(argv)] == 1 &&
	[regexp {^(.+?)([[:space:]|&><;].*)$} $config(command) x config(progname) config(params)]} {
	# nothing
    } else {
	set config(progname) [lindex $config(argv) 0]
	set config(params) [join [lrange $config(argv) 1 end]]
    }

    if {[config_option copy]} {
	lappend config(data) $config(progname)
	set config(command) "[getinterpreter $config(progname)] [file tail $config(progname)] $config(params)"
    }
    
    debug 2 "sudo=$config(sudo), progname=$config(progname), params=$config(params), command=$config(command)"

    hostlist_setup
    
    debug 1 "running $config(command)"
    if {$config(sudo)!=""} {
	debug 1 "... in sudo mode"
    }
    debug 1 "... on $config(hosts)"
    
    mainloop runcmd "$config(sudo)$config(command)"
    
    debug 2 "running epilogue script"
    ::hostproc::epilogue
}

proc rex_command args {
    rex_command_common \
	-usage {rex run [OPTIONS] PROGRAM [ARGS...]} \
	-docstring {Runs PROGRAM on the given hosts.}
}

proc readdefault {} {
    global defaultfile
    if [file exists $defaultfile] {
	debug 2 "reading default file $defaultfile"
	::config::read $defaultfile
    }
}

proc savedefault {} {
    global config
    global defaultfile
    
    if {[catch {open "$defaultfile" "w"} fd] == 0} {
	set key {default,hostgroup_stack}
        if [info exists config($key)] {
	    puts $fd [list set ::config($key) $config($key)]
	}
	close $fd
    } else {
	terror "can't open $defaultfile: $fd"
	exit 2
    }
}

proc rex_group_select {} {
    global config
    
    proc ::hostproc::prologue {} {
	unset -nocomplain ::config(default,selected)
    }
    proc ::hostproc::logout {host ref status} {
	if {$status == 0} {
	    lappend ::config(default,selected) $host
	}
    }

    rex_command_common \
	-usage {rex group select [OPTIONS] COMMAND [ARGS...]} \
	-docstring {Selects hosts on which COMMAND succeeds.}
    
    if {![info exists config(default,selected)]} {
	terror "no hosts match the predicate"
	exit 1
    }
    unset -nocomplain config(option,hostgroup)
    set config(default,predicate) [join $config(argv)]
    ::config::push

    savedefault
}

proc rex_group_pop {} {
    global argc
    global config

    rex_parse_cmdline \
	-usage       {rex group pop} \
	-docstring   {Pop current hostgroup off the stack.}

    if {$argc != 0} {
	terror "too many arguments"
	exit 2
    }
    
    unset -nocomplain config(default,selected)
    unset -nocomplain config(default,predicate)
    ::config::pop
    savedefault
}

proc rex_group_push {} {
    global argc
    global argv
    global config
    
    rex_parse_cmdline \
	-usage       {rex group push GROUP} \
	-docstring   {Select the hostgroup and push it on stack.}

    if {$argc != 1} {
	terror "bad arguments"
	exit 1
    }

    unset -nocomplain config(default,selected)
    unset -nocomplain config(default,predicate)
    option_set group [lindex $argv 0]
    read_hostgroup [config_option hostgroup]
    ::config::push
    
    savedefault
}

proc rex_group_swap {} {
    global argc
    global config
    
    rex_parse_cmdline \
	-usage       {rex group swap N} \
	-docstring   {Exchange top of group stack with its Nth entry.} \
	-footer {Use 'rex group show -a' to inspect the stack.}

    if {$argc != 1} {
	terror "bad arguments"
	exit 1
    }
    set n [argcvshift]
    
    if ![info exists config(default,hostgroup_stack)] {
	terror "no group stack"
	exit 2
    }
    if {$n <= 0 || $n > [expr [llength $config(default,hostgroup_stack)] - 1]} {
	terror "bad frame index"
	exit 2
    }
    set i [expr [llength $config(default,hostgroup_stack)] - $n - 1]
    set t [lindex $config(default,hostgroup_stack) end]
    lset config(default,hostgroup_stack) end \
	[lindex $config(default,hostgroup_stack) $i]
    lset config(default,hostgroup_stack) $i $t

    savedefault
}

proc rex_group_drop {} {
    global argc
    global config

    rex_parse_cmdline \
	-usage       {rex group drop N} \
	-docstring   {Remove Nth frame from the hostgroup stack.} \
	-footer {Use 'rex group show -a' to inspect the stack.}

    if {$argc != 1} {
	terror "bad arguments"
	exit 1
    }
    set n [argcvshift]
    
    if ![info exists config(default,hostgroup_stack)] {
	terror "no group stack"
	exit 2
    }
    if {$n < 0 || $n > [expr [llength $config(default,hostgroup_stack)] - 1]} {
	terror "bad frame index"
	exit 2
    }

    set i [expr [llength $config(default,hostgroup_stack)] - $n - 1]
    set config(default,hostgroup_stack) \
	[lreplace $config(default,hostgroup_stack) $i $i]

    savedefault
}
    
proc rex_group_show {} {
    global argc
    global argv
    global config

    set all false
    set hosts false

    rex_parse_cmdline \
	-usage       {rex group show [OPTION]} \
	-docstring   {Show selected hostgroup.} \
	-group global {
	    all,a
	      {show all stack entries}
	      {uplevel 3 {set all true}}
	    hosts,H
	      {show hosts}
	      {uplevel 3 {set hosts true}}
	} \
	-footer {Options are mutually exclusive.}
		    
    
    if {$argc != 0} {
	terror "too many arguments"
	exit 2
    }
    if {$all && $hosts} {
	terror "--all and --hosts cannot be used together"
	exit 2
    }

    if {$all && [info exists config(default,hostgroup_stack)]} {
	set n 0
	foreach ent [lreverse $config(default,hostgroup_stack)] {
	    puts -nonewline [format "% 3d. " $n]
	    incr n

	    array unset cv
	    array set cv $ent
	    if [info exists cv(option,hostgroup)] {
		puts $cv(option,hostgroup)
	    } elseif [info exists cv(default,selected)] {
		if [info exists cv(default,predicate)] {
		    puts "selection: $cv(default,predicate)"
		} else {
		    puts "selected hosts"
		}
	    } else {
		puts "MALFORMED ENTRY"
	    }
	}
    } else {
	if [info exists config(option,hostgroup)] {
	    puts $config(option,hostgroup)
	} elseif [info exists config(default,selected)] {
	    if [info exists config(default,predicate)] {
		puts "selection: $config(default,predicate)"
	    } else {
		puts "selected hosts"
	    }
	} else {
	    exit 2
	}
	if {$hosts && [info exists config(hosts)]} {
	    foreach h $config(hosts) {
		puts $h
	    }
	}
    }
}

proc rex_group {} {
    global argc
    global argv
    global argv0
    global usrconfdir
    
    ::getopt::parse \
	-usage       {rex group COMMAND [OPTIONS] [ARGS]} \
	-docstring   {Manipulate hostgroups.} \
	-footer {COMMANDs are:
 drop                       remove given frame from stack
 pop                        pop currently selected hostgroup off stack
 push                       push new hostgroup
 select                     select hosts matching predicate command
 show                       show selected hostgroup (and hosts)
 swap                       swap given frame and the top of stack
} \
	-commit \
        argc argv

    if {[llength $argv] == 0} {
	terror "missing subcommand; try 'rex group --help' for help"
        exit 1
    }
    set subcom [argcvshift]

    switch -- $subcom {
	drop           rex_group_drop
	pop            rex_group_pop
	push           rex_group_push
	select         rex_group_select
	show           rex_group_show
	swap           rex_group_swap
	
	default        {
	    terror "unknown subcommand $subcom; try 'rex group --usage' for help"
	    exit 1
	}
    }    
}

proc rex_list {} {
    global argv0
    global argc
    global argv
    global config
    global env

    rex_parse_cmdline \
	-usage {rex list [groups]} \
	-alias {{rex list [OPTIONS] hosts}} \
	-docstring {Lists hostgroups or hosts in a hostgroup.} \
	-description {In first form, produces a listing of the defined
hostgroups along with their descriptions.

In the second form, lists hostnames obtained as a result of applying
the OPTIONS (at least one must be given).} \
    -group global { 
	group,g=NAME
	  {select host group}
          { option_set group $optarg }
	ignore-hosts,i
	  {ignore the list of hosts read from the hostgroup file}
	  { option_set ignore-hosts true }
    } \
    -group mode { 
	host,H=HOST
	  {add HOST to the host list}
	  { lappend ::config(hosts) {*}[split $optarg ","] }
	exclude-host,X=HOST
	  {remove HOST from the host list}
          { lappend ::config(exclude_hosts) {*}[split $optarg ","] }
    }

    switch -- $argc {
	0    listgroups
	1    { switch -- [argcvshift] {
	           groups    listgroups
	           hosts     {
		       hostlist_setup
		       if {[info exists config(option,hostgroup)]} {
			   puts "Hosts in group $config(option,hostgroup)"
			   foreach host $config(hosts) {
			       puts "$host"
			   }
		       } else {
			   terror "usage: $argv list -gNAME hosts"
			   exit 1
		       }
		   }
	           default   { terror "unknown argument to list command"
		               exit 1 
		   }
	       }
	}
	default { terror "too many arguments to list command"
	          exit 1
	}
    }
    
    exit 0
}

proc rex_copy_from {} {
    global argc
    global argv
    global argv0
    global env
    global config

    rex_parse_cmdline \
	-usage {rex rcp|copy-from [OPTIONS] HOST FILE [FILE...] DEST} \
	-docstring {Copies FILEs from HOST to DEST on the local machine.} \
	-group global {
	    group,g=NAME
	      {select host group}
	      { option_set group $optarg }
	} \
	-group mode {
	    interactive,I
	      {interactively ask for missing usernames and passwords}
	      { option_set interactive true }	

	    password,p=PASS
	      {set password (unsafe!)}
	      { set ::config(pass) $optarg }

	    user,u=NAME
	      {log in as user NAME}
	      { set ::config(user) $optarg }
	}	
    
    if {$argc < 3} {
	terror "too few arguments for copy-from"
	exit 1
    } else {
	debug 2 "copy-from mode"
    }

    exit [runcprev {*}$argv]
}

proc rex_copy_to {} {
    global argc
    global argv
    global argv0
    global config

    rex_parse_cmdline \
	-usage     {rex cp|copy [OPTIONS] FILE [FILE...] DEST} \
	-docstring {Copies FILEs to DEST on each host.} \
	-group global {
	group,g=NAME
	  {select host group}
	  { option_set group $optarg }
	ignore-hosts,i
	  {ignore the list of hosts read from the hostgroup file}
	  { option_set ignore-hosts true }
	} \
	-group mode {
	confirm,w
	  {prompt and wait for confirmation before each host}
	  { option_set confirm true }
	host,H=HOST
	  {add HOST to the host list}
	  { lappend ::config(hosts) {*}[split $optarg ","] }
	exclude-host,X=HOST
	  {remove HOST from the host list}
	  { lappend ::config(exclude_hosts) {*}[split $optarg ","] }
	interactive,I
	  {interactively ask for missing usernames and passwords}
	  { option_set interactive true }	
	jobs,j=N
	  {run N jobs at once}
	  { option_set jobs $optarg }
	no-host-header
	  {don't print hostname before output from the host}
	  { option_set no-host-header true }
	password,p=PASS
	  {set password (unsafe!)}
	  { set ::config(pass) $optarg }
	prefix,P
	  {prefix each output line with the server name or IP}
	  { option_set prefix true }
	user,u=NAME
	  {log in as user NAME}
	  { set ::config(user) $optarg }
	sudo
          {copy in privileged mode}
	  setsudo
	}	    

    if { $argc < 2 } {
	terror "too few arguments"
	exit 1
    } else {
	debug 2 "copy-to mode"
    }

    if {$argc} {
	set config(argv) $argv
    }
    debug 2 "argv=[join $config(argv)]"

    hostlist_setup

    if {$config(sudo) != ""} {
	lappend config(data) {*}[lrange $argv 0 end-1]
	set config(argv) [list {cp} {*}$config(data) [lindex $argv end]]
	
	set config(progname) cp
	set config(command) [join $config(argv)]
	debug 2 "copying [llength $config(data)] files: [join $config(data)]"
	debug 2 "sudo=$config(sudo), progname=$config(progname), command=$config(command) ([llength $config(command)] args)"
	debug 2 "... on $config(hosts)"
	mainloop runcmd "$config(sudo)$config(command)"
	return
    }	


    debug 1 "copying $config(argv) to $config(hosts)"
    mainloop runcp {*}$config(argv)
}

proc rex_login {} {
    global argc
    global argv
    global argv0
    global config
    global ssh_options

    rex_parse_cmdline \
	-usage   {rex login [OPTIONS] HOST} \
	-docstring {Log in to HOST.} \
	-group global {
	    group,g=NAME
	      {select host group}
	      { option_set group $optarg }
	} \
	-group mode {
	    interactive,I
	      {interactively ask for missing usernames and passwords}
	      { option_set interactive true }	

	    password,p=PASS
	      {set password (unsafe!)}
	      { set ::config(pass) $optarg }

	    user,u=NAME
	      {log in as user NAME}
	      { set ::config(user) $optarg }
	
	    zsh-quirk,Z
	      {try to cope with hosts running zsh}
	      { option_set zsh-quirk true }

	    sudo
	      {run PROGRAM via sudo}
	      setsudo
	}
    
    if {$argc == 0} {
	terror "hostname is required in login mode"
	exit 1
    } elseif {$argc > 1} {
	terror "only one hostname is allowed in login mode"
	exit 1
    }
    set host [lshift argv]

    log_user [config_option log] 

    debug 2 "logging in to $host"

    set batch [job create]
    set spawn_id [job start batch $host ssh {*}$ssh_options [hostuser $host]@$host]
    job set batch $spawn_id zsh-quirk [config_option zsh-quirk]
    add_host_key_list batch $spawn_id earlycmd earlycmd
    job lappend batch $spawn_id cmdlist "stty -echo"

    while {[job count $batch] > 0} {
	expect {
            -i [job sidlist $batch]

	    -re {^Authenticated to} {
		set sid $expect_out(spawn_id)
		job transition batch $sid AUTHENTICATED
		while {[job exists $batch $sid earlycmd]} {
		    set cmd [job lshift batch $sid earlycmd]
		    debug 3 "[job id $batch $sid]: sending early $cmd"
		    send -i $sid "$cmd\r"
		}
	    }

	    -re {assword:|assword for .*:} {
		set sid $expect_out(spawn_id)
		set host [job get $batch $sid host]
		debug 3 "[job id $batch $sid]: prompted for password in state [job get $batch $sid state]"
		switch -- [job get $batch $sid state] {
		    {INIT} {
			if {[catch {hostpass $host} result] == 0} {
			    send -i $sid "$result\r"
			    job transition batch $sid PASS_SENT
			} else {
			    terror "[job id $batch $sid]: requires password, but none is given"
			    job close batch $sid
			}
		    }
		    {COMMAND} {
			if {[catch {hostpass $host} result] == 0} {
			    send -i $sid "$result\r"
			    job transition batch $sid SUDO
			} else {
			    terror "[job id $batch $sid]: sudo requires password, but none is given"
			    job close batch $sid
			}			    
		    }
		    {PASS_SENT} {
			set sid $expect_out(spawn_id)
			terror "bad password for [hostuser $host] on [job get $batch $sid hostname]"
			job close batch $sid
		    }
		    default {
			# FIXME
			terror "unexpected password prompt from [job get $batch $sid hostname] in state [job get $batch $sid state]"
			job close batch $sid
		    }
		}
	    }

	    -re {^[^\n]*\n} {
		set sid $expect_out(spawn_id)
		switch -- [job get $batch $sid state] {
		    {INIT} {
			set text [regsub -all {[\r\n]} $expect_out(0,string) {}]
			terror -nosave "[job id $batch $sid]: $text"
		    }
		}
	    }

	    -re $config(prompt) {
		set sid $expect_out(spawn_id)
		debug 3 "[job id $batch $sid]: prompt seen in state [job get $batch $sid state]"
		switch -- [job get $batch $sid state] {
		    {AUTHENTICATED} {
			set cmd [job lshift batch $sid cmdlist]
			debug 3 "[job id $batch $sid]: sending $cmd"
			send -i $sid "$cmd\r"
			job transition batch $sid STTY
		    }
		    {STTY} {
			if {[job exists $batch $sid cmdlist]} {
			    set cmd [job lshift batch $sid cmdlist]
			    debug 3 "[job id $batch $sid]: sending $cmd"
			    send -i $sid "$cmd\r"
			} elseif {$config(sudo) != ""} {
			    send -i $sid "sudo -s\r"
			    job transition batch $sid COMMAND
			} else {
			    job transition batch $sid COMMAND
			    send -i $sid "stty echo\r"
			    interact {
				\004 { send -i $sid "exit\r" }
			    }
			    job close batch $sid
			}
		    }
		    {COMMAND} -
		    {SUDO} {
			send -i $sid "stty echo\r"
			interact {
			    \004 { send -i $sid "exit\r" }
			}
			job close batch $sid
		    }
		}
	    }
	    
	    timeout {
		set sid $expect_out(spawn_id)
		if {[job get $batch $sid state] == "AUTHENTICATED"} {
		    if {[job get $batch $sid zsh-quirk]} {
			debug 1 "[job id $batch $sid]: timed out waiting for prompt; retrying in zsh-quirk mode"
			send -i $sid "unsetopt ZLE\r"
			send -i $sid "PS1='$ '\r"
			job unset batch $sid zsh-quirk
			continue
		    } else {
			terror "timed out waiting for prompt from [job get $batch $sid hostname]"
		    }
		} else {
		    terror "connection to [job get $batch $sid hostname] timed out"
		}
		job close batch $sid
	    }

	    denied {
		set sid $expect_out(spawn_id)
		terror "bad password for [hostuser [job get $batch $sid host]] on [job get $batch $sid hostname]"
		job close batch $sid
	    }

	    eof {
		set sid $expect_out(spawn_id)
		job close batch $sid
	    }
	}
    }   
    debug 2 "quitting"
}

proc rex_editdb {} {
    global argc
    global argv
    global argv0
    global usrconfdir

    rex_parse_cmdline \
	-usage       {rex edit [FILE]} \
	-docstring   {Edit rex database FILE (default ~/.rex/db).} 
    
    switch -- $argc {
	0  { set dbname "$usrconfdir/db" }
	1  { set dbname [argcvshift] }
	default {
	    terror "too many arguments to edit"
	    exit 1
	}
    }
    
    set dir [file dirname $dbname]

    if {![file exists $dir]} {
	if {![getyn "Directory $dir does not exist: create"]} {
	    exit 0
	}
	file mkdir $dir
    }

    editdb $dbname    
}

# #######################################################################
# The game begins...
# #######################################################################

set footer {COMMANDS are:
  run, command         run command on hosts
  cp, copy             copy (distribute) files to hosts
  rcp, copy-from       copy files from a host
  login                log in to a host
  list                 list available hostgroups or servers in a hostgroup
  edit                 edit rex database file
  group                select a hostgroup and maintain a stack of hostfroups    

Use `rex COMMAND --help', to obtain help for a particular COMMAND.
 	
Report bugs to <gray+rex@gnu.org.ua>
}

::getopt::parse \
    -usage  {rex [OPTIONS] COMMAND [ARGS...]} \
    -docstring {Rex runs a command on several hosts.} \
    -footer $footer \
    -commit \
    -group default {
	config,c=FILE
	{read config from FILE}
	{set ::config(file) $optarg}

	debug,d
	{increase debugging level}
	{ incr ::config(debug) }

	log,l
	{log everything to the standard output}
	{ set ::config(option,log) 1 }

	no-init-file,no-rc-file,q
	{don't load rc file}
	{ set ::config(option,no-init-file) 1 }

	noop,N
	{ignore all commands (useful for side effects)}
	{ set ::config(option,noop) 1 }

	no-resolve,n
	{don't resolve IP addresses when printing hostnames}
	{ set ::config(option,resolve) 0 }

	tcl-trace,T
	{dump full TCL traces on errors}
	{ option_set tcl-trace true }
	
	version,V
	{print program version and copyright statement}
	prversion

	verbose,v
	{print additional warnings}
	{ set ::config(option,verbose) 1 }
    } argc argv

if {$argc == 0} {
    terror "no command"
    exit 1
}

array set modetrans {
    run            run
    command        run

    copy           copy-to
    cp             copy-to

    copy-from      copy-from
    rcp            copy-from

    list           list
    edit           edit
}

set config(mode) [argcvshift]
if {[info exist modetrans($config(mode))]} {
    set config(mode) $modetrans($config(mode))
}

trap {
    cleanup
    exit
} {SIGINT SIGQUIT SIGHUP SIGTERM}

switch -- $config(mode) {
    run            rex_command

    group          rex_group
    
    copy-to        rex_copy_to
    
    copy-from      rex_copy_from
    
    login          rex_login
    list           rex_list
    edit           rex_editdb

    default        {
	terror "unknown mode: $config(mode)"
	exit 1
    }    
}

cleanup

exit 0

