/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.295 by lgorrie, Thu Apr 21 07:39:12 2005 UTC revision 1.296 by lgorrie, Mon May 2 18:44:50 2005 UTC
# Line 373  connections, otherwise it will be closed Line 373  connections, otherwise it will be closed
373        port)))        port)))
374    
375  (defun serve-connection (socket style dont-close external-format)  (defun serve-connection (socket style dont-close external-format)
376    (let ((client (accept-connection socket :external-format external-format)))    (let ((client (accept-authenticated-connection
377                     socket :external-format external-format)))
378      (unless dont-close      (unless dont-close
379        (close-socket socket))        (close-socket socket))
380      (let ((connection (create-connection client style external-format)))      (let ((connection (create-connection client style external-format)))
# Line 381  connections, otherwise it will be closed Line 382  connections, otherwise it will be closed
382        (push connection *connections*)        (push connection *connections*)
383        (serve-requests connection))))        (serve-requests connection))))
384    
385    (defun accept-authenticated-connection (&rest args)
386      (let ((new (apply #'accept-connection args))
387            (secret (slime-secret)))
388        (when secret
389          (unless (string= (decode-message new) secret)
390            (close new)
391            (error "Incoming connection doesn't know the password.")))
392        new))
393    
394    (defun slime-secret ()
395      "Finds the magic secret from the user's home directory.  Returns nil
396    if the file doesn't exist; otherwise the first line of the file."
397      (with-open-file (in
398                       (merge-pathnames (user-homedir-pathname)
399                                        #+unix #p".slime-secret")
400                       :if-does-not-exist nil)
401        (and in (read-line in nil ""))))
402    
403  (defun serve-requests (connection)  (defun serve-requests (connection)
404    "Read and process all requests on connections."    "Read and process all requests on connections."
405    (funcall (connection.serve-requests connection) connection))    (funcall (connection.serve-requests connection) connection))
# Line 388  connections, otherwise it will be closed Line 407  connections, otherwise it will be closed
407  (defun announce-server-port (file port)  (defun announce-server-port (file port)
408    (with-open-file (s file    (with-open-file (s file
409                       :direction :output                       :direction :output
410                       :if-exists :overwrite                       :if-exists :error
411                       :if-does-not-exist :create)                       :if-does-not-exist :create)
412      (format s "~S~%" port))      (format s "~S~%" port))
413    (simple-announce-function port))    (simple-announce-function port))
# Line 442  This is an optimized way for Lisp to del Line 461  This is an optimized way for Lisp to del
461    (let* ((socket (create-socket *loopback-interface* 0))    (let* ((socket (create-socket *loopback-interface* 0))
462           (port (local-port socket)))           (port (local-port socket)))
463      (encode-message `(:open-dedicated-output-stream ,port) socket-io)      (encode-message `(:open-dedicated-output-stream ,port) socket-io)
464      (accept-connection socket :external-format external-format)))      (accept-authenticated-connection
465         socket :external-format external-format)))
466    
467  (defun handle-request (connection)  (defun handle-request (connection)
468    "Read and process one request.  The processing is done in the extend    "Read and process one request.  The processing is done in the extend

Legend:
Removed from v.1.295  
changed lines
  Added in v.1.296

  ViewVC Help
Powered by ViewVC 1.1.5