home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / games / volume14 / dunnet / part01 / dun-unix.el < prev    next >
Lisp/Scheme  |  1992-08-31  |  14KB  |  495 lines
  1. ;;;;;;;;;;;;;;;;;;;
  2. ;;;;
  3. ;;;; UNIX
  4. ;;;;
  5. ;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defun unix-parse (args)
  8.   (interactive "*p")
  9.   (beginning-of-line)
  10.   (let (beg esign)
  11.     (setq beg (+ (point) 2))
  12.     (end-of-line)
  13.     (if (and (not (= beg (point)))
  14.          (string= "$" (buffer-substring (- beg 2) (- beg 1))))
  15.     (progn
  16.       (setq line (downcase (buffer-substring beg (point))))
  17.       (princ line)
  18.       (if (eq (parse2 nil unix-verbs line) -1)
  19.           (progn
  20.         (if (setq esign (string-match "=" line))
  21.             (doassign line)        
  22.           (mprinc (car line-list))
  23.           (mprincl ": not found.")))))
  24.       (goto-char (point-max))
  25.       (mprinc "\n"))
  26.     (if (eq dungeon-mode 'unix)
  27.     (mprinc "$ "))))
  28.  
  29. (defun doassign (line)
  30.   (if (not wizard)
  31.       (let (passwd)
  32.     (mprinc "Enter wizard password: ")
  33.     (setq passwd (read-line))
  34.     (if (not batch-mode)
  35.         (mprinc "\n"))
  36.     (if (string= passwd "moby")
  37.         (progn
  38.           (setq wizard t)
  39.           (doassign line))
  40.       (mprincl "Incorrect.")))
  41.  
  42.     (let (varname epoint afterq i value)
  43.       (setq varname (substring line 0 esign))
  44.       (if (not (setq epoint (string-match ")" line)))
  45.       (if (string= (substring line (1+ esign) (+ esign 2))
  46.                "\"")
  47.           (progn
  48.         (setq afterq (substring line (+ esign 2)))
  49.         (setq epoint (+
  50.                   (string-match "\"" afterq)
  51.                   (+ esign 3))))
  52.         
  53.         (if (not (setq epoint (string-match " " line)))
  54.         (setq epoint (length line))))
  55.     (setq epoint (1+ epoint))
  56.     (while (and
  57.         (not (= epoint (length line)))
  58.         (setq i (string-match ")" (substring line epoint))))
  59.       (setq epoint (+ epoint i 1))))
  60.       (setq value (substring line (1+ esign) epoint))
  61.       (dungeon-eval varname value))))
  62.  
  63. (defun dungeon-eval (varname value)
  64.   (let (eval-error)
  65.     (switch-to-buffer (get-buffer-create "*dungeon-eval*"))
  66.     (erase-buffer)
  67.     (insert "(setq ")
  68.     (insert varname)
  69.     (insert " ")
  70.     (insert value)
  71.     (insert ")")
  72.     (setq eval-error nil)
  73.     (condition-case nil
  74.     (eval-current-buffer)
  75.       (error (setq eval-error t)))
  76.     (kill-buffer (current-buffer))
  77.     (switch-to-buffer "*dungeon*")
  78.     (if eval-error
  79.     (mprincl "Invalid syntax."))))
  80.   
  81.  
  82. (defun unix-interface ()
  83.   (login)
  84.   (if logged-in
  85.       (progn
  86.     (setq dungeon-mode 'unix)
  87.     (define-key dungeon-mode-map "\r" 'unix-parse)
  88.     (mprinc "$ "))))
  89.  
  90.  
  91.  
  92. (defun login ()
  93.   (let (tries username password)
  94.     (setq tries 4)
  95.     (while (and (not logged-in) (> (setq tries (- tries 1)) 0))
  96.       (mprinc "\n\nUNIX System 5, Release 2.2 (pokey)\n\nlogin: ")
  97.       (setq username (read-line))
  98.       (if (not batch-mode)
  99.       (mprinc "\n"))
  100.       (mprinc "password: ")
  101.       (setq password (read-line))
  102.       (if (not batch-mode)
  103.       (mprinc "\n"))
  104.       (if (or (not (string= username "toukmond"))
  105.           (not (string= password "robert")))
  106.       (mprincl "login incorrect")
  107.     (setq logged-in t)
  108.     (mprincl "
  109. Welcome to Unix\n
  110. Please clean up your directories.  The filesystem is getting full.
  111. Our tcp/ip link to gamma is a little flakey, but seems to work.
  112. The current version of ftp can only send files from the current
  113. directory, and deletes them after they are sent!  Be careful.
  114.  
  115. Note: Restricted bourne shell in use.\n")))
  116.   (setq dungeon-mode 'dungeon)))
  117.  
  118. (defun ls (args)
  119.   (if (car args)
  120.       (let (ocdpath ocdroom)
  121.     (setq ocdpath cdpath)
  122.     (setq ocdroom cdroom)
  123.     (if (not (eq (cd args) -2))
  124.         (ls nil))
  125.     (setq cdpath ocdpath)
  126.     (setq cdroom ocdroom))
  127.     (if (= cdroom -10)
  128.     (ls-inven))
  129.     (if (= cdroom -2)
  130.     (ls-rooms))
  131.     (if (= cdroom -3)
  132.     (ls-root))
  133.     (if (= cdroom -4)
  134.     (ls-usr))
  135.     (if (> cdroom 0)
  136.     (ls-room))))
  137.  
  138. (defun ls-root ()
  139.   (mprincl "total 4
  140. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  141. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  142. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 usr
  143. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 rooms"))
  144.  
  145. (defun ls-usr ()
  146.   (mprincl "total 4
  147. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  148. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  149. drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 toukmond"))
  150.  
  151. (defun ls-rooms ()
  152.   (mprincl "total 16
  153. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  154. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..")
  155.   (dolist (x visited)
  156.     (mprinc
  157. "drwxr-xr-x  3 root     staff           512 Jan 1 1970 ")
  158.     (mprincl (nth x room-shorts))))
  159.  
  160. (defun ls-room ()
  161.   (mprincl "total 4
  162. drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
  163. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
  164. -rwxr-xr-x  3 root     staff          2048 Jan 1 1970 description")
  165.   (dolist (x (nth cdroom room-objects))
  166.     (if (and (>= x 0) (not (= x 255)))
  167.     (progn
  168.       (mprinc "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
  169.       (mprincl (nth x objfiles))))))
  170.  
  171. (defun ls-inven ()
  172.   (mprinc "total 467
  173. drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 .
  174. drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..")
  175.   (dolist (x unix-verbs)
  176.     (if (not (eq (car x) 'IMPOSSIBLE))
  177.     (progn
  178.       (mprinc"
  179. -rwxr-xr-x  1 toukmond restricted    10423 Jan 1 1970 ")
  180.       (mprinc (car x)))))
  181.   (mprinc "\n")
  182.   (if (not uncompressed)
  183.       (mprincl
  184. "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 paper.o.Z"))
  185.   (dolist (x inventory)
  186.     (mprinc 
  187. "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
  188.     (mprincl (nth x objfiles))))
  189.  
  190. (defun echo (args)
  191.   (let (nomore var)
  192.     (setq nomore nil)
  193.     (dolist (x args)
  194.         (if (not nomore)
  195.         (progn
  196.           (if (not (string= (substring x 0 1) "$"))
  197.               (progn
  198.             (mprinc x)
  199.             (mprinc " "))
  200.             (setq var (intern (substring x 1)))
  201.             (if (not (boundp var))
  202.             (mprinc " ")
  203.               (if (member var restricted)
  204.               (progn
  205.                 (mprinc var)
  206.                 (mprinc ": Permission denied")
  207.                 (setq nomore t))
  208.             (eval (list 'mprinc var))
  209.             (mprinc " ")))))))
  210.         (mprinc "\n")))
  211.  
  212.  
  213. (defun ftp (args)
  214.   (let (host username passwd)
  215.     (if (not (car args))
  216.     (mprincl "ftp: hostname required on command line.")
  217.       (setq host (intern (car args)))
  218.       (if (not (member host '(gamma endgame)))
  219.       (mprincl "ftp: Unknown host.")
  220.     (if (eq host 'endgame)
  221.         (mprincl "ftp: connection to endgame not allowed")
  222.       (if (not ethernet)
  223.           (mprincl "ftp: host not responding.")
  224.         (mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70")
  225.         (mprinc "Username: ")
  226.         (setq username (read-line))
  227.         (if (string= username "toukmond")
  228.         (if batch-mode
  229.             (mprincl "toukmond ftp access not allowed.")
  230.           (mprincl "\ntoukmond ftp access not allowed."))
  231.           (if (string= username "anonymous")
  232.           (if batch-mode
  233.               (mprincl
  234.                "Guest login okay, send your user ident as password.")
  235.             (mprincl 
  236.              "\nGuest login okay, send your user ident as password."))
  237.         (if batch-mode
  238.             (mprinc "Password required for ")
  239.           (mprinc "\nPassword required for "))
  240.         (mprincl username))
  241.           (mprinc "Password: ")
  242.           (setq ident (read-line))
  243.           (if (not (string= username "anonymous"))
  244.           (if batch-mode
  245.               (mprincl "Login failed.")
  246.             (mprincl "\nLogin failed."))
  247.         (if batch-mode
  248.            (mprincl "Guest login okay, user access restrictions apply.")
  249.           (mprincl "\nGuest login okay, user access restrictions apply."))
  250.         (ftp-commands)
  251.         (setq newlist 
  252. '("What password did you use during anonymous ftp to gamma?"))
  253.         (setq newlist (append newlist (list ident)))
  254.         (rplaca (nthcdr 1 endgame-questions) newlist)))))))))
  255.   
  256. (defun ftp-commands ()
  257.   (setq exitf nil)
  258.   (let (line)
  259.     (while (not exitf)
  260.       (mprinc "ftp> ")
  261.       (setq line (read-line))
  262.       (if 
  263.       (eq
  264.        (parse2 nil 
  265.          '((type . ftptype) (binary . bin) (bin . bin) (send . send)
  266.            (put . send) (quit . ftpquit) (help . ftphelp)
  267.            (ascii . fascii)
  268.          ) line)
  269.      -1)
  270.       (mprincl "No such command.  Try help.")))
  271.     (setq ftptype 'ascii)))
  272.  
  273. (defun ftptype (args)
  274.   (if (not (car args))
  275.       (mprincl "Usage: type [binary | ascii]")
  276.     (setq args (intern (car args)))
  277.     (if (eq args 'binary)
  278.     (bin nil)
  279.       (if (eq args 'ascii)
  280.       (fascii 'nil)
  281.     (mprincl "Unknown type.")))))
  282.  
  283. (defun bin (args)
  284.   (mprincl "Type set to binary.")
  285.   (setq ftptype 'binary))
  286.  
  287. (defun fascii (args)
  288.   (mprincl "Type set to ascii.")
  289.   (setq ftptype 'ascii))
  290.  
  291. (defun ftpquit (args)
  292.   (setq exitf t))
  293.  
  294. (defun send (args)
  295.   (if (not (car args))
  296.       (mprincl "Usage: send <filename>")
  297.     (setq args (car args))
  298.     (let (counter foo)
  299.       (setq foo nil)
  300.       (setq counter 0)
  301.  
  302. ;;; User can send commands!  Stupid user.
  303.  
  304.  
  305.       (if (assq (intern args) unix-verbs)
  306.       (progn
  307.         (rplaca (assq (intern args) unix-verbs) 'IMPOSSIBLE)
  308.         (mprinc "Sending ")
  309.         (mprinc ftptype)
  310.         (mprinc " file for ")
  311.         (mprincl args)
  312.         (mprincl "Transfer complete."))
  313.  
  314.     (dolist (x objfiles)
  315.       (if (string= args x)
  316.           (progn
  317.         (if (not (member counter inventory))
  318.             (progn
  319.               (mprincl "No such file.")
  320.               (setq foo t))
  321.           (mprinc "Sending ")
  322.           (mprinc ftptype)
  323.           (mprinc " file for ")
  324.           (mprinc (downcase (cadr (nth counter objects))))
  325.           (mprincl ", (0 bytes)")
  326.           (if (not (eq ftptype 'binary))
  327.               (progn
  328.             (if (not (member -6 (nth 12 room-objects)))
  329.                 (replace room-objects 12
  330.                      (append (nth 12 room-objects) (list -6))))
  331.             (remove-obj-from-inven counter))
  332.             (remove-obj-from-inven counter)
  333.             (replace room-objects 12
  334.                  (append (nth 12 room-objects) (list counter))))
  335.           (setq foo t)
  336.           (mprincl "Transfer complete."))))
  337.       (setq counter (+ 1 counter)))
  338.     (if (not foo)
  339.         (mprincl "No such file."))))))
  340.  
  341. (defun ftphelp (args)
  342.   (mprincl 
  343.    "Possible commands are:\nsend    quit    type   ascii  binary   help"))
  344.  
  345. (defun uexit (args)
  346.   (setq dungeon-mode 'dungeon)
  347.   (mprincl "\nYou step back from the console.")
  348.   (define-key dungeon-mode-map "\r" 'dungeon-parse)
  349.   (if (not batch-mode)
  350.       (dungeon-messages)))
  351.  
  352. (defun pwd (args)
  353.   (mprincl cdpath))
  354.  
  355. (defun uncompress (args)
  356.   (if (not (car args))
  357.       (mprincl "Usage: uncompress <filename>")
  358.     (setq args (car args))
  359.     (if (or uncompressed
  360.         (and (not (string= args "paper.o"))
  361.          (not (string= args "paper.o.z"))))
  362.     (mprincl "Uncompress command failed.")
  363.       (setq uncompressed t)
  364.       (setq inventory (append inventory (list 5))))))
  365.  
  366. (defun rlogin (args)
  367.   (if (not (car args))
  368.       (mprincl "Usage: rlogin <hostname>")
  369.     (setq args (car args))
  370.     (if (string= args "endgame")
  371.     (rlogin-endgame)
  372.       (if (not (string= args "gamma"))
  373.       (mprincl "No such host.")
  374.     (if (not ethernet)
  375.         (mprincl "Host not responding.")
  376.       (mprinc "Password: ")
  377.       (setq passwd (read-line))
  378.       (if (not (string= passwd "worms"))
  379.           (mprincl "\nlogin incorrect")
  380.         (mprinc 
  381. "\nYou begin to feel strange for a moment, and you lose your items."
  382.          )
  383.         (replace room-objects 10 (append (nth 0 room-objects) inventory))
  384.         (setq inventory nil)
  385.         (setq current-room 12)
  386.         (uexit nil)))))))
  387.   
  388. (defun cd (args)
  389.   (if (not (car args))
  390.       (mprincl "Usage: cd <path>")
  391.     (setq tcdpath cdpath)
  392.     (setq tcdroom cdroom)
  393.     (setq badcd nil)
  394.     (condition-case nil
  395.     (setq path-elements (get-path (car args) nil))
  396.       (error (mprincl "Invalid path.")
  397.          (setq badcd t)))
  398.     (dolist (pe path-elements)
  399.       (unless badcd
  400.       (if (not (string= pe "."))
  401.       (if (string= pe "..")
  402.           (progn
  403.         (if (> tcdroom 0)                       ;In a room
  404.             (progn
  405.               (setq tcdpath "/rooms")
  406.               (setq tcdroom -2))
  407.                     ;In /rooms,/usr,root
  408.           (if (or (= tcdroom -2) (= tcdroom -4) (= tcdroom -3))
  409.               (progn
  410.             (setq tcdpath "/")
  411.             (setq tcdroom -3))
  412.             (if (= tcdroom -10)                  ;In /usr/toukmond
  413.             (progn
  414.               (setq tcdpath "/usr")
  415.               (setq tcdroom -4))))))
  416.         (if (string= pe "/")
  417.         (progn
  418.           (setq tcdpath "/")
  419.           (setq tcdroom -3))
  420.           (if (= tcdroom -4)
  421.           (if (string= pe "toukmond")
  422.               (progn
  423.             (setq tcdpath "/usr/toukmond")
  424.             (setq tcdroom -10))
  425.             (nosuchdir))
  426.         (if (= tcdroom -10)
  427.             (nosuchdir)
  428.           (if (> tcdroom 0)
  429.               (nosuchdir)
  430.             (if (= tcdroom -3)
  431.             (progn
  432.               (if (string= pe "rooms")
  433.                   (progn
  434.                 (setq tcdpath "/rooms")
  435.                 (setq tcdroom -2))
  436.                 (if (string= pe "usr")
  437.                 (progn
  438.                   (setq tcdpath "/usr")
  439.                   (setq tcdroom -4))
  440.                   (nosuchdir))))
  441.               (if (= tcdroom -2)
  442.               (progn
  443.                 (dolist (x visited)
  444.                   (setq room-check (nth x room-shorts))
  445.                   (if (string= room-check pe)
  446.                   (progn
  447.                     (setq tcdpath 
  448.                       (concat "/rooms/" room-check))
  449.                     (setq tcdroom x))))
  450.                 (if (= tcdroom -2)
  451.                 (nosuchdir)))))))))))))
  452.     (if (not badcd)
  453.     (progn
  454.       (setq cdpath tcdpath)
  455.       (setq cdroom tcdroom)
  456.       0)
  457.       -2)))
  458.  
  459. (defun nosuchdir ()
  460.   (mprincl "No such directory.")
  461.   (setq badcd t))
  462.  
  463. (defun cat (args)
  464.   (if (not (setq args (car args)))
  465.       (mprincl "Usage: cat <ascii-file-name>")
  466.     (if (string-match "/" args)
  467.     (mprincl "cat: only files in current directory allowed.")
  468.       (if (and (> cdroom 0) (string= args "description"))
  469.       (mprincl (car (nth cdroom rooms)))
  470.     (if (setq doto (string-match "\\.o" args))
  471.         (progn
  472.           (if (= cdroom -10)
  473.           (setq checklist inventory)
  474.         (setq checklist (nth cdroom room-objects)))
  475.           (if (not (member (cdr 
  476.                (assq (intern (substring args 0 doto)) objnames))
  477.                    checklist))
  478.           (mprincl "File not found.")
  479.         (mprincl "Ascii files only.")))
  480.       (if (assq (intern args) unix-verbs)
  481.           (mprincl "Ascii files only.")
  482.         (mprincl "File not found.")))))))
  483.   
  484. (defun zippy (args)
  485.   (mprincl (yow)))
  486.  
  487. (defun rlogin-endgame ()
  488.   (if (not (= (score nil) 90))
  489.       (mprincl "You have not achieved enough points to connect to endgame.")
  490.     (mprincl"\nWelcome to the endgame.  You are a truly noble adventurer.")
  491.     (setq current-room 0)
  492.     (setq endgame t)
  493.     (replace room-objects 102 '(26))
  494.     (uexit nil)))
  495.