# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake  to update from <pkg>-buildversion.txt
# module template: punkshell/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm
#
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2009 Jose F. Nieves
#
# @@ Meta Begin
# Application punk::sshrun 999999.0a1.0
# Meta platform     tcl
# Meta license      ISC
# @@ Meta End

# Copyright (c) 2009 Jose F. Nieves <nieves@ltp.uprrp.edu>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_punk::sshrun 0 999999.0a1.0]
#[copyright "2009"]
#[titledesc {Tcl procedures to execute tcl scripts in remote hosts}]  [comment {-- Name section and table of contents description --}]
#[moddesc {punk::sshrun tclssh clone}]             [comment {-- Description at end of page heading --}]
#[require punk::sshrun]
#[keywords module ssh]
#[description]
#[para] This is a clone of tclssh by Jose F. Nieves
#[para] The original repo is at: https://bitbucket.org/noaaport/tclssh/src/master/
#[para] This version is namespaced under punk::sshrun specifically for the Punk shell project - and may lag the original project or diverge.
#[para] You are encouraged to use the original Tclssh source from the above URL for your own projects

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[section Overview]
#[para] overview of punk::sshrun
#[para] SYNOPSIS
#[para] package require punk::sshrun
#[para] -
#[para] punk::sshrun::connect [lb]-t <tclsh_name>[rb] [lb]-- <ssh_options>[rb] [lb]<user>@[rb]<host>
#[para] Defaults: -t tclsh
#[subsection Concepts]
#[para] -

####### original wiki documentation
##  Overview
##  Tclssh is a package of pure Tcl functions for executing Tcl scripts in a remote host. It is used by Nbsp and the WRFPak to offload some long-time running jobs in parallel to other computers.
##
##  The remote host must be accessible via ssh keys without a password; that is, for example, the contents of your ./ssh/id_rsa.pub must be added to the .ssh/authorized_keys file in the remote host.
##
##  The directory
##
##  <prefix>/share/doc/examples
##  has several examples that can be used for testing and documentation.
##
##  Example
##  The best way to explain how to use is by looking at one of them, ex-1.tcl.
##
##  #!/usr/bin/tclsh
##
##  package require ssh
##
##  #
##  # Collect in the string "script" the script that will be sent to the
##  # remote (slave) host.
##  #
##  set script {
##  puts "I am a remote host named [info hostname] executing a script
##  that my master sent me. I am going to sent him back the results of some
##  commands. Here they are:
##
##      The date is: [exec date]
##      My info is: [exec uname -a]
##
##  Now I need to inform my master that I have finished.
##
##  DONE 0"
##  };
##
##  set slave "is.1-loop.net";     # This is the remote host
##
##  #
##  # If the tcl shell in the remote host is just "tclsh" (e.g. a linux system)
##  # the -t option (and its argment) can be omitted; otherwise it can be
##  # used to specify the name of the remote tcl shell.
##  #
##  ::ssh::connect -t tclsh8.6 -- $slave
##  ::ssh::push $slave $script
##  ::ssh::send $slave;
##  while {[::ssh::pop_line $slave line] >= 0} {
##      if {[regexp {^DONE\s+(\d+)} $line match code]} {
##  	break;
##      }
##      puts $line;
##  }
##  ::ssh::disconnect $slave;
##
##  puts "Slave finished with code: $code";
##  Below is the output of executing ex-1.tcl from a machine named elite:
##
##  [nieves@elite examples]$ ./ex-1.tcl
##  I am a remote host named is.1-loop.net executing a script
##  that my master sent me. I am going to sent him back the results of some
##  commands. Here they are:
##
##      The date is: Sun Dec  9 17:35:43 AST 2012
##      My info is: Linux is 2.6.32-308.8.2.el5.028stab101.1 #1 SMP Sun Jun 24 20:25:35 MSD 2012 i686 GNU/Linux
##
##  Now I need to inform my master that I have finished.

##  Slave finished with code: 0
##  [nieves@elite examples]$
##  Several other examples in the
##
##  <prefix>/share/doc/examples
##  directory illustrate more capabilities of this package.















# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[subsection dependencies]
#[para] packages used by punk::sshrun
#[list_begin itemized]

package require Tcl 8.6-
package require cmdline
#*** !doctools
#[item] [package {Tcl 8.6}]
#[item] [package {cmdline}]

# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]

#*** !doctools
#[list_end]

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[section API]

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# oo::class namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::sshrun::class {
    #*** !doctools
    #[subsection {Namespace punk::sshrun::class}]
    #[para] class definitions
    if {[info commands [namespace current]::interface_sample1] eq ""} {
        #*** !doctools
        #[list_begin enumerated]

        # oo::class create interface_sample1 {
        #     #*** !doctools
        #     #[enum] CLASS [class interface_sample1]
        #     #[list_begin definitions]

        #     method test {arg1} {
        #         #*** !doctools
        #         #[call class::interface_sample1    [method test] [arg arg1]]
        #         #[para] test method
        #         puts "test: $arg1"
        #     }

        #     #*** !doctools
        #     #[list_end] [comment {-- end definitions interface_sample1}]
        # }

        #*** !doctools
        #[list_end] [comment {--- end class enumeration ---}]
    }
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::sshrun {
    namespace export *

    variable ssh;
    array set ssh {};

    #*** !doctools
    #[subsection {Namespace punk::sshrun}]
    #[para] Core API functions for punk::sshrun
    #[list_begin definitions]


    proc connect {args} {
        #*** !doctools
        #[call connect [arg args]]
        #[para] Must be called first.
        #[para] This proc opens an io channel to the tclsh in the remote host (via ssh) that is kept in an internal variable for subsequent use.
        #[para] The file handle can be retrieved if desired through the command: get_filehandle {host}
        variable ssh;

        set usage {connect [-t <tclsh_name>] [-- <ssh_options>]
        [<user>@]<host>};
        set optlist {{t.arg "tclsh"}};

        array set option [::cmdline::getoptions args $optlist $usage];
        set cmd [concat "|ssh" $args $option(t) 2>@ stdout];
        set F [open $cmd r+];

        set host [lindex $args end];
        if {[regexp {(.*)@(.*)} $host match s1 s2]} {
            set user $s1;
            set host $s2;
        }

        # These are the only internal variables (apart from the "user" variables).
        set ssh($host,F) $F;
        set ssh($host,script) [list];
    }

    proc disconnect {host} {
        #*** !doctools
        #   [call disconnect [arg host]]
        #   [para] Must be called last. Closes the filehandle opened by connect.
        variable ssh;

        system::_verify_connection $host;
        set status [catch {
        close $ssh($host,F);
        } errmsg];

        unset ssh($host,F);
        unset ssh($host,script);

        if {$status != 0} {
            return -code error $errmsg;
        }
    }

    proc push {host script} {
        #*** !doctools
        #   [call push [arg host] [arg script]]
        #   [para] <script> can be any tcl code.
        #   [para] For example, if the remote host is named "diablo"
        #   [example {
        #       ssh::push "diablo" "exec date"
        #       ssh::push "diablo" "exec uname -a"
        #   }]
        #   [para] The commands are note executed immediately. Instead, the "push" proc simply accumulates them in a list that is sent to the host when the "send" procedure is executed.
        #   [para] Each push proc inserts the newline '\n' character after each <script>
        #   [para] In the above example. Internally, each <script> is a member of a list, and when the "send" proc is invoked the entire script is constructed as a "join <list> \n

        variable ssh;
        system::_verify_connection $host;
        lappend ssh($host,script) $script;
    }

    proc send {host} {
        #*** !doctools
        #   [call send [arg host]]
        #   [para]This proc does the equivalent of a
        #   [example {
        #       puts <filehandle> [join <script_list> \n]
        #       flush <filehandle>
        #   }]
        variable ssh;
        system::_verify_connection $host;

        set status [catch {
            puts $ssh($host,F) [join $ssh($host,script) "\n"];
            flush $ssh($host,F);
        } errmsg];

        set ssh($host,script) [list];

        if {$status != 0} {
            return -code error $errmsg;
        }
    }
    proc send_exit {host} {
        #*** !doctools
        #   [call send_exit [arg host]]
        #   [para] This proc is similar to the above, but it "pushes" an exit command at the end of the script. The proc does the equivalent of
        #   [example {
        #       ssh::push <host> "exit"
        #       ssh::send <host>
        #   }]
        #   [para] The net effect if this is that the remote host's tclsh will exit, so that the filehandle receives an eof and we can use
        #   [example {
        #       [read <filehandle>]
        #   }]
        #   [para]to read the entire output at once (see the pop proc below)

        push $host "exit";
        send $host;
    }

    proc pop_line {host line_varname} {
        #*** !doctools
        #   [call pop_line [arg host] [arg line_varname]]
        #   [para]After executing a "send", this can be used to read one line of output. The proc does the equivalent of
        #   [example {
	    #       [gets <filehandle> line]
        #   }]
        upvar $line_varname line;
        variable ssh;

        system::_verify_connection $host;
        set r [gets $ssh($host,F) line];
        return $r;
    }

    proc pop_all {host output_varname} {
        #*** !doctools
        #   [call pop_all [arg host] [arg output_varname]]
        #   [para]This proc does the equivalent of
        #   [example {
        #       while {[pop_line $host line] >=0} {
        #           puts $line;
        #       }
        #   }]
        #   [para] but all the output is returned as one string in output_varname.
        #   [para]It should be used only when we know that the remote host's tclsh will exit, so that the above code will detect the eof and exit
        #   [para](see the send_exit proc above)
        #   [para]The function returns the number of lines read (0 if nothing is read before encoutering eof)
        #
        upvar $output_varname output;
        variable ssh;

        system::_verify_connection $host;

        set r 0;
        set output_list [list];
        while {[pop_line $host line] >= 0} {
            incr r;
            lappend output_list $line;
        }
        set output [join $output_list "\n"];

        return $r;
    }
    proc pop_read {host numbytes output_varname} {
        #*** !doctools
        #   [call pop_read [arg host] [arg numbytes] [arg output_varname]]
        #   [para] Returns: numbytes read. If numbytes is not positive, then read is called without the numbytes argument.
        upvar $output_varname output;
        variable ssh;

        system::_verify_connection $host;

        if {$numbytes <= 0} {
        set output [read $ssh($host,F)];
        } else {
        set output [read $ssh($host,F) $numbytes];
        }

        return [string length $output];
    }

    proc hfileevent {host readable_writable script} {
        #*** !doctools
        #   [call hfileevent [arg host] [arg readable_writable] [arg script]]
        #   [para] Equivalent to:
        #   [example {
        #       fileevent <filehandle> $readable_writable $script
        #   }]
        variable ssh;
        system::_verify_connection $host;
        chan event $ssh($host,F) $readable_writable $script;
    }

    proc hfconfigure {host args} {
        #*** !doctools
        #   [call hconfigure [arg host] [arg args]]
        variable ssh;
        system::_verify_connection $host;
        eval chan configure $ssh($host,F) $args;
    }

    proc rexec {host script output_varname} {
        #*** !doctools
        #   [call rexec [arg host] [arg script] [arg output_varname]]
        #   [para] shortcut for:
        #   [example {
        #      ssh::rexec_nopop $host $script
        #      ssh::pop_all $host outputvar
        #   }]
        upvar $output_varname output;
        rexec_nopop $host $script;
        pop_all $host output;
    }

    proc rexec_nopop {host script} {
        push $host $script;
        send_exit $host;
    }

    #
    # Utility
    #
    proc set_var {host var val} {
        variable ssh;
        # These functions can be used even when there is no valid connection
        # and therefore we do not call _verify_connection here.
        set ssh($host,user,$var) $val;
    }

    proc get_var {host var} {
        variable ssh;
        if {[info exists ssh($host,user,$var)] == 0} {
            return -code error "$var not defined";
        }
        return $ssh($host,user,$var);
    }

    proc incr_var {host var {step 1}} {
        variable ssh;
        if {[info exists ssh($host,user,$var)] == 0} {
            return -code error "$var not defined";
        }
        puts "incr ssh($host,user,$var) by $step";
        incr ssh($host,user,$var) $step;
    }

    proc set_lvar {var val} {
        set host "localhost";
        set_var $host $var $val;
    }

    proc get_lvar {var} {
        set host "localhost";
        set status [catch {
            set r [get_var $host $var];
        } errmsg];

        if {$status != 0} {
            return -code error $errmsg;
        }
        return $r;
    }

    proc incr_lvar {var {step 1}} {
        set host "localhost";
        incr_var $host $var $step;
    }

    #
    # low level
    #
    proc get_filehandle {host} {
        #*** !doctools
        #   [call get_filehandle [arg host]]
        variable ssh;
        system::_verify_connection $host;

        return $ssh($host,F);
    }

    #*** !doctools
    #[list_end] [comment {--- end definitions namespace punk::sshrun ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::sshrun::lib {
    namespace export *
    namespace path [namespace parent]
    #*** !doctools
    #[subsection {Namespace punk::sshrun::lib}]
    #[para] Secondary functions that are part of the API
    #[list_begin definitions]

    #proc utility1 {p1 args} {
    #    #*** !doctools
    #    #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]]
    #    #[para]Description of utility1
    #    return 1
    #}



    #*** !doctools
    #[list_end] [comment {--- end definitions namespace punk::sshrun::lib ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Internal]
namespace eval punk::sshrun::system {
    #*** !doctools
    #[subsection {Namespace punk::sshrun::system}]
    #[para] Internal functions that are not part of the API

    #
    # private
    #
    proc _verify_connection {host} {
        upvar ::punk::sshrun::ssh ssh
        #variable ssh;
        if {[info exists ssh($host,F)]} {
            return 1;
        }
        return -code error "There is no connection to $host.";
    }


}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready
package provide punk::sshrun [namespace eval punk::sshrun {
    variable pkg punk::sshrun
    variable version
    set version 999999.0a1.0
}]
return

#*** !doctools
#[manpage_end]