source: tol/tolsh/tolsh.vfs/lib/app-tolsh/tolsh.tcl @ b47c991

1941-docker-image-to-testdevel
Last change on this file since b47c991 was b47c991, checked in by Jorge Pérez <josp.jorge@…>, 15 years ago

refs #1259, implementamos el argumento '-np' en tol::initlibrary, interpretamos la opcion -np en tolsh y tolbase

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@3655 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100755
File size: 16.8 KB
Line 
1#!/usr/bin/env tclsh
2
3###############################################################################
4#
5# tolsh.tcl --
6#
7###############################################################################
8
9package provide tolsh 1.0
10
11###############################################################################
12#
13#  Tol_HciWriter --
14#
15#  This file will be invoked by TOL if HCI output is enabled
16#
17###############################################################################
18proc Tol_HciWriter { msg } {
19  puts [string trim $msg]
20}
21
22###############################################################################
23#
24#  namespace tolsh -- encapsulate tolsh functionality
25#
26###############################################################################
27namespace eval ::tolsh {
28  variable options
29
30  # By default load initLibrary
31  #
32  set options(lang)    0
33  set options(initlib) 1
34  set options(iniproject) 1
35  set options(compile) ""
36  set options(vmode)   ""
37  set options(out,enabled) no
38  set options(runmode) ""
39  set options(tolversion) ""
40}
41
42###############################################################################
43#
44#  getoptions -- process the command line
45#
46#  The command line accepted by tolsh is:
47#
48#    -i       --> do not include initLibrary
49#    -np      --> do not load _iniproject.tol
50#    -c"..."  --> compile a tol expression
51#    -c "..." --> compile a tol expression
52#    -v?A?    --> enable all output
53#    -vE      --> enable error output
54#    -vS      --> enable system output
55#    -vU      --> enable user output
56#    -vT      --> enable trace output
57#    -m?A?    --> disable all output
58#    -mE      --> disable error output
59#    -mS      --> disable system output
60#    -mU      --> disable user output
61#    -mT      --> disable trace output
62#    -d       --> start in dialog mode
63#    -e?n?    --> use english language
64#    -s?p?    --> use spanish language
65#    -tolversion ver --> specify an strict tol version to start with
66#    -server [port]  --> start tol as a server tolsvc.<pid>.log will be the log
67#             [port] is the port number where the serve will be listening.
68#
69#  Any other value will be considered a file to compile
70#
71#  Arguments:
72#
73###############################################################################
74proc ::tolsh::getoptions { cmdline } {
75  variable options
76
77  logtmp "entering ::tolsh::getoptions $cmdline"
78
79  # cmdline could be a bad list so the next sentence could fail.
80  # try to test it in front of bugs situations.
81  set num [llength $cmdline]
82  set delayed_msg ""
83  set i 0
84  while {$i < $num} {
85    set item [lindex $cmdline $i]
86    if {[string index $item 0] eq "-"} {
87      set opt [string range $item 1 end]
88      if {$opt eq "e" || $opt eq "en"} {
89        set $options(lang) 0
90      } elseif {$opt eq "s" || $opt eq "sp"} {
91        set $options(lang) 1
92      } elseif {$opt eq "i"} {
93        # initLibrary should not be loaded
94        #
95        set options(initlib) 0
96      } elseif {$opt eq "np"} {
97        set $options(iniproject) 0
98      } elseif {[string index $opt 0] eq "c"} {
99        if {[string length $opt]>1} {
100          # The tol expression is part of the option
101          #
102          set expr [string range $opt 1 end]
103        } else {
104          # Next argument is the expression to compile
105          #
106          incr i
107          set expr [lindex $cmdline $i]
108        }
109        # Put expr in the list of "things" to compile
110        #
111        lappend options(compile) [list expr $expr]
112      } elseif {[string index $opt 0] eq "v"} {
113        if {[regexp {^[A|S|U|T|E|W]*$} [string range $opt 1 end] mode]} {
114          if {$mode eq ""} {
115            set mode A
116          }
117          if {[regexp {[A|S]} $mode]} {
118            set options(out,enabled) yes
119          }
120          append options(vmode) "v$mode "
121        } else {
122          append delayed_msg "\nignoring unknown verbose mode: '$opt'"
123        }
124      } elseif {[string index $opt 0] eq "m"} {
125        if {[regexp {^[A|S|U|T|E|W]*$} [string range $opt 1 end] mode]} {
126          if {$mode eq ""} {
127            set mode A
128          }
129          if {[regexp {[A|S]} $mode]} {
130            set options(out,enabled) no
131          }
132          append options(vmode) "m$mode "
133        } else {
134          append delayed_msg "\nignoring unknown mute mode: '$opt'"
135        }
136      } elseif {$opt eq "d"}  {
137        if {$options(runmode) ne "" && $options(runmode) ne "interactive"} {
138          puts "Replacing previous run mode '$options(runmode)' with 'interactive'"
139        }
140        set options(runmode) "interactive"
141      } elseif {$opt eq "tolversion"} {
142        incr i
143        set options(tolversion) [lindex $cmdline $i]
144      } elseif {$opt eq "server"} {
145        # check if next argument is the port number
146        set port [lindex $cmdline [expr {$i+1}]]
147        if {[string is integer $port]} {
148          # $i+1 is an integer, should be considered as a port number
149          incr i
150          if {$port <= 0} {
151            puts "Could not start as a server: invalid port number '${port}'"
152            exit
153          }
154          if {$options(runmode) ne "" && $options(runmode) ne "server"} {
155            puts "Replacing previous run mode '$options(runmode)' with 'server'"
156          }
157          set options(runmode) "server"
158          set options(server,port) $port
159        } else {
160          puts "Could not start as a server: invalid port number '${port}'"
161          exit
162        }
163      } elseif {$opt eq "slave"} {
164        # the next argument is the port number
165        set options(server,port) [lindex $cmdline [expr {$i+1}]]
166        incr i
167        if {$options(runmode) ne "" && $options(runmode) ne "slave"} {
168          puts "Replacing previous run mode '$options(runmode)' with 'slave'"
169        }
170        set options(runmode) "slave"
171      } elseif {$opt eq "shared"} {
172        # the next argument is the port number
173        set options(shared,port) [lindex $cmdline [expr {$i+1}]]
174        incr i
175        if {$options(runmode) ne "" && $options(runmode) ne "shared"} {
176          puts "Replacing previous run mode '$options(runmode)' with 'shared'"
177        }
178        set options(runmode) "shared"
179      }  elseif {$opt eq "shport"} {
180        # the next argument is the port number
181        set options(shared,port) [lindex $cmdline [expr {$i+1}]]
182        incr i
183      } else {
184        append delayed_msg "\nignoring unknown option: '$item'"
185      }
186    } else {
187      # Consider this option as a tol file to compile.
188      #
189      if {![file exists $item] || ![file readable $item]} {
190        puts "file $item does not exist or is not readable"
191      } else {
192        lappend options(compile) [list file $item]
193      }
194    }
195    incr i
196  }
197  if {$delayed_msg ne ""} {
198    std $delayed_msg
199  }
200}
201
202###############################################################################
203#
204#  something_to_compile -- tell us if there is something to do
205#
206#  Depending on the command line processing some tol expression or
207#  files needs to be compiled. All this is stored in options(compile)
208#
209#  Return:
210#
211#    true value if there is something to compile in $options(compile)
212#    false if $options(compile) is empty
213#
214###############################################################################
215proc ::tolsh::something_to_compile { } {
216  variable options
217
218  llength $options(compile)
219}
220
221###############################################################################
222#
223#  show_usage -- show how to invoke tolsh
224#
225#  This proc print into stdout a message that list the valid options accepted.
226#
227###############################################################################
228proc ::tolsh::show_usage { } {
229  puts "[get_app_name] \[options] filename ...\noptions:"
230  puts {
231    -i file  --> include a file but not initLibrary
232    -np      --> do not load _iniproject.tol
233    -c"..."  --> compile a tol expression
234    -c "..." --> compile a tol expression
235    -v?A?    --> enable all output
236    -vE      --> enable error output
237    -vS      --> enable standard output
238    -vU      --> enable user output
239    -vT      --> enable trace output
240    -m?A?    --> disable all output
241    -mE      --> disable error output
242    -mS      --> disable standard output
243    -mU      --> disable user output
244    -mT      --> disable trace output
245    -d       --> start in dialog mode
246    -e?n?    --> use english language
247    -s?p?    --> use spanish language
248    -tolversion --> specify an strict tol version to start with
249    -server [port] --> start tol as a server tolsvc.<pid>.log will be the log
250            [port] is the port number where the serve will be listening.
251 
252  Multiple verbose mode is accepted in one option, for instance,
253
254    -vUE
255  }
256}
257
258###############################################################################
259#
260#  getArgv0 -- return the name of the app
261#
262###############################################################################
263proc ::tolsh::get_app_name {} {
264    global argv0
265
266    set name [file tail $argv0]
267    return [file rootname $name]
268}
269
270###############################################################################
271#
272#  append_message -- save a message
273#
274###############################################################################
275proc ::tolsh::std { msg } {
276  variable options
277
278  if {$options(out,enabled)} {
279    puts $msg
280  }
281}
282
283#puts "starkit = [namespace exist ::starkit]"
284#puts "topdir = [file dir $starkit::topdir]"
285#puts "info script = [info script]"
286#puts "starkit::startup = [starkit::startup]"
287#puts "[ info commands starkit::* ]"
288#puts "argv0 = $argv0"
289
290proc ::tolsh::setup_pkg { pkg } {
291  if {[lsearch [package names] $pkg]==-1} {
292    if {[namespace exist ::starkit]} {
293      set bindir [file dir $starkit::topdir]
294      set libdir [file join $bindir .. lib]
295      set pkg_dirs [glob -nocomplain -dir $libdir ${pkg}*]
296      if {[llength $pkg_dirs]} {
297        lappend ::auto_path [file normalize $libdir]
298      } else {
299        set tclsh [auto_execok tclsh]
300        if {![catch {
301          exec echo puts {$::auto_path} | $tclsh
302        } ext_auto_path]} {
303          foreach p $ext_auto_path {
304            if {[lsearch $::auto_path $p]==-1} {
305              lappend ::auto_path $p
306            }
307          }
308        }
309      }
310      tclPkgUnknown ${pkg}+1 ""
311    } else {
312      set pkg_dev_dir [file normalize [file join .. $pkg]]
313      if {[file exists $pkg_dev_dir] && [file isdir $pkg_dev_dir]} {
314        lappend ::auto_path $pkg_dev_dir
315      }
316    }
317  }
318}
319
320###############################################################################
321#
322#  setup_autopath --
323#
324#  Set auto_path in order to find correctly the following packages:
325#
326#    - toltcl
327#    - rmtps_client
328#
329###############################################################################
330proc ::tolsh::setup_autopath { } {
331  logtmp "entering ::tolsh::setup_autopath"
332
333  setup_pkg toltcl
334  setup_pkg tolcomm
335  setup_pkg tlogger
336  setup_pkg tequila
337  setup_pkg tequilas
338
339  logtmp "auto_path = $::auto_path"
340  logtmp "leaving ::tolsh::setup_autopath" 
341}
342
343proc GetHomeDir { } {
344  global env
345  # Check if we're using windows
346  if { $::tcl_platform(platform) eq "windows" } {
347    package require registry 1.0
348    set key1 {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders}
349    set key2 {Personal}
350    set env_home [ registry get $key1 $key2 ]
351    if {[string match %USERPROFILE%* $env_home]} {
352      set env_home [string replace $env_home 0 12 $env(USERPROFILE)]
353    }
354  } else {
355    set env_home $env(HOME)
356  }
357  return $env_home
358}
359
360###############################################################################
361#
362#  main -- entry point for tolsh application
363#
364###############################################################################
365proc ::tolsh::run { cmdline } {
366  variable options
367
368  #logtmp "user : [ exec whoami ]"
369  logtmp "entering run with cmdline = $cmdline"
370  # Process command line options
371  #
372  getoptions $cmdline
373  logtmp "options(compile): $options(compile)"
374  logtmp "options(runmode): $options(runmode)"
375  if {![something_to_compile] && ($options(runmode) eq "")} {
376    show_usage
377    return
378  }
379 
380  logtmp "pase getoptions"
381
382  # Ensure Toltcl is found
383  #
384  setup_autopath
385
386  # Load Toltcl (+tol) and initLibrary if required
387  #
388  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
389    package require -exact Toltcl 2.0.2
390    tol::initkernel $options(lang) $options(vmode)
391
392    if {$options(initlib)} {
393      tol::initlibrary $options(iniproject)
394    }
395
396    set appdata [string trim \
397               [lindex [::tol::info var [list Text TolAppDataPath]] 2] \"]
398    logtmp "appdata = $appdata"
399  }
400
401  set tolcomm_dir [file join [GetHomeDir] ".tol" "tolcomm"]
402  file mkdir $tolcomm_dir
403
404  # load rmtps_client and tolclient if required
405  #
406  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
407 
408    if {[catch {package require rmtps_client} msg]} {
409      std "could not load rmtps_client: $msg"
410    } else {
411      ::rmtps_client::init [file join $tolcomm_dir "rmtps_client.log"]
412      if {[catch rmtps_client::define_TOLAPI msg]} {
413        std "could not load tol code for rmtps_client: $msg"
414      }
415    }
416 
417    if {[catch {package require tolclient} msg]} {
418      std "could not load tolclient: $msg"
419    } else {
420      ::tolclient::init [file join $tolcomm_dir "tolclient.log"]
421      if {[catch ::tolclient::define_TOLAPI msg]} {
422        std "could not load tol code for rmtps_client: $msg"
423      }
424    }
425   
426  }
427
428  # Compile expression and tol file provided in the command line if required
429  #
430  if {$options(runmode) != "server" && $options(runmode) != "shared" \
431                                    && $options(runmode) != "slave" } {
432
433    foreach item $options(compile) {
434      if {[lindex $item 0] eq "expr"} {
435        tol::console eval [lindex $item 1]
436      } elseif {[lindex $item 0] eq "file"} {
437        tol::include [lindex $item 1]
438      }
439    }
440
441  }
442 
443  if {$options(runmode) eq "interactive"} {
444    # assign our event handler for stdin
445    fileevent stdin readable ::tolsh::stdin_handler
446    # send a startup message and initial prompt
447    puts stdout "TOL interactive shell activated..."
448    console_prompt
449    # enter the tcl event loop
450    vwait __forever__
451   
452  } elseif {$options(runmode) eq "server"} {
453    puts "runmode=server"
454    run_as_server $tolcomm_dir
455   
456  } elseif {$options(runmode) eq "shared"} {
457    puts "runmode=shared"
458    run_as_shared $tolcomm_dir
459 
460  } elseif {$options(runmode) eq "slave"} {
461    puts "runmode=slave"
462    run_as_slave $tolcomm_dir   
463  }
464}
465
466proc ::tolsh::run_as_server {tolcomm_dir} {
467  variable options
468  package require tolserver
469
470  set shared_port [ clone ]
471  tolserver::start -port $options(server,port) \
472    -shport $shared_port \
473    -logfile [file join $tolcomm_dir "tolserver.log"] \
474    -compile $options(compile)
475  vwait __forever__
476}   
477
478proc ::tolsh::find_shared_port { port } {
479  puts "::tolsh::find_shared_port $port"
480  set i 0
481  while { $i < 100 } {
482    if { [ catch { socket localhost $port } fd ] } {
483      puts "find_shared_port OK = $port"
484      return $port
485    }
486    incr port
487    incr i
488  }
489  puts "find_shared_port FAIL!"
490  return 0
491}
492
493proc ::tolsh::clone {} {
494  variable options
495
496  puts "::tolsh::clone"
497  set tolsh [list [info nameofexecutable] ]
498  if { $starkit::tolsh_mode ne "starpack" } {
499    lappend tolsh $::argv0
500  }
501  set shared_port [ find_shared_port 20458 ]
502  if { !$shared_port } {
503    puts "::tolsh::clone: could not find a valid port for shared data"
504    exit
505  }
506  eval exec $tolsh -shared $shared_port &
507  after 5000            ;# wait for data sharing are created by 'shared'
508  puts "exec slave"
509  eval exec $tolsh -slave $options(server,port) -shport $shared_port &
510  return $shared_port
511}
512
513proc ::tolsh::run_as_shared { tolcomm_dir } {
514  package require tolshared
515  variable options
516
517  tolshared::start $options(shared,port) $tolcomm_dir
518}   
519
520proc ::tolsh::run_as_slave { tolcomm_dir } {
521  variable options
522  package require tolslave
523
524  tolslave::start -port $options(server,port) -shport $options(shared,port) \
525    -logfile [file join $tolcomm_dir "tolslave.log"]
526  vwait __forever__
527}   
528
529proc ::tolsh::console_cmd { cmd } {
530  if {$cmd eq "END" || $cmd eq "QUIT" || $cmd eq "EXIT"} {
531    exit
532  } else {
533    puts stdout "unknown console command: '$cmd'"
534  }
535}
536
537proc ::tolsh::console_eval { tol_stms } {
538  set con_objs0 [tol::console stack list]
539  tol::console eval $tol_stms
540  set con_objs1 [tol::console stack list]
541  if {[llength $con_objs1]>[llength $con_objs0]} {
542    puts stdout [lindex [lindex $con_objs1 end] 2]
543  }
544}
545
546proc ::tolsh::console_prompt {} {
547    puts -nonewline stdout \
548        "[clock format [clock seconds] -format %H:%M:%S] TOL> "
549    flush stdout
550}
551
552proc ::tolsh::stdin_handler {} {
553  # get the data from stdin
554  #
555  gets stdin data
556  if {[string index $data 0] eq "\\"} {
557    console_cmd [string toupper [string range $data 1 end]]
558  } else {
559    console_eval $data
560  }
561  # return a new pseudo-prompt
562  console_prompt
563  return
564}
565
566proc logtmp { msg } {
567  return
568  set user [ exec whoami ]
569  set fd [ open "/tmp/tolsh.${user}.log" a ]
570  puts $fd $msg
571  flush $fd
572  close $fd
573}
574
575::tolsh::run $argv
Note: See TracBrowser for help on using the repository browser.