#!/bin/sh  
# \
  exec oagwish "$0" "$@"


set auto_path [linsert $auto_path 0  /usr/local/oag/apps/lib/$env(HOST_ARCH)]
set auto_path [linsert $auto_path 0 /usr/local/oag/lib_patch/$env(HOST_ARCH)]
set CVSRevisionAuthor "\$Revision: 1.9 $ \$Author: soliday $"

APSStandardSetup
package require BLT

proc runExec {args} {
    set command ""
    APSStrictParseArguments {command}
    global debug status
    if {$debug} {
	set status "([clock format [clock seconds] -format "%H:%M:%S %D"]) runExec $command"
    }
    if {![llength $command]} {
	return -code error "no command given (tclDPServer)"
    }
    global allowedPrograms
    if {[llength $allowedPrograms]} {
	set executable [string tolower [file rootname [file tail [lindex $command 0]]]]
	if {[lsearch -exact $allowedPrograms $executable] == -1} {
	    return -code error "command $executable not allowed"
	}
    }

    global statusVar outputVar errorVar
    set statusVar 0
    if {[catch {eval blt::bgexec statusVar -output outputVar -error errorVar $command} result]} {
	return -code error "$result"
    }
    if {$debug} {
	set status "([clock format [clock seconds] -format "%H:%M:%S %D"]) runExec finished"
    }
    return -code ok
}

proc queryJob {args} {
    global running
    global debug status
    if {$debug} {
	set status "([clock format [clock seconds] -format "%H:%M:%S %D"]) queryJob"
    }
    return -code ok "[expr {$running - 1}]"
}

proc killJob {args} {
    global statusVar
    global debug status
    if {$debug} {
	set status "([clock format [clock seconds] -format "%H:%M:%S %D"]) killJob"
    }
    set statusVar 1
    return -code ok
}

proc runSource {args} {
    set fileName ""
    APSStrictParseArguments {fileName}
    global debug status
    if {$debug} {
	set status "([clock format [clock seconds] -format "%H:%M:%S %D"]) runSource $fileName"
    }
    if {![llength $fileName]} {
	return -code error "no file name given (tclDPServer)"
    }
    if {[catch {source $fileName} result]} {
	return -code error "$result"
    }
    if {$debug} {
	set status "([clock format [clock seconds] -format "%H:%M:%S %D"]) runSource finished"
    }
    return -code ok "$result"
}

set parser [interp create -safe]

$parser alias runExec runExec
$parser alias queryJob queryJob
$parser alias killJob killJob
$parser alias runSource runSource

proc server_accept {cid addr port} {
    global remoteHost
    global debug status
    if {$debug} {
	set status "([clock format [clock seconds] -format "%H:%M:%S %D"]) server_accept $cid $addr $port"
    }
    if {($remoteHost == "") || ($addr == "$remoteHost")} {
        fileevent $cid readable "server_handle $cid"
        fconfigure $cid -buffering line
    } else {
        catch {close $cid}
    }
}

set running 0
proc server_handle {cid} {
    global debug status
    if {$debug} {
	set status "([clock format [clock seconds] -format "%H:%M:%S %D"]) server_handle $cid"
    }
    if {[gets $cid request] < 0} {
        catch {close $cid}
    } else {
        global parser buffer running
	if {($running) && ($request != "queryJob") && ($request != "killJob")} {
	    catch {puts $cid [list error_result -output "Error: Another job is already running"]}
	    catch {close $cid}
	    return
	}
        append buffer $request "\n"
        if {[info complete $buffer]} {
            set request $buffer
            set buffer ""
	    incr running 1
            if {[catch {$parser eval $request} result]} {
                catch {puts $cid [list error_result -output $result]}
            } else {
                catch {puts $cid [list ok_result -output $result]}
            }
	    incr running -1
            catch {close $cid}
        }
    }
}

proc server_accept_quit {args} {
    exit
}

set args $argv
set force 0
set kill 0
set remoteHost ""
set poisson 0
set debug 0

if [APSStrictParseArguments {force kill remoteHost poisson debug}] {
    puts stderr "usage: tclDPServer \[-remoteHost <IPaddress>\] \[-poisson \[1|0\]\] \[-force \[1|0\] | -kill \[1|0\]\]\n[join [split $CVSRevisionAuthor $] ""]"
    puts stderr "Only one remote host will be allowed to connect for security reasons"
    exit 1
}
set allowedPrograms ""
if {$poisson} {
    append allowedPrograms "autofish automesh cclcells cclfish cdtfish cfish dtlcells dtlfish ellcav ellfish fish force fscale list35 mdtcells mdtfish pandira poisson rfqfish sccfish segfield sf7 sf8 sfo sfotable "
}



#port 4581 is used for connections with tclDPClient
if [catch {socket -server server_accept 4581}] {    
    if {$force || $kill} {
        if [catch {socket localhost 4582} sid] {
            puts stderr "Unable to close previous version of tclDServer: $sid"
            exit 1
        } else {
            if {$kill} {
                exit
            }
            after 200
            if [catch {socket -server server_accept 4581}] {
                puts stderr "Unable to close previous version of tclDPServer"
                exit 1
            }
        }
    } else {
        puts stderr "port already in use, terminating program"
        exit 1
    }
}

if {$kill} {
    exit
}

#port 4582 is used to tell the server to quit
if [catch {socket -server server_accept_quit 4582}] {
    puts stderr "port already in use, terminating program"
    exit 1
}

wm geometry . +0+0
frame .userFrame
pack .userFrame -fill both -expand true
button .userFrame.exit -text "Exit tclDPServer" -command exit
pack .userFrame.exit -anchor w

if {$debug} {
    set status Ready...
    APSScrolledStatus .status \
	-parent .userFrame \
	-textVariable status \
	-width 80 \
	-packOption "-fill both -expand true"
}

#vwait enter-mainloop
proc up {} {
    update
    after 1000 up
}
up
