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

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

tolsh on unix x86_64 platform must include /usr/lib in auto_path

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