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

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

refs #1409, now trunk is 3.2

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@4150 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100755
File size: 17.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)    ""
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    logtmp "set item [lindex $cmdline $i]"
86    set item [lindex $cmdline $i]
87    if {[string index $item 0] eq "-"} {
88      set opt [string range $item 1 end]
89      if {$opt eq "e" || $opt eq "en"} {
90        set options(lang) "en"
91      } elseif {$opt eq "s" || $opt eq "sp"} {
92        set options(lang) "es"
93      } elseif {$opt eq "i"} {
94        # initLibrary should not be loaded
95        #
96        set options(initlib) 0
97      } elseif {$opt eq "np"} {
98        set options(iniproject) 0
99      } elseif {[string index $opt 0] eq "c"} {
100        if {[string length $opt]>1} {
101          # The tol expression is part of the option
102          #
103          set expr [string range $opt 1 end]
104        } else {
105          # Next argument is the expression to compile
106          #
107          incr i
108          set expr [lindex $cmdline $i]
109        }
110        # Put expr in the list of "things" to compile
111        #
112        lappend options(compile) [list expr $expr]
113      } elseif {[string index $opt 0] eq "v"} {
114        if {[regexp {^[A|S|U|T|E|W]*$} [string range $opt 1 end] mode]} {
115          if {$mode eq ""} {
116            set mode A
117          }
118          if {[regexp {[A|S]} $mode]} {
119            set options(out,enabled) yes
120          }
121          append options(vmode) "v$mode "
122        } else {
123          append delayed_msg "\nignoring unknown verbose mode: '$opt'"
124        }
125      } elseif {[string index $opt 0] eq "m"} {
126        if {[regexp {^[A|S|U|T|E|W]*$} [string range $opt 1 end] mode]} {
127          if {$mode eq ""} {
128            set mode A
129          }
130          if {[regexp {[A|S]} $mode]} {
131            set options(out,enabled) no
132          }
133          append options(vmode) "m$mode "
134        } else {
135          append delayed_msg "\nignoring unknown mute mode: '$opt'"
136        }
137      } elseif {$opt eq "d"}  {
138        if {$options(runmode) ne "" && $options(runmode) ne "interactive"} {
139          puts "Replacing previous run mode '$options(runmode)' with 'interactive'"
140        }
141        set options(runmode) "interactive"
142      } elseif {$opt eq "tolversion"} {
143        incr i
144        set options(tolversion) [lindex $cmdline $i]
145      } elseif {$opt eq "server"} {
146        # check if next argument is the port number
147        set port [lindex $cmdline [expr {$i+1}]]
148        if {[string is integer $port]} {
149          # $i+1 is an integer, should be considered as a port number
150          incr i
151          if {$port <= 0} {
152            puts "Could not start as a server: invalid port number '${port}'"
153            exit
154          }
155          if {$options(runmode) ne "" && $options(runmode) ne "server"} {
156            puts "Replacing previous run mode '$options(runmode)' with 'server'"
157          }
158          set options(runmode) "server"
159          set options(server,port) $port
160        } else {
161          puts "Could not start as a server: invalid port number '${port}'"
162          exit
163        }
164      } elseif {$opt eq "slave"} {
165        # the next argument is the port number
166        set options(server,port) [lindex $cmdline [expr {$i+1}]]
167        incr i
168        if {$options(runmode) ne "" && $options(runmode) ne "slave"} {
169          puts "Replacing previous run mode '$options(runmode)' with 'slave'"
170        }
171        set options(runmode) "slave"
172      } elseif {$opt eq "shared"} {
173        # the next argument is the port number
174        set options(shared,port) [lindex $cmdline [expr {$i+1}]]
175        incr i
176        if {$options(runmode) ne "" && $options(runmode) ne "shared"} {
177          puts "Replacing previous run mode '$options(runmode)' with 'shared'"
178        }
179        set options(runmode) "shared"
180      }  elseif {$opt eq "shport"} {
181        # the next argument is the port number
182        set options(shared,port) [lindex $cmdline [expr {$i+1}]]
183        incr i
184      } else {
185        append delayed_msg "\nignoring unknown option: '$item'"
186      }
187    } else {
188      # Consider this option as a tol file to compile.
189      #
190      if {![file exists $item] || ![file readable $item]} {
191        puts "file $item does not exist or is not readable"
192      } else {
193        lappend options(compile) [list file $item]
194      }
195    }
196    incr i
197  }
198  if {$delayed_msg ne ""} {
199    std $delayed_msg
200  }
201}
202
203###############################################################################
204#
205#  something_to_compile -- tell us if there is something to do
206#
207#  Depending on the command line processing some tol expression or
208#  files needs to be compiled. All this is stored in options(compile)
209#
210#  Return:
211#
212#    true value if there is something to compile in $options(compile)
213#    false if $options(compile) is empty
214#
215###############################################################################
216proc ::tolsh::something_to_compile { } {
217  variable options
218
219  llength $options(compile)
220}
221
222###############################################################################
223#
224#  show_usage -- show how to invoke tolsh
225#
226#  This proc print into stdout a message that list the valid options accepted.
227#
228###############################################################################
229proc ::tolsh::show_usage { } {
230  puts "[get_app_name] \[options] filename ...\noptions:"
231  puts {
232    -i file  --> include a file but not initLibrary
233    -np      --> do not load _iniproject.tol
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  #puts ":tolsh::setup_pkg $pkg [namespace exist ::starkit] "
292  if {[lsearch [package names] $pkg]==-1} {
293    if {[namespace exist ::starkit]} {
294      set bindir [file dir $starkit::topdir]
295      set libdir [file join $bindir .. lib]
296      set pkg_dirs [glob -nocomplain -dir $libdir ${pkg}*]
297      if {[llength $pkg_dirs]} {
298        lappend ::auto_path [file normalize $libdir]
299      } elseif { $::tcl_platform(platform) eq "unix" } {
300          set activeTcl "/opt/ActiveTcl-8.4/lib"
301          if { [ file exists $activeTcl ] &&
302               [ lsearch $::auto_path $activeTcl ] == -1 } {
303            lappend ::auto_path $activeTcl
304          }
305          if { [ lsearch $::auto_path "/usr/lib" ] == -1 } {
306            lappend ::auto_path "/usr/lib"
307          }
308      } else {
309        set tclsh [auto_execok tclsh]
310        if {![catch {
311          exec echo puts {$::auto_path} | $tclsh
312        } ext_auto_path]} {
313          foreach p $ext_auto_path {
314            if {[lsearch $::auto_path $p]==-1} {
315              lappend ::auto_path $p
316            }
317          }
318        }
319      }
320      tclPkgUnknown ${pkg}+1 ""
321    } else {
322      set pkg_dev_dir [file normalize [file join .. $pkg]]
323      if {[file exists $pkg_dev_dir] && [file isdir $pkg_dev_dir]} {
324        lappend ::auto_path $pkg_dev_dir
325      }
326    }
327  }
328}
329
330###############################################################################
331#
332#  setup_autopath --
333#
334#  Set auto_path in order to find correctly the following packages:
335#
336#    - toltcl
337#    - rmtps_client
338#
339###############################################################################
340proc ::tolsh::setup_autopath { } {
341  logtmp "entering ::tolsh::setup_autopath"
342
343  setup_pkg toltcl
344  setup_pkg tolcomm
345  setup_pkg tlogger
346  setup_pkg tequila
347  setup_pkg tequilas
348
349  logtmp "auto_path = $::auto_path"
350  logtmp "leaving ::tolsh::setup_autopath" 
351}
352
353proc GetHomeDir { } {
354  global env
355  # Check if we're using windows
356  if { $::tcl_platform(platform) eq "windows" } {
357    package require registry 1.0
358    set key1 {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders}
359    set key2 {Personal}
360    set env_home [ registry get $key1 $key2 ]
361    if {[string match %USERPROFILE%* $env_home]} {
362      set env_home [string replace $env_home 0 12 $env(USERPROFILE)]
363    }
364  } else {
365    set env_home $env(HOME)
366  }
367  return $env_home
368}
369
370###############################################################################
371#
372#  main -- entry point for tolsh application
373#
374###############################################################################
375proc ::tolsh::run { cmdline } {
376  variable options
377
378  #logtmp "user : [ exec whoami ]"
379  logtmp "entering run with cmdline = $cmdline"
380  # Process command line options
381  #
382  getoptions $cmdline
383  logtmp "options(compile): $options(compile)"
384  logtmp "options(runmode): $options(runmode)"
385  if {![something_to_compile] && ($options(runmode) eq "")} {
386    show_usage
387    return
388  }
389 
390  logtmp "pase getoptions"
391
392  # Ensure Toltcl is found
393  #
394  setup_autopath
395
396  # Load Toltcl (+tol) and initLibrary if required
397  #
398  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
399    if {[info exist ::env(USE_TOLTCL_32)]} {
400      puts "requested to load Toltcl from $::env(USE_TOLTCL_32)"
401      load $::env(USE_TOLTCL_32)
402    } else {
403      package require -exact Toltcl 3.2
404    }
405    #puts "tol::initkernel $options(lang) $options(vmode)"
406    tol::initkernel $options(lang) $options(vmode)
407
408    if {$options(initlib)} {
409      tol::initlibrary $options(iniproject)
410    }
411    # why should I do that?
412    if { $options(lang) ne "" } {
413      ::tol::language $options(lang)
414    }
415    set appdata [string trim \
416               [lindex [::tol::info var [list Text TolAppDataPath]] 2] \"]
417    logtmp "appdata = $appdata"
418  }
419
420  set tolcomm_dir [file join [GetHomeDir] ".tol" "tolcomm"]
421  file mkdir $tolcomm_dir
422
423  # load rmtps_client and tolclient if required
424  #
425  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
426 
427    if {[catch {package require rmtps_client} msg]} {
428      std "could not load rmtps_client: $msg"
429    } else {
430      ::rmtps_client::init [file join $tolcomm_dir "rmtps_client.log"]
431      if {[catch rmtps_client::define_TOLAPI msg]} {
432        std "could not load tol code for rmtps_client: $msg"
433      }
434    }
435 
436    if {[catch {package require tolclient} msg]} {
437      std "could not load tolclient: $msg"
438    } else {
439      ::tolclient::init [file join $tolcomm_dir "tolclient.log"]
440      if {[catch ::tolclient::define_TOLAPI msg]} {
441        std "could not load tol code for rmtps_client: $msg"
442      }
443    }
444   
445  }
446
447  # Compile expression and tol file provided in the command line if required
448  #
449  if {$options(runmode) != "server" && $options(runmode) != "shared" \
450                                    && $options(runmode) != "slave" } {
451
452    foreach item $options(compile) {
453      if {[lindex $item 0] eq "expr"} {
454        tol::console eval [lindex $item 1]
455      } elseif {[lindex $item 0] eq "file"} {
456        tol::include [lindex $item 1]
457      }
458    }
459
460  }
461 
462  if {$options(runmode) eq "interactive"} {
463    # assign our event handler for stdin
464    fileevent stdin readable ::tolsh::stdin_handler
465    # send a startup message and initial prompt
466    puts stdout "TOL interactive shell activated..."
467    console_prompt
468    # enter the tcl event loop
469    vwait __forever__
470   
471  } elseif {$options(runmode) eq "server"} {
472    #puts "runmode=server"
473    run_as_server $tolcomm_dir
474   
475  } elseif {$options(runmode) eq "shared"} {
476    #puts "runmode=shared"
477    run_as_shared $tolcomm_dir
478 
479  } elseif {$options(runmode) eq "slave"} {
480    #puts "runmode=slave"
481    run_as_slave $tolcomm_dir   
482  }
483}
484
485proc ::tolsh::run_as_server {tolcomm_dir} {
486  variable options
487  package require tolserver
488
489  set shared_port [ clone ]
490  tolserver::start -port $options(server,port) \
491    -shport $shared_port \
492    -logfile [file join $tolcomm_dir "tolserver.log"] \
493    -compile $options(compile)
494  vwait __forever__
495}   
496
497proc ::tolsh::find_shared_port { port } {
498  puts "::tolsh::find_shared_port $port"
499  set i 0
500  while { $i < 100 } {
501    if { [ catch { socket localhost $port } fd ] } {
502      puts "find_shared_port OK = $port"
503      return $port
504    }
505    incr port
506    incr i
507  }
508  puts "find_shared_port FAIL!"
509  return 0
510}
511
512proc ::tolsh::clone {} {
513  variable options
514
515  puts "::tolsh::clone"
516  set tolsh [list [info nameofexecutable] ]
517  if { $starkit::tolsh_mode ne "starpack" } {
518    lappend tolsh $::argv0
519  }
520  set shared_port [ find_shared_port 20458 ]
521  if { !$shared_port } {
522    puts "::tolsh::clone: could not find a valid port for shared data"
523    exit
524  }
525  eval exec $tolsh -shared $shared_port &
526  after 5000            ;# wait for data sharing are created by 'shared'
527  puts "exec slave"
528  eval exec $tolsh -slave $options(server,port) -shport $shared_port &
529  return $shared_port
530}
531
532proc ::tolsh::run_as_shared { tolcomm_dir } {
533  package require tolshared
534  variable options
535
536  tolshared::start $options(shared,port) $tolcomm_dir
537}   
538
539proc ::tolsh::run_as_slave { tolcomm_dir } {
540  variable options
541  package require tolslave
542
543  tolslave::start -port $options(server,port) -shport $options(shared,port) \
544    -logfile [file join $tolcomm_dir "tolslave.log"]
545  vwait __forever__
546}   
547
548proc ::tolsh::console_cmd { cmd } {
549  if {$cmd eq "END" || $cmd eq "QUIT" || $cmd eq "EXIT"} {
550    exit
551  } else {
552    puts stdout "unknown console command: '$cmd'"
553  }
554}
555
556proc ::tolsh::console_eval { tol_stms } {
557  set con_objs0 [tol::console stack list]
558  tol::console eval $tol_stms
559  set con_objs1 [tol::console stack list]
560  if {[llength $con_objs1]>[llength $con_objs0]} {
561    puts stdout [lindex [lindex $con_objs1 end] 2]
562  }
563}
564
565proc ::tolsh::console_prompt {} {
566    puts -nonewline stdout \
567        "[clock format [clock seconds] -format %H:%M:%S] TOL> "
568    flush stdout
569}
570
571proc ::tolsh::stdin_handler {} {
572  # get the data from stdin
573  #
574  gets stdin data
575  if {[string index $data 0] eq "\\"} {
576    console_cmd [string toupper [string range $data 1 end]]
577  } else {
578    console_eval $data
579  }
580  # return a new pseudo-prompt
581  console_prompt
582  return
583}
584
585proc logtmp { msg } {
586  return
587  set user $::tcl_platform(user)
588  set fd [ open "/tmp/tolsh.${user}.log" a ]
589  puts $fd $msg
590  flush $fd
591  close $fd
592}
593
594::tolsh::run $argv
Note: See TracBrowser for help on using the repository browser.