/[emacs]/emacs/lisp/server.el
ViewVC logotype

Diff of /emacs/lisp/server.el

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

revision 1.90 by monnier, Mon Feb 10 21:44:24 2003 UTC revision 1.91 by monnier, Sat Apr 12 19:04:11 2003 UTC
# Line 1  Line 1 
1  ;;; server.el --- Lisp code for GNU Emacs running as server process  ;;; server.el --- Lisp code for GNU Emacs running as server process
2    
3  ;; Copyright (C) 1986, 87, 92, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002  ;; Copyright (C) 1986,87,92,94,95,96,97,98,99,2000,01,02,2003
4  ;;       Free Software Foundation, Inc.  ;;       Free Software Foundation, Inc.
5    
6  ;; Author: William Sommerfeld <wesommer@athena.mit.edu>  ;; Author: William Sommerfeld <wesommer@athena.mit.edu>
# Line 159  This means that the server should not ki Line 159  This means that the server should not ki
159  are done with it in the server.")  are done with it in the server.")
160  (make-variable-buffer-local 'server-existing-buffer)  (make-variable-buffer-local 'server-existing-buffer)
161    
 ;; Fixme: This doesn't look secure.  If it really is, it deserves a  
 ;; comment, but I'd expect it to be created in a protected subdir as  
 ;; normal.  -- fx  
162  (defvar server-socket-name  (defvar server-socket-name
163    (format "/tmp/esrv%d-%s" (user-uid)    (format "/tmp/emacs%d-%s/server" (user-uid)
164            (substring (system-name) 0 (string-match "\\." (system-name)))))            (substring (system-name) 0 (string-match "\\." (system-name)))))
165    
166  (defun server-log (string &optional client)  (defun server-log (string &optional client)
# Line 223  are done with it in the server.") Line 220  are done with it in the server.")
220              (t " ")))              (t " ")))
221     arg t t))     arg t t))
222    
223    (defun server-ensure-safe-dir (dir)
224      "Make sure DIR is a directory with no race-condition issues.
225    Creates the directory if necessary and makes sure:
226    - there's no symlink involved
227    - it's owned by us
228    - it's not readable/writable by anybody else."
229      (setq dir (directory-file-name dir))
230      (let ((attrs (file-attributes dir)))
231        (unless attrs
232          (letf (((default-file-modes) ?\700)) (make-directory dir))
233          (setq attrs (file-attributes dir)))
234        ;; Check that it's safe for use.
235        (unless (and (eq t (car attrs)) (eq (nth 2 attrs) (user-uid))
236                     (zerop (logand ?\077 (file-modes dir))))
237          (error "The directory %s is unsafe" dir))))
238    
239  ;;;###autoload  ;;;###autoload
240  (defun server-start (&optional leave-dead)  (defun server-start (&optional leave-dead)
241    "Allow this Emacs process to be a server for client processes.    "Allow this Emacs process to be a server for client processes.
# Line 233  Emacs distribution as your standard \"ed Line 246  Emacs distribution as your standard \"ed
246    
247  Prefix arg means just kill any existing server communications subprocess."  Prefix arg means just kill any existing server communications subprocess."
248    (interactive "P")    (interactive "P")
249      ;; Make sure there is a safe directory in which to place the socket.
250      (server-ensure-safe-dir (file-name-directory server-socket-name))
251    ;; kill it dead!    ;; kill it dead!
252    (condition-case () (delete-process server-process) (error nil))    (condition-case () (delete-process server-process) (error nil))
253    ;; Delete the socket files made by previous server invocations.    ;; Delete the socket files made by previous server invocations.
# Line 271  Server mode runs a process that accepts Line 286  Server mode runs a process that accepts
286    ;; Fixme: Should this check for an existing server socket and do    ;; Fixme: Should this check for an existing server socket and do
287    ;; nothing if there is one (for multiple Emacs sessions)?    ;; nothing if there is one (for multiple Emacs sessions)?
288    (server-start (not server-mode)))    (server-start (not server-mode)))
 (custom-add-version 'server-mode "21.4")  
289    
290  (defun server-process-filter (proc string)  (defun server-process-filter (proc string)
291    "Process a request from the server to edit some files.    "Process a request from the server to edit some files.
# Line 296  PROC is the server process.  Format of S Line 310  PROC is the server process.  Format of S
310        (setq string (substring string (match-end 0)))        (setq string (substring string (match-end 0)))
311        (setq client (cons proc nil))        (setq client (cons proc nil))
312        (while (string-match "[^ ]* " request)        (while (string-match "[^ ]* " request)
313          (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))          (let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
               (pos 0))  
314            (setq request (substring request (match-end 0)))            (setq request (substring request (match-end 0)))
315            (cond            (cond
316             ((equal "-nowait" arg) (setq nowait t))             ((equal "-nowait" arg) (setq nowait t))
317  ;;; This is not safe unless we make sure other users can't send commands.             ((equal "-eval" arg) (setq eval t))
 ;;;        ((equal "-eval" arg) (setq eval t))  
318             ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))             ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
319              (let ((display (server-unquote-arg (match-string 1 request))))              (let ((display (server-unquote-arg (match-string 1 request))))
320                (setq request (substring request (match-end 0)))                (setq request (substring request (match-end 0)))

Legend:
Removed from v.1.90  
changed lines
  Added in v.1.91

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26