Changeset 71d0868 in tol for tolsh/tolsh.vfs/lib/tolcomm/rmtps_client.tcl

Timestamp:

Dec 15, 2009, 1:39:04 PM (17 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

1941-docker-image-to-test, devel, master

Children:

bc98cf7

Parents:

e213da6

Message:

fix #812 : ps_runtol tcl client side, RemoteTOL tol cliente side of RUNTOL request

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@1810 be4846ae-f051-483a-831f-b64e7d08527f

File:

• tolsh/tolsh.vfs/lib/tolcomm/rmtps_client.tcl (modified) (4 diffs)

tolsh/tolsh.vfs/lib/tolcomm/rmtps_client.tcl

@@ -10 +10 @@
 package provide rmtps_client 1.0
 
-package require tlogger
+package require base64
+
+if { [ catch { package require tlogger } ] } {
+  namespace eval tlogger {
+    variable _level "error"
+
+    proc init { svc {logfile ""} } {
+    }
+    
+    proc level { svc l } {
+      variable _level $l
+    }
+
+    proc log { l msg } {
+      variable _level 
+
+      if { $l eq $_level } {
+        puts $msg
+      }
+    }
+  }
+}
 
 ###############################################################################
@@ -159 +180 @@
 }
 
+proc ask_server_channel { chan request } {
+
+  usado sobre todo para pedir la razon del fallo
+
+  el timeout quizas deba cerrar el channel, esa peticion se cancela
+
+  file channels puedo usarlo para verificar si un socket existe.
+}
+
 ###############################################################################
 #
@@ -270 +300 @@
   # Answer from server must be an integer value
   #
-  if {$result eq "" || ![string is integer $result]} {
+  if { $result eq "" || ![string is integer $result] ||
+      ![string is boolean $result] } {
     set result -1
   } else {
@@ -358 +389 @@
 }
 
+
+###############################################################################
+#
+#  ps_runtol -- execute a TOL process on a remote host
+#
+#   Arguments --
+#
+#     host        - computer (remote host) where RmtPS_Server is running
+#     port        - port where the server socket is listening
+#     cmdln_args  - TOL arguments
+#
+#   Return --
+#
+#     PID of the process if cmdline could be executed
+#     0 if the command line could not be executed
+#
+###############################################################################
+proc ::rmtps_client::ps_runtol { host port cmdln_args } {
+
+  log "debug" "enter ps_runtol $host $port $cmdln_args"
+
+  # send request to server
+  #
+  set cmdln64 [ base64::encode -wrapchar "" $cmdln_args ]
+  #set cmdln64 $cmdln_args
+  set result [ask_server $host $port "RUNTOL $cmdln64"]
+  # Make sure that 0 or PID>0 is returned
+  #
+  if {![string is integer $result] || $result<0} {
+    set result 0
+  }
+
+  log "debug" "leave ps_runtol $host $port $cmdln_args : $result"
+
+  set result
+}
+
 ###############################################################################
 #