Revamp rc file support.

While improving rc file support and making it (hopefully) more
convenient, this commit alters the priority of rc ws. command
line settings.  This will be reverted in future commits.

* rex (::getopt::parse): New option -postprocess. When given,
supplies the name of a function to be called after parsing command
line.  The function returns a list of triplets: {option line file},
where option is a (list of) option and eventual argument, line and
file give the location of the corresponding statement in the rc
file.  The list is then processed by calls to ::getopt::getopt,
one call per option.
(::config): Deprecate the old way of setting configuration
variables. Provide functions for each particular setting, that
make rc file look more or less like a traditional UNIX configuration
file, while still providing possibility for using full strength of
TCL.
Catch and process syntax errors.
(modetrans): New array. Translates various spellings of the mode
argument to ensure config(mode) is set uniformly.

1 files changed, 269 insertions, 34 deletions

diff --git a/rex b/rex
index 43dbfed..aaee3f7 100755
--- a/rex
+++ b/rex
@@ -193,7 +193,7 @@ namespace eval ::getopt {
     variable opterr 1
     variable optchar
     variable optopt
-
+    
     proc init {} {
 	variable optarg
 	set optarg ""
@@ -625,7 +625,7 @@ namespace eval ::getopt {
 	}
 	exit 0
     }
-    
+
     proc parse {args} {
 	while {[llength $args] > 0} {
 	    set arg [lindex $args 0]
@@ -637,7 +637,11 @@ namespace eval ::getopt {
 		-before {
 		    set before [lindex $args 1]
 		    set args [lreplace $args [set args 0] 1]
-		}	       
+		}
+		-postprocess {
+		    set postprocess [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]
@@ -661,7 +665,7 @@ namespace eval ::getopt {
 		default { break }
 	    }
 	}
-
+	
 	if {[llength $args] != 3} {
 	    return -code error "bad number of arguments [llength $args]"
 	}
@@ -754,7 +758,7 @@ namespace eval ::getopt {
 	}
 	lappend param $argc $argv
 	lappend param $shortopts
-
+	
 	getopt {*}$param {
 	    upvar before before
 	    if {[info exists before]} {
@@ -772,6 +776,44 @@ namespace eval ::getopt {
 	variable optind
 	set argv [lrange $argv $optind end]
 	set argc [expr $argc - $optind]
+
+	if {[info exists postprocess]} {
+	    foreach optitem [eval $postprocess] {
+		set opt [lindex $optitem 0]
+		
+		if {[info exists progname]} {
+		    set loc "$progname:"
+		} else {
+		    set loc ""
+		}
+		if {[llength $optitem] == 3} {
+		    append loc "[lindex $optitem 2]:"
+		}
+		append loc [lindex $optitem 1]
+		
+		init
+		set param [list -progname $loc]
+		if {[info exists longopts]} {
+		    lappend param -longopts $longopts
+		}
+
+		lappend param 1 $opt
+		lappend param $shortopts
+
+		getopt {*}$param {
+		    upvar before before
+		    if {[info exists before]} {
+			eval $before
+		    }
+		    upvar select select
+		    switch -- $optchar {*}$select \
+			? { exit 1 } \
+			default {
+			    return -code error "option should have been recognized: $optchar"
+			}
+		}
+	    }
+	}
     }
 }
 # #######################################################################
@@ -1282,7 +1324,8 @@ proc dbchanged {filename var} {
     upvar $var olddb
 
     readdb $filename newdb
-    foreach newkey [lsort -command keycmp [array names newdb]] oldkey [lsort -command keycmp [array names olddb]] {
+    foreach newkey [lsort -command keycmp [array names newdb]] \
+	    oldkey [lsort -command keycmp [array names olddb]] {
 	if {$oldkey != $newkey} {
 	    return 1
 	}
@@ -2141,7 +2184,157 @@ namespace eval ::hostproc {
 # #######################################################################
 namespace eval ::config {
     variable initialized 0
-    variable cfgvars {sudo hosts user password command program}
+    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 hosts
+	lappend hosts {*}$args
+    }
+
+    proc ifmode {args} {
+	switch -- $::config(mode) {*}$args
+    }
+    
+    proc option {args} {
+	global config
+	set frame [info frame -1]
+	lappend opt $args
+	lappend opt [dict get $frame line]
+	if {[dict get $frame type] == "source"} {
+	    lappend opt [dict get $frame file]
+	}
+	lappend config(postprocess) $opt
+    }
+
+    proc timeout {args} {
+	set frame [info frame -1]
+	set locus [dict get $frame line]
+	if {[dict get $frame type] == "source"} {
+	    set locus "[dict get $frame file]:$locus"
+	}
+	switch -- [llength $args] {
+	    0 { return $::timeout }
+	    1 { set ::timeout [lindex $args 1] }
+	    default {		
+		terror "$locus: usage: timeout ?value?"
+	    }
+	}
+    }
+
+    proc environ {args} {
+	set frame [info frame -1]
+	set locus [dict get $frame line]
+	if {[dict get $frame type] == "source"} {
+	    set locus "[dict get $frame file]:$locus"
+	}
+	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: 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} {
+	    set frame [info frame -2]
+	    set locus [dict get $frame line]
+	    if {[dict get $frame type] == "source"} {
+		set locus "[dict get $frame file]:$locus"
+	    }
+	    terror "$locus: 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} {
+	set frame [info frame -2]
+	set locus [dict get $frame line]
+	if {[dict get $frame type] == "source"} {
+	    set locus "[dict get $frame file]:$locus"
+	}
+
+	if {[llength $arglist] != 1} {
+	    terror "$locus: usage: sudo on|off"
+	    return
+	}
+	switch -nocase -- [lindex $args 0] {
+	    on setsudo
+	    off { unset -nocomplain ::config(sudo) }
+	    default {
+		terror "$locus: usage: sudo on|off"
+	    }
+	}
+    }
+
+    proc user {name} {
+	set ::config(user) $user
+    }
+
+    proc password {text} {
+	set ::config(pass) [::passenc $text]
+    }
     
     proc read {file} {
 	variable cfgvars 
@@ -2149,9 +2342,35 @@ namespace eval ::config {
 	foreach var $cfgvars {
 	    variable $var
 	}
-	source $file
-	set initialized 1
+	if {[catch {source $file} result options] == 0} {
+	    set initialized 1
+	} else {
+	    set locus "$file"
+	    if {[dict get $options -code] == 1} {
+		append locus ":" [dict get $options -errorline]
+	    }
+	    terror "$locus: $result"
+	    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
@@ -2164,8 +2383,14 @@ namespace eval ::config {
 	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)]} {
@@ -2175,7 +2400,7 @@ namespace eval ::config {
 			debug 3 "config(hosts) = $config(hosts)"
 		    }
 		} else {
-		    eval { set config($var) [valueof $var] }
+		    set config($var) [valueof $var]
 		    debug 3 "config($var) = $config($var)"
 		}
 	    }
@@ -2227,7 +2452,7 @@ proc hostlist_setup {} {
     global libpath
     global sysconfdir
     global usrconfdir
-    
+
     if {[info exists config(hosts)] \
 	    && [info exists config(exclude_hosts)] \
 	    && [llength $config(exclude_hosts)] > 0} {
@@ -2329,7 +2554,7 @@ proc common_config_setup {} {
 			terror "  $dir"
 		    }
 		} elseif {[config_option verbose]} {
-		    warning "the following directories doesn't exist:"
+		    warning "the following directories don't exist:"
 		    foreach dir $missing {
 			terror "  $dir"
 		    }
@@ -2351,7 +2576,10 @@ proc common_config_setup {} {
     }
 
     debug 2 "importing configuration settings"
-    ::config::export    
+    ::config::export
+    if {[info exists config(postprocess)]} {
+	return $config(postprocess)
+    }    
 }
 
 proc cleanup {} {
@@ -2441,10 +2669,9 @@ proc rex_command args {
 	}
     }
 
-    set config(mode) command
-    
     ::getopt::parse -usage {rex run [OPTIONS] PROGRAM [ARGS...]} \
 	-docstring {Runs PROGRAM on the given hosts.} \
+	-postprocess common_config_setup \
 	-before {global config} argc argv {
 	buffer-output,b
 	  {buffer output from servers}
@@ -2510,8 +2737,6 @@ proc rex_command args {
 	  { set config(option,zsh-quirk) 1 }
     }
 
-    common_config_setup
-
     # FIXME
     if {[config_option noop]} {
 	updatedb
@@ -2630,8 +2855,6 @@ proc rex_list {} {
     global config
     global env
 
-    set config(mode) list
-
     ::getopt::parse \
 	-usage {rex list [groups]} \
 	-alias {{rex list [OPTIONS] hosts}} \
@@ -2641,16 +2864,17 @@ 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).} \
+        -postprocess common_config_setup \
         -before {global config} argc argv {
 	group,g=NAME
 	  {select host group}
-	  { set config(option,hostgroup) $optarg }
+          { set config(option,hostgroup) $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 ","] }
+          { lappend config(exclude_hosts) {*}[split $optarg ","] }
 	ignore-hosts,i
 	  {ignore the list of hosts read from the hostgroup file}
 	  { set config(option,ignore-hosts) 1 }
@@ -2661,10 +2885,8 @@ the OPTIONS (at least one must be given).} \
 	1    { switch -- [argcvshift] {
 	           groups    listgroups
 	           hosts     {
+		       hostlist_setup
 		       if {[info exists config(option,hostgroup)]} {
-			   common_config_setup
-			   hostlist_setup
-
 			   foreach host $config(hosts) {
 			       puts "$host"
 			   }
@@ -2696,6 +2918,7 @@ proc rex_copy_from {} {
     ::getopt::parse \
 	-usage {rex rcp|copy-from [OPTIONS] HOST FILE [FILE...] DEST} \
 	-docstring {Copies FILEs from HOST to DEST on the local machine.} \
+	-postprocess common_config_setup \
 	-before {global config} argc argv {
 	    
 	interactive,I
@@ -2718,7 +2941,6 @@ proc rex_copy_from {} {
 	debug 2 "copy-from mode"
     }
 
-    common_config_setup
     exit [runcprev {*}$argv]
 }
 
@@ -2731,6 +2953,7 @@ proc rex_copy_to {} {
     ::getopt::parse \
 	-usage     {rex cp|copy [OPTIONS] FILE [FILE...] DEST} \
 	-docstring {Copies FILEs to DEST on each host.} \
+	-postprocess common_config_setup \
 	-before {global config} argc argv {
 	confirm,w
 	  {prompt and wait for confirmation before each host}
@@ -2782,7 +3005,6 @@ proc rex_copy_to {} {
     }
     debug 2 "argv=[join $config(argv)]"
 
-    common_config_setup
     hostlist_setup
 
     if {$config(sudo) != ""} {
@@ -2813,6 +3035,7 @@ proc rex_login {} {
     ::getopt::parse \
 	-usage   {rex login [OPTIONS] HOST} \
 	-docstring {Log in to HOST.} \
+	-postprocess common_config_setup \
 	-before {global config} argc argv {
 	    
 	interactive,I
@@ -2845,8 +3068,6 @@ proc rex_login {} {
     }
     set host [lshift argv]
 
-    common_config_setup
-    
     log_user [config_option log] 
 
     debug 2 "logging in to $host"
@@ -3080,7 +3301,24 @@ if {$argc == 0} {
     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
@@ -3088,14 +3326,11 @@ trap {
 } {SIGINT SIGQUIT SIGHUP SIGTERM}
 
 switch -- $config(mode) {
-    run            -
-    command        rex_command
+    run            rex_command
     
-    cp             -
-    copy           rex_copy_to
+    copy-to        rex_copy_to
     
-    copy-from      -
-    rcp            rex_copy_from
+    copy-from      rex_copy_from
     
     login          rex_login
     list           rex_list