system.tk

openPBS的开放源代码

	if [systemRefreshGet $sysframe] {
		systemNodesReCreate $sysframe
		update idletasks
	}
}

proc systemDisplayClusterStatus {sysframe cname} {
	global canvas

	set cf [systemClusterFrameGet $sysframe $cname]

	set usepool [clusterUsePoolGet $cf]
	set availpool [clusterAvailPoolGet $cf]
	set totpool [clusterTotPoolGet $cf]

	set statusLine ""
	if {$totpool > 1} {
		set statusLine \
	     "Nodes:: $statusLine Total:$totpool Used:$usepool Avail:$availpool"
	}

	set offpool [clusterOfflinePoolGet $cf]
	if {$offpool != 0} {
		set statusLine "$statusLine Offl:$offpool"
	}

	set dwnpool [clusterDownPoolGet $cf]
	if {$dwnpool != 0} {
		set statusLine "$statusLine Down:$dwnpool"
	}

	set rsvpool [clusterReservedPoolGet $cf]
	if {$rsvpool != 0} {
		set statusLine "$statusLine Rsvd:$rsvpool"
	}
	set unkpool [clusterUnkPoolGet $cf]
	if {$unkpool != 0} {
		set statusLine "$statusLine Unk:$unkpool"
	}

	set cpu_assn [clusterCpusAssnGet $cf]
	if {$cpu_assn != 0} {
		set statusLine "$statusLine CpusAssn:$cpu_assn"

		set cpu_max [clusterCpusMaxGet $cf]
		if {$cpu_max != 0} {
			set statusLine "$statusLine/$cpu_max"
		}
	}
	set vprocs_assn [clusterVprocsAssnGet $cf]
	if {$vprocs_assn != 0} {
		set statusLine "$statusLine VPROCsUsed:$vprocs_assn"
	}

	set sbar [clusterStatusBarGet $cf]

        $sbar configure -text $statusLine
	set statusLineWidth \
	   	[expr [string length $statusLine] * $canvas(medLabelFontWidth)]

	if {$statusLineWidth > [clusterDisplayWidthGet $cf]} {
		clusterRefreshPut $cf 1
	}
	clusterFooterHeaderPut $cf $statusLine
}


# BUG: if a node was in the OFFLINE, and then on the next iteration
#	becomes FREE (no job on it), its color never gets updated to OFFLINE . 
proc systemPopulateNodesWithInfo {sysframe {create 0}} {
	global sysnodes canvas sysinfo

	if {[string compare $sysframe ""] == 0} {
		return
	}

	if {$sysinfo(LCK) || $sysinfo(PREFLCK)} {
	    InfoBox_sendmsg "systemPopulateNodesWithInfo: intentionally not updating since either another one is running, or pref dialog active." 1
	    return	
	}

	set sysinfo(LCK) 1

	set systemName [systemNameGet $sysframe]
	busy_cursor
	InfoBox_flush 1
	InfoBox_sendmsg "populatesNodesWithInfo: updating" 0

	update idletasks
        unsetNodeColorInUseMapping
	foreach n [systemNodeNamesGet $sysframe] {
		systemNodeInfoUnset $sysframe $n
		systemNodeInfo2Unset $sysframe $n
	}

	set serverl [serverNamesSorted $systemName \
			[serverNamesGet $systemName] nodeslist $sysframe]

	foreach server_name $serverl {
		if {[string compare $nodeslist($server_name) ""] != 0} {
			systemGetJobsInfo $sysframe $server_name
		}
	}

	set donehosts ""
	foreach n [systemNodeNamesGet $sysframe] {

		InfoBox_sendmsg "." 0 1

		set fullnodeFrame [systemNodeFrameGet $sysframe $n FULL]
		set mirrornodeFrame [systemNodeFrameGet $sysframe $n MIRROR]

		set nodejob [systemNodeInfoGet $sysframe $n]
		set nodestat [systemNodeStatusGet $sysframe $n]
		set nodetype [systemNodeTypeGet $sysframe $n]
		set nodeinfo2 [systemNodeInfo2Get $sysframe $n]

		switch -exact -- $nodetype {
                  NOMOM {
                        if {[string compare $nodejob ""] == 0 && \
                            ([string compare $nodestat INUSE-EXCLUSIVE] == 0 \
			     || [string compare $nodestat INUSE-SHARED] == 0)} {
                                nodeUpdateStat $sysframe $n FREE
                        }
			systemNodeInfoPut $sysframe $n \
					[concat $nodeinfo2 $nodejob]
                  }
		  NOMOM_SNODE {
			systemNodeInfoPut $sysframe $n \
					[concat $nodeinfo2 $nodejob]
		  }
		  MOM	{
			if {[string compare $nodejob ""] == 0 && \
		    	    ([string compare $nodestat INUSE-EXCLUSIVE] == 0 \
			     || [string compare $nodestat INUSE-SHARED] == 0)} {
				nodeUpdateStat $sysframe $n NOINFO
			}

			catch {openrm $n} fd
			InfoBox_sendmsg "systemPopulateNodesWithInfo: openrm($n): $fd" end
			if {$fd < 0} {
				nodeUpdateStat $sysframe $n DOWN
			} else {
				set status [TSgetStatus $fd $sysframe $n 1]
				switch -exact -- $status {
				  FREE {
				      set qlist [sendTSQueries $fd \
								$systemName $n]
				      set qexpr [recvResponses $fd \
							$systemName $n $qlist]

				      set qexpr [concat $qexpr $nodejob]
				      systemNodeInfoPut $sysframe $n $qexpr
				      systemUpdateInUse $sysframe $n $nodejob
				  }
				  NOINFO {
				      systemUpdateInUse $sysframe $n $nodejob
				  }
			        }

				catch {closerm $fd}
				InfoBox_sendmsg "systemPopulateNodesWithInfo: closerm($n)" end
			}
		  }
		  MOM_SNODE {
			set qexpr ""	
			catch {openrm $n} fd
			InfoBox_sendmsg "systemPopulateNodesWithInfo: openrm($n): $fd" end
			if {$fd >= 0} {
				set status [TSgetStatus $fd $sysframe $n 0]
				if {[string compare $status FREE] == 0} {
					set qlist [sendTSQueries $fd \
								$systemName $n]
					set qexpr [recvResponses $fd \
							$systemName $n $qlist]

			        }

				catch {closerm $fd}
				InfoBox_sendmsg "systemPopulateNodesWithInfo: closerm($n)" end
			}
			set qexpr [concat $nodeinfo2 $qexpr $nodejob]
			systemNodeInfoPut $sysframe $n $qexpr
		  }
		}
		set nodeinfo [systemNodeInfoGet $sysframe $n]

		if { [string compare $nodeinfo ""] != 0 } {
			nodeDisplayInfo $fullnodeFrame $nodeinfo $create
			nodeDisplayInfo $mirrornodeFrame $nodeinfo $create
		} else {
			nodeRemLines $fullnodeFrame 0
			nodeRemLines $mirrornodeFrame 0
		      	nodeColorIt $fullnodeFrame $n
		      	nodeColorIt $mirrornodeFrame $n
		}
	}

	foreach f [systemClusterNamesGet $sysframe] {
		systemDisplayClusterStatus $sysframe $f
	}

	systemRefreshDisplay $sysframe
	colorBarUpdate
	InfoBox_sendmsg "done." 0 1 5
	remove_busy_cursor

	set sysinfo(LCK) 0

}

proc systemUpdateInUse {sysframe n jobslist} {

	set len [lindex [lindex [lindex $jobslist 0] 1] 3]

	if {[string compare $len ""] == 0} {
		set len 0
	}
	if {$len == 1} {
		nodeUpdateStat $sysframe $n INUSE-EXCLUSIVE
	} elseif {$len > 1} {
		nodeUpdateStat $sysframe $n INUSE-SHARED
	}

}

proc systemGetJobsInfo {sysframe server_name} {

	if {[string compare $sysframe ""] == 0 || \
	    [string compare $server_name ""] == 0} {
		return
	}

	foreach nname [systemNodeNamesGet $sysframe] {
		set name [split $nname ,]
		set superhost [lindex $name 0]
		set fullhost  [lindex $name 1]
		
		if {[string compare $fullhost ""] == 0} {
			set node $superhost
		} else {
			set node $fullhost
		}
		set chophost  [lindex [split $node .] 0]
		set nodeMatch($node) $nname
		set nodeMatch($chophost) $nname
	}


	catch {unset jobs}
	catch {unset vp_used}
	set cpus_assn 0
	catch {pbsconnect $server_name} fd
	InfoBox_sendmsg "systemGetJobsInfo: pbsconnect($server_name): $fd" end
	set cframe [systemClusterFrameGet $sysframe $server_name]
	if { $fd >= 0 } {
		catch {pbsstatserv} sinfo
		set attribl [lindex $sinfo 1]

		foreach a $attribl {
			set res [lindex $a 0]
			set val [lindex $a 1]
			if {[string compare $res "resources_max.ncpus"] == 0} {
			      if {[string compare $cframe ""] != 0} {
			      	clusterCpusMaxPut $cframe $val
			      }
			} elseif {[string compare $res \
				   "resources_assigned.nodect"] == 0} {
				clusterVprocsAssnPut $cframe $val
			}
		}

		catch {pbsstatjob} jinfo
		InfoBox_sendmsg "systemGetJobsInfo: pbsstatjob($server_name): " end

		foreach j $jinfo {
			set jobid [lindex $j 0]
			set attribl [lindex $j 1]

			set user ""
			set state ""
			set hostlist {}
			set nodeslist {}
			set ncpus 0
			foreach a $attribl {
				set res [lindex $a 0]
				set val [lindex $a 1]

				if { [string compare $res "Job_Owner"] == 0 } {
					set user [lindex [split $val @] 0]
				} elseif {[string compare $res \
							   "job_state"] == 0} {
					set state $val
				} elseif {[string compare $res \
							   "exec_host"] == 0} {
					set hostlist [split $val +]
				} elseif {[string compare $res \
					  "resources_used.nodes"] == 0} {
					set nodeslist [split $val +]
				} elseif {[string compare $res \
					  "Resource_List.ncpus"] == 0} {
					set ncpus $val
				} elseif {[string compare $state ""] != 0 && \
					      [string compare $state R] != 0} {
					break
				}

			}
			if {[string compare $state R] == 0} {
				incr cpus_assn $ncpus
				if {[string compare $nodeslist ""] != 0} {
					set hlist $nodeslist
				} else {
					set hlist $hostlist
				}
				catch {unset ujobinfo}
				foreach h1 $hlist {
					set h1_list [split $h1 /]
					set h [lindex $h1_list 0] 
					set p [lindex $h1_list 1]

					if {[string compare $p ""] != 0} {
					    if {![info exists ujobinfo($h)]} {
						set ujobinfo($h) " on vprocs $p"
						set vp_used($h,$p) 1
					    } else {
						append ujobinfo($h) ":$p"
					    }
					} else {
					    set ujobinfo($h) ""
					}
				}

				foreach h [array names ujobinfo] {

					if [info exists nodeMatch($h)] {
					  if {$ncpus != 0} {
				     	    lappend jobs($nodeMatch($h)@$user) \
					     "$jobid$ujobinfo($h) (cpus=$ncpus)"
					   } else {
				     	    lappend jobs($nodeMatch($h)@$user) \
							"$jobid$ujobinfo($h)"
					  }
					}
				}
			}
		}

		catch {pbsdisconnect}
		InfoBox_sendmsg "pbsdisconnect($server_name)" end
	}

	foreach j [array names jobs] {
		set jinfo [split $j @]
		set nodename [lindex $jinfo 0]
		set user [lindex $jinfo 1]
		set numj [llength $jobs($j)]
		lappend nodejobs($nodename) "$user [join $jobs($j) ,]"
		if {![info exists njobs($nodename)]} {
			set njobs($nodename) $numj
		} else {
			incr njobs($nodename) $numj
		}
			
		if {![info exists nusers($nodename)]} {
			set nusers($nodename) 1
		} else {
			incr nusers($nodename)
		}
	}

	
	foreach n [array names nodejobs] {
		set header "Jobs: "
		if {$nusers($n) <= 1} {
			lappend header " $nusers($n) " "USER: "
		} else {
			lappend header " $nusers($n) " "USERs: "
		}

		if {$njobs($n) <= 1} {
			lappend header " $njobs($n) " "JID: "
		} else {
			lappend header " $njobs($n) " "JIDs: "
		}

		systemNodeInfoAppend $sysframe $n \
					[list $nodejobs($n) $header NODEJOB]

		set nodetype [systemNodeTypeGet $sysframe $n]

		systemUpdateInUse $sysframe $n [systemNodeInfoGet $sysframe $n]
	}

	if [info exists cframe] {
		clusterCpusAssnPut $cframe $cpus_assn
	}

	if {[info exists vp_used]} {
		set accum 0
		foreach pro [array names vp_used] {
			incr accum $vp_used($pro)
		}
		clusterVprocsAssnPut $cframe $accum
	}
}

proc systemAdjustNodesDistances {sysframe} {
        global canvas

        foreach n [systemNodeNamesGet $sysframe] {
                set nframe [systemNodeFrameGet $sysframe $n FULL]

                set ccanv [clusterCanvasGet [nodeClusterFrameGet $nframe]]

                set offset [nodeOffsetWidthGet $nframe]
                if { [string compare $offset ""] != 0 && $offset != 0 } {
                        $ccanv move $nframe $offset 0
                        nodeXposPut $nframe [expr [nodeXposGet $nframe] + \
                                                                        $offset]
                        nodeOffsetWidthPut $nframe 0
                }

        }

        foreach c [systemClusterNamesGet $sysframe] {
                set cframe [systemClusterFrameGet $sysframe $c]

                set systemc [systemCanvasGet [clusterSystemFrameGet $cframe]]
                set offset [clusterOffsetWidthGet $cframe]
                if { [string compare $offset ""] != 0 && $offset != 0 } {
                        $systemc move $cframe $offset 0
                        clusterXposPut $cframe [expr [clusterXposGet $cframe] \
                                                     + $offset]
                        clusterOffsetWidthPut $cframe 0
                }
        }
}