Changeset bc98cf7 in tol for tolbase


Ignore:
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

Location:
tolbase/lib/rmtps_client
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • tolbase/lib/rmtps_client/rmtps_client.tcl

    r71d0868 rbc98cf7  
    99
    1010package provide rmtps_client 1.0
     11
     12package require base64
     13
     14if { [ catch { package require tlogger } ] } {
     15  namespace eval tlogger {
     16    variable _level "error"
     17
     18    proc init { svc {logfile ""} } {
     19    }
     20   
     21    proc level { svc l } {
     22      variable _level $l
     23    }
     24
     25    proc log { l msg } {
     26      variable _level
     27
     28      if { $l eq $_level } {
     29        puts $msg
     30      }
     31    }
     32  }
     33}
    1134
    1235###############################################################################
    … …  
    3861  #
    3962  variable mydir [file normalize [file dir [info script]]]
     63
     64 
     65}
     66
     67proc ::rmtps_client::init { {logfile ""} } {
     68  ::tlogger::init  rmtps_client $logfile
     69  ::tlogger::level rmtps_client "error"
     70}
     71
     72proc ::rmtps_client::log { level msg } {
     73 
     74  ::tlogger::log rmtps_client $level $msg
    4075}
    4176
    … …  
    96131  variable error_reason
    97132
     133  log "debug" "wait_result $chan"
     134
    98135  if {![eof $chan]} {
    99136    if {[gets $chan data] == -1} {
     137      log "debug" "wait_result : incomplete data"
    100138      return;                   # only handle complete lines
    101139    }
    … …  
    106144    fileevent $chan readable {}
    107145    set error_reason "end of channel from server"
     146    log "warn" "wait_result : end of channel from server"
    108147    # Cancel vwait
    109148    #
    … …  
    116155  # Return the data via the vwaited variable
    117156  #
     157  log "debug" "wait_result read : $data"
    118158  set server_result $data
    119159}
    … …  
    128168  variable server_result
    129169  variable error_reason
     170
     171  log "debug" "handle_timeout $chan"
    130172
    131173  # Set result from server to empty to return from vwait
    … …  
    161203  variable asking_error
    162204
     205  log "debug" "enter ask_server $host $port $request"
     206
    163207  # open channel to server
    164208  #
    … …  
    190234  vwait ::rmtps_client::server_result
    191235 
    192 #  if {$asking_error} {
    193 #    set asking_error 0
    194 #  } elseif {[string is integer $server_result] && $server_result==0} {
    195 #    set asking_error 1
    196 #    set error_reason [ask_server $host $port "LERROR"]
    197 #  }
    198236  catch {close $chan}
     237
     238  log "debug" "enter ask_server $host $port $server_result"
     239 
    199240  set server_result
    200241}
    … …  
    218259proc ::rmtps_client::server_ping { host port } {
    219260
     261  log "debug" "enter server_ping $host $port"
     262
    220263  # send request to server
    221264  #
    222265  set ans [ask_server $host $port "PING"]
    223   expr {$ans eq "RMTPS_SERVER WORKING"}
     266  set result [expr {$ans eq "RMTPS_SERVER WORKING"}]
     267
     268  log "debug" "leave server_ping $host $port"
     269
     270  set result
    224271}
    225272
    … …  
    243290proc ::rmtps_client::ps_is_active { host port PID } {
    244291
     292  log "debug" "enter ps_is_active $host $port $PID"
     293
    245294  # send request to server
    246295  #
    247296  set result [ask_server $host $port "ALIVE $PID"]
    248   # Answer from server must be an integer or boolean value
    249   #
    250   if {![string is integer $result] || ![string is boolean $result]} {
     297
     298  log "debug" "from ask_server = '$result'"
     299
     300  # Answer from server must be an integer value
     301  #
     302  if { $result eq "" || ![string is integer $result] ||
     303      ![string is boolean $result] } {
    251304    set result -1
    252305  } else {
    … …  
    255308    set result [expr {!!$result}]
    256309  }
     310
     311  log "debug" "leave ps_is_active $host $port $PID : $result"
     312
     313  set result
    257314}
    258315
    … …  
    277334###############################################################################
    278335proc ::rmtps_client::ps_kill { host port PID } {
     336
     337  log "debug" "enter ps_kill $host $port $PID"
    279338
    280339  # send request to server
    … …  
    288347    # Make sure 0, 1 or -1 is returned
    289348    #
    290     expr {$result==-1?-1:$result!=0}
    291   }
     349    set result [expr {$result==-1?-1:$result!=0}]
     350  }
     351
     352  log "debug" "leave ps_kill $host $port $PID : $result"
     353
     354  set result
    292355}
    293356
    … …  
    310373proc ::rmtps_client::ps_run { host port cmdline } {
    311374
     375  log "debug" "enter ps_run $host $port $cmdline"
     376
    312377  # send request to server
    313378  #
    … …  
    318383    set result 0
    319384  }
     385
     386  log "debug" "leave ps_run $host $port $cmdline : $result"
     387
     388  set result
     389}
     390
     391
     392###############################################################################
     393#
     394#  ps_runtol -- execute a TOL process on a remote host
     395#
     396#   Arguments --
     397#
     398#     host        - computer (remote host) where RmtPS_Server is running
     399#     port        - port where the server socket is listening
     400#     cmdln_args  - TOL arguments
     401#
     402#   Return --
     403#
     404#     PID of the process if cmdline could be executed
     405#     0 if the command line could not be executed
     406#
     407###############################################################################
     408proc ::rmtps_client::ps_runtol { host port cmdln_args } {
     409
     410  log "debug" "enter ps_runtol $host $port $cmdln_args"
     411
     412  # send request to server
     413  #
     414  set cmdln64 [ base64::encode -wrapchar "" $cmdln_args ]
     415  #set cmdln64 $cmdln_args
     416  set result [ask_server $host $port "RUNTOL $cmdln64"]
     417  # Make sure that 0 or PID>0 is returned
     418  #
     419  if {![string is integer $result] || $result<0} {
     420    set result 0
     421  }
     422
     423  log "debug" "leave ps_runtol $host $port $cmdln_args : $result"
     424
    320425  set result
    321426}

  • tolbase/lib/rmtps_client/rmtps_client.tol

    r71d0868 rbc98cf7  
    1010 *  Argumentos:
    1111 *
    12  *    Host:
    13  *    Port:
     12 *    Host: host que aloja al servidor RMTPS
     13 *   
     14 *    Port: puerto donde el servidor RMPTS esta escuchando
    1415 *
    1516 *  Resultado:
    … …  
    3738 *  Argumentos:
    3839 *
    39  *    Host:
    40  *    Port:
     40 *    Host: host que aloja al servidor RMTPS
     41 *   
     42 *    Port: puerto donde el servidor RMPTS esta escuchando
     43 *
    4144 *    CmdLine:
    4245 *
    … …  
    6568
    6669/**
     70 *  RemoteTOL -- Invoca un proceso TOL remoto
     71 *
     72 *  Argumentos:
     73 *
     74 *    Host: host que aloja al servidor RMTPS
     75 *   
     76 *    Port: puerto donde el servidor RMPTS esta escuchando
     77 *
     78 *    Args:
     79 *
     80 *  Resultado:
     81 *
     82 *    PID del proceso TOL lanzado o 0 si algun error ha ocurrido
     83 * 
     84 */
     85Real RemoteTOL(Text Host, Real Port, Set Args )
     86{
     87
     88  Text cmd = "::rmtps_client::ps_runtol";
     89  Text port = FormatReal(Port, "%.0lf");
     90  Text project = Args[ 1 ];
     91  Set tolargs = Args[ 2 ];
     92  Set cmdln_args = If( project=="", Copy( Empty ),
     93                       [[ "-project", project ]] );
     94  Set EvalSet( tolargs, Real( Set item ) {
     95      Text type = Name( item[ 1 ] );
     96      Case( type=="expr", {
     97          Set Append( cmdln_args, [[ "-expr", item[ 1 ] ]] );
     98          Real 0
     99        },
     100        type=="file", {
     101          Real idx_rel = FindIndexByName( item, "relative" );
     102          Set Append( cmdln_args,
     103                      If( idx_rel, {
     104                          Set [[ "-relative", item[ idx_rel ],
     105                                 "-file", item[ 1 ] ]]
     106                        }, {
     107                          Set [[ "-file", item[ 1 ] ]]
     108                        } ) );
     109          Real 0
     110        } ,
     111        1, {
     112          Warning( "RemoteTOL: tipo de elemento desconocido '"
     113                   + type + "' debe "
     114                   "ser 'expr' o 'file'" );
     115          Real 0
     116        } );
     117        Real 0
     118    } );
     119  Set tcl_args = [[ cmd, host, port ]] << [[ cmdln_args ]];
     120  //Set View( tcl_args, "Std" );
     121  Set result = Tcl_EvalEx( tcl_args );
     122  Real If(result["status"], Eval(result["result"]),{
     123      WriteLn("RemoteTOL: "+result["result"],"E");
     124      Real 0
     125    })
     126};
     127PutDescription("Ejecuta en proceso TOL remoto. Args es un conjunto con los "
     128               "argumentos a pasar a TOL en la linea de comandos.\n"
     129               "Los elementos de Args son interpretados por el servidor de "
     130               "procesos TOL y se traducen en argumentos de linea de comandos "
     131               "al proceso TOL que se invoca. Los argumentos son:\n"
     132               "\tText project = nombre del proyecto que se cargara\n"
     133               "\tSet tolargs = conjunto de elementos a evaluar.\n"
     134               "El conjunto tolargs contiene expresiones TOL o archivos a "
     135               "evaluar en la linea de comandos. Cada uno de los "
     136               "elementos es un conjunto con los siguientes elementos con "
     137               "nombre:\n"
     138               "\tText tolargs[1] : contiene la expresion o el nombre del "
     139               "\tarchivo a evaluar. El nombre de tolargs[1] debe ser expr o "
     140               "\tfile. Si el nombre es expr el valor se considera una "
     141               "\texpresion TOL. Si el nombre es file el valor se considera "
     142               "\tel nombre de un archivo a evaluar."
     143               "\tText relative = nombre de proyecto respecto al cual se "
     144               "\tcargara el archivo TOL. Este campo es opcional y solo se "
     145               "\tconsidera cuando el tolargs[1] es un archivo. Por omision "
     146               "\tel archivo se toma trelativo al argumento project.\n\n"
     147               "Retorna el PID del proceso TOL ejecutado o 0 si algun error "
     148               "ocurrio durante el intento de ejecucion. "
     149               "Necesita que un servidor RmtPS_Server este escuchando en el "
     150               "puerto Port del ordenador Host",
     151               RemoteTOL);
     152
     153/**
    67154 *  RemoteAlive -- Verifica, en remoto, si un proceso continua vivo
    68155 *
    69156 *  Argumentos:
     157 *
     158 *    Host: host que aloja al servidor RMTPS
     159 *   
     160 *    Port: puerto donde el servidor RMPTS esta escuchando
    70161 *
    71162 *    Host:
    … …  
    108199 *  Argumentos:
    109200 *
     201 *    Host: host que aloja al servidor RMTPS
     202 *   
     203 *    Port: puerto donde el servidor RMPTS esta escuchando
     204 *
    110205 *    Host:
    111206 *    Port:
Note: See TracChangeset for help on using the changeset viewer.