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

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

refs #1028, tequila server is started on the first available port starting from port number 20458.

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