# Library functions for the batch_queue library 
#
# File: batch_queue/lib/icbqs_server.tcl
#
# $Revision$ on $Date$
# 
# Copyright (c) 1993-2003 ICEM CFD Engineering
#
#---------------------------------------------------------------------

# This file should not require that any other files be sourced !  --jka
# but, we should try not to duplicate too much guibase code here! --jka
# but, we should try not to duplicate too much batch_queue code here! --jka

if {"" == [info commands mess]} {
    proc mess {text {color black}} {
	puts -nonewline $text
    }
}

global is_win

if ![info exists is_win] {
    global tcl_platform 
    if [info exists tcl_platform(platform)] {
	set is_win [string compare $tcl_platform(platform) unix]
    } else {
	set is_win [expr ![file exists /etc/passwd]]
    }
}

if {"" == [info commands cmd_tempfile]} {
    
    proc cmd_tempfile {fn {suff ""}} {
	global cmd_tempfile_dir is_win
	if [info exists cmd_tempfile_dir] {
	    set pref $cmd_tempfile_dir/
	} elseif $is_win {
	    set pref ""
	} else {
	    set pref /tmp/
	}
	for {set i 0} {[file exists $pref$fn$i$suff]} {incr i} {}
	return $pref$fn$i$suff
    }
}

if {"" == [info commands cmd_chmod]} {
    proc cmd_chmod {mod file} {
	global is_win
	if !$is_win {
	    if [catch {file attributes $file -permissions 0$mod} res] {
		puts "Warning: could not chmod file: $res"
		return 1
	    }			    
	} else { return 1 }	
	
	return 0
    }
}

if 0 {
disable this -Wayne
if {"" == [info commands bgerror]} {
    proc bgerror { args } {
	if 0 {
	    # not sure yet...fixme --jka
	    if ![catch { info level -1 } level_info] {
		if { 1 < [llength $level_info] } {
		    set level_info [lindex $level_info 0]
		}
	    }
	    puts stderr $level_info
	}
	puts stderr "bgerror says errorInfo is $::errorInfo"
    }
}
}

# these should match those in batch_queue/lib/batch_queue.tcl
# but to set up a server, I want only one file to have to be extant. --jka

proc batch_queue_job_running {}    { return "RUNNING"    }
proc batch_queue_job_queued {}     { return "QUEUED"    }
proc batch_queue_job_terminated {} { return "TERMINATED" }
proc batch_queue_job_finished {}   { return "FINISHED"   }
proc batch_queue_job_unknown {}    { return "UNKNOWN"    }


## Get the default port to use for the IcBQS server, currently 6791.

proc batch_queue_icbqs_server_port_default {} { return "6791" }


# --------------------------------------------------------------------

# for testing only

proc batch_queue_icbqs_server_test_echo { seconds } {
    
    set cmdfile [cmd_tempfile echo_test .sh]
    set fp [open $cmdfile w]
    puts $fp "\#!/bin/sh"
    puts $fp "echo 'I am echoing...can you hear me now? Good. I am going to sleep for $seconds seconds...'"
    puts $fp "sleep $seconds"
    puts $fp "echo 'I am awake and finished.'"
    close $fp
    if [cmd_chmod 0755 $cmdfile] {
	catch { eval exec chmod 00755 $cmdfile }
    }
    set pid [exec $cmdfile &]
    
    return $pid
}

# for testing only

proc batch_queue_icbqs_server_test_sigsegv { } {
    
    set cmdfile [cmd_tempfile sigsegv_test .sh]
    set fp [open $cmdfile w]
    puts $fp "\#!/bin/sh"
    puts $fp "echo 'This process sucks *so* bad...it is *so* depressing...I think I will raise a SIGSEGV...'"
    puts $fp "raise SIGSEGV"    
    puts $fp "set stat = \$status"
    puts $fp "echo 'status $stat'"
    puts $fp "echo 'Where am I? Is this the afterlife?'"    
    puts $fp "exit $stat"
    close $fp
    cmd_chmod 0755 $cmdfile
    set pid [exec $cmdfile &]
    
    return $pid
}


## This proc will allow the server to check whether or not the given path
## is exported/mounted for it.

proc batch_queue_icbqs_server_check_file_path { server_path } {
    
    if {("" != $server_path) && [file exists $server_path] && [file readable $server_path]} {
	return 1
    }
    # note also [file owned x] and [file writeable x] for elsewhere    
    return 0
}


##

proc batch_queue_icbqs_server_tmp_filepath_get { base extension } {
    return [cmd_tempfile $base $extension]    
}


## Get (by ftp) the file from the client at the path and return the server_path

proc batch_queue_icbqs_server_get_file { client client_path } {
    
    # create a tmp file name for server_path
    set base [file tail [file rootname $client_path]]
    set ext [file extension $client_path]
    if {"" != $ext} { set ext ".${ext}" }
    set server_path [cmd_tempfile $base $ext]
    
    # user and password?
    
    set stat [batch_queue_ftp_open_get $client $user $passwd $client_path $server_path]
    
    return $server_path
}


## Given the replay file and logfile, then run med.
## THIS PROC **MUST** RETURN THE PROCESS ID

proc batch_queue_icbqs_server_medbatch_exec { replay_file logfile {icemacn ""} } {
    global env
    
    set cmdfile [cmd_tempfile medbatch_startup .csh]
    
    set medbin [batch_queue_icbqs_server_medbatch_progpath $icemacn 0]
    set cmd "$medbin -batch -script $replay_file"
    
    set fp [open $cmdfile w]
    puts $fp "\#!/bin/csh -f"
    puts $fp "\#\n\# med startup script for job \"$replay_file\"\n"
    puts $fp "cd [file dirname $replay_file]"
    if {"" != $icemacn} {
	puts $fp "setenv ICEM_ACN $icemacn"
    }
    puts $fp $cmd
    close $fp
    cmd_chmod 0755 $cmdfile
    
    # set pid [exec $cmdfile >& $logfile &] fixme -- add logfile to args of this function
    set pid [exec $cmdfile &]
    
    return $pid
}


## Get thed med executable program path based on current env vars...

proc batch_queue_icbqs_server_medbatch_progpath {{icemacn ""} {interactive 0}} {
    global env is_win
    
    # --> MED_DIR, MED_ROOT: this is for me...    
    
    if { ( [info exists env(MED_DIR)]  && ![string equal "" $env(MED_DIR)]  ) || \
	     ( [info exists env(MED_ROOT)] && ![string equal "" $env(MED_ROOT)] )} {
	
	set prog med
	
    } else {
	
	if {"" == $icemacn} {
	    set icemacn $env(ICEM_ACN)
	}
	
	if { $is_win && !$interactive} {
	    set prog [file join $icemacn bin med_batch]
	} else {
	    set prog [file join $icemacn bin med]
	}
    }
    
    return $prog
}


## See if a command exists in the tcl interp

proc batch_queue_icbqs_server_is_command_tcl { command } {
    return [expr { "" != [info commands $command] } ]
}


## See whether command is valid in this server interp. It exists in
## order to restrict the execution of arbitrary shell scripts in
## which all hell could break loose

proc batch_queue_icbqs_server_is_command_ok { command } {
    
    return 1 ; # fixme FIXME FIXME FIXME FIXME FIXME FIXME FIXME FIXME FIXME !!
    
    # --> First, see whether the setup had "valid commands" specified as an arg
    
    global icbqs_server_valid_commands    
    if { [info exists icbqs_server_valid_commands] && ("" != $icbqs_server_valid_commands) } {
	return [expr {0 <= [lsearch $valid_commands $command]}]
    }
    
    # --> Otherwise, require that the command is a TCL comamnd starting with "batch_queue_"
    
    set valid_string "batch_queue_"
    
    if {("" != [info commands $command]) && \
	    [string equal -length [string length $valid_prefix] $valid_prefix $command]} {
	return 1
    }

    # --> If we are allowing shell scripts, then check that it is a valid path with permissions
    
    global icbqs_server_allow_shell_scripts
    if { [info exists icbqs_server_allow_shell_scripts] && $icbqs_server_allow_shell_scripts } {
	if { [file isfile $command] && [file executable $command] } {
	    return 1
	}
    }
    
    # --> No dice.
    
    return 0
}


# --------------------------------------------------------------------


## Initialize an IcBQS server. Examples args are:
##    "-port_start 6790 -port_end 6792 -valid_commands {commandone commandtwo} -allow_shell_scripts
## fixme-doc more detail.

proc sst { args } {
    if {$args == ""} {
	batch_queue_icbqs_server_start
    } else {
	batch_queue_icbqs_server_start $args
    }
}

proc batch_queue_icbqs_server_start { args } {
    global icbqs_server_allow_shell_scripts
    global icbqs_server_valid_commands
    global icbqs_server_terminate    
    
    puts "\nStarting IcBQS server $args...\n"
    
    #
    # --> get args, init'ing defaults first
    #
    
    set port_start ""
    set port_end ""    
    set valid_commands ""
    set allow_shell_scripts 0
    
    foreach {n v} $args {
	if {"-" != [string range $n 0 0]} {
	    puts "icbqs_server: warning: cannot interpret tag \"$n\" in setting up IcBQS server!"
	    continue
	}
	set [string range $n 1 end] $v
    }
    
    #
    # --> Add this file's procs to the list of valid commands
    #
    
    set icbqs_server_valid_commands [concat $valid_commands [info commands "batch_queue_icbqs_server_*"]]
    set icbqs_server_allow_shell_scripts $allow_shell_scripts
    
    #
    # --> Open the port and wait for commands
    #
    
    if {"" == [batch_queue_icbqs_server_open_port $port_start]} {
	puts "Error: could not set up IcBQS server"
    }
    
    #
    # --> Wait for commands
    #
    
    puts "icbqs_server_start: Ready...\n"
    
    vwait icbqs_server_terminate
}


## Create a socket to a port on the server in the given range. Returns the port
## actually acquired.

proc batch_queue_icbqs_server_open_port { server_port_start {server_port_end 49151} } {
    global icbqs_server_info
    
    if {("" != [batch_queue_icbqs_server_get_datum PORT]) && \
	    ("" != [batch_queue_icbqs_server_get_datum SOCKET])} {
	return [batch_queue_icbqs_server_get_datum PORT]
    }
    if {"" == $server_port_start} {
	set server_port_start [batch_queue_icbqs_server_port_default]
    }
    
    for {set port $server_port_start} {$port <= $server_port_end} {incr port} {	

	# FIXME: Transport Level Security
	# fixme: (add option to) use tls::socket ?-server command? ?options? port
	if ![catch {socket -server batch_queue_icbqs_server_accept_socket $port} sock] {
	    
	    batch_queue_icbqs_server_set_datum PORT   $port
	    batch_queue_icbqs_server_set_datum SOCKET $sock
	    batch_queue_icbqs_server_print_data
	    
	    # this is the good return...the port number
	    return $port
	}
    }
    
    # we are returning poorly...a null_string    
    puts "Error: could not open server socket between $server_port_start and $server_port_end"    
    batch_queue_icbqs_server_unset_data
    
    return ""
}


## Accept the given socket <em>sock</em> etc. This should not be called directly, rather
## is only used by the "socket" command in <em>batch_queue_icbqs_server_open_port</em>.

proc batch_queue_icbqs_server_accept_socket { sock addr port } {
    global icbqs_server_info
    
    set icbqs_server_info(socket,$sock) [list $addr $port]
    fconfigure $sock -buffering line
    fileevent $sock readable [list batch_queue_icbqs_server_accept_input $sock]

    set sockname [fconfigure $sock -sockname]
    set peername [fconfigure $sock -peername]
    
    if 0 { ;# debug block -->
	mess "From client $addr on port \"$port\", using socket: $sock"

	mess "\nCommunicating on socket \"$sock\":\n"
	mess "\tsockname: $sockname\n"
	mess "\tpeername: $peername\n\n"
    } ;# <-- debug block
}


## This proc accepts ANY commands from a connected client. It is possible
## to limit this list of commands at server statup with the arg:
##    "-valid_commands [list $commandone $commandtwo]"
## but this should not be considered a safe-interp.
##
## Otherwise an EOF marker will indicate that the socket is being closed from
## the client side and so should be closed by the server.

proc batch_queue_icbqs_server_accept_input { sock } {
    global icbqs_server_info
    global is_win
    set cmdfile ""
    set pid -1
    
    if {[eof $sock] || [catch {gets $sock line}]} {
	#
	# end of file or abnormal connection drop
	#
	close $sock
	puts "icbqs_server: closing $sock $icbqs_server_info(socket,$sock)"
	unset icbqs_server_info(socket,$sock)
	
    } else {
	if {[string compare $line "quit"] == 0} {
	    #
	    # Prevent new connections.
	    # Existing connections stay open.
	    #
	    catch { close [batch_queue_icbqs_server_get_datum SOCKET] }
	}
	
	batch_queue_icbqs_server_print_data
	
	set command [lindex $line 0]
	set args    [lrange $line 1 end]
	
	if {"" == $command} {
	    puts "Warning: Received null command; probably Icepak exited..." ;# fixme
	    return
	}
	
	puts "Executing command:\n\"$command\"\nfrom peer: [fconfigure $sock -peername]"
	
	#
	# --> It may be a Tcl command, or may be a shell command
	#   
	
	if [batch_queue_icbqs_server_is_command_tcl $command] {

	    if [catch { eval $line } res] {
		puts "icbqs_server: warning: command failed: $res"
	    }
	    puts $sock $res
	    flush $sock

	    # check that the command is ok to be exec'd
	} elseif [batch_queue_icbqs_server_is_command_ok $command] {

	    set logfile [cmd_tempfile icbqslog .log]
		
	    # fixme -- FIXME -- fixme -- 
	    # this is where we'll have to wrap the script to handle signals etc.
		
	    if $is_win {
		set pid [eval exec $line >& $logfile &]
	    } else {
		set cmdfile [cmd_tempfile icbqscmd .tmp]
		set fp [open $cmdfile w]
		puts $fp "\#!/bin/csh -f"
		puts $fp "set echo"
                puts $fp "set scriptpath=$line"
                puts $fp "set dir=\$scriptpath:h"
                puts $fp "set filename=\$scriptpath:t"
                puts $fp "cd \$dir"
		puts $fp "./\$filename"
		puts $fp "set stat = \$status"
		puts $fp "echo status \$stat"
		puts $fp "exit \$stat"
		close $fp
		cmd_chmod 0755 $cmdfile
		set pid [exec $cmdfile >& $logfile &]

		#this is for testing -- we should not allow arbitary scripts ... --jka
#		set pid [eval exec $line &]
	    }
	    
#	    puts "PID of command:\n[lindex $line 0]\nis \"$pid\""   

	    puts $sock $pid
	    flush $sock
	} else {
	    puts "icbqs_server: you don't have permission \
                  to execute $command..."
	}
    }
    
    if {"" != $pid} {
	# FIXME: keep track of the input so the the server can say how busy it is, how many
	# processes, what commands, what the pid is, so it can kill it...
	
	# make sure that as these jobs FINISH, this val gets decremented -- fixme
	# maybe we need to wrap the "command" so that it will do this for us when it finishs?
	# that sounds ok...    
	
	set icbqs_server_jobman($pid) [batch_queue_job_running]
	
	# etc. fixme	
    }
    
    puts "icbqs_server_accept_input: Ready...\n"
}


## Get a particular bit of information <em>what</em> from the server.

proc batch_queue_icbqs_server_get_datum { what } {
    global icbqs_server_info
    if [info exists icbqs_server_info($what)] {
	return $icbqs_server_info($what)
    }
    return ""
}


## Set a particular bit of information <em>what</em> from the server to <em>val</em>.

proc batch_queue_icbqs_server_set_datum { what val } {
    global icbqs_server_info
    set icbqs_server_info($what) $val
}


## Unset all data for the IcBQS server

proc batch_queue_icbqs_server_unset_data {} {
    global icbqs_server_info
    
    unset icbqs_server_info(SOCKET)
    unset icbqs_server_info(PORT)
}


## Tell the IcBQS server to print what it knows

proc batch_queue_icbqs_server_print_data {} {
    
    set port [batch_queue_icbqs_server_get_datum PORT]
    set sock [batch_queue_icbqs_server_get_datum SOCKET]
    if {("" == $port) && ("" == $sock)} {
	puts "icbqs_server: no ports are open"
    } else {
	#puts "\nOn server, sock: [fconfigure $sock -sockname]"
	#puts "icbqs_server: server set up on port \"$port\" with socket \"$sock\"."
    }    
}


## Ask the IcBQS server for the list of available commands.

proc batch_queue_icbqs_server_help {} {
    puts "\nIcBQS-Server commands:"
    puts "\t[info commands icbqs_server_*]"
}


## Killed the process associated with the process id <em>process_id</em>.

proc batch_queue_icbqs_server_kill_process { process_id } {
    
    # fixme for windows
    
    if [catch {exec kill -9 $process_id} res] {
	#puts "Error: could not kill process $process_id: $res"
    }
    
    #puts "Killed process $process_id"
    
    return "SUCCESS"
}


## Killed the process associated with the process id <em>process_id</em>.

proc batch_queue_icbqs_server_process_exists { process_id } {
    
    # watch this `ps' command! remember it has a column-header row (-> "- 1")
    # fixme for windows and check for all unices --fixme --jka
    
    catch {exec ps -p $process_id | wc} res
    if {"" == $res} {
	return 0
    } else {
	#puts "debug: got res: $res for process existing"
    }
    set nprocesses [expr [lindex $res 0] - 1]
    
    return [expr {1 == $nprocesses}]
}


## Update the process status of the process <em>process_id</em>.

proc batch_queue_icbqs_server_update_process_status { process_id } {
    global icbqs_server_jobman
    
    if [batch_queue_icbqs_server_process_exists $process_id] {
	# should still be set to "RUNNING"
	return [batch_queue_job_running]
    }
    
    # figure out whether "FINISHED" or "TERMINATED"
    # FIXME	!!!!
    #set icbqs_server_jobs($process_id) "FINISHED"
    
    return [batch_queue_job_finished]
}


## Get a list of IcBQS jobs which are RUNNING.

proc batch_queue_icbqs_server_running_job_pids {} {    
    global icbqs_server_jobman

    if { ![info exists icbqs_server_jobman] } {
	return ""
    }
    
    set running_jobs ""
    
    foreach pid [array names icbqs_server_jobman] {
	if {[batch_queue_job_running] == [batch_queue_icbqs_server_update_process_status $pid]} {
	    lappend running_jobs $pid
	}
    }
    
    return $running_jobs
}


## Tell the IcBQS server to close the socket cleanly.

proc batch_queue_icbqs_server_close_socket_cleanly {} {
    
    set port [batch_queue_icbqs_server_get_datum PORT]
    set sock [batch_queue_icbqs_server_get_datum SOCKET]
    if {"" != $sock} {
	close $sock
	icbqs_server_unset_data
	puts "icbqs_server: closing port \"$port\" at socket \"$sock\""
    }
}


## Tell the IcBQS server to quit cleanly, killing all extant IcBQS jobs.

proc batch_queue_icbqs_server_quit {} {
    
    puts "icbqs_server: cleaning up for exit..."
    
    set remaining_jobs [batch_queue_icbqs_server_running_job_pids]
    if {0 < [llength $remaining_jobs]} {
	puts "icbqs_server: there are still [llength $remaining_jobs] jobs running...killing them"
	foreach pid $remaining_jobs {
	    batch_queue_icbqs_server_kill_process $pid
	}
    }
    
    batch_queue_icbqs_server_close_socket_cleanly
    
    puts "icbqs_server: ...cleanup finished.\n"
    
    exit
}


## Ask the IcBQS server how busy it is. Returns a list such that:
##    {$njobs $machine_load}
## and (0 < $machine_load < 10) where 10 is super-busy and 0 is lazy

proc batch_queue_icbqs_server_how_busy_are_you {} {
    
    set n_icbqs_jobs [llength [batch_queue_icbqs_server_running_job_pids]]
    
    set machine_load 0 ;  # fixme: parse "top n 1 b" on *nix
    
    return [list $n_icbqs_jobs $machine_load]
}


# -----------------------------------------------------------------------------------------------


# (These are support for trying to figure out how busy a machine is, how much it can
#  handle, etc. Much work to be done here.)


## fixme-doc.
## e.g. "Linux"

proc batch_queue_icbqs_server_get_os {} {
    global tcl_platform
    # maybe more, or different
    return $tcl_platform(os)
}


## fixme-doc.
## e.g., "unix"

proc batch_queue_icbqs_server_get_platform {} {
    global tcl_platform
    # maybe more, or different
    return $tcl_platform(platform)
}


## fixme-doc.
## e.g, "i686"

proc batch_queue_icbqs_server_get_cpu {} {
    global tcl_platform
    # maybe more, or different
    return $tcl_platform(machine) 
}


## fixme-doc.

proc batch_queue_icbqs_server_get_nprocesses {} {
    
    switch -- [batch_queue_icbqs_server_get_platform] {
	unix {
	    if ![catch { eval exec "ps ax | wc -l" } nprocesses] {
		error "could not get number of processes..."
	    }
	}
	default {
	    fixme   
	}
    }
}


## fixme-doc.

proc batch_queue_icbqs_server_get_free_memory {} {
    
    set mem_free 0
    set mem_free_unit kB
    
    switch -- [batch_queue_icbqs_server_get_os] {
	
	Linux - linux {
	    if ![catch {eval exec cat /proc/meminfo | grep MemFree} res] {
		set mem_free      [lindex $res 1]
		set mem_free_unit [lindex $res 2]
	    }
	}	
	default {
	    fixme
	}
    }
    
    # fixme -- watch var "mem_free_unit"
    
    return $mem_free
}

