home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / gnu / emacs / sources / 799 / meta-server.el < prev   
Encoding:
Text File  |  1992-11-17  |  12.0 KB  |  307 lines
  1. ;; metaserver-mode.el --- major mode for watching netrek site info
  2. ;; Author: 1992 William M. Perry, Indiana University (wmperry@indiana.edu)
  3. ;; Maintainer: wmperry@indiana.edu
  4. ;; Created: 10/17/92
  5. ;; Version: 1.5b
  6. ;; Last Modified: Thu Nov 12 23:41:40 1992
  7. ;; Keywords: Netrek Metaserver
  8.  
  9. ;; This file is not part of GNU Emacs.
  10.  
  11. ;; This is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either Version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; This software is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; For a copy of the GNU General Public License write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. (defvar metaserver-use-background nil
  25.   "*Use the background.el package or not?  Default is nil")
  26.  
  27. (defvar metaserver-site "charon.amdahl.com"
  28.   "*What machine is the metaserver on?")
  29.  
  30. (defvar metaserver-port 3521 "*Which port to query on metaserver")
  31.  
  32. (defvar metaserver-trailing-headers ".*That's.*"
  33.   "String that comes at the end of the metaserver output")
  34.  
  35. (defvar metaserver-netrek-binary "netrek_udp" 
  36.   "*Normal netrek client to run when in non-borg mode.")
  37.  
  38. (defvar metaserver-use-borg nil "*Use borg or not?")
  39. (defvar metaserver-ping-program "/usr/etc/ping -s" "*Ping Program.")
  40. (defvar metaserver-ping-packets 10 "*# of pings to send to a server.")
  41. (defvar metaserver-ping-sizeof 65 "*Size of packets to send a server.")
  42. (defvar metaserver-list-all nil "*List every server, open or not.")
  43.  
  44. (defvar metaserver-borg-binary "sunborg3"
  45.   "*Borg netrek client to run when in borg mode.")
  46.  
  47. (defvar metaserver-headers-kill-to "^-h *"
  48.   "*Denotes last line of metaserver headers.")
  49.  
  50. (defvar metaserver-empty-site-regexp "Not Responding\\|Nobody"
  51.   "*Regular expression that matches empty sites.")
  52.  
  53. (defvar metaserver-data-regexp "-h \\([^ ]*\\) *-p \\([^ ]*\\)\\(.*\\)"
  54.   "*Parenthesized regular expression where the first parenthesized regexp
  55. matches the host, the second matches the port, and the third matches any
  56. data to be kept in the MetaServer buffer.")
  57.  
  58. (defvar metaserver-site-order "descending"
  59.   "*How to sort the open sites....  can be \"ascending\" or \"descending\".
  60. Ascending means put sites with wait queues at the bottom of the list.")
  61.  
  62. (defvar metaserver-brief-description
  63.   "- B Toggle Borg Status - L Toggle List All - R Refresh - RETURN Run Netrek"
  64.   "One line description of key bindings, etc.")
  65.  
  66. (defvar metaserver-mode-map () "mode map used in metaserver-mode")
  67.  
  68. (if metaserver-use-background
  69.     (load "background" nil t))
  70.  
  71.  
  72. (if metaserver-mode-map ()
  73.   (setq metaserver-mode-map (make-sparse-keymap)))
  74.  
  75. (define-key metaserver-mode-map "b"     'metaserver-toggle-borg)
  76. (define-key metaserver-mode-map "B"     'metaserver-toggle-borg)
  77. (define-key metaserver-mode-map "n"     'next-line)
  78. (define-key metaserver-mode-map "p"     'previous-line)
  79. (define-key metaserver-mode-map "P"     'metaserver-ping)
  80. (define-key metaserver-mode-map "q"     'metaserver-quit)
  81. (define-key metaserver-mode-map "Q"     'metaserver-quit)
  82. (define-key metaserver-mode-map "l"     'metaserver-toggle-list)
  83. (define-key metaserver-mode-map "L"     'metaserver-toggle-list)
  84. (define-key metaserver-mode-map "r"     'metaserver-refresh)
  85. (define-key metaserver-mode-map "R"     'metaserver-refresh)
  86. (define-key metaserver-mode-map " "     'scroll-up)
  87. (define-key metaserver-mode-map "\C-?"  'scroll-down)
  88. (define-key metaserver-mode-map "\C-m"  'metaserver-run-netrek)
  89. (define-key metaserver-mode-map "?"     'metaserver-describe-briefly)
  90. (define-key metaserver-mode-map "h"     'metaserver-describe-briefly)
  91.  
  92. (defun flip-list (thelist)
  93.   (interactive)
  94.   (if (cdr thelist)
  95.       (append (flip-list (cdr thelist)) (list (car thelist)))
  96.     (list (car thelist))))
  97.  
  98. (defun metaserver-toggle-list ()
  99.   "Toggles whether to list all the servers and updates mode line accordingly."
  100.   (interactive)
  101.   (if buffer-read-only (toggle-read-only))
  102.   (setq metaserver-list-all (not metaserver-list-all))
  103.   (metaserver-update-mode-line)
  104.   (if (not metaserver-list-all)
  105.       (save-excursion
  106.     (goto-char (point-min))
  107.     (delete-matching-lines metaserver-empty-site-regexp))
  108.     (save-excursion
  109.       (goto-char (point-max))
  110.       (if (equal metaserver-site-order "descending")
  111.       (metaserver-insert-list (flip-list metaserver-empty-list))
  112.     (metaserver-insert-list metaserver-empty-list))))
  113.   (if (not buffer-read-only) (toggle-read-only)))
  114.  
  115. (defun metaserver-describe-briefly ()
  116.   "Describe briefly the keys used in metaserver-mode."
  117.   (interactive)
  118.   (message metaserver-brief-description))
  119.  
  120. (defun metaserver-toggle-borg ()
  121.   "Toggles whether to use the borg binary or the netrek binary.  Updates the
  122. mode line accordingly."
  123.   (interactive)
  124.   (setq metaserver-use-borg (not metaserver-use-borg))
  125.   (setq mode-line-process (if metaserver-use-borg "-Borg" ""))
  126.   (metaserver-update-mode-line))
  127.  
  128. ;;; Update the mode line to show flags of borg-use and list-all
  129. (defun metaserver-update-mode-line ()
  130.   "Change mode-line to include -Borg and/or -All if appropriate, and force an
  131. update."
  132.   (setq mode-line-process 
  133.     (concat (if metaserver-use-borg "-Borg" "")
  134.         (if metaserver-list-all "-All" "")))
  135.   (set-buffer-modified-p nil))
  136.  
  137. (defun metaserver-mode ()
  138. "   This is a major mode for viewing active netrek servers.  A list of active
  139. servers is put in a buffer, displaying wait queue status, and time the server
  140. was last checked.
  141.  
  142.     User modifiable variables are:
  143.       metaserver-netrek-binary: Normal netrek client binary
  144.         metaserver-borg-binary: Borg netrek client binary
  145.   metaserver-empty-site-regexp: Regular expression that matches empty sites
  146.     metaserver-headers-kill-to: Regular expression that matches last line of
  147.                                 the metaserver headers.
  148.        metaserver-ping-program: Program to use to ping servers
  149.        metaserver-ping-packets: # of packets to send to server when pinging
  150.         metaserver-ping-sizeof: Size in bytes of packets sent during a ping
  151.            metaserver-list-all: Show all servers or just open ones?
  152.            metaserver-use-borg: Run normal client or borg client?
  153.          metaserver-site-order: Ascending or descending order when
  154.                                 printing sites?  
  155.                metaserver-site: Home of the metaserver
  156.                metaserver-port: Port of the metaserver"
  157.   (interactive)
  158.   (kill-all-local-variables)
  159.   (use-local-map metaserver-mode-map)
  160.   (setq major-mode 'metaserver-mode)
  161.   (setq mode-name "MetaServer")
  162.   (metaserver-update-mode-line))
  163.  
  164. ;;; Get the millisecond seek time to the server
  165. (defun metaserver-ping ()
  166.   (interactive)
  167.   (save-excursion
  168.     (save-window-excursion
  169.       (let* ((tmp (grab-current-line))
  170.          (server (substring tmp 0 (string-match " " tmp))))
  171.     (message "Pinging %s..." server)
  172.     (shell-command (concat metaserver-ping-program " "
  173.                    server " "
  174.                    (int-to-string metaserver-ping-sizeof) " "
  175.                    (int-to-string metaserver-ping-packets)))
  176.     (let ((ping-str (progn (set-buffer "*Shell Command Output*")
  177.                    (buffer-string)))
  178.           (ping-regexp (concat ".*packets transmitted, "
  179.                    ".* packets received, \\(.*\\)\\\n"
  180.                    "round-trip (ms) \\(.*\\)")))
  181.       (kill-buffer "*Shell Command Output*")
  182.       (if (string-match ping-regexp ping-str)
  183.           (message "%s:%s"
  184.                (substring ping-str (match-beginning 1) (match-end 1))
  185.                (substring ping-str (match-beginning 2) (match-end 2)))
  186.         (message "%s is not responding..." server)))))))
  187.  
  188. (defun metaserver-insert-headers ()
  189.   "Insert headers in metaserver buffer.... makes it easier to read."
  190.   (erase-buffer)
  191.   (insert (format "%53s\n%-40s%35s\n" "Mins" "Site"
  192.           "Ago   Status        Flags"))
  193.   (while (< (current-column) 79) (insert "-"))
  194.   (insert "\n"))
  195.  
  196. (defun metaserver-insert-list (thelist)
  197.   "Insert a list of (server . port . data) into the buffer"
  198.   (let* ((tmp thelist))
  199.     (while tmp
  200.       (let* ((site (car (car tmp)))
  201.          (data (car (cdr (cdr (car tmp))))))
  202.     (insert (format "%-40s%39s\n" site data)))
  203.       (setq tmp (cdr tmp)))))
  204.  
  205. (defun metaserver-filter (proc string)
  206.   "Filter for the stream to the metaserver.  Calls parser when appropriate."
  207.   (setq metaserver-server-output (concat metaserver-server-output string))
  208.   (if (string-match metaserver-trailing-headers string) (metaserver-parser)))
  209.  
  210. (defun metaserver-parser ()
  211.   "Parses out the metaserver string into a list.  Constructs buffer."
  212.   (setq metaserver-server-output (substring 
  213.              metaserver-server-output
  214.              (string-match metaserver-headers-kill-to
  215.                    metaserver-server-output)
  216.              nil))
  217.   (setq metaserver-server-output 
  218.     (substring metaserver-server-output
  219.            0 (1- (string-match metaserver-trailing-headers 
  220.                        metaserver-server-output))))
  221.   (while (not (equal "" metaserver-server-output))
  222.     (let* ((tmp (substring metaserver-server-output 
  223.                0 (string-match "$" metaserver-server-output))))
  224.       (setq metaserver-server-output 
  225.         (substring metaserver-server-output
  226.                (1+ (string-match "$" metaserver-server-output))
  227.                    nil))
  228.       (string-match metaserver-data-regexp tmp)
  229.       (let* ((site (substring tmp (match-beginning 1) (match-end 1)))
  230.          (port (string-to-int 
  231.             (substring tmp (match-beginning 2) (match-end 2))))
  232.          (data (substring tmp (match-beginning 3) (match-end 3))))
  233.     (if (not (string-match metaserver-empty-site-regexp data))
  234.         (setq metaserver-open-list
  235.           (append (cons (cons site (cons port (cons data '()))) '())
  236.               metaserver-open-list))
  237.       (setq metaserver-empty-list
  238.         (append (cons (cons site (cons port (cons data '()))) '())
  239.             metaserver-empty-list))))))
  240.   (save-excursion
  241.     (switch-to-buffer "*MetaServer*")
  242.     (goto-char (point-min))
  243.     (metaserver-insert-headers)
  244.     (if (equal "descending" metaserver-site-order)
  245.     (metaserver-insert-list (flip-list metaserver-open-list))
  246.       (metaserver-insert-list metaserver-open-list))
  247.     (if metaserver-list-all 
  248.     (if (equal "descending" metaserver-site-order)
  249.         (metaserver-insert-list (flip-list metaserver-empty-list))
  250.       (metaserver-insert-list metaserver-empty-list)))
  251.     (message "")
  252.     (if (not buffer-read-only) (toggle-read-only))))
  253.       
  254. (defun metaserver-refresh ()
  255.   "Start the metaserver.  Get site info, put in buffer, etc, etc."
  256.   (interactive)
  257.   (message "Calling metaserver at %s %d..." metaserver-site metaserver-port)
  258.   (switch-to-buffer "*MetaServer*")
  259.   (metaserver-mode)
  260.   (if buffer-read-only (toggle-read-only))
  261.   (erase-buffer)
  262.   (setq metaserver-server-output nil
  263.     metaserver-empty-list nil
  264.     metaserver-open-list nil)
  265.   (set-process-filter
  266.    (open-network-stream "metaserver" nil metaserver-site metaserver-port)
  267.    'metaserver-filter))
  268.  
  269. (defun metaserver-quit ()
  270.   (interactive)
  271.   (kill-buffer "*MetaServer*"))
  272.  
  273. (defun metaserver-run-netrek ()
  274.   "Run a netrek client in the background."
  275.   (interactive)
  276.   (if (and metaserver-use-background (not (boundp 'background)))
  277.       (load "background" nil t))
  278.   (if (not (getenv "DISPLAY"))
  279.       (message "DISPLAY variable not set... must use Xwindows to play netrek!")
  280.     (save-excursion
  281.       (let* ((tmp (buffer-substring (progn (beginning-of-line) (point))
  282.                     (progn (end-of-line) (point))))
  283.          (site (substring tmp 0 (string-match " " tmp)))
  284.          (port 2592)
  285.          (tmplist (if metaserver-list-all
  286.               (append metaserver-open-list metaserver-empty-list)
  287.             metaserver-open-list)))
  288.     (while tmplist
  289.       (let* ((current-site (car (car tmplist)))
  290.          (current-port (car (cdr (car tmplist)))))
  291.         (if (equal current-site site)
  292.         (let* ((the-command (concat (if metaserver-use-borg
  293.                         metaserver-borg-binary
  294.                           metaserver-netrek-binary)
  295.                         " -h " site " -p "
  296.                         (int-to-string port))))
  297.           (if metaserver-use-background
  298.               (background the-command)
  299.             (start-process "netrek" nil shell-file-name "-c" 
  300.                     (message the-command)))
  301.           (setq tmplist nil))
  302.           (setq tmplist (cdr tmplist)))))))))
  303.   
  304. (defun grab-current-line ()
  305.   (buffer-substring (progn (beginning-of-line) (point))
  306.             (progn (end-of-line) (point))))
  307.