#! /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-2016 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.0"
set sysconfdir "/usr/local/etc"
set usrconfdir "$env(HOME)/.rex"
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 {
	    puts "B"
	    return -code [dict get $options -code] -options $options
	}
    }
}

proc option_set {args} {
    global optiondef
    global config

#    puts "option_set [llength $args] $args"
    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 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 {[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-2016 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 "[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
		    }
		    {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} {
			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} {
			debug 2 "EOF from [job get $batch $sid hostname], waiting for $sid"
			job close batch $sid
			wait -i $sid

			::hostproc::finish $host output($host)
		    }
		    {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
    }

    # 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.      
    proc finish {host ref} {
	upvar $ref text
	if {[info exists text]} {
	    if {![config_option no-host-header]} {
		puts "[hostname $host]:"
	    }
	    foreach line $text {
		if {[config_option prefix]} {
		    puts -nonewline "[hostname $host]> "
		}
		puts -nonewline $line
	    }
	}
    }
}

# #######################################################################
#
# #######################################################################
namespace eval ::config {
    variable initialized 0
    variable cfgvars {sudo hosts user password command}
    variable update_hint
    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 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" &&
			![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 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 rex_parse_cmdline {args} {
    global argc argv argv0

    set arglist {}
    while {[llength $args] > 0} {
	switch -- [lindex $args 0] {
	    -usage -
	    -alias -
	    -description -
	    -footer -
	    -docstring {
		set opt [lshift args]
		lappend arglist $opt [lshift args]
	    }
	    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
    
    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
		}
	    }
	}
    }
    
    catch_config_error {::getopt::run $parser global } 1

    # Read hostgroup config
    if {[info exists config(option,hostgroup)]} {
	unset -nocomplain cfg
	foreach dir $confpath {
	    set groupdir "$dir/hostgroup"
	    if {![file exists $groupdir]} {
		lappend missing $groupdir
		continue
	    }
	    set cfg "$groupdir/[config_option hostgroup]/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: $config(option,hostgroup)"
	    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
	}
    }

    # 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 args {
    global argv0
    global argc
    global argv
    global config
    global env

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

    rex_parse_cmdline \
	-usage {rex run [OPTIONS] PROGRAM [ARGS...]} \
	-docstring {Runs PROGRAM on the given hosts.} \
	-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 }
	}

    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_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 $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

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
    
    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

