From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Spencer Baugh Newsgroups: gmane.emacs.devel Subject: [PATCH 2/5] server.el: accept FDs from emacsclient Date: Mon, 6 Jun 2016 21:25:03 -0400 Message-ID: <1465262706-5229-3-git-send-email-sbaugh@catern.com> References: <1465262706-5229-1-git-send-email-sbaugh@catern.com> NNTP-Posting-Host: plane.gmane.org X-Trace: ger.gmane.org 1465262840 13490 80.91.229.3 (7 Jun 2016 01:27:20 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 7 Jun 2016 01:27:20 +0000 (UTC) Cc: Spencer Baugh To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Jun 07 03:27:19 2016 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1bA5nb-0003rd-4B for ged-emacs-devel@m.gmane.org; Tue, 07 Jun 2016 03:27:19 +0200 Original-Received: from localhost ([::1]:46345 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bA5na-0006YS-DL for ged-emacs-devel@m.gmane.org; Mon, 06 Jun 2016 21:27:18 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51512) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bA5m6-0005a9-43 for emacs-devel@gnu.org; Mon, 06 Jun 2016 21:25:49 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bA5lz-00023d-VS for emacs-devel@gnu.org; Mon, 06 Jun 2016 21:25:45 -0400 Original-Received: from catern.com ([104.131.201.120]:38405 helo=mail.catern.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bA5lz-00022g-Mq for emacs-devel@gnu.org; Mon, 06 Jun 2016 21:25:39 -0400 Original-Received: from [127.0.0.1] (localhost [127.0.0.1]) (using TLSv1.2 with cipher ECDHE-RSA-AES128-GCM-SHA256 (128/128 bits)) (No client certificate requested) by mail.catern.com (Postfix) with ESMTPSA id DC42E4F576; Tue, 7 Jun 2016 01:25:31 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=catern.com; s=default; t=1465262732; bh=DYkGMywgzkXWAWUPEc4OQ6A9tq1B7k3pgDkvmjPHi/M=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=ASjrbL8W5lXs86Cy3f8RJium3Ccj0Nqc/ZxG5bDd5PgDBD50liMOuJLSzTy2W+M0o 1jf0PDz/8ujtSfdB4/t7TawLORCYVEdmlyWTUJlpW0BeBK6r/g86BdjcQOQ9unR+qX hb9lpTdYD68QgxruJDjFW3M55k3Nyrj4o/ZQt5HE= In-Reply-To: <1465262706-5229-1-git-send-email-sbaugh@catern.com> X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [generic] X-Received-From: 104.131.201.120 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:204218 Archived-At: The emacs server passes :ancillary t to make-network-process, and stores any file descriptors it receives from a client. --- lisp/server.el | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 55 insertions(+), 3 deletions(-) diff --git a/lisp/server.el b/lisp/server.el index e4cf431..894f8ac 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -352,6 +352,9 @@ server-delete-client (when (and terminal (eq (terminal-live-p terminal) t)) (delete-terminal terminal)))) + ;; Delete associated processes using this client's fds + (mapc #'delete-process (process-get proc :pipelines)) + ;; Delete the client's process. (if (eq (process-status proc) 'open) (delete-process proc)) @@ -670,6 +673,7 @@ server-start :plist '(:authenticated nil)) (list :family 'local :service server-file + :ancillary-data t :plist '(:authenticated t))))) (unless server-process (error "Could not start server process")) (process-put server-process :server-file server-file) @@ -915,7 +919,7 @@ server-execute-continuation (process-put proc 'continuation nil) (if continuation (ignore-errors (funcall continuation))))) -(cl-defun server-process-filter (proc string) +(cl-defun server-process-filter (proc string &optional ancillary) "Process a request from the server to edit some files. PROC is the server process. STRING consists of a sequence of commands prefixed by a dash. Some commands have arguments; @@ -1015,6 +1019,9 @@ server-execute-continuation Suspend this terminal, i.e., stop the client process. Sent when the user presses C-z." (server-log (concat "Received " string) proc) + (when ancillary + (server-log (format "Received fds %s" ancillary) proc) + (process-put proc :fds ancillary)) ;; First things first: let's check the authentication (unless (process-get proc :authenticated) (if (and (string-match "-auth \\([!-~]+\\)\n?" string) @@ -1262,6 +1269,50 @@ server-execute-continuation ;; condition-case (error (server-return-error proc err)))) +(defvar server-emacsclient-proc nil + "Non-nil if running commands for a client of our server. +If we are currently evaluating Lisp in response to client commands, +this variable contains the process for communicating with that +client.") + +(defun server-pager-sentinel (proc event) + (internal-default-process-sentinel proc event) + (when (equal event "finished\n") + (let ((emacsclient (process-get proc :emacsclient))) + (setf (process-get emacsclient :pipelines) + (delq proc (process-get emacsclient :pipelines))) + (server-delete-client emacsclient)))) + +(defun server-pager () + "Start a process reading from FDs passed in by the current client. +This function will start a process which will begin reading from the +FDs passed in by the current client and copying their input to a +*pager* buffer. + +This function should only be run by passing --eval to an emacsclient +that also has the -l or --pipeline option, like so: + echo some data | emacsclient -l --eval '(server-pager)'" + ;; we remove two fds from the emacsclient process, and add ourselves + ;; in for later deletion when the emacsclient quits + (if (null server-emacsclient-proc) + (error "Cannot be run out of emacsclient --eval context") + (let ((buf (get-buffer "*pager*"))) + (when buf (kill-buffer buf))) + (let* ((infd (pop (process-get server-emacsclient-proc :fds))) + (outfd (pop (process-get server-emacsclient-proc :fds))) + (buffer (generate-new-buffer "*pager*")) + (proc (make-fd-process :name "pager-proc" + :buffer buffer + :noquery t + :sentinel #'server-pager-sentinel + :infd infd + :outfd outfd + :plist (list :emacsclient server-emacsclient-proc)))) + (push proc (process-get server-emacsclient-proc :pipelines)) + (pop-to-buffer buffer) + proc))) + + (defun server-execute (proc files nowait commands dontkill frame tty-name) ;; This is run from timers and process-filters, i.e. "asynchronously". ;; But w.r.t the user, this is not really asynchronous since the timer @@ -1272,7 +1323,8 @@ server-execute ;; including code that needs to wait. (with-local-quit (condition-case err - (let ((buffers (server-visit-files files proc nowait))) + (let ((buffers (server-visit-files files proc nowait)) + (server-emacsclient-proc proc)) (mapc 'funcall (nreverse commands)) ;; If we were told only to open a new client, obey @@ -1294,7 +1346,7 @@ server-execute ;; Client requested nowait; return immediately. (server-log "Close nowait client" proc) (server-delete-client proc)) - ((and (not dontkill) (null buffers)) + ((and (not dontkill) (null buffers) (null (process-get proc :pipelines))) ;; This client is empty; get rid of it immediately. (server-log "Close empty client" proc) (server-delete-client proc))) -- 2.8.2