jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
799 Commits
1 Branch
1 Tag
191 MiB
 
 
 
 
 
 
Tree: 04aa034aa3
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '04aa034aa3'
${ noResults }
punkshell/src/modules/punk/sshrun-999999.0a1.0.tm

551 lines
16 KiB
Raw Blame History

# -*- 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]