#!/bin/sh
#
# multissh
#
# Program for simultaneously executing commands on multiple remote hosts.
#
# Written by Andy Goth <unununium@openverse.com>, 2005
#
# The next line restarts with tclsh\
exec tclsh "$0" ${1+"$@"}

# TODO/ideas:
# - Continue investigation of closing only stdin and leaving stdout/stderr open.
# - Continue investigation of getting stderr text without closing the channel.
# - Double-check that the standalone/sourced test is correct.
# - Make reentrant by eliminating globals or creating "instances".
# - Allow the caller to supply handlers for various events.
# - Convert the puts's into default event handlers.
# - Allow the caller to supply an alternate source for stdin data.
# - Optionally return immediately and expose [node_wait] in some form.
# - Be more configurable in general.
# - Write a GUI frontend.

# Create a namespace.
namespace eval ::multissh {
    namespace export multissh
}

# Adds a node to the list.
proc ::multissh::node_create {id chan name} {
    variable nodes
    array set nodes [list\
        $id,chan $chan   \
        $id,name $name   \
    ]
    lappend nodes(dir) $id
}

# Removes a node from the list.
proc ::multissh::node_delete {id} {
    variable nodes
    array unset nodes $id,*
    set index [lsearch -exact $nodes(dir) $id]
    set nodes(dir) [lreplace $nodes(dir) $index $index]
}

# Returns the number of nodes in the list.
proc ::multissh::node_count {} {
    variable nodes
    return [llength $nodes(dir)]
}

# Returns a list of all node ids.
proc ::multissh::node_list {} {
    variable nodes
    return $nodes(dir)
}

# Returns the channel associated with a node.
proc ::multissh::node_chan {id} {
    variable nodes
    return $nodes($id,chan)
}

# Returns the name of a node.
proc ::multissh::node_name {id} {
    variable nodes
    return $nodes($id,name)
}

# Waits for an update to the node list.
proc ::multissh::node_wait {} {
    vwait [namespace current]::nodes
}

# Broadcasts data to all nodes.
proc ::multissh::node_broadcast {data} {
    # Send input data to all children.
    foreach id [node_list] {
        node_send $id $data
    }
}

# Sends data to a node.
proc ::multissh::node_send {id data} {
    if {[catch {
        # Send the data.
        puts -nonewline [node_chan $id] $data
        flush [node_chan $id]
    }]} {
        # Uh oh, error writing to child.
        node_close $id
    }
}

# Gets one line of data from a node
proc ::multissh::node_gets {id} {
    gets [node_chan $id]
}

# Closes a node.
proc ::multissh::node_close {id} {
    # Blocking must be reenabled in order to kill the child and get stderr.
    fconfigure [node_chan $id] -blocking true

    # I understand that in the latest versions of Tcl 8.5, it's possible to
    # combine stdout and stderr.  This means we won't have to wait until the
    # channel is closed to get the text sent to stderr, but also it makes it
    # impossible to differentiate between stdout and stderr.  All in all I
    # don't think we can use this feature.
    if {[catch {close [node_chan $id]} result]} {
        puts stderr "[node_name $id]: $result"
    }
    node_delete $id
}

# Returns true if a node's channel is blocked.
proc ::multissh::node_blocked {id} {
    return [fblocked [node_chan $id]]
}

# Returns true if a node's channel is at end of file.
proc ::multissh::node_eof {id} {
    return [eof [node_chan $id]]
}

# Broadcasts data to all remaining children.
proc ::multissh::broadcast {} {
    variable broadcast_seen_data

    # Get the data.
    set data [read stdin]

    if {[eof stdin]} {
        # No more input data.
        close stdin

        # Filthy hack to work around Tcl's lack of support for closing
        # individual file descriptors in a read-write channel...
        #
        # BUG: This doesn't do the right thing, only an approximation thereof.
        # It should be closing the stdins of the children, but this isn't
        # possible with the current version of the Tcl commands.
        if {$broadcast_seen_data} {
            # Kill everything.
            foreach id [node_list] {
                node_close $id
            }
        }
    } else {
        # Send!
        set broadcast_seen_data true
        node_broadcast $data
    }
}

# Receives data from a child.
proc ::multissh::receive {id} {
    # Get the data.
    set data [node_gets $id]

    if {[node_blocked $id]} {
        # Don't have a complete line yet.
        return
    }

    if {![node_eof $id] || $data ne ""} {
        # Send received data to stdout.
        puts stdout "[node_name $id]: $data"
    }

    if {[node_eof $id]} {
        # Child quit.
        node_close $id
    }
}

# Prepare for a multissh session.
proc ::multissh::multissh_init {} {
    variable broadcast_seen_data

    set broadcast_seen_data false
}

# The main procedure.
proc ::multissh::multissh {node_list command_line} {
    # Create child processes.
    set id 0
    foreach name $node_list {
        if {[catch {open |[list ssh -e none $name $command_line] a+} result]} {
            # Failure to start ssh. 
            puts stderr "$name: $result"
        } else {
            # Success.
            fconfigure $result -blocking false -buffering line\
                    -translation binary
            node_create $id $result $name
            fileevent $result readable [namespace code [list receive $id]]
            incr id
        }
    }

    # Initialize internal variables and such.
    multissh_init

    # Arrange to broadcast all data from stdin to all children.
    fconfigure stdin -blocking false -buffering none -translation binary
    fileevent stdin readable [namespace code broadcast]

    # Wait for all children to quit.
    while {[node_count] != 0} {
        node_wait
    }
}

# Check to see if we were sourced or executed directly.
if {[catch {
    file stat [file normalize [info script]] a
    file stat [file normalize $argv0       ] b
    set same_file [expr {$a(ino) == $b(ino) && $a(dev) == $b(dev)}]
    unset a b
}]} {
    set same_file false
}
if {$same_file} {
    # Executed directly.
    if {[llength $argv] != 2} {
        puts stderr "Usage: multissh \"list of nodes\" \"command to execute\""
        exit 1
    } else {
        multissh::multissh [lindex $argv 0] [lindex $argv 1]
    }
} else {
    # Sourced.
    unset same_file
    namespace import ::multissh::multissh
    package provide multissh 0.2
}

# vim: set ts=4 sts=4 sw=4 tw=80 et ft=tcl: