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