#!/usr/local/bin/wish # # This script generates a process browser, which lists the running # processes (using unix "ps") and allows you to send signals (such as KILL) # using a popup menu. # # Create a scrollbar on the right side of the main window and a listbox # on the left side. # # Henry Minsky (hqm@ai.mit.edu) May 1994 # # # (Update Record) # Sep 1995 K.Fujii Added a horizontal scroll bar. # Added the machine name to the title bar. # Added "list all jobs" and "list my jobs" to # "Options". # Colors are now taken from VUE resources, which # works only on hp-ux and requires "getvuecolor". # Oct 1995 K.Fujii Improved "find" function. # Oct 1995 K.Fujii Updated to work with tk4.0. # # proc strip_blanks { str} { set tmpstr "" ; foreach i $str { if {$i != ""} { lappend tmpstr $i } } return $tmpstr } #-- # Default settings. #-- set menufont "helvb12" set messagefont "helvb12" set helpfont "fixed" set tfont "fixed" # proc split_rgb {name} { set rgblength [string length $name] case $rgblength { 4 {set format "#%1x%1x%1x"; set shift 12} 7 {set format "#%2x%2x%2x"; set shift 8} 10 {set format "#%3x%3x%3x"; set shift 4} 13 {set format "#%4x%4x%4x"; set shift 0} default {error "syntax error in color name \"$name\""} } if {[scan $name $format red green blue] != 3} { error "syntax error in color name \"$name\"" } set red [expr $red<<$shift] set green [expr $green<<$shift] set blue [expr $blue<<$shift] return "$rgblength $red $green $blue" } proc darken_color {color scale} { set rgblist [split_rgb $color] set rgblength [lindex $rgblist 0] set red [format %.0f [expr $scale*[lindex $rgblist 1]]] set green [format %.0f [expr $scale*[lindex $rgblist 2]]] set blue [format %.0f [expr $scale*[lindex $rgblist 3]]] case $rgblength { 4 {set format "#%01x%01x%01x"} 7 {set format "#%02x%02x%02x"} 10 {set format "#%03x%03x%03x"} 13 {set format "#%04x%04x%04x"} default {error "syntax error in color name \"$name\""} } set new_color [format "$format" $red $green $blue] return $new_color } set how_dark 0.875 set vuecolors [exec getvuecolor] set scrollbarcolor [lindex $vuecolors 2] set textbgcolor [darken_color $scrollbarcolor $how_dark] set hdbcolor [lindex $vuecolors 7] # set scrollbaracolor $scrollbarcolor set hdfcolor "yellow" set fwdcolor "white" # set sbwidth 12 #-- # Add host name to title. #-- set host $env(HOST) wm title . "Running Processes on $host" #-- # The default update time of display is 10 seconds # You can change it in the configure menu. #-- set MIN_UPDATE_PERIOD 2000 set UPDATE_PERIOD 10000 #-- # The default double click behavior. #-- set USER_SIG KILL #-- # The default command line args to "ps" # set DEFAULT_PS_ARGS "-auxww" # # set DEFAULT_PS_ARGS "-ef" #-- set logname $env(LOGNAME) # set DEFAULT_PS_ARGS "-eu $logname" set DEFAULT_PS_ARGS "-u" #-- # Remember the last selected item. #-- set last_i -1 set last_pat "." #-- # You can get the implementation dependent signal names for your system # from /usr/include/signal.h #-- set common_sigs { {INT 2 interupt} {QUIT 3 quit} {IOT 6 abort} {KILL 9 non-catchable, non-ignorable kill} {STOP 17 sendable stop signal not from tty} {ALRM 14 alarm clock} {TERM 15 software termination signal} } #-- # Make a button bar for the common signals. #-- frame .bbar button .bbar.kill -text KILL -command { send_signal KILL } \ -font $menufont -highlightthickness 0 button .bbar.int -text INT -command { send_signal INT } \ -font $menufont -highlightthickness 0 button .bbar.quit -text QUIT -command { send_signal QUIT } \ -font $menufont -highlightthickness 0 button .bbar.iot -text IOT -command { send_signal IOT } \ -font $menufont -highlightthickness 0 button .bbar.term -text TERM -command { send_signal TERM } \ -font $menufont -highlightthickness 0 button .bbar.stop -text STOP -command { send_signal STOP } \ -font $menufont -highlightthickness 0 button .bbar.hup -text HUP -command { send_signal HUP } \ -font $menufont -highlightthickness 0 pack .bbar.kill .bbar.int .bbar.quit \ .bbar.iot .bbar.term .bbar.stop .bbar.hup \ -side left -padx 0m -ipadx 6m -pady 1m #-- # Set signals. #-- set all_sigs { {HUP 1 hangup} {INT 2 interrupt} {QUIT 3 quit} {ILL 4 illegal instruction (not reset when caught)} {TRAP 5 trace trap (not reset when caught)} {ABRT 6 abort()} {IOT SIGABRT compatibility} {EMT 7 EMT instruction} {FPE 8 floating point exception} {KILL 9 kill (cannot be caught or ignored)} {BUS 10 bus error} {SEGV 11 segmentation violation} {SYS 12 bad argument to system call} {PIPE 13 write on a pipe with no one to read it} {ALRM 14 alarm clock} {TERM 15 software termination signal from kill} {URG 16 urgent condition on IO channel} {STOP 17 sendable stop signal not from tty} {TSTP 18 stop signal from tty} {CONT 19 continue a stopped process} {CHLD 20 to parent on child stop or exit} {TTIN 21 to readers pgrp upon background tty read} {TTOU 22 like TTIN for output if (tp->t_local<OSTOP)} {IO 23 input/output possible signal} {XCPU 24 exceeded CPU time limit} {XFSZ 25 exceeded file size limit} {VTALRM 26 virtual time alarm} {PROF 27 profiling time alarm} {WINCH 28 window size changes} {INFO 29 information request} {USR1 30 user defined signal 1} {USR2 31 user defined signal 2} } set posix_sigs { {HUP 1 hangup} {INT 2 interrupt} {QUIT 3 quit} {ILL 4 illegal instruction (not reset when caught)} {ABRT 6 abort()} {FPE 8 floating point exception} {KILL 9 kill (cannot be caught or ignored)} {SEGV 11 segmentation violation} {PIPE 13 write on a pipe with no one to read it} {ALRM 14 alarm clock} {TERM 15 software termination signal from kill} {STOP 17 sendable stop signal not from tty} {TSTP 18 stop signal from tty} {CONT 19 continue a stopped process} {CHLD 20 to parent on child stop or exit} {TTIN 21 to readers pgrp upon background tty read} {TTOU 22 like TTIN for output if (tp->t_local<OSTOP)} {USR1 30 user defined signal 1} {USR2 31 user defined signal 2} } ################################################################ set common_ps_keywords { {%cpu percentage cpu usage (alias pcpu)} {%mem percentage memory usage (alias pmem)} {uid effective user ID} {user user name (from uid)} {majflt total page faults} {minflt total page reclaims} {msgrcv total messages received (reads from pipes/sockets)} {msgsnd total messages sent (writes on pipes/sockets)} {vsz virtual size in Kbytes (alias vsize)} {nice nice value (alias ni)} {nsigs total signals taken (alias nsignals)} {nswap total swaps in/out} {pgid process group number} {pid process ID} {ppid parent process ID} {rgid real group ID} {ruid real user ID} {ruser user name (from ruid)} {start time started} {time accumulated cpu time, user + system (alias cputime)} {tpgid control terminal process group ID} {tsiz text size (in Kbytes)} {tty full name of control terminal} {lim memoryuse limit} {logname login name of user who started the process} } set ALL_ps_keywords { {%cpu percentage cpu usage (alias pcpu)} {%mem percentage memory usage (alias pmem)} {acflag accounting flag (alias acflg)} {cpu short-term cpu usage factor (for scheduling)} {inblk total blocks read (alias inblock)} {jobc job control count} {ktrace tracing flags} {ktracep tracing vnode} {lim memoryuse limit} {lstart time started} {majflt total page faults} {minflt total page reclaims} {msgrcv total messages received (reads from pipes/sockets)} {msgsnd total messages sent (writes on pipes/sockets)} {nice nice value (alias ni)} {nivcsw total involuntary context switches} {nsigs total signals taken (alias nsignals)} {nswap total swaps in/out} {nvcsw total voluntary context switches} {nwchan wait channel (as an address)} {oublk total blocks written (alias oublock)} {p_ru resource usage (valid only for zombie)} {paddr swap address} {pagein pageins (same as majflt)} {pgid process group number} {pid process ID} {ppid parent process ID} {pri scheduling priority} {re core residency time (in seconds; 127 = infinity)} {rgid real group ID} {rlink reverse link on run queue, or 0} {rss resident set size} {rsz resident set size + (text size / text use count) (alias rs- size)} {ruid real user ID} {ruser user name (from ruid)} {sess session pointer} {sig pending signals (alias pending)} {sigcatch caught signals (alias caught)} {sigignore ignored signals (alias ignored)} {sigmask blocked signals (alias blocked)} {sl sleep time (in seconds; 127 = infinity)} {start time started} {svgid saved gid from a setgid executable} {svuid saved uid from a setuid executable} {tdev control terminal device number} {time accumulated cpu time, user + system (alias cputime)} {tpgid control terminal process group ID} {tsess control terminal session pointer} {tsiz text size (in Kbytes)} {tt control terminal name (two letter abbreviation)} {tty full name of control terminal} {ucomm name to be used for accounting} {uid effective user ID} {upr scheduling priority on return from system call (alias usrpri)} {user user name (from uid)} {vsz virtual size in Kbytes (alias vsize)} {wchan wait channel (as a symbolic name)} {xstat exit or stop status (valid only for stopped or zombie process)} {logname login name of user who started the process} } set state_fields { {D Process in disk (or other short term, uninterruptable) wait.} {I Process that is idle (sleeping for longer than about 20 seconds).} {P Process in page wait.} {R Process is Runnable.} {S Process is sleeping for less than about 20 seconds.} {T Process is stopped.} {Z Process is dead (a ``zombie'').} {+ Process is in the foreground process group of its control terminal.} {< Process has raised CPU scheduling priority.} {> Process has specified a soft limit on memory requirements and is currently exceeding that limit; such a pro cess is (necessarily) not swapped.} {A Process has asked for random page replacement (VA_ANOM, from vadvise(2), for example, lisp(1) in a garbage collect).} {E The process is trying to exit.} {L The process has pages locked in core (for example, for raw I/O).} {N The process has reduced CPU scheduling priority (see setpriority(2)).} {S The process has asked for FIFO page replacement (VA_SEQL, from vadvise(2), for example, a large image processing program using virtual memory to sequentially address voluminous data).} {s The process is a session leader.} {V The process is suspended during a vfork.} {W The process is swapped out.} {X The process is being traced or debugged.} } #-- # get the doc string for a process state character (from ps -o state). #-- proc lookup_proc_state {char} { global state_fields foreach entry $state_fields { if {$char == [string index $entry 0]} { return $entry; } } return {} } set PROCESS_FLAGS { {SLOAD 0x0000001 in core} {SSYS 0x0000002 swapper or pager process} {SLOCK 0x0000004 process being swapped out} {SSWAP 0x0000008 save area flag} {STRC 0x0000010 process is being traced} {SWTED 0x0000020 another tracing flag} {SSINTR 0x0000040 sleep is interruptible} {SPAGE 0x0000080 process in page wait state} {SKEEP 0x0000100 another flag to prevent swap out} {SOMASK 0x0000200 restore old mask after taking signal} {SWEXIT 0x0000400 working on exiting} {SPHYSIO 0x0000800 doing physical I/O} {SVFORK 0x0001000 process resulted from vfork(2)} {SVFDONE 0x0002000 another vfork flag} {SNOVM 0x0004000 no vm, parent in a vfork} {SPAGV 0x0008000 init data space on demand, from vnode} {SSEQL 0x0010000 user warned of sequential vm behavior} {SUANOM 0x0020000 user warned of random vm behavior} {STIMO 0x0040000 timing out during sleep} {SNOCLDSTOP 0x0080000 no SIGCHLD when children stop} {SCTTY 0x0100000 has a controlling terminal} {SOWEUPC 0x0200000 owe process an addupc() call at next} {SSEL 0x0400000 selecting; wakeup/waiting danger} {SEXEC 0x0800000 process called exec(2)} {SHPUX 0x1000000 HP-UX process (HPUXCOMPAT)} {SULOCK 0x2000000 locked in core after swap error} {SPTECHG 0x4000000 pte's for process have changed} } #-- # Define menu bar items. #-- # menu bar widget frame .mbar -bd 2 menubutton .mbar.file -relief raised -text "File" \ -underline 0 -menu .mbar.file.menu -font $menufont \ -highlightthickness 0 menubutton .mbar.options -relief raised -text "Options" \ -underline 0 -menu .mbar.options.menu -font $menufont \ -highlightthickness 0 menubutton .mbar.signals -relief raised -text "Send Signal" \ -underline 0 -menu .mbar.signals.menu -font $menufont \ -highlightthickness 0 menu .mbar.file.menu menu .mbar.options.menu #-- # Setup a cascaded menu of signals. #-- menu .mbar.signals.menu menu .mbar.signals.menu.com_signals -bd 4 menu .mbar.signals.menu.all_signals -bd 4 menu .mbar.signals.menu.posix_signals -bd 4 #-- # Add entries to "Signals" Menu. #-- .mbar.signals.menu add cascade -label "Common Signals" \ -menu .mbar.signals.menu.com_signals -font $menufont .mbar.signals.menu add cascade -label "POSIX Signals" \ -menu .mbar.signals.menu.posix_signals -font $menufont .mbar.signals.menu add cascade -label "All Signals" \ -menu .mbar.signals.menu.all_signals -font $menufont #-- # Add entries to "File" Menu. #-- .mbar.file.menu add command -label "About" -command { about_box } \ -font $menufont .mbar.file.menu add command -label "Quit" -command { exit 0 } \ -font $menufont #-- # Add entries to "Options" Menu. #-- # defaults set confirm_signals 1 set list_which_signals $common_ps_keywords .mbar.options.menu add checkbutton -label "Confirm Signals" \ -variable confirm_signals -font $menufont .mbar.options.menu add separator .mbar.options.menu add radiobutton -label "List Common Process Info" \ -variable list_which_signals -value $common_ps_keywords -font $menufont .mbar.options.menu add radiobutton -label "List ALL Process Info" \ -variable list_which_signals -value $ALL_ps_keywords -font $menufont # # 95/08/29 K.Fujii Added the following two list options. # .mbar.options.menu add separator .mbar.options.menu add command -label "List my jobs" \ -command "list_my_jobs" -font $menufont .mbar.options.menu add command -label "List all jobs" \ -command "list_all_jobs" -font $menufont .mbar.options.menu add separator # .mbar.options.menu add command -label "Set Update Period..." \ -command "change_update_period" -font $menufont .mbar.options.menu add command -label "Set 'ps' Command Line Args..." \ -command "change_ps_args" -font $menufont #-- # Create pull down menu entries for each of the system signals. #-- # add one menu entry for each signal. #-- proc add_items {menu items} { global menufont foreach entry $items { set signame [lindex $entry 0] $menu add command -label $entry \ -command [list "send_signal" $signame] \ -font $menufont } } add_items .mbar.signals.menu.com_signals $common_sigs add_items .mbar.signals.menu.all_signals $all_sigs add_items .mbar.signals.menu.posix_signals $posix_sigs pack .mbar -side top -fill x -anchor w button .mbar.update -relief raised \ -text "Update" -command { get_unix_procs $greppat} \ -font $menufont -highlightthickness 0 button .mbar.help -relief raised \ -text "Help" -command { help_dialog} \ -font $menufont -highlightthickness 0 pack .mbar.file \ .mbar.options \ .mbar.signals \ -side left -anchor w -fill x -ipadx 5m pack .mbar.update .mbar.help -side right ################ tk_menuBar .mbar .mbar.quit \ .mbar.options \ .mbar.com_signals \ .mbar.posix_signals \ .mbar.all_signals ################################################################ #-- # Create an entry field for restricting the visible entries. # This simulates the "ps auxww | grep foo" idiom. #-- frame .findbar -bd 2 -relief groove label .findbar.findlabel -text "Find:" -font $menufont label .findbar.greplabel -text "Filter:" -font $menufont entry .findbar.findentry -width 20 -relief sunken -bd 2 \ -textvariable findpat -highlightthickness 0 entry .findbar.filterentry -width 20 -relief sunken -bd 2 \ -textvariable greppat -highlightthickness 0 bind .findbar.filterentry {update_unix_procs} bind .findbar.findentry {find_unix_proc} pack .findbar.greplabel .findbar.filterentry \ .findbar.findlabel .findbar.findentry \ -side left -padx 6m -ipadx 3m pack .findbar -side top -fill x -anchor w proc ShowKey {} { toplevel .showKey wm title .showKey "Show Keypresses" wm geometry .showKey 500x200 label .showKey.l -relief flat button .showKey.b -text OK -command { destroy .showKey } pack .showKey.l -in .showKey -fill both -expand 1 -side top pack .showKey.b -in .showKey -fill x -expand 0 -side top -padx 5 -pady 5 .showKey.l configure -text "KeyCode: %k; KeySym: %K;" focus .showKey.l bind .showKey.l { .showKey.l configure -text "KeyCode: %k; KeySym: %K;" } } ################################################################ # This runs ps with the (optional) user command line args. # It fills the listbox with a list of all the processes running, # using the ps output. # # How do we locate the PID of a process? # # We then look through the keyword (header) list to see if we find the PID # column, and remember which column that is, so we can operate on selected # processes. Yeesh. After we do 'split' on each line of output, we need # to eliminate the multiple blanks, and we still are hoping that ps # doesn't insert a blank between two words in a column. There is no # direct portable system call which gives basic process information about # all processes on a machine. There is just 'ps', and we are parsing the # random text output of a stupid utility program. # # Argh. unix sucks. # frame .f0 -bd 0 label .f0.header -relief groove -anchor w -font $tfont \ -foreground $hdfcolor -background $hdbcolor pack .f0.header -side top -fill x pack .f0 -side top -fill x frame .f1 -bd 2 frame .f1.sbox -bd 0 -relief sunken #-- # Setup scroll bar. #-- scrollbar .f1.sbox.vscroll -command ".f1.list yview" \ -background $scrollbarcolor \ -troughcolor $textbgcolor \ -width $sbwidth \ -highlightthickness 0 \ -activebackground $scrollbaracolor pack .f1.sbox.vscroll -side right -fill y pack .f1.sbox -side right -fill y -padx 4 #-- # 95/09/13 K.Fujii Added X-scroll. #-- frame .f2 -bd 2 frame .f2.sbox -bd 0 -relief sunken frame .f2.box -width 24 -height 20 scrollbar .f2.sbox.hscroll -command ".f1.list xview" \ -background $scrollbarcolor \ -troughcolor $textbgcolor \ -width $sbwidth \ -highlightthickness 0 \ -activebackground $scrollbaracolor -orient horizontal pack .f2.box -side right pack .f2.sbox.hscroll -side bottom -fill x pack .f2.sbox -side bottom -fill x #-- # Setup listbox. #-- wm minsize . 80 24 listbox .f1.list -relief sunken -bd 2 -width 80 -height 24 \ -selectmode extended \ -selectborderwidth 0 \ -selectbackground $fwdcolor \ -selectforeground $textbgcolor \ -background $textbgcolor \ -highlightthickness 0 \ -yscroll ".f1.sbox.vscroll set" \ -xscroll ".f2.sbox.hscroll set" \ -setgrid yes -font $tfont \ -yscrollcommand ".f1.sbox.vscroll set" pack .f1.list -side top -expand yes -fill both -anchor w pack .f1 -expand yes pack .f1 .f2 .bbar -side top -fill both -anchor w ################################################################ #-- # Set up args to 'ps'. # We either got args from the command line, or we default # to -auxww #-- if $argc>0 {set ps_args [lindex $argv 0]} \ else {set ps_args $DEFAULT_PS_ARGS} #-- # This runs ps and gets the results into a list of entries. # FILTER is a variable used to filter the results, a la grep. #-- proc get_unix_procs {filter} { global ps_args last_i # The PID column is the column which has the pid numbers in it. # This can change depending on the options passed to 'ps'. global pid_column argc argv # save the old list scroll value set oldyview [.f1.list nearest 0] set oldsize [.f1.list size] # Open a pipe to the "ps" program, with some args. set unix_procs_fd [open "|ps $ps_args"] # Get the column headers, from the first line of output from ps. set header [gets $unix_procs_fd] .f0.header config -text $header set ps_columns [strip_blanks $header] set pid_column [lsearch $ps_columns "PID"] if { $pid_column < 0 } { puts "Couldn't locate the PID column in the output from 'ps' \ so I can't send a signal to a process:" puts $header set last_i -1 exit 1 } # Clear the list items. .f1.list delete 0 [.f1.list size ] # Fill in listbox with process entries from 'ps' command output. while { [set i [gets $unix_procs_fd]] != {} } { if [regexp $filter $i] { .f1.list insert end $i } } close $unix_procs_fd # if the list has not changed size much, try to preserve viewpoint if {abs([.f1.list size] - $oldsize) < 2} { .f1.list yview $oldyview } set last_i -1 } proc update_unix_procs {} { global greppat get_unix_procs $greppat } ################################################################ # Finds first entry matching $findpat # # Also scrolls the display to make the item visible if it is not already. proc find_unix_proc {} { global findpat last_i last_pat if { $findpat != $last_pat } { set last_i -1 } set last_pat $findpat .f1.list select clear 0 [.f1.list size] set entries [.f1.list size] set last [expr $entries - 1] for { set i [expr $last_i + 1] } { $i <= $last } { incr i } { if { $findpat != "" & [regexp $findpat [.f1.list get $i]] } { .f1.list yview $i .f1.list select set $i if { $i < $last } { set last_i $i break } } if { $i == $last } { set last_i -1 } } } proc find_unix_proc_old {} { global findpat set entries [.f1.list size] for { set i 0} { $i < $entries } { incr i } { if [regexp $findpat [.f1.list get $i]] { .f1.list yview $i .f1.list select set $i break } } } # Set up bindings for the browser. bind .f1.list {destroy .} bind .f1.list {destroy .} focus .f1.list bind .f1.list \ { set oldconfirm $confirm_signals set confirm_signals 1 foreach i [.f1.list curselection] {show_pinfo} set confirm_signals $oldconfirm } proc signals_menu {ps_string} { global fields set fields [strip_blanks [split $ps_string " "]]; puts $fields } # Send signal looks at the currently selected entries in the listbox # and sends the signal to all of them. proc send_signal {signal} { global confirm_signals set pids [selected_processes] set proceed 1 if {$pids != {}} { if {$confirm_signals} {set proceed [confirm_dialog $signal $pids]} if {$proceed} { eval exec [format "kill -%s" $signal] $pids } update_unix_procs } } # get the selected entries from the listbox and extract # the pid fields from each selection proc selected_processes {} { global pid_column set z {} foreach i [.f1.list curselection] { set fields [strip_blanks [split [.f1.list get $i] " "]]; lappend z [lindex $fields $pid_column] } return $z } # The loop running in the background. # We want to make sure that we don't update if there is # a current selection in the window. proc update_loop {} { global UPDATE_PERIOD if {[.f1.list curselection] == {}} { update_unix_procs } after $UPDATE_PERIOD update_loop } ################ # The main loop ! update_loop ################################################################ # # Dialog box for confirmation of kill command # # Returns 1 if proceed, 0 if cancel # proc confirm_dialog {signame pids} { global val messagefont set val 1 # create top level window toplevel .confirm -class Dialog wm title .confirm "Confirm Kill Command" wm iconname .confirm Dialog frame .confirm.top -relief raised -bd 1 pack .confirm.top -side top -fill both frame .confirm.bot -relief raised -bd 1 pack .confirm.bot -side bottom -fill both message .confirm.top.msg -width 3i \ -text "Send $signame to processes $pids ?" \ -font $messagefont -aspect 200 pack .confirm.top.msg -side right -expand yes -fill both -padx 3m -pady 1m label .confirm.top.bitmap -bitmap warning pack .confirm.top.bitmap -side left -padx 3m -pady 1m frame .confirm.bot.default -relief sunken -bd 1 raise .confirm.bot.default pack .confirm.bot.default -side left -expand yes -padx 3m -pady 2m button .confirm.bot.ok -text "OK" -bd 1 \ -command {set val 1} \ -font $messagefont pack .confirm.bot.ok -in .confirm.bot.default \ -side left -padx 2m -pady 2m \ -ipadx 2m -ipady 1m button .confirm.bot.cancel -text "Cancel" -bd 1 \ -command {set val 0} \ -font $messagefont pack .confirm.bot.cancel -side left -expand yes \ -padx 3m -pady 2m -ipadx 2m -ipady 1m bind .confirm ".confirm.bot.ok flash; set val 1" set oldFocus [focus] grab set .confirm focus .confirm tkwait variable val destroy .confirm focus $oldFocus return $val } ################################################################ proc msg_dialog {msg} { global messagefont helpfont toplevel .helpwin message .helpwin.msg -text $msg \ -font $helpfont -aspect 200 button .helpwin.ok -text OK -command { destroy .helpwin } -font $messagefont pack .helpwin.msg .helpwin.ok -side top } proc help_dialog {} { msg_dialog {This program will send a signal to the selected process. There \ are several equivalent ways to choose a signal to send. \ First, select a process from the list below, then select a signal \ to send to it, either using a button on the bottom of the window, \ or from one of the signal menus. The commonly used signals have their own buttons along the bottom of the window. The signal menus contain the following (redundant) sets of signals: Common_Signals contains commonly used signals. POSIX_Signals contains POSIX standard signals. All_signals contains all signals available. The "Filter" text entry field is essentially equivalent to "ps auxww | grep foo" for some value of foo. The "Find" entry box lets you select the first process matching the entry foo. The Options menu contains some configuration settings. "Confirm" will pop up a dialog before executing a kill command. "List Common Process Info": double click on process pops up dialog of common useful process info. "List ALL Process Info": double click on process pops up dialog of ALL process info available through ps. "Set Update Period" adjusts the time between updating the display (and running "ps" again, which is expensive for some reason. "Set Command Line Args" sets the option string which is sent to ps. It defaults to "-auxww" } } proc about_box {} { msg_dialog {The tkps browser was written by Henry Minsky (hqm@ai.mit.edu) This is Version 1.1, May 1994 Terms of the GNU public license apply. } } ################################################################ # This ought to be a generic program to change a variable's value proc change_update_period {} { global UPDATE_PERIOD MIN_UPDATE_PERIOD menufont update_time set update_time $UPDATE_PERIOD catch {destroy .update} # create top level window toplevel .update -class Dialog wm title .update "Set Update Period" wm iconname .update Dialog frame .update.bot -relief raised -bd 1 frame .update.top -relief raised -bd 1 pack .update.top -side top -fill both pack .update.bot -side bottom -fill both button .update.bot.ok -relief raised \ -text "OK" -command {destroy .update} -font $menufont pack .update.bot.ok -side bottom -ipadx 6m -ipady 2m -expand yes label .update.top.label -text "Update period (ms):" entry .update.top.val -width 20 -relief sunken \ -bd 2 -textvariable update_time pack .update.top.label .update.top.val \ -side left -padx 6m -ipadx 3m bind .update.top.val "destroy .update" set oldFocus [focus] grab set .update focus .update.top tkwait window .update focus $oldFocus # Don't let the updates go too fast. if {$update_time < $MIN_UPDATE_PERIOD} { set UPDATE_PERIOD $MIN_UPDATE_PERIOD} else { set UPDATE_PERIOD $update_time } } ################################################################ # Dialog to change args to ps. This should call a dialog subroutine. # proc change_ps_args {} { # global ps_args newargs menufont DEFAULT_PS_ARGS # catch {destroy .newargs} set args $ps_args # create top level window toplevel .newargs -class Dialog wm title .newargs "Set Command Line Args" wm iconname .newargs Dialog frame .newargs.bot -relief raised -bd 1 frame .newargs.top -relief raised -bd 1 pack .newargs.top -side top -fill both pack .newargs.bot -side bottom -fill both button .newargs.bot.ok -relief raised \ -text "OK" -command {destroy .newargs} -font $menufont pack .newargs.bot.ok -side bottom -ipadx 6m -ipady 2m -expand yes label .newargs.top.label -text "Command Line Args To \"ps\":" entry .newargs.top.val -width 30 -relief sunken \ -bd 2 -textvariable newargs pack .newargs.top.label .newargs.top.val \ -side left -padx 6m -ipadx 3m bind .newargs.top.val "destroy .newargs" set oldFocus [focus] grab set .newargs focus .newargs.top tkwait window .newargs focus $oldFocus # Don't let the updates go too fast. if {$newargs != ""} { set ps_args $newargs} else { set ps_args $DEFAULT_PS_ARGS } update_unix_procs } # runs 'man' on the NAME given, and puts the output # in a text widget proc manpage {name} { text .text -releif raised -bd 2 \ -yscrollcommand ".scrolltext set" scrollbar .scrolltext -command ".text yview" } ################################################################ # Routines to display a popup text widget with detailed info on a process # Makes a comma separated list of the first item in each list # in a list of lists. proc first_items {l} { set z {} foreach i $l { set keyword [lindex $i 0]; set z [lappend z $keyword]; } return [join $z ","]; } # call ps on a specific pid, and put text into text widget proc fill_info_window {pid widget} { global list_which_signals PROCESS_FLAGS # We need to run ps twice, once to get the command name, which has spaces # in it, and once more for all the other keywords that hopefully # have no spaces inside individual items. That's ps. One tool which does # its job badly. # Oh, I hear you say. Unix processes are inexpensive. Run ps once # for each keyword arg. Then you won't have to worry about ambiguous separators # in the output. Yeah, ok, sure. whatever. Why fight it. I don't care anymore. set unix_procs_fd [open "|ps -p $pid -o command"] gets $unix_procs_fd; # strip header set command [gets $unix_procs_fd] close $unix_procs_fd $widget insert end [format "COMMAND: %s\n_______________________________\n" $command]; # Open a pipe to the "ps" program, with some args. set args [format "state,flags,%s" [first_items $list_which_signals] ] set unix_procs_fd [open "|ps -p $pid -o $args"] # Get the column headers, from the first line of output from ps. gets $unix_procs_fd # actually just discard it set pstats [strip_blanks [gets $unix_procs_fd]] close $unix_procs_fd # Look at the process run state, and get the doc strings for each flag set pstate [lindex $pstats 0] set len [string length $pstate] for {set i 0} { $i < $len } { incr i } { set state_entries [lookup_proc_state [string index $pstate $i]] $widget insert end $state_entries $widget insert end "\n" } scan [lindex $pstats 1] "%x" flags # try to decode the process flags $widget insert end "\nPROCESS FLAGS:\n" # {SLOAD 0x0000001 in core} # {SPTECHG 0x4000000 pte's for process have changed} # step through the bits of the flag, see which are set for { set i 0} { $i < 20} {incr i} { if { ($flags & (1 << $i )) != 0} { set docstring [lindex $PROCESS_FLAGS $i]; $widget insert end [format "%s\n" $docstring]; } } $widget insert end "\n_______________________________\n" # Print rest of keyword fields and doc strings. set lim [llength $list_which_signals]; for {set k 2} {$k < $lim } {incr k} { set entry [lindex $list_which_signals [expr $k - 2]] $widget insert end [format "%s:\t%s\t%s\n" [lindex $entry 0] \ [lindex $pstats $k] \ [lrange $entry 1 end]] } } proc show_pinfo {} { set sp [selected_processes] foreach p $sp { show_detailed_proc $p } } proc show_detailed_proc {pid} { global menufont set P .pinfo$pid set TOP $P.top # create top level window toplevel $P -class Dialog frame $TOP -relief raised -bd 1 pack $TOP -side top -fill both frame $P.bot -relief raised -bd 1 pack $P.bot -side bottom -fill both # text widget for process info strings text $TOP.text -relief raised -bd 2 \ -yscrollcommand "$TOP.scroll set" scrollbar $TOP.scroll -command "$TOP.text yview" fill_info_window $pid $TOP.text pack $TOP.scroll -side right -fill y pack $TOP.text -side left wm title $P "Process $pid Info" wm iconname $P "PID $pid" frame $P.bot.default -relief sunken -bd 1 raise $P.bot.default button $P.bot.ok -text "DISMISS" -bd 1 -relief raised\ -command [list "destroy" $P] -font $menufont button $P.bot.kill -text "KILL PROCESS" -bd 1 -relief raised\ -command [list "exec" "kill" "-KILL" $pid] -font $menufont pack $P.bot.ok -in $P.bot.default \ -side left -padx 2m -pady 2m \ -ipadx 2m -ipady 1m pack $P.bot.default $P.bot.kill -side left -expand yes \ -padx 3m -pady 2m -ipadx 2m -ipady 1m bind $P "$P.bot.ok flash; set val 1" } #-- # 95/08/29 K.Fujii New procs. #-- proc list_my_jobs {} { global ps_args logname set ps_args "-u" update_unix_procs } proc list_all_jobs {} { global ps_args set ps_args "-au" update_unix_procs }