More on Security

[Chris Lindblad <cjl%ai.mit.edu@RELAY.CS.NET>]

    Date: Tue, 7 Nov 89 11:57 PST
    From: DMittman@robotics.jpl.nasa.gov (David Mittman)

    According to my sources, the Sun folk are worried that because
    their network connections between machines might be buggy and subject
    to break-in, they want to rely on console security to ensure that no
    unauthorized access to their Suns is made over the net.

    The *only* thing that will satisfy them, it seems, is a "standard" login
    prompt that allows only authorized users access to the machine. They
    find the idea of locking up the keyboard somewhat silly.

I guess this pretty much rules out having PC's or Macintoshes on the net
too.  

Anyway, try out this hack I wrote.  This checks passwords against those
added in the File Server activity (and hence stored in encrypted form in
"local:>File-Server>passwords.data").

To give yourself a password, select the "File Server" activity and using
the "Set User Password" command.  

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10; Lowercase: Yes -*-

(defvar *inside-lispm-login* nil)

(defun lispm-login ()
  (let-globally ((fw:*function-keys-enabled* nil)
		 (fw:*system-menu-enabled* nil)
		 (fw:*select-keys-enabled* nil))
    (let ((*inside-lispm-login* t)
	  (username nil)
	  (password nil)
	  (condition nil))
      (loop
	(send-if-handles *query-io* :clear-history)
	(send-if-handles *query-io* :clear-window)
	(unless (eq si:*user* si:*not-logged-in-user*)
	  (setq si:*command-loop-read-function* 'cp::command-loop-read-function)
	  (si:draw-initial-window)
	  (process-abort *current-process* :all t))
	(multiple-value-setq (username password)
	  (fs:prompt-for-user-and-password 
	    net:*local-host* username condition t t t nil nil))
	(setq condition nil)
	(when (and username password)
	  (condition-case (error)
	       (progn
		 (fs:with-automatic-login-to-sys-host
		   (lmfs:check-and-err-password username nil password))
		 (zl:login username))
	     (error (setq condition error))))))))

(advise cp::command-loop-break-read-function :before lispm-login nil
  (when *inside-lispm-login*
    (process-abort *current-process* :all t)))

(si:compile-advice 'cp::command-loop-break-read-function)

(advise dbg:enter-debugger :before lispm-login nil
  (when *inside-lispm-login*
    (process-abort *current-process* :all t)))

(si:compile-advice 'dbg:enter-debugger)

(advise zl:logout :after lispm-login nil
  (setq si:*command-loop-read-function* 'lispm-login))

(si:compile-advice 'zl:logout)