#!/home/local/bin/wish -f # # tkms : A tk metaserver interface # # If you are just receiving this code, it is most necessary to change # some variables. (See CONFIGURATION after the comments). # #---------------------------------------------------------------------- # 5/17/96 -- Bob Campbell (rsc@ncar.ucar.edu) # # The only change in this version is that I've added a routine to list # players on a particular server by pressing the server's 'status' # box. Again, it may be buggy and not the most efficient since I'm # still a bit green to tcl/tk. # Note this uses port 3522 on the metaserver, and not the gopher # connection that the web server at the Netrek Homepage uses. # Haven't looked into it, but it may be possible to use gopher to # connect straight to the server itself. This would have the added # benefit of being able to get a report even if the meteaserver can't # connect to the server. # #---------------------------------------------------------------------- #---------------------------------------------------------------------- # 4/29/96 -- Bob Campbell (rsc@ncar.ucar.edu) # # I'll call this Version 4.0, since it's now updated for Tk 4.1. # This was my first lunge into Tk, no previous experience, # just reading the man pages for 1/2 an hour, and doing some # logical holistics (hmmm, that _looks_ right) # # Tk 4.1 has changed the options to listbox, apparently to standardise # all the Tk routines/functions to a single set of options. This # is manifested by the removal of the -geometry option to listbox, # and the addition of -width and -height. There may have been other # changes, but this is the only one I'm aware of. # #---------------------------------------------------------------------- #---------------------------------------------------------------------- # 12/8/93 -- Mike Hoswell (hoswell@ncar.ucar.edu) # # Dubbing This Version 3.0. Not responsible for bad programming, as # I've only been tk'ing for a week. # # Besides a general code-cleanup, I added the following: # 1. Toggle Buttons to select any combination of server types. # 2. A default list of servers to use when the metaserver is down. # 3. Toggle Buttons to select viewing of 'Not responding' and # 'Nobody playing' servers. # 4. Toggle Button to use Borg, instead of clicking on column2. # 5. A preferred list of servers that are put ahead of the others. # 6. Changed the status label to a listbox with a scrollbar. # 7. Pings are sent directly to the listbox. # #---------------------------------------------------------------------- # Version 3.2: # # More code-cleanup. # Put options in a menu-bar. Help in menu-bar yet to be implemented. # Removed 'useBorg', and replaced with 'overrideClient' option. # #---------------------------------------------------------------------- #---------------------------------------------------------------------- # Original writing: # # Thu Jul 23, 2:06 p.m. PDT 1992 # # This script is modified so that you can use it WITHOUT the # tclRawTCP extension. # # This Tk program displays the output of the METASERVER program. # If you double click on the server name a netrek will be started for # that server. # # Go ahead and do anything you want with this code. # # -Sam Shen (sls@aero.org) # #---------------------------------------------------------------------- #---------------------------------------------------------------------- # Additions made by jwh: # # 8/1/93 James W. Hawtin Commodore wibble # # jwh@cs.bham.ac.uk # # I have updated the script to work from port 3521 rather than 3520 this is # so that the a correct rsa or normal blessed client will be started # depending on which server is selected, this information (about) rsa is # obtained from charon. # # I have also made the tmp file a bit more unique so that more than one # server can be used on a machine # # Calvin's address has been corrected. # 28/1/93 James W. Hawtin Commodore wibble # # jwh@cs.bham.ac.uk # # Changed the order of the servers because the metaserver has changed the # way it displays the data, Ie. most popular last not first :-( # 6/12/93 James W. Hawtin (wibble) # # cgjwh@lut.ac.uk # # Change the interface so that the third column would ping the netrek server # Compiled my own telnet port reading code, which means the metaserver can # now be used in background. Finially I changed the metaserver address, from # amdahl. #---------------------------------------------------------------------- #---------------------------------------------------------------------- # CONFIGURATION # # Where is metaserver running? # set metaserver { metaserver.ecst.csuchico.edu 3521 } set playerlist { metaserver.ecst.csuchico.edu 3522 } # # Clients : regular/paradise/additional clients. These are slapped # together to make the 'override client' menu. # set netrek { { "COW Lite" ~/bin/COW-lite-1.20.sun4.solaris23 -R } } set paradise { { "Paradise" ~/bin/ } } set clients { { "Berkeley" ~/bin/netrek.Berkeley.RSA2 } { "Sound" ~/bin/netrek.Berk.sound } { "BRM Hadley" /home/yoda/hoswell/lib/brmh } { "COW Lite" ~/bin/COW-lite-1.20.sun4.solaris23 -R } { "BerkRicksMoo" ~/bin/BRM.3.00pl2.sun4 } { "COW" ~/bin/COW.1.01pl2.sun4.dyna } } # # Where is my telnet command? # set tnet /bin/telnet # # For servers that lie about what host address to use. Calvin is # the only one I know that needs this. Correct address entered by jwh 9/1/93 # set addressMap(calvin.usc.edu) 128.125.253.129 # # Command Interface Defaults. Change these to suit... they can be changed # at run-time. # set showBronco 1 set showHockey 1 set showChaos 1 set showSturgeon 0 set showParadise 0 set showEmpty 0 set showNoRespond 0 set showPreferred 1 set overrideClient 0 set useMetaserver 1 # # The server list to use when the metaserver is down. # set defaultServerList { { bigbang.astro.indiana.edu 2592 B } { hockey.ksu.edu 2592 H } { hydra.cfm.brown.edu 2592 B } { wormhole.ecst.csuchico.edu 2592 B } { vlsi.ics.uci.edu 2592 B } } # # List of preferred servers to list before the others # set preferredServerList { bigbang.astro.indiana.edu bronco.ece.cmu.edu hockey.ksu.edu calvin.usc.edu wormhole.ecst.csuchico.edu hydra.cfm.brown.edu } #---------------------------------------------------------------------- # Beyond here you shouldn't need to modify anthing. # # Make me a bit unique # catch "exec /usr/ucb/whoami" suffix # # Where is the temp File? # set tmpFile /tmp/.serverList.$suffix set playersFile /tmp/.playerList.$suffix # # The accumulated list of clients # set clientlist [concat $clients $netrek $paradise] set client [string trim "[lindex [lindex $netrek 0] 1]"] #---------------------------------------------------------------------- # QuinListView # # Updates the (scrolled) listboxes # proc QuinListView {name args} { eval "$name.server.list yview $args" eval "$name.port.list yview $args" eval "$name.last.list yview $args" eval "$name.status.list yview $args" eval "$name.type.list yview $args" } #---------------------------------------------------------------------- # CreateColumn # # Creates a vertical column with the structure: # # frame # label -- Title of Column # listbox -- List of Entries # proc CreateColumn {name yscroll title wi hi } { frame $name label $name.label -text $title -relief raised listbox $name.list -yscroll $yscroll -relief raised -height $hi \ -width $wi pack append $name \ $name.label "top fill" \ $name.list "top fill expand" } #---------------------------------------------------------------------- # CreateQuinList # # Creates the column lists with the structure: # # frame # server # port # last # status # type # frame # dummytitle # scrollbar # proc CreateQuinList {name title1 title2 title3 title4 title5} { frame $name -borderwidth 4 -relief ridge frame $name.sframe label $name.sframe.dummytitle -text "" scrollbar $name.sframe.scroll -command "QuinListView $name" pack append $name.sframe \ $name.sframe.dummytitle "top fillx" \ $name.sframe.scroll "top expand fill" CreateColumn $name.server "$name.sframe.scroll set" $title1 30 20 CreateColumn $name.port "$name.sframe.scroll set" $title2 4 20 CreateColumn $name.last "$name.sframe.scroll set" $title3 4 20 CreateColumn $name.status "$name.sframe.scroll set" $title4 16 20 CreateColumn $name.type "$name.sframe.scroll set" $title5 5 20 pack append $name \ $name.sframe "right filly" \ $name.server "left fill expand" \ $name.port "left fill expand" \ $name.last "left fill expand" \ $name.status "left fill expand" \ $name.type "left fill expand" } #---------------------------------------------------------------------- # getline # # returns a line of text from an open file # proc getline {fileid} { set glresult "" for {set tempC [read $fileid 1]} \ {($tempC != "") && ($tempC != "\n")} \ {set tempC [read $fileid 1]} { append glresult $tempC } return $glresult } #---------------------------------------------------------------------- # InsertList # # Inserts the server/port/last/status/type fields, as queried by # the metaserver, or from the defaultServerList, into their corresponding # column lists. # proc InsertList {position server port last status type} { .servers.server.list insert $position $server .servers.port.list insert $position $port set last_suffix "mins" switch $last { "" { set last_suffix "" } 1 { set last_suffix "min" } } .servers.last.list insert $position "$last $last_suffix" .servers.status.list insert $position $status set s_type "Unknown" switch $type { "B" {set s_type "Bronco"} "P" {set s_type "Paradise"} "C" {set s_type "Choas"} "H" {set s_type "Hockey"} "S" {set s_type "Sturgeon"} "" {set s_type ""} } .servers.type.list insert $position $s_type } #---------------------------------------------------------------------- # UpdateList # # Either queries the metaserver or uses the defaults, as specified. # proc UpdateList {} { global n metaserver port tmpFile tnet global showEmpty showNoRespond showPreferred global showBronco showHockey showChaos showParadise showSturgeon global useMetaserver defaultServerList preferredServerList if {$useMetaserver == 0} { .sf.status insert 0 "Using resource defaults..." update .servers.server.list delete 0 end .servers.port.list delete 0 end .servers.last.list delete 0 end .servers.status.list delete 0 end .servers.type.list delete 0 end foreach defaultServer $defaultServerList { InsertList 0 \ [ lindex $defaultServer 0 ] \ [ lindex $defaultServer 1 ] \ "" \ "" \ [ lindex $defaultServer 2 ] } } { .sf.status insert 0 "Connecting to [lindex $metaserver 0]..." update catch "exec $tnet [lindex $metaserver 0] \ [lindex $metaserver 1] > $tmpFile" set of [open $tmpFile] set readingServers 0 set n 0 set n_pref 0 .servers.server.list delete 0 end .servers.port.list delete 0 end .servers.last.list delete 0 end .servers.status.list delete 0 end .servers.type.list delete 0 end while {[eof $of] == 0} { set line [getline $of] if {[string first \ "---------------------------------------" $line] == 0} { set readingServers 1 continue } if {$readingServers == 0} { continue } if {[string trim $line] == ""} { set readingServers 0 continue } # # Remove Empty / Non-responding Servers if !showEmpty / !showNoRespond # switch [string trim "[string range $line 54 59]"] { "Nobody" { if {$showEmpty == 0} { continue } } "Not re" { if {$showNoRespond == 0} { continue } } } # # Remove various types of servers if: # !showBronco, !showHockey, !showChaos, !showParadise, !showSturgeon # switch [string trim "[string range $line 78 78]"] { "B" { if {$showBronco == 0} { continue } } "H" { if {$showHockey == 0} { continue } } "C" { if {$showChaos == 0} { continue } } "P" { if {$showParadise == 0} { continue } } "S" { if {$showSturgeon == 0} { continue } } } # # Find position to place the list: # 0 == top of list, if it's a preferred server, or if !showPreferred. # n_pref == top of non-preferred servers. # set pos 0 if {$showPreferred == 1} { if {[lsearch $preferredServerList \ [string trim [lindex $line 1]]] != -1} { incr n_pref } { set pos $n_pref } } InsertList $pos \ [string trim [lindex $line 1]] \ [string trim [lindex $line 3]] \ [string trim [lindex $line 4]] \ [string range $line 54 70] \ [string range $line 78 78] incr n } # # Put a blank line after preferred servers # if {$n_pref != 0} { InsertList $n_pref "" "" "" "" "" } close $of exec rm -f $tmpFile .sf.status insert 0 "Read $n servers." .time config -text "Last update at: [exec date]" } } #---------------------------------------------------------------------- # StartNetrek # # Parses the options to see which client to use of: # paradise / bronco # proc StartNetrek {server port type} { global netrek paradise global addressMap global client overrideClient if {[info exists addressMap($server)] == 1} { set server $addressMap($server) } if {$overrideClient == 1} { set use_client $client } { if {[string trim "[lindex $type 0]"] == "Paradise"} { set use_client [string trim "[lindex [lindex $paradise 0] 1]"] } { set use_client [string trim "[lindex [lindex $netrek 0] 1]"] } } .sf.status insert 0 "Starting: $use_client -h $server -p $port" exec $use_client -h $server -p $port & } #---------------------------------------------------------------------- # SetClient # # Sets the client to the prescribed value. # proc SetClient {widget value} { global client set client $value $widget.client config -text $value } #---------------------------------------------------------------------- # UpdateClient # # Updates the enable/disabling of the client used. # proc UpdateClient {} { global overrideClient switch $overrideClient { 0 { .command.options.cframe.cbutton configure -state disabled } 1 { .command.options.cframe.cbutton configure -state normal } } } #---------------------------------------------------------------------- # UpdateState # # Updates the state of the interface. State is effectively # reflected by the useMetaserver variable. # proc UpdateState {} { global useMetaserver switch $useMetaserver { 0 { .command.msframe.update configure -state disabled } 1 { .command.msframe.update configure -state normal } } UpdateList } #---------------------------------------------------------------------- # StartPing # # Pings the server in question # proc StartPing {server} { global addressMap global tmpFile if {[info exists addressMap($server)] == 1} { set server $addressMap($server) } .sf.status insert 0 "Pinging: $server" update set output [split [exec ping -s $server 1024 20] "\n"] foreach line $output { .sf.status insert 0 "$line" } } #---------------------------------------------------------------------- # Current Players # # telnets to the Metaserver and lists players on a server # proc CurrentPlayers {server} { global addressMap playersFile global tnet playerlist if {[info exists addressMap($server)] == 1} { set server $addressMap($server) } # print out a little status thing to knwo we hit the button .sf.status insert 0 "Checking players on $server" update # catch the telnet since the connection auto-closes after info is spewed catch "exec $tnet [lindex $playerlist 0] \ [lindex $playerlist 1] > $playersFile" # name the output file 'of'. $playersfile is set in options section set of [open $playersFile] #when we find the right server change this to 1 until we find 'Server:' again set foundit 0 # parse everything in $of while { [eof $of] == 0 } { set line [getline $of] #if it empty, go to next line if {[string trim $line] == ""} { continue } #if we find Server:, determine if it the one we want or not # if it is, set foundit to 1, else set foundit to 0. # the plan is, if foundit is on, and the line doesn't start with 'Server:' # print the lines until we find 'Server:' again, then stop printing. if { [string trim [lindex $line 0]] == "Server:" } { if { [string trim [lindex $line 1]] == "$server" } { \ set foundit 1 } else { \ set foundit 0 } } if { $foundit == 1 } { .sf.status insert 0 "$line" } } # print a little something in case the output is empty, so we know its done. .sf.status insert 0 "Done checking." exec rm -f $playersFile } #---------------------------------------------------------------------- # Here lies the main window Creation # option add borderwidth 2 interactive wm minsize . 600 100 wm title . "tkms : Tk MetaServer Interface : Version 4.1" wm iconname . "tkms" wm geometry . 600x620+0+0 # # Menu Bar # frame .menuBar -borderwidth 2 -relief raised menubutton .menuBar.options \ -menu {.menuBar.options.m} \ -text Options menu .menuBar.options.m .menuBar.options.m add \ checkbutton -label {Show Bronco } -variable showBronco .menuBar.options.m add \ checkbutton -label {Show Hockey } -variable showHockey .menuBar.options.m add \ checkbutton -label {Show Chaos } -variable showChaos .menuBar.options.m add \ checkbutton -label {Show Paradise } -variable showParadise .menuBar.options.m add \ checkbutton -label {Show Sturgeon } -variable showSturgeon .menuBar.options.m add separator .menuBar.options.m add \ checkbutton -label {Show "Nobody playing"} -variable showEmpty .menuBar.options.m add \ checkbutton -label {Show "Not responding"} -variable showNoRespond .menuBar.options.m add separator .menuBar.options.m add \ checkbutton -label {Show Preferred First} -variable showPreferred menubutton .menuBar.help \ -menu {.menuBar.help.m} \ -text Help menu .menuBar.help.m pack append .menuBar \ .menuBar.options {left frame center} \ .menuBar.help {right frame center} # # Information label # label .info \ -text "Using MetaServer : [lindex $metaserver 0] : [lindex $metaserver 1]" # # The Command frame # frame .command -borderwidth 4 -relief ridge frame .command.msframe -borderwidth 2 -relief raised switch $useMetaserver { 0 { set msstate "disabled" } 1 { set msstate "normal" } } button .command.msframe.update -padx 20 -pady 20 \ -text "Call Metaserver" -command UpdateList \ -state $msstate pack append .command.msframe \ .command.msframe.update "left frame center expand" frame .command.options -borderwidth 2 -relief raised checkbutton .command.options.useMS -padx 10 -relief flat \ -text "Use Metaserver" -variable useMetaserver \ -command {UpdateState} checkbutton .command.options.overrideOn -padx 10 -relief flat \ -text {Override Client} -variable overrideClient \ -command {UpdateClient} frame .command.options.cframe -borderwidth 2 -relief flat switch $overrideClient { 0 { set cfstate "disabled" } 1 { set cfstate "normal" } } label .command.options.cframe.clabel \ -borderwidth 0 -padx 10 -text {Client:} menubutton .command.options.cframe.cbutton \ -menu .command.options.cframe.cbutton.m \ -text v -state $cfstate -padx 10 -relief raised menu .command.options.cframe.cbutton.m foreach pclient $clientlist { .command.options.cframe.cbutton.m add command \ -command "SetClient .command.options.cframe [lindex $pclient 1]" \ -label [lindex $pclient 0] } label .command.options.cframe.client \ -anchor w -relief sunken \ -text $client pack append .command.options.cframe \ .command.options.cframe.clabel "left frame center fill" \ .command.options.cframe.client "left frame center expand fill" \ .command.options.cframe.cbutton "right frame center fill" pack append .command.options \ .command.options.useMS "top frame w expand" \ .command.options.overrideOn "top frame w expand" \ .command.options.cframe "top frame w expand" frame .command.qframe -borderwidth 2 -relief raised button .command.qframe.quit -padx 20 -pady 20 \ -text "Quit" -command exit pack append .command.qframe \ .command.qframe.quit "left frame center expand" pack append .command \ .command.msframe "left frame w expand fill" \ .command.options "left frame w expand fill" \ .command.qframe "left frame w expand fill" # # Time Queried label # label .time # # The list of servers # CreateQuinList .servers "Server" "Port" "Last" "Status" "Type" # # Status listbox # frame .sf -borderwidth 4 -relief ridge scrollbar .sf.scroll -command { eval ".sf.status yview" } listbox .sf.status -yscroll ".sf.scroll set" -relief flat -width 40 \ -height 5 pack append .sf \ .sf.status "left expand fill" \ .sf.scroll "left filly" # # Finally, pack everything on the main window # pack append . \ .menuBar "fillx" \ .info "fillx" \ .command "fillx" \ .time "fillx" \ .servers "fill expand" \ .sf "fill expand" # # Start by updating the list (calling the metaserver) # UpdateList # # Bindings # bind .servers.server.list \ {StartNetrek \ [.servers.server.list get [.servers.server.list nearest %y]] \ [.servers.port.list get [.servers.server.list nearest %y]] \ [.servers.type.list get [.servers.server.list nearest %y]] } bind .servers.port.list \ {StartPing \ [.servers.server.list get [.servers.server.list nearest %y]] } bind .servers.status.list \ {CurrentPlayers \ [.servers.server.list get [.servers.server.list nearest %y]] }