interfaces/xmaxima/Tkmaxima/Send-some.tcl

   1 ############################################################
   2 # Send-some.tcl                                            #
   3 # Copyright (C) 1998 William F. Schelter                   #
   4 # For distribution under GNU public License.  See COPYING. #
   5 #                                                          #
   6 #     Time-stamp: "2024-03-25 20:06:43 villate"            #
   7 ############################################################
   8 # Usage:
   9 # catch {close $socket}
  10 # source send-some.tcl ; openConnection $tohost $port $magic $program
  11 # one linux14 do
  12 # run-one.tcl octave  4448 billy1
  13 # then from any machine do:
  14 # can also open maxima at same time
  15 # source send-some.tcl ; openConnection linux14 4448 billy1 octave
  16 # then
  17 # sendOneWait octave 2+3
  18 # 5
  19 # If you specified -debug when starting the server then you can
  20 #    evaluate tcl commands in the process controlling 'program'
  21 #   eg:  sendCommand octave "list 1 1"
  22 #
  23 #-----------------------------------------------------------------
  24 #
  25 # myVwait --  this is a replacement for vwait which is missing from
  26 # the plugin tcl.   It is 'supposed' to be the same but in fact if it
  27 # is a fileevent handler that is supposed to do the setting, then the
  28 # fileevent handler might indeed get called continuously because the
  29 # file becomes readable, and myVwait which was checking a variable that
  30 # the handler set,  never gets a chance to return, since the handler
  31 # is called again and again.   So Remove the handler when it is invoked.
  32 # Note this uses tracing of the variable or array, and may interfere
  33 # with other tracing.
  34 #  Results:
  35 #
  36 #  Side Effects: waits till the variable is set if it was unset, or
  37 # until its value is different.
  38 #
  39 #----------------------------------------------------------------
  40 #
  41 proc myVwait { var  } {
  42     global _waiting maxima_priv
  43     set tem [split $var "(" ]
  44     set variable [lindex $tem 0]
  45     global $variable
  46     lappend maxima_priv(myVwait) $variable
  47     set index ""
  48     if { [llength $tem ] > 1 } {
  49         set index [lindex [split [lindex $tem 1] ")" ] 0]
  50     }
  51
  52     set action  "_myaction [list $index]"
  53     trace variable $variable w $action
  54     set _waiting 1
  55
  56     while { [set _waiting] } {
  57         #puts "still waiting _waiting=$_waiting"
  58         update
  59     }
  60     set maxima_priv(myVwait) [ ldelete $variable $maxima_priv(myVwait)]
  61     trace vdelete $variable w $action
  62 }
  63
  64 proc _myaction { ind name1 name2 op } {
  65     global _waiting
  66     # puts "action $ind $name1 $name2 $op"
  67     if { "$ind" == "$name2" } {
  68
  69         global $name1
  70         set _waiting 0
  71     }
  72 }
  73
  74 # proc myVwait { x args } {uplevel "#0"  vwait $x }
  75 if { "[info commands vwait]" == "vwait"  } {
  76     proc myVwait { x  } {
  77         global maxima_priv
  78 # Fix for Tcl 8.5: linking unreachable global variables used to be ignored
  79 # in Tcl 8.4 but in 8.5 it raises an error. The catch command should
  80 # restore the Tcl 8.4 behavior. (villate, 20080513)
  81         catch {global $x}
  82         lappend maxima_priv(myVwait) $x
  83         vwait $x
  84         set maxima_priv(myVwait) [ ldelete $x $maxima_priv(myVwait)]
  85     }
  86 }
  87
  88 proc omDoInterrupt { win } {
  89     foreach v [ $win tag names] {
  90         if { [regexp "com:pdata\\((\[a-z_A-Z]*)," $v junk program] } {
  91             set var [string range $v 4 end]
  92             # puts "interrupt program=$program,$var"
  93             after 10 uplevel "#0" set $var <interrupted>
  94             catch { sendInterrupt $program }
  95         }
  96     }
  97 }
  98
  99
 100 proc omDoAbort { win } {
 101     foreach v [ $win tag names] {
 102         set var [string range $v 4 end]
 103         if { [regexp "com:pdata\\((\[a-z_A-Z]*)," $v junk program] } {
 104             set prog [programName $program]
 105             if { "[info command abort_$prog]" != "" } {
 106                 abort_$prog $program
 107                 after 200 uplevel "#0" set $var <aborted>
 108             }
 109             cleanPdata $program
 110             set var [string range $v 4 end]
 111             # rputs "interrupt program=$program,$var"
 112             after 200 uplevel "#0" set $var <aborted>
 113         }
 114     }
 115 }
 116
 117 proc  msleep { n } {
 118     global Msleeping
 119     set Msleeping 1
 120     after $n "set Msleeping 0"
 121     debugsend "waiting Msleeping.."
 122     myVwait Msleeping
 123     debugsend "..donewaiting Msleeping"
 124 }
 125
 126 proc message { msg } {
 127     global maxima_priv _debugSend
 128     if { $_debugSend } { puts "setting message=<$msg>" }
 129     catch { set maxima_priv(load_rate) $msg }
 130 }
 131
 132 proc sendOne { program  com }  {
 133     global  pdata maxima_priv
 134     incr pdata($program,currentExpr)
 135     set socket $pdata($program,socket)
 136
 137     if { [eof $socket] } {
 138         error [mc "connection closed"]
 139     }
 140     # puts "sending $program ([lindex [fconfigure $socket -peername] 1])"
 141     message [concat [mc "sending"] "$program" [mc "on"] "[lindex [fconfigure $socket -peername] 1]"]
 142     debugsend "sending.. {$com<$pdata($program,currentExpr)\|fayve>}"
 143     set msg "$com<$pdata($program,currentExpr)\|fayve>\n"
 144     proxyPuts $socket $msg
 145 }
 146 #
 147 #-----------------------------------------------------------------
 148 #
 149 # sendOneDoCommand --  sends to PROGRAM the COMMAND and then
 150 # when the result comes back it invokes the script CALLBACK with
 151 # one argument appended: the global LOCATION where the result
 152 # will be.   [uplevel "#0" set $LOCATION] would retrieve it.
 153 #
 154 #  Results: returns immediately the location that will be
 155 #  watched.
 156 #
 157 #  Side Effects: CALLBACK is invoked later by tracing the
 158 #  result field
 159 #
 160 #----------------------------------------------------------------
 161 #
 162 proc sendOneDoCommand {program command callback } {
 163     global pdata
 164
 165     if { ![assureProgram $program 5000 2] } { return "cant connect"}
 166     set ii [expr {$pdata($program,currentExpr) + 1}]
 167     catch { unset pdata($program,results,$ii)}
 168     trace variable pdata($program,results,$ii) w \
 169             [list invokeAndUntrace $callback]
 170     sendOne $program $command
 171     return pdata($program,results,$ii)
 172 }
 173
 174 proc testit { program com } {
 175     sendOneDoCommand $program $com "jimmy"
 176     proc jimmy {s} { puts "<result is:[uplevel #0 set $s]>" ; flush stdout}
 177 }
 178
 179 proc invokeAndUntrace { callback name1 name2 op args} {
 180     #puts "callback:$callback $name1 $name2 $op, args=$args"
 181     #puts "trace vdelete [set name1]($name2) w [list invokeAndUntrace $callback]"
 182     trace vdelete [set name1]($name2) w [list invokeAndUntrace $callback]
 183     lappend callback  [set name1]($name2)
 184     # puts "callback=$callback" ; flush stdout
 185     if { [catch { eval $callback } errmsg ] } {
 186         global errorInfo
 187         # report the error in the background
 188         set com [list  error [concat [mc "had error in"] "$callback:[string range $errmsg 0 300].."]    $errorInfo]
 189         after 1 $com
 190     }
 191 }
 192
 193 proc sendOneWait { program com } {
 194     global pdata
 195     if { ![assureProgram $program 5000 2] } { return "cant connect"}
 196     set ii [expr {$pdata($program,currentExpr) + 1}]
 197     catch { unset pdata($program,results,$ii)}
 198     sendOne $program $com
 199     set i $pdata($program,currentExpr)
 200     set socket $pdata($program,socket)
 201     if { $ii != $i } { error "expected $ii got $i as expression number " }
 202     debugsend "waiting for pdata($program,results,$i)"
 203     myVwait pdata($program,results,$i)
 204     debugsend "..done waiting for pdata($program,results,$i)"
 205     return $pdata($program,results,$i)
 206 }
 207
 208 proc closeConnection { program } {
 209     global pdata
 210     catch {
 211         set sock $pdata($program,socket)
 212         set pdata(input,$sock) ""
 213         cleanPdata $program
 214         close $sock
 215     }
 216 }
 217
 218 proc dtrace { } {
 219     global _debugSend
 220     if { $_debugSend } {
 221         puts "at: [info level -1]"
 222         if { [info level]>2 } {puts "   from:[info level -2 ]"}
 223     }
 224 }
 225
 226 proc openConnection { tohost port magic program } {
 227     global  pdata
 228     dtrace
 229     set msg "magic: $magic\n"
 230     set retries 2
 231     message [concat [mc "connecting to"] "nmtp($port)://$tohost/$program"]
 232     debugsend "openConnection { $tohost $port $magic $program }"
 233
 234     while { [incr retries -1] > 0 \
 235                 && [catch {set socket [openSocketAndSend $tohost $port $msg 1]}] } {
 236         debugsend retries=$retries
 237         msleep 400
 238     }
 239     if { $retries == 0 } { return 0}
 240     message [concat [mc "connected to"] "nmtp//$tohost:$port/$program"]
 241     set pdata($program,socket) $socket
 242     set pdata($program,currentExpr) 0
 243     set pdata(input,$socket) ""
 244     catch { fconfigure $socket -blocking 0 }
 245     fileevent $socket readable "getResults $program $socket"
 246     return 1
 247 }
 248
 249 proc sendInterrupt { program } {
 250     global pdata interrupt_signal
 251     set socket $pdata($program,socket)
 252     maxStatus [mc "Sending socket interrupt"]
 253     puts $socket $interrupt_signal
 254     flush $socket
 255 }
 256
 257 proc sendCommand { program c }   {
 258     global  pdata
 259     set socket $pdata($program,socket)
 260     puts $socket "<command:$c>"
 261     flush $socket
 262 }
 263
 264 proc dumpInfo {program } {
 265     sendCommand $program dumpInfo
 266 }
 267
 268 proc getResults {  program socket } {
 269     # debugsend "enter:getResults"
 270     global pdata  next_command_available next_command results ii
 271     if { [eof $socket] } {
 272         close $socket ;
 273         debugsend "closed $socket"
 274         cleanPdata $program
 275         return "<$program exitted>"
 276     }
 277     set s [read $socket]
 278     if { "[string index $s 0]" != "" } {
 279         set s [append pdata(input,$socket) $s]
 280         while { [set inds [testForFayve $s]] != "" } {
 281             set input $pdata(input,$socket)
 282             # set next_command_available 1
 283             debugsend "input=$input"
 284             set gotback [string range $input 0 [expr {[lindex $inds 0] -1}]]
 285             set index [lindex $inds 2]
 286             set pdata($program,results,$index) $gotback
 287             if { [string first "exitted>" $gotback] > 0 } {
 288                 close $socket
 289                 cleanPdata $program
 290             }
 291
 292             debugsend "gotback{$index:$gotback}"
 293             set s \
 294                     [string range $input [expr {1 + [lindex $inds 1]}] end ]
 295             set pdata(input,$socket) $s
 296         }
 297     }
 298     return ""
 299 }
 300
 301 proc cleanPdata { program } {
 302     global pdata
 303     catch { close $pdata($program,socket) }
 304     catch { unset pdata($program,socket) }
 305     catch { unset pdata($program,preeval) }
 306     catch {
 307         foreach v [array names $program,results,*] {
 308             unset pdata($v)
 309         }
 310     }
 311 }
 312
 313 proc currentTextWinWidth { } {
 314     set width 79
 315     catch {
 316         set t [oget [omPanel .] textwin]
 317         set width [expr {round([winfo width $t]*1.0 / [font measure [$t cget -font] 0]) - 12 }]
 318     }
 319     return $width
 320 }
 321 #
 322 #-----------------------------------------------------------------
 323 #
 324 # assureProgram --
 325 #
 326 #  Results: return 2 if the program was already open, and 1 if it is just
 327 # now opened.   0 if cant open it.
 328 #
 329 #  Side Effects: program is started.
 330 #
 331 #----------------------------------------------------------------
 332 #
 333 proc assureProgram { program timeout tries } {
 334     # puts "assure: program=$program"
 335     global pdata
 336     set MathServer { some.server.example.org 4443 }
 337
 338     if { $tries <=  0   } { return 0}
 339
 340     if  { [catch { set socket $pdata($program,socket) } ] \
 341             || [catch { eof $socket}] \
 342             || [eof $socket] \
 343             || [catch { set s [read $socket]; append pdata(input,$socket) $s }] } {
 344         cleanPdata $program
 345         message [concat [mc "connecting"] "[lindex $MathServer 0]"]
 346         set msg "OPEN [programName $program] MMTP/1.0\nLineLength: [currentTextWinWidth]\n\n\n"
 347         if {[catch {openSocketAndSend [lindex $MathServer 0] \
 348                 [lindex $MathServer 1] "$msg\n"} sock] } {
 349             error [concat [mc "Can't connect to"] "$MathServer." [mc "You can try another host by altering Base Program under the \"File\" menu."]]
 350         }
 351
 352         set pdata($program,currentExpr) 0
 353         fconfigure $sock -blocking 0
 354         if { [eof $sock] } {return 0}
 355         message [concat [mc"connected to"] "[lindex $MathServer 0]"]
 356         debugsend $msg
 357         set result ""
 358         set pdata(waiting,$sock) 1
 359         set script "close $sock ; debugsend {after closing} ; set pdata(waiting,$sock) -1"
 360         debugsend "script=$script,timeout=$timeout"
 361         set af [after $timeout $script ]
 362         debugsend "after=$af"
 363         while {1 } {
 364             debugsend "waiting pdata(waiting,$sock)=$pdata(waiting,$sock)"
 365             #       puts "pdata=[array get pdata *$sock* ]"
 366             fileevent $sock readable "if { [eof $sock] }  {set pdata(waiting,$sock) -2} else { set pdata(waiting,$sock) 0 ;} ;fileevent $sock readable {} "
 367             set pdata(waiting,$sock) 1
 368             debugsend "waiting on  pdata(waiting,$sock)"
 369             myVwait pdata(waiting,$sock)
 370
 371             debugsend "..done now pdata(waiting,$sock)=$pdata(waiting,$sock)"
 372             if { $pdata(waiting,$sock) < 0 } {
 373                 debugsend "timed out,$pdata(waiting,$sock)"
 374                 return 0
 375             }
 376             set me [read $sock]
 377             if { "[string index $me 0]" == ""  && [eof $sock] } {
 378                 debugsend "nothing there"
 379                 return 0
 380             }
 381             append result $me
 382             debugsend "result=<$result>"
 383             if { [regexp "RUNNING (\[^ \]+) MMTP\[^\n\]*\nHost: (\[^\n ]+)\nPort: (\[0-9\]+)\nMagic: (\[^\n \]+)\n" \
 384                     $result junk prog tohost port magic] } {
 385                 after cancel $af
 386                 debugsend "doing openConnection  $tohost $port $magic $program"
 387                 close $sock
 388                 return [openConnection  $tohost $port $magic $program]
 389             }
 390         }
 391     } elseif { [eof $socket] } {
 392         close $socket
 393         unset pdata($program,socket)
 394         return [assureProgram $program $timeout [expr {$tries -1}]]
 395     } else {
 396         # already open
 397         return 2
 398     }
 399 }
 400
 401 # name may look like "maxima#1.2"
 402 proc programName { name } {
 403     set name [file tail $name]
 404     return [lindex [split $name #] 0]
 405 }
 406
 407 proc getMatch { s inds } {
 408     return [string range $s [lindex $inds 0] [lindex $inds 1]]
 409 }
 410
 411 proc testForFayve { input } {
 412     set EOFexpr "|fayve>"
 413     set ind [string first $EOFexpr $input]
 414     if { $ind < 0 } { return "" } else {
 415         regexp -indices {<([0-9]+)\|fayve>} $input all first
 416         set n [getMatch $input $first]
 417         return "$all $n"
 418     }
 419 }
 420
 421 #### the following is correct but just a fair bit slower.. ####
 422 ##### because of all the arguments to be parsed for the other..
 423 proc statServer1  {server {timeout 1000}} {
 424     global statServer
 425     set ans ""
 426     if { ![catch { set s [eval socket $server]} ] } {
 427         puts $s "STAT MMTP/1.0\n" ; flush $s
 428         if { [readAllData $s -tovar statServer(data) \
 429                 -mimeheader statServer(header) -timeout $timeout ] > 0 } {
 430             set head $statServer(header)
 431             #      puts "data=<$statServer(data)>"
 432             set res $statServer(header)\n\n$statServer(data)
 433             unset statServer
 434             return $res
 435         }
 436     }
 437     return ""
 438 }
 439 #
 440 #-----------------------------------------------------------------
 441 #
 442 # needToDo --  Check if we have already done OPERATION for  NAME into data
 443 #
 444 #  Results: returns 0 if the data for name is not preloaded, and 1 otherwise
 445 #
 446 #  Side Effects: adds NAME to those preloaded for PROGRAM if not there
 447 #
 448 #----------------------------------------------------------------
 449 #
 450 proc preeval { program name } {
 451     global pdata
 452     assureProgram $program 5000 2
 453     if { ![info exists pdata($program,preeval)] || \
 454     [lsearch  $pdata($program,preeval) $name] < 0 } {
 455         lappend pdata($program,preeval) $name
 456         return 0
 457     } else {
 458         return 1
 459     }
 460 }
 461
 462 proc statServer  {server {timeout 1000}} {
 463     global statServer1_
 464     set ans ""
 465     if { ![catch { set s [eval socket $server]} ] } {
 466         puts $s "STAT MMTP/1.0\n" ; flush $s
 467         if { [readDataTilEof $s data $timeout ] } {
 468             foreach v { jobs currentjobs } {
 469                 if { [regexp "\n$v: (\[^\n]*)\n" $data junk val] } {
 470                     lappend ans $v $val
 471                 }
 472             }
 473         }
 474     }
 475     return $ans
 476 }
 477
 478 proc isAlive1 { s } {
 479     global maxima_priv
 480     if { [catch { read $s } ] } {
 481         set maxima_priv(isalive) -1
 482     } else {
 483         set maxima_priv(isalive) 1
 484     }
 485     close $s
 486 }
 487
 488 proc isAlive { server {timeout 1000} } {
 489     global maxima_priv
 490
 491     if { [ catch { set s [eval socket -async $server] } ] } { return -1 }
 492     set maxima_priv(isalive) 0
 493     fconfigure $s -blocking 0
 494     fileevent    $s writable     "isAlive1 $s"
 495     set c1 "set maxima_priv(isalive) -2"
 496     set after_id [after $timeout $c1]
 497     myVwait maxima_priv(isalive)
 498     catch { close $s}
 499     after cancel $after_id
 500     return $maxima_priv(isalive)
 501 }
 502
 503 proc debugsend { s } {
 504     global _debugSend
 505     if { $_debugSend } {
 506
 507         puts $s
 508         flush stdout
 509     }
 510 }