Re: Back to emacsclient/server

["Juanma Barranquero" <lekktu@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 905 bytes --]

Updated patch; mainly changes in emacsclient.c:

 - Now --server-file=xxx (or EMACS_SERVER_FILE=xxx) tries to open:
   - "xxx" (as an absolute or relative path)
   - "%HOME%/.emacs.d/server/xxx"
   - "%APPDATA%/.emacs.d/server/xxx" (on Windows)
 - With no --server-file, it tries to open a local socket.
  - If no --server-file and no local sockets, acts like
"--server-file=server" (which is the same default that server.el
uses).

Some more unresolved questions:

  - Ideas about making server.el bring the frame to the front? Also,
making it compatible with pop-up-frames = t (requested by Drew).

  - In GNU/Linux, is the above search sequence the right one, or
should it use getpwnam (...)->pw_dir to locate the user home
directory?

(Note: I'm beating this into shape with the idea of installing it in
the next few days; I sure hope the pretest is not a problem...)

                     /L/e/k/t/u

[-- Attachment #2: newserver-u.patch --]
[-- Type: application/octet-stream, Size: 32111 bytes --]

Index: lisp/server.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/server.el,v
retrieving revision 1.113
diff -u -2 -r1.113 server.el
--- lisp/server.el	6 Jul 2006 22:48:16 -0000	1.113
+++ lisp/server.el	27 Oct 2006 22:02:28 -0000
@@ -83,4 +83,38 @@
   :group 'external)
 
+(defcustom server-use-tcp nil
+  "If non-nil, use TCP sockets instead of local sockets."
+  :set #'(lambda (sym val)
+           (unless (featurep 'make-network-process '(:family local))
+             (setq val t)
+             (unless load-in-progress
+               (message "Local sockets unsupported, using TCP sockets")))
+           (when val (random t))
+           (set-default sym val))
+  :group 'server
+  :type 'boolean
+  :version "22.1")
+
+(defcustom server-host nil
+  "The name or IP address to use as host address of the server process.
+If set, the server accepts remote connections; otherwise it is local."
+  :group 'server
+  :type '(choice
+          (string :tag "Name or IP address")
+          (const :tag "Local" nil))
+  :version "22.1")
+(put 'server-host 'risky-local-variable t)
+
+(defcustom server-auth-dir "~/.emacs.d/server/"
+  "Directory for server authentication files."
+  :group 'server
+  :type 'directory
+  :version "22.1")
+(put 'server-auth-dir 'risky-local-variable t)
+
+(defvar server-auth-key nil
+  "The current server authentication key.")
+(put 'server-auth-key 'risky-local-variable t)
+
 (defcustom server-visit-hook nil
   "*Hook run when visiting a file for the Emacs server."
@@ -167,11 +201,11 @@
 (defun server-log (string &optional client)
   "If a *server* buffer exists, write STRING to it for logging purposes."
-  (if (get-buffer "*server*")
-      (with-current-buffer "*server*"
-	(goto-char (point-max))
-	(insert (current-time-string)
-		(if client (format " %s:" client) " ")
-		string)
-	(or (bolp) (newline)))))
+  (when (get-buffer "*server*")
+    (with-current-buffer "*server*"
+      (goto-char (point-max))
+      (insert (current-time-string)
+	      (if client (format " %s:" client) " ")
+	      string)
+      (or (bolp) (newline)))))
 
 (defun server-sentinel (proc msg)
@@ -232,9 +266,10 @@
   (let ((attrs (file-attributes dir)))
     (unless attrs
-      (letf (((default-file-modes) ?\700)) (make-directory dir))
+      (letf (((default-file-modes) ?\700)) (make-directory dir t))
       (setq attrs (file-attributes dir)))
     ;; Check that it's safe for use.
     (unless (and (eq t (car attrs)) (eq (nth 2 attrs) (user-uid))
-		 (zerop (logand ?\077 (file-modes dir))))
+                 (or (eq system-type 'windows-nt)
+                     (zerop (logand ?\077 (file-modes dir)))))
       (error "The directory %s is unsafe" dir))))
 
@@ -249,11 +284,13 @@
 Prefix arg means just kill any existing server communications subprocess."
   (interactive "P")
+  (when server-process
   ;; kill it dead!
-  (if server-process
-      (condition-case () (delete-process server-process) (error nil)))
-  ;; Delete the socket files made by previous server invocations.
-  (condition-case ()
+    (ignore-errors (delete-process server-process))
+    (ignore-errors
+      ;; Delete the socket or authentication files made by previous server invocations.
+      (if (eq (process-contact server-process :family) 'local)
       (delete-file (expand-file-name server-name server-socket-dir))
-    (error nil))
+        (setq server-auth-key nil)
+        (delete-file (expand-file-name server-name server-auth-dir)))))
   ;; If this Emacs already had a server, clear out associated status.
   (while server-clients
@@ -263,17 +300,41 @@
   (unless leave-dead
     ;; Make sure there is a safe directory in which to place the socket.
-    (server-ensure-safe-dir server-socket-dir)
-    (if server-process
+    (server-ensure-safe-dir (if server-use-tcp server-auth-dir server-socket-dir))
+    (when server-process
 	(server-log (message "Restarting server")))
     (letf (((default-file-modes) ?\700))
       (setq server-process
-	    (make-network-process
-	     :name "server" :family 'local :server t :noquery t
-	     :service (expand-file-name server-name server-socket-dir)
-	     :sentinel 'server-sentinel :filter 'server-process-filter
+            (apply #'make-network-process
+                   :name server-name
+                   :server t
+                   :noquery t
+                   :sentinel 'server-sentinel
+                   :filter 'server-process-filter
 	     ;; We must receive file names without being decoded.
 	     ;; Those are decoded by server-process-filter according
 	     ;; to file-name-coding-system.
-	     :coding 'raw-text)))))
+                   :coding 'raw-text
+                   ;; The rest of the arguments depend on the kind of socket used
+                   (if server-use-tcp
+                       (list :family nil
+                             :service t
+                             :host (or server-host 'local)
+                             :plist '(:authenticated nil))
+                     (list :family 'local
+                           :service (expand-file-name server-name server-socket-dir)
+                           :plist '(:authenticated t))))))
+    (unless server-process (error "Could not start server process"))
+    (when server-use-tcp
+      (setq server-auth-key
+	    (loop
+               ;; The auth key is a 64-byte string of random chars in the range `!'..`~'.
+	       for i below 64
+	       collect (+ 33 (random 94)) into auth
+	       finally return (concat auth)))
+      (with-temp-file (expand-file-name server-name server-auth-dir)
+        (set-buffer-multibyte nil)
+        (setq buffer-file-coding-system 'no-conversion)
+        (insert (format-network-address (process-contact server-process :local))
+                "\n" server-auth-key)))))
 
 ;;;###autoload
@@ -290,12 +351,24 @@
   (server-start (not server-mode)))
 \f
-(defun server-process-filter (proc string)
+(defun* server-process-filter (proc string)
   "Process a request from the server to edit some files.
 PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
+  ;; First things first: let's check the authentication
+  (unless (process-get proc :authenticated)
+    (if (and (string-match "-auth \\(.*?\\)\n" string)
+             (string= (match-string 1 string) server-auth-key))
+        (progn
+          (setq string (substring string (match-end 0)))
+          (process-put proc :authenticated t)
+          (server-log "Authentication successful" proc))
+      (server-log "Authentication failed" proc)
+      (delete-process proc)
+      ;; We return immediately
+      (return-from server-process-filter)))
   (server-log string proc)
-  (let ((prev (process-get proc 'previous-string)))
+  (let ((prev (process-get proc :previous-string)))
     (when prev
       (setq string (concat prev string))
-      (process-put proc 'previous-string nil)))
+      (process-put proc :previous-string nil)))
   ;; If the input is multiple lines,
   ;; process each line individually.
@@ -308,5 +381,5 @@
 	  (files nil)
 	  (lineno 1)
-	  (tmp-frame nil) ; Sometimes used to embody the selected display.
+	  (tmp-frame nil) ;; Sometimes used to embody the selected display.
 	  (columnno 0))
       ;; Remove this line from STRING.
@@ -338,6 +411,6 @@
 	    (setq arg (server-unquote-arg arg))
 	    ;; Now decode the file name if necessary.
-	    (if coding-system
-		(setq arg (decode-coding-string arg coding-system)))
+	    (when coding-system
+	      (setq arg (decode-coding-string arg coding-system)))
 	    (if eval
 		(let* (errorp
@@ -384,17 +457,17 @@
       ;; call pop-to-buffer etc.), delete it to avoid preserving the
       ;; connection after the last real frame is deleted.
-      (if tmp-frame
-	  (if (eq (selected-frame) tmp-frame)
-	      (set-frame-parameter tmp-frame 'visibility t)
-	    (delete-frame tmp-frame)))))
+      (when tmp-frame
+	(if (eq (selected-frame) tmp-frame)
+	    (set-frame-parameter tmp-frame 'visibility t)
+	  (delete-frame tmp-frame)))))
   ;; Save for later any partial line that remains.
   (when (> (length string) 0)
-    (process-put proc 'previous-string string)))
+    (process-put proc :previous-string string)))
 
 (defun server-goto-line-column (file-line-col)
   (goto-line (nth 1 file-line-col))
   (let ((column-number (nth 2 file-line-col)))
-    (if (> column-number 0)
-	(move-to-column (1- column-number)))))
+    (when (> column-number 0)
+      (move-to-column (1- column-number)))))
 
 (defun server-visit-files (files client &optional nowait)
@@ -468,31 +541,31 @@
 	  (setq server-clients (delq client server-clients))))
       (setq old-clients (cdr old-clients)))
-    (if (and (bufferp buffer) (buffer-name buffer))
-	;; We may or may not kill this buffer;
-	;; if we do, do not call server-buffer-done recursively
-	;; from kill-buffer-hook.
-	(let ((server-kill-buffer-running t))
-	  (with-current-buffer buffer
-	    (setq server-buffer-clients nil)
-	    (run-hooks 'server-done-hook))
-	  ;; Notice whether server-done-hook killed the buffer.
-	  (if (null (buffer-name buffer))
+    (when (and (bufferp buffer) (buffer-name buffer))
+      ;; We may or may not kill this buffer;
+      ;; if we do, do not call server-buffer-done recursively
+      ;; from kill-buffer-hook.
+      (let ((server-kill-buffer-running t))
+	(with-current-buffer buffer
+	  (setq server-buffer-clients nil)
+	  (run-hooks 'server-done-hook))
+	;; Notice whether server-done-hook killed the buffer.
+	(if (null (buffer-name buffer))
+	    (setq killed t)
+	  ;; Don't bother killing or burying the buffer
+	  ;; when we are called from kill-buffer.
+	  (unless for-killing
+	    (when (and (not killed)
+		       server-kill-new-buffers
+		       (with-current-buffer buffer
+			 (not server-existing-buffer)))
 	      (setq killed t)
-	    ;; Don't bother killing or burying the buffer
-	    ;; when we are called from kill-buffer.
-	    (unless for-killing
-	      (when (and (not killed)
-			 server-kill-new-buffers
-			 (with-current-buffer buffer
-			   (not server-existing-buffer)))
-		(setq killed t)
-		(bury-buffer buffer)
-		(kill-buffer buffer))
-	      (unless killed
-		(if (server-temp-file-p buffer)
-		    (progn
-		      (kill-buffer buffer)
-		      (setq killed t))
-		  (bury-buffer buffer)))))))
+	      (bury-buffer buffer)
+	      (kill-buffer buffer))
+	    (unless killed
+	      (if (server-temp-file-p buffer)
+		  (progn
+		    (kill-buffer buffer)
+		    (setq killed t))
+		(bury-buffer buffer)))))))
     (list next-buffer killed)))
 
@@ -521,8 +594,8 @@
 	      (buffer-backed-up nil))
 	  (save-buffer))
-      (if (and (buffer-modified-p)
-	       buffer-file-name
-	       (y-or-n-p (concat "Save file " buffer-file-name "? ")))
-	  (save-buffer)))
+      (when (and (buffer-modified-p)
+		 buffer-file-name
+		 (y-or-n-p (concat "Save file " buffer-file-name "? ")))
+	(save-buffer)))
     (server-buffer-done (current-buffer))))
 
@@ -544,6 +617,6 @@
     ;; See if any clients have any buffers that are still alive.
     (while tail
-      (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
-	  (setq live-client t))
+      (when (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
+	(setq live-client t))
       (setq tail (cdr tail)))
     (or (not live-client)
@@ -611,6 +684,6 @@
 	      ;; The buffer is already displayed: just reuse the window.
 	      (let ((frame (window-frame win)))
-		(if (eq (frame-visible-p frame) 'icon)
-		    (raise-frame frame))
+		(when (eq (frame-visible-p frame) 'icon)
+		  (raise-frame frame))
 		(select-window win)
 		(set-buffer next-buffer))
@@ -620,9 +693,9 @@
 		   (select-window server-window))
 		  ((framep server-window)
-		   (if (not (frame-live-p server-window))
-		       (setq server-window (make-frame)))
+		   (unless (frame-live-p server-window)
+		     (setq server-window (make-frame)))
 		   (select-window (frame-selected-window server-window))))
-	    (if (window-minibuffer-p (selected-window))
-		(select-window (next-window nil 'nomini 0)))
+	    (when (window-minibuffer-p (selected-window))
+	      (select-window (next-window nil 'nomini 0)))
 	    ;; Move to a non-dedicated window, if we have one.
 	    (when (window-dedicated-p (selected-window))
Index: lib-src/emacsclient.c
===================================================================
RCS file: /cvsroot/emacs/emacs/lib-src/emacsclient.c,v
retrieving revision 1.77
diff -u -2 -r1.77 emacsclient.c
--- lib-src/emacsclient.c	18 Jul 2006 16:33:45 -0000	1.77
+++ lib-src/emacsclient.c	28 Oct 2006 00:09:27 -0000
@@ -27,9 +27,14 @@
 #endif
 
+#ifdef WINDOWSNT
+#define HAVE_SOCKETS
+#define NO_SOCKETS_IN_FILE_SYSTEM
+#endif
+
 #undef signal
 
 #include <ctype.h>
 #include <stdio.h>
-#include <getopt.h>
+#include "getopt.h"
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
@@ -38,6 +43,10 @@
 #ifdef VMS
 # include "vms-pwd.h"
-#else
+#else /* not VMS */
+#ifdef WINDOWSNT
+# include <io.h>
+#else /* not WINDOWSNT */
 # include <pwd.h>
+#endif /* not WINDOWSNT */
 #endif /* not VMS */
 
@@ -49,4 +58,19 @@
 #endif
 \f
+#define SEND_STRING(data) (send_to_emacs (s, (data)))
+#define SEND_QUOTED(data) (quote_file_name (s, (data)))
+
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+
+#ifndef EXIT_FAILURE
+#define EXIT_FAILURE 1
+#endif
+
+#ifndef NO_RETURN
+#define NO_RETURN
+#endif
+\f
 /* Name used to invoke this program.  */
 char *progname;
@@ -68,4 +92,7 @@
 char *socket_name = NULL;
 
+/* If non-NULL, the filename of the authentication file.  */
+char *server_file = NULL;
+
 void print_help_and_exit () NO_RETURN;
 
@@ -78,4 +105,5 @@
   { "alternate-editor", required_argument, NULL, 'a' },
   { "socket-name",	required_argument, NULL, 's' },
+  { "server-file",	required_argument, NULL, 'f' },
   { "display",	required_argument, NULL, 'd' },
   { 0, 0, 0, 0 }
@@ -91,9 +119,10 @@
 {
   alternate_editor = getenv ("ALTERNATE_EDITOR");
+  server_file = getenv ("EMACS_SERVER_FILE");
 
   while (1)
     {
       int opt = getopt_long (argc, argv,
-			     "VHnea:s:d:", longopts, 0);
+			     "VHnea:s:f:d:", longopts, 0);
 
       if (opt == EOF)
@@ -115,4 +144,8 @@
 	  break;
 
+	case 'f':
+	  server_file = optarg;
+	  break;
+
 	case 'd':
 	  display = optarg;
@@ -157,7 +190,11 @@
 -n, --no-wait           Don't wait for the server to return\n\
 -e, --eval              Evaluate the FILE arguments as ELisp expressions\n\
--d, --display=DISPLAY   Visit the file in the given display\n\
--s, --socket-name=FILENAME\n\
-                        Set the filename of the UNIX socket for communication\n\
+-d, --display=DISPLAY   Visit the file in the given display\n"
+#ifndef NO_SOCKETS_IN_FILE_SYSTEM
+"-s, --socket-name=FILENAME\n\
+                        Set the filename of the UNIX socket for communication\n"
+#endif
+"-f, --server-file=FILENAME\n\
+			Set the filename of the TCP configuration file\n\
 -a, --alternate-editor=EDITOR\n\
                         Editor to fallback to if the server is not running\n\
@@ -167,12 +204,116 @@
 }
 
+\f
+/*
+  Try to run a different command, or --if no alternate editor is
+  defined-- exit with an errorcode.
+*/
+void
+fail (argc, argv)
+     int argc;
+     char **argv;
+{
+  if (alternate_editor)
+    {
+      int i = optind - 1;
+      execvp (alternate_editor, argv + i);
+      fprintf (stderr, "%s: error executing alternate editor \"%s\"\n",
+               progname, alternate_editor);
+    }
+  else
+    {
+      fprintf (stderr, "%s: No socket or alternate editor.  Please use:\n\n"
+#if !defined (NO_SOCKETS_IN_FILE_SYSTEM)
+"\t--socket-name\n"
+#endif
+"\t--server-file      (or environment variable EMACS_SERVER_FILE)\n\
+\t--alternate-editor (or environment variable ALTERNATE_EDITOR)\n",
+               progname);
+    }
+  exit (EXIT_FAILURE);
+}
+
+\f
+#if !defined (HAVE_SOCKETS)
+
+int
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  fprintf (stderr, "%s: Sorry, the Emacs server is supported only\n",
+	   argv[0]);
+  fprintf (stderr, "on systems with Berkeley sockets.\n");
+
+  fail (argc, argv);
+}
+
+#else /* HAVE_SOCKETS */
+
+#ifdef WINDOWSNT
+# include <winsock2.h>
+#else
+# include <sys/types.h>
+# include <sys/socket.h>
+# include <sys/un.h>
+# include <sys/stat.h>
+# include <errno.h>
+#endif
+
+#define AUTH_KEY_LENGTH      64
+#define SEND_BUFFER_SIZE   4096
+
+extern char *strerror ();
+extern int errno;
+
+/* Buffer to accumulate data to send in TCP connections.  */
+char send_buffer[SEND_BUFFER_SIZE + 1];
+int sblen = 0;	/* Fill pointer for the send buffer.  */
+
+/* Let's send the data to Emacs when either
+   - the data ends in "\n", or
+   - the buffer is full (but this shouldn't happen)
+   Otherwise, we just accumulate it.  */
+void send_to_emacs (s, data)
+     SOCKET s;
+     char *data;
+{
+  while (data)
+    {
+      int dlen = strlen (data);
+      if (dlen + sblen >= SEND_BUFFER_SIZE)
+	{
+	  int part = SEND_BUFFER_SIZE - sblen;
+	  strncpy (&send_buffer[sblen], data, part);
+	  data += part;
+	  sblen = SEND_BUFFER_SIZE;
+	}
+      else if (dlen)
+	{
+	  strcpy (&send_buffer[sblen], data);
+	  data = NULL;
+	  sblen += dlen;
+	}
+      else
+	break;
+
+      if (sblen == SEND_BUFFER_SIZE
+	  || (sblen > 0 && send_buffer[sblen-1] == '\n'))
+	{
+	  int sent = send (s, send_buffer, sblen, 0);
+	  if (sent != sblen)
+	    strcpy (send_buffer, &send_buffer[sent]);
+	  sblen -= sent;
+	}
+    }
+}
+
 /* In NAME, insert a & before each &, each space, each newline, and
    any initial -.  Change spaces to underscores, too, so that the
    return value never contains a space.  */
-
 void
-quote_file_name (name, stream)
+quote_file_name (s, name)
+     SOCKET s;
      char *name;
-     FILE *stream;
 {
   char *copy = (char *) malloc (strlen (name) * 2 + 1);
@@ -204,71 +345,140 @@
   *q++ = 0;
 
-  fprintf (stream, "%s", copy);
+  SEND_STRING (copy);
 
   free (copy);
 }
 
-/* Like malloc but get fatal error if memory is exhausted.  */
+#ifdef WINDOWSNT
+/* Wrapper to make WSACleanup a cdecl, as required by atexit().	 */
+void close_winsock ()
+{
+  WSACleanup ();
+}
+#endif /* WINDOWSNT */
 
-long *
-xmalloc (size)
-     unsigned int size;
+void initialize_sockets ()
 {
-  long *result = (long *) malloc (size);
-  if (result == NULL)
-  {
-    perror ("malloc");
-    exit (EXIT_FAILURE);
-  }
-  return result;
+#ifdef WINDOWSNT
+  WSADATA wsaData;
+
+  /* Initialize the WinSock2 library.  */
+  if (WSAStartup (MAKEWORD (2, 0), &wsaData))
+    {
+      fprintf (stderr, "%s: error initializing WinSock2", progname);
+      exit (EXIT_FAILURE);
+    }
+
+  atexit (close_winsock);
+#endif /* WINDOWSNT */
 }
 \f
 /*
-  Try to run a different command, or --if no alternate editor is
-  defined-- exit with an errorcode.
+ * Read the information needed to set up a TCP comm channel with
+ * the Emacs server: host, port and authentication string.
 */
-void
-fail (argc, argv)
-     int argc;
-     char **argv;
+void get_server_config (server, authentication)
+     struct sockaddr_in *server;
+     char *authentication;
 {
-  if (alternate_editor)
+  FILE *config;
+  char dotted[32];
+  char *port;
+
+  if (! (config = fopen (server_file, "rb")))
+    {
+      char *home = getenv ("HOME");
+#ifdef WINDOWSNT
+      if (! home)
+          home = getenv ("APPDATA");
+#endif
+      if (home)
+        {
+          char *path = alloca (32 + strlen (home) + strlen (server_file));
+          sprintf (path, "%s/.emacs.d/server/%s", home, server_file);
+          config = fopen (path, "rb");
+        }
+    }
+
+  if (! config)
     {
-      int i = optind - 1;
-      execvp (alternate_editor, argv + i);
-      return;
+      fprintf (stderr, "%s: cannot read configuration file %s",
+               progname, server_file);
+      exit (EXIT_FAILURE);
+    }
+
+  if (fgets (dotted, sizeof dotted, config)
+      && (port = strchr (dotted, ':')))
+    {
+      *port++ = '\0';
     }
   else
     {
+      fprintf (stderr, "%s: invalid configuration info", progname);
       exit (EXIT_FAILURE);
     }
-}
 
+  server->sin_family = AF_INET;
+  server->sin_addr.s_addr = inet_addr (dotted);
+  server->sin_port = htons (atoi (port));
 
-\f
-#if !defined (HAVE_SOCKETS) || defined (NO_SOCKETS_IN_FILE_SYSTEM)
+  if (! fread (authentication, AUTH_KEY_LENGTH, 1, config))
+    {
+      fprintf (stderr, "%s: cannot read authentication info", progname);
+      exit (EXIT_FAILURE);
+    }
 
-int
-main (argc, argv)
-     int argc;
-     char **argv;
+  fclose (config);
+}
+
+SOCKET
+set_tcp_socket ()
 {
-  fprintf (stderr, "%s: Sorry, the Emacs server is supported only\n",
-	   argv[0]);
-  fprintf (stderr, "on systems with Berkeley sockets.\n");
+  SOCKET s;
+  struct sockaddr_in server;
+  unsigned long c_arg = 0;
+  struct linger l_arg = {1, 1};
+  char auth_string[AUTH_KEY_LENGTH + 1];
 
-  fail (argc, argv);
-}
+  initialize_sockets ();
 
-#else /* HAVE_SOCKETS */
+  get_server_config (&server, auth_string);
+
+  /*
+   * Open up an AF_INET socket
+   */
+  if ((s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0)
+    {
+      fprintf (stderr, "%s: ", progname);
+      perror ("socket");
+      return INVALID_SOCKET;
+    }
+
+  /*
+   * Set up the socket
+   */
+  if (connect (s, (struct sockaddr *) &server, sizeof server) < 0)
+    {
+      fprintf (stderr, "%s: ", progname);
+      perror ("connect");
+      return INVALID_SOCKET;
+    }
 
-#include <sys/types.h>
-#include <sys/socket.h>
-#include <sys/un.h>
-#include <sys/stat.h>
-#include <errno.h>
+  ioctlsocket (s, FIONBIO, &c_arg);
+  setsockopt (s, SOL_SOCKET, SO_LINGER, (char *) &l_arg, sizeof l_arg);
 
-extern char *strerror ();
-extern int errno;
+  /*
+   * Send the authentication
+   */
+  auth_string[AUTH_KEY_LENGTH] = '\0';
+
+  SEND_STRING ("-auth ");
+  SEND_STRING (auth_string);
+  SEND_STRING ("\n");
+
+  return s;
+}
+
+#if !defined (NO_SOCKETS_IN_FILE_SYSTEM)
 
 /* Three possibilities:
@@ -292,26 +502,9 @@
 }
 
-int
-main (argc, argv)
-     int argc;
-     char **argv;
+SOCKET
+set_local_socket ()
 {
-  int s, i, needlf = 0;
-  FILE *out, *in;
+  SOCKET s;
   struct sockaddr_un server;
-  char *cwd, *str;
-  char string[BUFSIZ];
-
-  progname = argv[0];
-
-  /* Process options.  */
-  decode_options (argc, argv);
-
-  if ((argc - optind < 1) && !eval)
-    {
-      fprintf (stderr, "%s: file name or argument required\n", progname);
-      fprintf (stderr, "Try `%s --help' for more information\n", progname);
-      exit (EXIT_FAILURE);
-    }
 
   /*
@@ -321,7 +514,7 @@
   if ((s = socket (AF_UNIX, SOCK_STREAM, 0)) < 0)
     {
-      fprintf (stderr, "%s: ", argv[0]);
+      fprintf (stderr, "%s: ", progname);
       perror ("socket");
-      fail (argc, argv);
+      return INVALID_SOCKET;
     }
 
@@ -353,5 +546,5 @@
       {
 	fprintf (stderr, "%s: socket-name %s too long",
-		 argv[0], socket_name);
+		 progname, socket_name);
 	exit (EXIT_FAILURE);
       }
@@ -388,5 +581,5 @@
 		  {
 		    fprintf (stderr, "%s: socket-name %s too long",
-			     argv[0], socket_name);
+			     progname, socket_name);
 		    exit (EXIT_FAILURE);
 		  }
@@ -400,29 +593,28 @@
       }
 
-     switch (sock_status)
-       {
-       case 1:
-	 /* There's a socket, but it isn't owned by us.  This is OK if
-	    we are root. */
-	 if (0 != geteuid ())
-	   {
-	     fprintf (stderr, "%s: Invalid socket owner\n", argv[0]);
-	     fail (argc, argv);
-	   }
-	 break;
-
-       case 2:
-	 /* `stat' failed */
-	 if (saved_errno == ENOENT)
-	   fprintf (stderr,
-		    "%s: can't find socket; have you started the server?\n\
+    switch (sock_status)
+      {
+      case 1:
+        /* There's a socket, but it isn't owned by us.  This is OK if
+           we are root. */
+        if (0 != geteuid ())
+          {
+            fprintf (stderr, "%s: Invalid socket owner\n", argv[0]);
+	    return INVALID_SOCKET;
+          }
+        break;
+
+      case 2:
+        /* `stat' failed */
+        if (saved_errno == ENOENT)
+          fprintf (stderr,
+                   "%s: can't find socket; have you started the server?\n\
 To start the server in Emacs, type \"M-x server-start\".\n",
-		    argv[0]);
-	 else
-	   fprintf (stderr, "%s: can't stat %s: %s\n",
-		    argv[0], server.sun_path, strerror (saved_errno));
-	 fail (argc, argv);
-	 break;
-       }
+		   progname);
+        else
+          fprintf (stderr, "%s: can't stat %s: %s\n",
+		   progname, server.sun_path, strerror (saved_errno));
+	return INVALID_SOCKET;
+      }
   }
 
@@ -430,29 +622,54 @@
       < 0)
     {
-      fprintf (stderr, "%s: ", argv[0]);
+      fprintf (stderr, "%s: ", progname);
       perror ("connect");
-      fail (argc, argv);
+      return INVALID_SOCKET;
     }
 
-  /* We use the stream OUT to send our command to the server.  */
-  if ((out = fdopen (s, "r+")) == NULL)
+  return s;
+}
+#endif /* ! NO_SOCKETS_IN_FILE_SYSTEM */
+
+SOCKET
+set_socket ()
+{
+  if (server_file)
+    return set_tcp_socket ();
+  else
+#ifndef NO_SOCKETS_IN_FILE_SYSTEM
+    return set_local_socket ();
+#else
     {
-      fprintf (stderr, "%s: ", argv[0]);
-      perror ("fdopen");
-      fail (argc, argv);
+      server_file = "server";
+      return set_tcp_socket ();
     }
+#endif
+}
 
-  /* We use the stream IN to read the response.
-     We used to use just one stream for both output and input
-     on the socket, but reversing direction works nonportably:
-     on some systems, the output appears as the first input;
-     on other systems it does not.  */
-  if ((in = fdopen (s, "r+")) == NULL)
+int
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  SOCKET s;
+  int i, rl, needlf = 0;
+  char *cwd;
+  char string[BUFSIZ+1];
+
+  progname = argv[0];
+
+  /* Process options.  */
+  decode_options (argc, argv);
+
+  if ((argc - optind < 1) && !eval)
     {
-      fprintf (stderr, "%s: ", argv[0]);
-      perror ("fdopen");
-      fail (argc, argv);
+      fprintf (stderr, "%s: file name or argument required\n", progname);
+      fprintf (stderr, "Try `%s --help' for more information\n", progname);
+      exit (EXIT_FAILURE);
     }
 
+  if ((s = set_socket ()) == INVALID_SOCKET)
+    fail (argc, argv);
+
 #ifdef HAVE_GETCWD
   cwd = getcwd (string, sizeof string);
@@ -465,8 +682,8 @@
 
 #ifdef HAVE_GETCWD
-      fprintf (stderr, "%s: %s (%s)\n", argv[0],
+      fprintf (stderr, "%s: %s (%s)\n", progname,
 	       "Cannot get current working directory", strerror (errno));
 #else
-      fprintf (stderr, "%s: %s (%s)\n", argv[0], string, strerror (errno));
+      fprintf (stderr, "%s: %s (%s)\n", progname, string, strerror (errno));
 #endif
       fail (argc, argv);
@@ -474,14 +691,14 @@
 
   if (nowait)
-    fprintf (out, "-nowait ");
+    SEND_STRING ("-nowait ");
 
   if (eval)
-    fprintf (out, "-eval ");
+    SEND_STRING ("-eval ");
 
   if (display)
     {
-      fprintf (out, "-display ");
-      quote_file_name (display, out);
-      fprintf (out, " ");
+      SEND_STRING ("-display ");
+      SEND_QUOTED (display);
+      SEND_STRING (" ");
     }
 
@@ -498,59 +715,69 @@
 	      if (*p != 0)
 		{
-		  quote_file_name (cwd, out);
-		  fprintf (out, "/");
+		  SEND_QUOTED (cwd);
+		  SEND_STRING ("/");
 		}
 	    }
+#ifndef WINDOWSNT
 	  else if (*argv[i] != '/')
+#else
+	  else if ((*argv[i] != '/')
+		   /* Absolute paths can also start with backslash
+		      or drive letters.	 */
+		   && (*argv[i] != '\\')
+		   && (!islower (tolower (*argv[i]))
+		       || (argv[i][1] != ':')))
+#endif
 	    {
-	      quote_file_name (cwd, out);
-	      fprintf (out, "/");
+	      SEND_QUOTED (cwd);
+	      SEND_STRING ("/");
 	    }
 
-	  quote_file_name (argv[i], out);
-	  fprintf (out, " ");
+	  SEND_QUOTED (argv[i]);
+	  SEND_STRING (" ");
 	}
     }
   else
     {
-      while ((str = fgets (string, BUFSIZ, stdin)))
+      while (fgets (string, BUFSIZ, stdin))
 	{
-	  quote_file_name (str, out);
+	  SEND_QUOTED (string);
 	}
-      fprintf (out, " ");
+      SEND_STRING (" ");
     }
 
-  fprintf (out, "\n");
-  fflush (out);
+  SEND_STRING ("\n");
 
   /* Maybe wait for an answer.   */
-  if (nowait)
-    return EXIT_SUCCESS;
-
-  if (!eval)
+  if (!nowait)
     {
-      printf ("Waiting for Emacs...");
-      needlf = 2;
+      if (!eval)
+        {
+          printf ("Waiting for Emacs...");
+          needlf = 2;
+        }
+      fflush (stdout);
+
+      /* Now, wait for an answer and print any messages.  */
+      while ((rl = recv (s, string, BUFSIZ, 0)) > 0)
+        {
+	  string[rl] = '\0';
+          if (needlf == 2)
+            printf ("\n");
+	  printf ("%s", string);
+	  needlf = string[0] == '\0' ? needlf : string[strlen (string) - 1] != '\n';
+        }
+
+      if (needlf)
+        printf ("\n");
+      fflush (stdout);
     }
-  fflush (stdout);
-
-  /* Now, wait for an answer and print any messages.  */
-  while ((str = fgets (string, BUFSIZ, in)))
-    {
-      if (needlf == 2)
-	printf ("\n");
-      printf ("%s", str);
-      needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
-    }
-
-  if (needlf)
-    printf ("\n");
-  fflush (stdout);
 
+  closesocket (s);
   return EXIT_SUCCESS;
 }
 
 #endif /* HAVE_SOCKETS */
-\f
+
 #ifndef HAVE_STRERROR
 char *
Index: lib-src/makefile.w32-in
===================================================================
RCS file: /cvsroot/emacs/emacs/lib-src/makefile.w32-in,v
retrieving revision 2.46
diff -u -2 -r2.46 makefile.w32-in
--- lib-src/makefile.w32-in	9 Oct 2006 19:57:43 -0000	2.46
+++ lib-src/makefile.w32-in	27 Oct 2006 22:02:28 -0000
@@ -21,5 +21,5 @@
 #
 
-ALL = make-docfile hexl ctags etags movemail ebrowse sorted-doc digest-doc
+ALL = make-docfile hexl ctags etags movemail ebrowse sorted-doc digest-doc emacsclient
 
 .PHONY: $(ALL)
@@ -33,5 +33,4 @@
 #		$(BLD)/server.exe	\
 #		$(BLD)/emacstool.exe	\
-#		$(BLD)/emacsclient.exe	\
 #		$(BLD)/cvtmail.exe	\
 
@@ -60,4 +59,5 @@
 sorted-doc:	$(BLD) $(BLD)/sorted-doc.exe
 digest-doc:	$(BLD) $(BLD)/digest-doc.exe
+emacsclient:	$(BLD) $(BLD)/emacsclient.exe
 
 test-distrib:	$(BLD) $(BLD)/test-distrib.exe
@@ -75,4 +75,17 @@
 		$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(MOVEMAILOBJS) $(WSOCK32) $(LIBS)
 
+ECLIENT_CFLAGS = -DWINDOWSNT -DHAVE_GETCWD -DHAVE_STRERROR -c
+ECLIENTOBJS =	$(BLD)/emacsclient.$(O) \
+		$(BLD)/getopt.$(O) \
+		$(BLD)/getopt1.$(O) \
+		$(BLD)/ntlib.$(O)
+
+$(BLD)/emacsclient.exe:		$(ECLIENTOBJS)
+# put wsock32.lib before $(LIBS) to ensure we don't link to ws2_32.lib
+		$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(ECLIENTOBJS) $(WSOCK32) $(LIBS)
+
+$(BLD)/emacsclient.$(O):	emacsclient.c
+		$(CC) $(ECLIENT_CFLAGS) $(CC_OUT)$@ emacsclient.c
+
 ETAGSOBJ      = $(BLD)/etags.$(O) \
 		$(BLD)/getopt.$(O) \
@@ -297,4 +310,5 @@
 		$(CP) $(BLD)/sorted-doc.exe $(INSTALL_DIR)/bin
 		$(CP) $(BLD)/digest-doc.exe $(INSTALL_DIR)/bin
+		$(CP) $(BLD)/emacsclient.exe $(INSTALL_DIR)/bin
 		- mkdir "$(INSTALL_DIR)/etc"
 		$(CP) $(DOC) $(INSTALL_DIR)/etc

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel