Changeset bc98cf7 in tol for tolbase/lib/rmtps_client/rmtps_client.tcl

Timestamp:

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

Author:

Jorge Pérez <josp.jorge@…>

Branches:

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

Children:

8642d7e

Parents:

71d0868

Message:

refs #812 : merging changes from tolsh

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

File:

• tolbase/lib/rmtps_client/rmtps_client.tcl (modified) (15 diffs)

tolbase/lib/rmtps_client/rmtps_client.tcl

@@ -9 +9 @@
 
 package provide rmtps_client 1.0
+
+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
+      }
+    }
+  }
+}
 
 ###############################################################################
@@ -38 +61 @@
   #
   variable mydir [file normalize [file dir [info script]]]
+
+  
+}
+
+proc ::rmtps_client::init { {logfile ""} } {
+  ::tlogger::init  rmtps_client $logfile
+  ::tlogger::level rmtps_client "error"
+}
+
+proc ::rmtps_client::log { level msg } {
+  
+  ::tlogger::log rmtps_client $level $msg
 }
 
@@ -96 +131 @@
   variable error_reason
 
+  log "debug" "wait_result $chan"
+
   if {![eof $chan]} {
     if {[gets $chan data] == -1} {
+      log "debug" "wait_result : incomplete data"
       return;                   # only handle complete lines
     }
@@ -106 +144 @@
     fileevent $chan readable {}
     set error_reason "end of channel from server"
+    log "warn" "wait_result : end of channel from server"
     # Cancel vwait
     #
@@ -116 +155 @@
   # Return the data via the vwaited variable
   #
+  log "debug" "wait_result read : $data"
   set server_result $data
 }
@@ -128 +168 @@
   variable server_result
   variable error_reason
+
+  log "debug" "handle_timeout $chan" 
 
   # Set result from server to empty to return from vwait
@@ -161 +203 @@
   variable asking_error
 
+  log "debug" "enter ask_server $host $port $request"
+
   # open channel to server
   #
@@ -190 +234 @@
   vwait ::rmtps_client::server_result
   
-#  if {$asking_error} {
-#    set asking_error 0
-#  } elseif {[string is integer $server_result] && $server_result==0} {
-#    set asking_error 1
-#    set error_reason [ask_server $host $port "LERROR"]
-#  }
   catch {close $chan}
+
+  log "debug" "enter ask_server $host $port $server_result"
+  
   set server_result
 }
@@ -218 +259 @@
 proc ::rmtps_client::server_ping { host port } {
 
+  log "debug" "enter server_ping $host $port"
+
   # send request to server
   #
   set ans [ask_server $host $port "PING"]
-  expr {$ans eq "RMTPS_SERVER WORKING"}
+  set result [expr {$ans eq "RMTPS_SERVER WORKING"}]
+
+  log "debug" "leave server_ping $host $port"
+
+  set result
 }
 
@@ -243 +290 @@
 proc ::rmtps_client::ps_is_active { host port PID } {
 
+  log "debug" "enter ps_is_active $host $port $PID"
+
   # send request to server
   #
   set result [ask_server $host $port "ALIVE $PID"]
-  # Answer from server must be an integer or boolean value
-  #
-  if {![string is integer $result] || ![string is boolean $result]} {
+
+  log "debug" "from ask_server = '$result'"
+
+  # Answer from server must be an integer value
+  #
+  if { $result eq "" || ![string is integer $result] ||
+      ![string is boolean $result] } {
     set result -1
   } else {
@@ -255 +308 @@
     set result [expr {!!$result}]
   }
+
+  log "debug" "leave ps_is_active $host $port $PID : $result"
+
+  set result
 }
 
@@ -277 +334 @@
 ###############################################################################
 proc ::rmtps_client::ps_kill { host port PID } {
+
+  log "debug" "enter ps_kill $host $port $PID"
 
   # send request to server
@@ -288 +347 @@
     # Make sure 0, 1 or -1 is returned
     #
-    expr {$result==-1?-1:$result!=0}
-  }
+    set result [expr {$result==-1?-1:$result!=0}]
+  }
+
+  log "debug" "leave ps_kill $host $port $PID : $result"
+
+  set result
 }
 
@@ -310 +373 @@
 proc ::rmtps_client::ps_run { host port cmdline } {
 
+  log "debug" "enter ps_run $host $port $cmdline"
+
   # send request to server
   #
@@ -318 +383 @@
     set result 0
   }
+
+  log "debug" "leave ps_run $host $port $cmdline : $result"
+
+  set result
+}
+
+
+###############################################################################
+#
+#  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
 }