source: tol/toltcl/library/tolsh.tcl

devel
Last change on this file was eb559d7, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1938
La versión de tolsh (ejecutable) y toltcl (paquete tcl) se gestionan desde CMakeLists.txt.
Se traslada la versión de tolsh.tcl (que estaba manual) a pkgIndex.tcl.in que usa lo definido en CMakeLists.txt.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7366 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 17.7 KB
Line 
1#!/usr/bin/env tclsh
2
3###############################################################################
4#
5# tolsh.tcl --
6#
7###############################################################################
8
9#@ Se lleva al pkgIndex.tcl.in para gestionar mejor las versiones.
10#@ package provide TolshApp 3.3
11
12###############################################################################
13#
14#  Tol_HciWriter --
15#
16#  This file will be invoked by TOL if HCI output is enabled
17#
18###############################################################################
19proc Tol_HciWriter { msg } {
20  puts [string trim $msg]
21}
22
23###############################################################################
24#
25#  namespace tolsh -- encapsulate tolsh functionality
26#
27###############################################################################
28namespace eval ::tolsh {
29  variable options
30
31  # By default load initLibrary
32  #
33  set options(lang)    ""
34  set options(initlib) 1
35  set options(iniproject) 1
36  set options(defaultpackages) 1
37  set options(compile) ""
38  set options(vmode)   ""
39  set options(out,enabled) no
40  set options(runmode) ""
41  set options(tolversion) ""
42}
43
44###############################################################################
45#
46#  getoptions -- process the command line
47#
48#  The command line accepted by tolsh is:
49#
50#    -i       --> do not include initLibrary
51#    -np      --> do not load _iniproject.tol
52#    -c"..."  --> compile a tol expression
53#    -c "..." --> compile a tol expression
54#    -v?A?    --> enable all output
55#    -vE      --> enable error output
56#    -vS      --> enable system output
57#    -vU      --> enable user output
58#    -vT      --> enable trace output
59#    -m?A?    --> disable all output
60#    -mE      --> disable error output
61#    -mS      --> disable system output
62#    -mU      --> disable user output
63#    -mT      --> disable trace output
64#    -d       --> start in dialog mode
65#    -e?n?    --> use english language
66#    -s?p?    --> use spanish language
67#    -tolversion ver --> specify an strict tol version to start with
68#    -server [port]  --> start tol as a server tolsvc.<pid>.log will be the log
69#             [port] is the port number where the serve will be listening.
70#
71#  Any other value will be considered a file to compile
72#
73#  Arguments:
74#
75###############################################################################
76proc ::tolsh::getoptions { cmdline } {
77  variable options
78
79  logtmp "entering ::tolsh::getoptions $cmdline"
80
81  # cmdline could be a bad list so the next sentence could fail.
82  # try to test it in front of bugs situations.
83  set num [llength $cmdline]
84  set delayed_msg ""
85  set i 0
86  while {$i < $num} {
87    logtmp "set item [lindex $cmdline $i]"
88    set item [lindex $cmdline $i]
89    if {[string index $item 0] eq "-"} {
90      set opt [string range $item 1 end]
91      if {$opt eq "e" || $opt eq "en"} {
92        set options(lang) "en"
93      } elseif {$opt eq "s" || $opt eq "sp"} {
94        set options(lang) "es"
95      } elseif {$opt eq "i"} {
96        # initLibrary should not be loaded
97        #
98        set options(initlib) 0
99      } elseif {$opt eq "ndp"} {
100        set options(defaultpackages) 0
101      }  elseif {$opt eq "np"} {
102        set options(iniproject) 0
103      } elseif {[string index $opt 0] eq "c"} {
104        if {[string length $opt]>1} {
105          # The tol expression is part of the option
106          #
107          set expr [string range $opt 1 end]
108        } else {
109          # Next argument is the expression to compile
110          #
111          incr i
112          set expr [lindex $cmdline $i]
113        }
114        # Put expr in the list of "things" to compile
115        #
116        lappend options(compile) [list expr $expr]
117      } elseif {[string index $opt 0] eq "v"} {
118        if {[regexp {^[A|S|U|T|E|W]*$} [string range $opt 1 end] mode]} {
119          if {$mode eq ""} {
120            set mode A
121          }
122          if {[regexp {[A|S]} $mode]} {
123            set options(out,enabled) yes
124          }
125          append options(vmode) "v$mode "
126        } else {
127          append delayed_msg "\nignoring unknown verbose mode: '$opt'"
128        }
129      } elseif {[string index $opt 0] eq "m"} {
130        if {[regexp {^[A|S|U|T|E|W]*$} [string range $opt 1 end] mode]} {
131          if {$mode eq ""} {
132            set mode A
133          }
134          if {[regexp {[A|S]} $mode]} {
135            set options(out,enabled) no
136          }
137          append options(vmode) "m$mode "
138        } else {
139          append delayed_msg "\nignoring unknown mute mode: '$opt'"
140        }
141      } elseif {$opt eq "d"}  {
142        if {$options(runmode) ne "" && $options(runmode) ne "interactive"} {
143          puts "Replacing previous run mode '$options(runmode)' with 'interactive'"
144        }
145        set options(runmode) "interactive"
146      } elseif {$opt eq "tolversion"} {
147        incr i
148        set options(tolversion) [lindex $cmdline $i]
149      } elseif {$opt eq "server"} {
150        # check if next argument is the port number
151        set port [lindex $cmdline [expr {$i+1}]]
152        if {[string is integer $port]} {
153          # $i+1 is an integer, should be considered as a port number
154          incr i
155          if {$port <= 0} {
156            puts "Could not start as a server: invalid port number '${port}'"
157            exit
158          }
159          if {$options(runmode) ne "" && $options(runmode) ne "server"} {
160            puts "Replacing previous run mode '$options(runmode)' with 'server'"
161          }
162          set options(runmode) "server"
163          set options(server,port) $port
164        } else {
165          puts "Could not start as a server: invalid port number '${port}'"
166          exit
167        }
168      } elseif {$opt eq "slave"} {
169        # the next argument is the port number
170        set options(server,port) [lindex $cmdline [expr {$i+1}]]
171        incr i
172        if {$options(runmode) ne "" && $options(runmode) ne "slave"} {
173          puts "Replacing previous run mode '$options(runmode)' with 'slave'"
174        }
175        set options(runmode) "slave"
176      } elseif {$opt eq "shared"} {
177        # the next argument is the port number
178        set options(shared,port) [lindex $cmdline [expr {$i+1}]]
179        incr i
180        if {$options(runmode) ne "" && $options(runmode) ne "shared"} {
181          puts "Replacing previous run mode '$options(runmode)' with 'shared'"
182        }
183        set options(runmode) "shared"
184      }  elseif {$opt eq "shport"} {
185        # the next argument is the port number
186        set options(shared,port) [lindex $cmdline [expr {$i+1}]]
187        incr i
188      } else {
189        append delayed_msg "\nignoring unknown option: '$item'"
190      }
191    } else {
192      # Consider this option as a tol file to compile.
193      #
194      if {![file exists $item] || ![file readable $item]} {
195        puts "file $item does not exist or is not readable"
196      } else {
197        lappend options(compile) [list file $item]
198      }
199    }
200    incr i
201  }
202  if {$delayed_msg ne ""} {
203    std $delayed_msg
204  }
205}
206
207###############################################################################
208#
209#  something_to_compile -- tell us if there is something to do
210#
211#  Depending on the command line processing some tol expression or
212#  files needs to be compiled. All this is stored in options(compile)
213#
214#  Return:
215#
216#    true value if there is something to compile in $options(compile)
217#    false if $options(compile) is empty
218#
219###############################################################################
220proc ::tolsh::something_to_compile { } {
221  variable options
222
223  llength $options(compile)
224}
225
226###############################################################################
227#
228#  show_usage -- show how to invoke tolsh
229#
230#  This proc print into stdout a message that list the valid options accepted.
231#
232###############################################################################
233proc ::tolsh::show_usage { } {
234  puts "[get_app_name] \[options] filename ...\noptions:"
235  puts {
236    -i file  --> include a file but not initLibrary
237    -np      --> do not load _iniproject.tol
238    -c "..." --> compile a tol expression
239    -v?A?    --> enable all output
240    -vE      --> enable error output
241    -vS      --> enable standard output
242    -vU      --> enable user output
243    -vT      --> enable trace output
244    -m?A?    --> disable all output
245    -mE      --> disable error output
246    -mS      --> disable standard output
247    -mU      --> disable user output
248    -mT      --> disable trace output
249    -d       --> start in dialog mode
250    -e?n?    --> use english language
251    -s?p?    --> use spanish language
252    -tolversion --> specify an strict tol version to start with
253    -server [port] --> start tol as a server tolsvc.<pid>.log will be the log
254            [port] is the port number where the serve will be listening.
255 
256  Multiple verbose mode is accepted in one option, for instance,
257
258    -vUE
259  }
260}
261
262###############################################################################
263#
264#  getArgv0 -- return the name of the app
265#
266###############################################################################
267proc ::tolsh::get_app_name {} {
268    global argv0
269
270    set name [file tail $argv0]
271    return [file rootname $name]
272}
273
274###############################################################################
275#
276#  append_message -- save a message
277#
278###############################################################################
279proc ::tolsh::std { msg } {
280  variable options
281
282  if {$options(out,enabled)} {
283    puts $msg
284  }
285}
286
287#puts "starkit = [namespace exist ::starkit]"
288#puts "topdir = [file dir $starkit::topdir]"
289#puts "info script = [info script]"
290#puts "starkit::startup = [starkit::startup]"
291#puts "[ info commands starkit::* ]"
292#puts "argv0 = $argv0"
293
294proc ::tolsh::setup_pkg { pkg } {
295  #puts ":tolsh::setup_pkg $pkg [namespace exist ::starkit] "
296  if {[lsearch [package names] $pkg]==-1} {
297    if {[namespace exist ::starkit]} {
298      set bindir [file dir $starkit::topdir]
299      set libdir [file join $bindir .. lib]
300      set pkg_dirs [glob -nocomplain -dir $libdir ${pkg}*]
301      if {[llength $pkg_dirs]} {
302        lappend ::auto_path [file normalize $libdir]
303      } elseif { $::tcl_platform(platform) eq "unix" } {
304          set activeTcl "/opt/ActiveTcl-8.4/lib"
305          if { [ file exists $activeTcl ] &&
306               [ lsearch $::auto_path $activeTcl ] == -1 } {
307            lappend ::auto_path $activeTcl
308          }
309          if { [ lsearch $::auto_path "/usr/lib" ] == -1 } {
310            lappend ::auto_path "/usr/lib"
311          }
312      } else {
313        set tclsh [auto_execok tclsh]
314        if {![catch {
315          exec echo puts {$::auto_path} | $tclsh
316        } ext_auto_path]} {
317          foreach p $ext_auto_path {
318            if {[lsearch $::auto_path $p]==-1} {
319              lappend ::auto_path $p
320            }
321          }
322        }
323      }
324      tclPkgUnknown ${pkg}+1 ""
325    } else {
326      set pkg_dev_dir [file normalize [file join .. $pkg]]
327      if {[file exists $pkg_dev_dir] && [file isdir $pkg_dev_dir]} {
328        lappend ::auto_path $pkg_dev_dir
329      }
330    }
331  }
332}
333
334###############################################################################
335#
336#  setup_autopath --
337#
338#  Set auto_path in order to find correctly the following packages:
339#
340#    - toltcl
341#    - rmtps_client
342#
343###############################################################################
344proc ::tolsh::setup_autopath { } {
345  logtmp "entering ::tolsh::setup_autopath"
346
347  setup_pkg toltcl
348  setup_pkg tolcomm
349  setup_pkg tlogger
350  setup_pkg tequila
351  setup_pkg tequilas
352
353  logtmp "auto_path = $::auto_path"
354  logtmp "leaving ::tolsh::setup_autopath" 
355}
356
357proc GetHomeDir { } {
358  global env
359  # Check if we're using windows
360  if { $::tcl_platform(platform) eq "windows" } {
361    package require registry 1.0
362    set key1 {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders}
363    set key2 {Personal}
364    set env_home [ registry get $key1 $key2 ]
365    if {[string match %USERPROFILE%* $env_home]} {
366      set env_home [string replace $env_home 0 12 $env(USERPROFILE)]
367    }
368  } else {
369    set env_home $env(HOME)
370  }
371  return $env_home
372}
373
374###############################################################################
375#
376#  main -- entry point for tolsh application
377#
378###############################################################################
379proc ::tolsh::run { cmdline } {
380  variable options
381
382  #logtmp "user : [ exec whoami ]"
383  logtmp "entering run with cmdline = $cmdline"
384  # Process command line options
385  #
386  getoptions $cmdline
387  logtmp "options(compile): $options(compile)"
388  logtmp "options(runmode): $options(runmode)"
389  if {![something_to_compile] && ($options(runmode) eq "")} {
390    show_usage
391    return
392  }
393 
394  logtmp "pase getoptions"
395
396  # Ensure Toltcl is found
397  #
398  setup_autopath
399
400  # Load Toltcl (+tol) and initLibrary if required
401  #
402  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
403    package require Toltcl
404    #puts "tol::initkernel $options(lang) $options(vmode)"
405    tol::initkernel $options(lang) $options(vmode)
406
407    if {$options(initlib)} {
408      tol::initlibrary -initproject $options(iniproject) \
409          -defaultpackages $options(defaultpackages)
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#puts "voy ::tolsh::run $argv"
595::tolsh::run $::argv
596exit
Note: See TracBrowser for help on using the repository browser.