Improve installer

* install: Install packages
* rc.tcl: Remove.
* rex.exp: Rename back to rex
* README: Update.
* README-hacking: Update.

1 files changed, 2596 insertions, 0 deletions

diff --git a/rex b/rex
new file mode 100755
index 0000000..07fb7ab
--- /dev/null
+++ b/rex
@@ -0,0 +1,2596 @@
+#! /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 "3.90"
+set sysconfdir "/etc/rex"
+set usrconfdir "$env(HOME)/.rex"
+set confpath [list $usrconfdir $sysconfdir]
+set libpath [list $usrconfdir/script $sysconfdir/script]
+
+array set config {
+    mode                 command
+    sudo                 ""
+    prompt               "(%|#|\\$) $"
+    max_scp_retry_count  5
+    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
+}
+
+# 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)
+	}
+    
+	set res {}
+
+	foreach x [hostorder] {
+	    set name "${x}_match"
+	    if {[info procs "$name"] == "$name"} {
+		eval $name $mode $arg res
+	    }
+	}
+	if {$res != ""} {
+	    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]} {
+	set x [::pmres::resolve -ip $arg]
+	if {$x != ""} {
+	    return $x
+	}
+    }
+    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} {
+	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]
+		}
+		-before {
+		    set before [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]
+		}
+		default { break }
+	    }
+	}
+
+	if {[llength $args] != 3} {
+	    return -code error "bad number of arguments [llength $args]"
+	}
+
+	upvar [lindex $args 0] argc
+	upvar [lindex $args 1] argv
+	set defs [lindex $args 2]
+	
+	# 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
+	for {set i 0} {$i < [llength $defs]} {incr i 3} {
+	    unset -nocomplain argname repr optlist
+	    set longacc {}
+
+	    set optstr [lindex $defs $i]
+	    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 [expr $i + 1]]
+	    lappend docdict(optdoc) $entry
+	    lappend select $repr [lindex $defs [expr $i + 2]]
+	}
+
+	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 before before
+	    if {[info exists before]} {
+		eval $before
+	    }
+	    upvar select select
+	    switch -- $optchar {*}$select \
+		h parsehelp \
+		? { exit 1 } \
+		default {
+		    return -code error "option should have been recognized: $optchar"
+		}
+	}
+
+	variable optind
+	set argv [lrange $argv $optind end]
+	set argc [expr $argc - $optind]
+    }
+}
+# #######################################################################
+# 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 {
+	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)]} {
+	    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 errors
+
+    if {![info exist errors]} {
+	set errors {}
+    }
+    set msg [join $args]
+    set errors [linsert $errors end $msg]
+    send_error "$argv0: $msg\n"
+}
+
+proc warning {args} {
+    if {[config_option verbose]} {
+	terror "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
+    }
+}
+
+proc maketempfile {} {
+    set tempfile ".rex.[pid].tmp"
+    exec "/bin/sh" -c "umask 077; touch $tempfile"
+    return $tempfile
+}
+
+# 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 temp [maketempfile]
+    set fd [open $temp "w"]
+    foreach key [lsort -command keycmp [array names x]] {
+	puts $fd "$key $x($key)"
+    }
+    close $fd
+    file rename -force $temp $file
+}
+
+# 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
+#  tempfile - temporary output file name
+#  dbvar    - array variable to get key/value pairs from.
+proc mkdbview {dbname tempfile dbvar} {
+    upvar $dbvar db
+    set fd [open $tempfile w]
+    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
+}    
+
+# 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"
+    }
+
+    trap {
+	file delete $tempfile
+	exit
+    } [list SIGINT SIGQUIT SIGHUP SIGTERM]
+    set tempfile [maketempfile]
+
+    mkdbview $dbname $tempfile rexdb
+    while 1 {
+	exec $ed $tempfile <@stdin >@stdout 2>@stderr
+	if {![dbchanged $tempfile rexdb]} {
+	    break
+	}
+
+	switch [whatnow] {
+	    e continue
+	    q break
+	    s {
+		svdbview $tempfile $dbname
+		break
+	    }
+	}
+    }
+    file delete $tempfile
+    trap SIG_DFL [list SIGINT SIGQUIT SIGHUP SIGTERM]
+}
+
+# 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 $key $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 == "" } {
+		exit 0
+	    }
+	    rexdbput pass [passenc $x]
+	    return $x
+	} else {
+	    rexdbput $key [passenc $x]
+	    return $x
+	}
+    }
+
+    if {[info exist config(pass)]} {
+	return [passdec $config(pass)]
+    }
+    # FIXME: Throw an error?
+    return ""
+}
+
+proc add_host_key_list {host key varname} {
+    global config
+    upvar $varname comlist