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> |
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) |
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. |
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. |
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. |
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))) |