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

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

refs #1409, tolsh debe requerir tolcl 3.1

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@4076 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100755
File size: 17.4 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    -v?A?    --> enable all output
235    -vE      --> enable error output
236    -vS      --> enable standard output
237    -vU      --> enable user output
238    -vT      --> enable trace output
239    -m?A?    --> disable all output
240    -mE      --> disable error output
241    -mS      --> disable standard output
242    -mU      --> disable user output
243    -mT      --> disable trace output
244    -d       --> start in dialog mode
245    -e?n?    --> use english language
246    -s?p?    --> use spanish language
247    -tolversion --> specify an strict tol version to start with
248    -server [port] --> start tol as a server tolsvc.<pid>.log will be the log
249            [port] is the port number where the serve will be listening.
250 
251  Multiple verbose mode is accepted in one option, for instance,
252
253    -vUE
254  }
255}
256
257###############################################################################
258#
259#  getArgv0 -- return the name of the app
260#
261###############################################################################
262proc ::tolsh::get_app_name {} {
263    global argv0
264
265    set name [file tail $argv0]
266    return [file rootname $name]
267}
268
269###############################################################################
270#
271#  append_message -- save a message
272#
273###############################################################################
274proc ::tolsh::std { msg } {
275  variable options
276
277  if {$options(out,enabled)} {
278    puts $msg
279  }
280}
281
282#puts "starkit = [namespace exist ::starkit]"
283#puts "topdir = [file dir $starkit::topdir]"
284#puts "info script = [info script]"
285#puts "starkit::startup = [starkit::startup]"
286#puts "[ info commands starkit::* ]"
287#puts "argv0 = $argv0"
288
289proc ::tolsh::setup_pkg { pkg } {
290  #puts ":tolsh::setup_pkg $pkg [namespace exist ::starkit] "
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      } elseif { $::tcl_platform(platform) eq "unix" } {
299          set activeTcl "/opt/ActiveTcl-8.4/lib"
300          if { [ file exists $activeTcl ] &&
301               [ lsearch $::auto_path $activeTcl ] == -1 } {
302            lappend ::auto_path $activeTcl
303          }
304          if { [ lsearch $::auto_path "/usr/lib" ] == -1 } {
305            lappend ::auto_path "/usr/lib"
306          }
307      } else {
308        set tclsh [auto_execok tclsh]
309        if {![catch {
310          exec echo puts {$::auto_path} | $tclsh
311        } ext_auto_path]} {
312          foreach p $ext_auto_path {
313            if {[lsearch $::auto_path $p]==-1} {
314              lappend ::auto_path $p
315            }
316          }
317        }
318      }
319      tclPkgUnknown ${pkg}+1 ""
320    } else {
321      set pkg_dev_dir [file normalize [file join .. $pkg]]
322      if {[file exists $pkg_dev_dir] && [file isdir $pkg_dev_dir]} {
323        lappend ::auto_path $pkg_dev_dir
324      }
325    }
326  }
327}
328
329###############################################################################
330#
331#  setup_autopath --
332#
333#  Set auto_path in order to find correctly the following packages:
334#
335#    - toltcl
336#    - rmtps_client
337#
338###############################################################################
339proc ::tolsh::setup_autopath { } {
340  logtmp "entering ::tolsh::setup_autopath"
341
342  setup_pkg toltcl
343  setup_pkg tolcomm
344  setup_pkg tlogger
345  setup_pkg tequila
346  setup_pkg tequilas
347
348  logtmp "auto_path = $::auto_path"
349  logtmp "leaving ::tolsh::setup_autopath" 
350}
351
352proc GetHomeDir { } {
353  global env
354  # Check if we're using windows
355  if { $::tcl_platform(platform) eq "windows" } {
356    package require registry 1.0
357    set key1 {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders}
358    set key2 {Personal}
359    set env_home [ registry get $key1 $key2 ]
360    if {[string match %USERPROFILE%* $env_home]} {
361      set env_home [string replace $env_home 0 12 $env(USERPROFILE)]
362    }
363  } else {
364    set env_home $env(HOME)
365  }
366  return $env_home
367}
368
369###############################################################################
370#
371#  main -- entry point for tolsh application
372#
373###############################################################################
374proc ::tolsh::run { cmdline } {
375  variable options
376
377  #logtmp "user : [ exec whoami ]"
378  logtmp "entering run with cmdline = $cmdline"
379  # Process command line options
380  #
381  getoptions $cmdline
382  logtmp "options(compile): $options(compile)"
383  logtmp "options(runmode): $options(runmode)"
384  if {![something_to_compile] && ($options(runmode) eq "")} {
385    show_usage
386    return
387  }
388 
389  logtmp "pase getoptions"
390
391  # Ensure Toltcl is found
392  #
393  setup_autopath
394
395  # Load Toltcl (+tol) and initLibrary if required
396  #
397  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
398    if {[info exist ::env(USE_TOLTCL_202)]} {
399      puts "requested to load Toltcl from $::env(USE_TOLTCL_202)"
400      load $::env(USE_TOLTCL_202)
401    } else {
402      package require -exact Toltcl 3.1
403    }
404    tol::initkernel $options(lang) $options(vmode)
405
406    if {$options(initlib)} {
407      tol::initlibrary $options(iniproject)
408    }
409
410    set appdata [string trim \
411               [lindex [::tol::info var [list Text TolAppDataPath]] 2] \"]
412    logtmp "appdata = $appdata"
413  }
414
415  set tolcomm_dir [file join [GetHomeDir] ".tol" "tolcomm"]
416  file mkdir $tolcomm_dir
417
418  # load rmtps_client and tolclient if required
419  #
420  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
421 
422    if {[catch {package require rmtps_client} msg]} {
423      std "could not load rmtps_client: $msg"
424    } else {
425      ::rmtps_client::init [file join $tolcomm_dir "rmtps_client.log"]
426      if {[catch rmtps_client::define_TOLAPI msg]} {
427        std "could not load tol code for rmtps_client: $msg"
428      }
429    }
430 
431    if {[catch {package require tolclient} msg]} {
432      std "could not load tolclient: $msg"
433    } else {
434      ::tolclient::init [file join $tolcomm_dir "tolclient.log"]
435      if {[catch ::tolclient::define_TOLAPI msg]} {
436        std "could not load tol code for rmtps_client: $msg"
437      }
438    }
439   
440  }
441
442  # Compile expression and tol file provided in the command line if required
443  #
444  if {$options(runmode) != "server" && $options(runmode) != "shared" \
445                                    && $options(runmode) != "slave" } {
446
447    foreach item $options(compile) {
448      if {[lindex $item 0] eq "expr"} {
449        tol::console eval [lindex $item 1]
450      } elseif {[lindex $item 0] eq "file"} {
451        tol::include [lindex $item 1]
452      }
453    }
454
455  }
456 
457  if {$options(runmode) eq "interactive"} {
458    # assign our event handler for stdin
459    fileevent stdin readable ::tolsh::stdin_handler
460    # send a startup message and initial prompt
461    puts stdout "TOL interactive shell activated..."
462    console_prompt
463    # enter the tcl event loop
464    vwait __forever__
465   
466  } elseif {$options(runmode) eq "server"} {
467    puts "runmode=server"
468    run_as_server $tolcomm_dir
469   
470  } elseif {$options(runmode) eq "shared"} {
471    puts "runmode=shared"
472    run_as_shared $tolcomm_dir
473 
474  } elseif {$options(runmode) eq "slave"} {
475    puts "runmode=slave"
476    run_as_slave $tolcomm_dir   
477  }
478}
479
480proc ::tolsh::run_as_server {tolcomm_dir} {
481  variable options
482  package require tolserver
483
484  set shared_port [ clone ]
485  tolserver::start -port $options(server,port) \
486    -shport $shared_port \
487    -logfile [file join $tolcomm_dir "tolserver.log"] \
488    -compile $options(compile)
489  vwait __forever__
490}   
491
492proc ::tolsh::find_shared_port { port } {
493  puts "::tolsh::find_shared_port $port"
494  set i 0
495  while { $i < 100 } {
496    if { [ catch { socket localhost $port } fd ] } {
497      puts "find_shared_port OK = $port"
498      return $port
499    }
500    incr port
501    incr i
502  }
503  puts "find_shared_port FAIL!"
504  return 0
505}
506
507proc ::tolsh::clone {} {
508  variable options
509
510  puts "::tolsh::clone"
511  set tolsh [list [info nameofexecutable] ]
512  if { $starkit::tolsh_mode ne "starpack" } {
513    lappend tolsh $::argv0
514  }
515  set shared_port [ find_shared_port 20458 ]
516  if { !$shared_port } {
517    puts "::tolsh::clone: could not find a valid port for shared data"
518    exit
519  }
520  eval exec $tolsh -shared $shared_port &
521  after 5000            ;# wait for data sharing are created by 'shared'
522  puts "exec slave"
523  eval exec $tolsh -slave $options(server,port) -shport $shared_port &
524  return $shared_port
525}
526
527proc ::tolsh::run_as_shared { tolcomm_dir } {
528  package require tolshared
529  variable options
530
531  tolshared::start $options(shared,port) $tolcomm_dir
532}   
533
534proc ::tolsh::run_as_slave { tolcomm_dir } {
535  variable options
536  package require tolslave
537
538  tolslave::start -port $options(server,port) -shport $options(shared,port) \
539    -logfile [file join $tolcomm_dir "tolslave.log"]
540  vwait __forever__
541}   
542
543proc ::tolsh::console_cmd { cmd } {
544  if {$cmd eq "END" || $cmd eq "QUIT" || $cmd eq "EXIT"} {
545    exit
546  } else {
547    puts stdout "unknown console command: '$cmd'"
548  }
549}
550
551proc ::tolsh::console_eval { tol_stms } {
552  set con_objs0 [tol::console stack list]
553  tol::console eval $tol_stms
554  set con_objs1 [tol::console stack list]
555  if {[llength $con_objs1]>[llength $con_objs0]} {
556    puts stdout [lindex [lindex $con_objs1 end] 2]
557  }
558}
559
560proc ::tolsh::console_prompt {} {
561    puts -nonewline stdout \
562        "[clock format [clock seconds] -format %H:%M:%S] TOL> "
563    flush stdout
564}
565
566proc ::tolsh::stdin_handler {} {
567  # get the data from stdin
568  #
569  gets stdin data
570  if {[string index $data 0] eq "\\"} {
571    console_cmd [string toupper [string range $data 1 end]]
572  } else {
573    console_eval $data
574  }
575  # return a new pseudo-prompt
576  console_prompt
577  return
578}
579
580proc logtmp { msg } {
581  return
582  set user $::tcl_platform(user)
583  set fd [ open "/tmp/tolsh.${user}.log" a ]
584  puts $fd $msg
585  flush $fd
586  close $fd
587}
588
589::tolsh::run $argv
Note: See TracBrowser for help on using the repository browser.