Mercurial > hg > xemacs-beta
annotate lisp/code-process.el @ 5885:c8bbb32fe124
Always return a string, #'current-message.
lisp/ChangeLog addition:
2015-04-04 Aidan Kehoe <kehoea@parhasard.net>
* gutter-items.el (append-progress-feedback):
* gutter-items.el (abort-progress-feedback):
Correct comments in both these functions, it's the progress stack
being adjusted, not the message stack.
* simple.el (message-stack):
Describe my recent change in the structure of this.
* simple.el (current-message):
Adjust the implementation of this to always return the string
displayed.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 04 Apr 2015 13:49:30 +0100 |
| parents | a216b3c2b09e |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; code-process.el --- Process coding functions for XEmacs. |
| 2 | |
| 3 ;; Copyright (C) 1985-1987, 1993, 1994, 1997 Free Software Foundation, Inc. | |
| 853 | 4 ;; Copyright (C) 1995, 2000, 2002 Ben Wing |
| 428 | 5 ;; Copyright (C) 1997 MORIOKA Tomohiko |
| 6 | |
| 7 ;; Author: Ben Wing | |
| 8 ;; MORIOKA Tomohiko | |
| 9 ;; Maintainer: XEmacs Development Team | |
| 10 ;; Keywords: mule, multilingual, coding system, process | |
| 11 | |
| 12 ;; This file is part of XEmacs. | |
| 13 | |
| 14 ;; This file is very similar to code-process.el | |
| 15 | |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
16 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
17 ;; under the terms of the GNU General Public License as published by the |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
18 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
19 ;; option) any later version. |
| 428 | 20 |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
21 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
22 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
23 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
24 ;; for more details. |
| 428 | 25 |
| 26 ;; You should have received a copy of the GNU General Public License | |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
27 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 28 |
| 29 ;;; Code: | |
| 30 | |
| 31 (defvar process-coding-system-alist nil | |
| 32 "Alist to decide a coding system to use for a process I/O operation. | |
| 33 The format is ((PATTERN . VAL) ...), | |
| 34 where PATTERN is a regular expression matching a program name, | |
| 35 VAL is a coding system, a cons of coding systems, or a function symbol. | |
| 36 If VAL is a coding system, it is used for both decoding what received | |
| 37 from the program and encoding what sent to the program. | |
| 38 If VAL is a cons of coding systems, the car part is used for decoding, | |
| 39 and the cdr part is used for encoding. | |
| 853 | 40 If VAL is a function symbol, it is called with two arguments, a symbol |
| 41 indicating the operation being performed (one of `start-process', | |
| 42 `call-process', `open-network-stream', or `open-multicast-group') and the | |
| 43 program name. The function must return a coding system or a cons of | |
| 44 coding systems which are used as above.") | |
| 428 | 45 |
| 46 (defun call-process (program &optional infile buffer displayp &rest args) | |
| 47 "Call PROGRAM synchronously in separate process. | |
| 853 | 48 |
| 428 | 49 The program's input comes from file INFILE (nil means `/dev/null'). |
| 853 | 50 XEmacs feature: INFILE can also be a list of (BUFFER [START [END]]), i.e. |
| 51 a list of one to three elements, consisting of a buffer and optionally | |
| 52 a start position or start and end position. In this case, input comes | |
| 53 from the buffer, starting from START (defaults to the beginning of the | |
| 54 buffer) and ending at END (defaults to the end of the buffer). | |
| 55 | |
| 428 | 56 Insert output in BUFFER before point; t means current buffer; |
| 57 nil for BUFFER means discard it; 0 means discard and don't wait. | |
| 837 | 58 If BUFFER is a string, then find or create a buffer with that name, |
| 59 then insert the output in that buffer, before point. | |
| 428 | 60 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, |
| 61 REAL-BUFFER says what to do with standard output, as above, | |
| 62 while STDERR-FILE says what to do with standard error in the child. | |
| 63 STDERR-FILE may be nil (discard standard error output), | |
| 853 | 64 t (mix it with ordinary output), a file name string, or (XEmacs feature) |
| 65 a buffer object. If STDERR-FILE is a buffer object (but not the name of | |
| 66 a buffer, since that would be interpreted as a file), the standard error | |
| 67 output will be inserted into the buffer before point. | |
| 428 | 68 |
| 853 | 69 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. |
| 428 | 70 Remaining arguments are strings passed as command arguments to PROGRAM. |
| 71 | |
| 853 | 72 If BUFFER is 0, returns immediately with value nil. |
| 73 Otherwise waits for PROGRAM to terminate and returns a numeric exit status | |
| 74 or a signal description string. If you quit, the process is first killed | |
| 75 with SIGINT, then with SIGKILL if you quit again before the process exits. | |
| 76 | |
| 77 If INFILE is a file, we transfer its exact contents to the process without | |
| 78 any encoding/decoding. (#### This policy might change.) | |
| 79 | |
| 80 Otherwise, the read/write coding systems used for process I/O on the | |
| 81 process are determined as follows: | |
| 82 | |
| 83 1. `coding-system-for-read', `coding-system-for-write', if non-nil. | |
| 84 (Intended as a temporary overriding mechanism for use by Lisp | |
| 85 code.) | |
| 86 2. The matching value for the process name from `process-coding-system-alist', | |
| 87 if any, and if non-nil. The value may be either a single coding | |
| 88 system, used for both read and write; or a cons of read/write; or a | |
| 89 function, called to get one of the other two values. | |
| 90 3. For writing: If a buffer was given in INFILE, the value of | |
| 91 `buffer-file-coding-system' in that buffer. | |
| 92 For reading: if a buffer was given in BUFFER, the value of | |
| 93 `buffer-file-coding-system-for-read' in that buffer. | |
| 94 4. The value of `default-process-coding-system', which should be a cons | |
| 95 of read/write coding systems, if the values are non-nil. | |
| 96 5. The coding system `undecided' for read, and `raw-text' for write. | |
| 97 | |
| 98 Note that the processes of determining the read and write coding systems | |
| 99 proceed essentially independently one from the other, as in `start-process'." | |
| 100 (let (cs-r cs-w) | |
| 101 (let (ret) | |
| 102 (catch 'found | |
| 103 (let ((alist process-coding-system-alist) | |
| 104 (case-fold-search nil)) | |
| 105 (while alist | |
| 106 (if (string-match (car (car alist)) program) | |
| 107 (throw 'found (setq ret (cdr (car alist))))) | |
| 108 (setq alist (cdr alist)) | |
| 109 ))) | |
| 110 (if (functionp ret) | |
| 111 (setq ret (funcall ret 'call-process program))) | |
| 112 (cond ((consp ret) | |
| 113 (setq cs-r (car ret) | |
| 114 cs-w (cdr ret))) | |
| 115 ((and ret (find-coding-system ret)) | |
| 116 (setq cs-r ret | |
| 117 cs-w ret)))) | |
| 118 (let ((coding-system-for-read | |
| 119 (or coding-system-for-read cs-r | |
| 120 (let ((thebuf (if (consp buffer) (car buffer) buffer))) | |
| 121 (and (or (bufferp thebuf) (stringp thebuf)) | |
| 122 (get-buffer thebuf) | |
| 123 (symbol-value-in-buffer | |
| 857 | 124 'buffer-file-coding-system-for-read (get-buffer thebuf)))) |
| 853 | 125 (car default-process-coding-system) |
| 126 'undecided)) | |
| 127 (coding-system-for-write | |
| 128 (or coding-system-for-write cs-w | |
| 129 (and (consp infile) | |
| 130 (symbol-value-in-buffer | |
| 131 'buffer-file-coding-system | |
| 132 (get-buffer (car infile)))) | |
| 133 (cdr default-process-coding-system) | |
| 134 'raw-text))) | |
| 135 (apply 'call-process-internal program infile buffer displayp args)))) | |
| 428 | 136 |
| 137 (defun call-process-region (start end program | |
| 138 &optional deletep buffer displayp | |
| 139 &rest args) | |
| 140 "Send text from START to END to a synchronous process running PROGRAM. | |
| 141 Delete the text if fourth arg DELETEP is non-nil. | |
| 142 | |
| 143 Insert output in BUFFER before point; t means current buffer; | |
| 144 nil for BUFFER means discard it; 0 means discard and don't wait. | |
| 837 | 145 If BUFFER is a string, then find or create a buffer with that name, |
| 146 then insert the output in that buffer, before point. | |
| 428 | 147 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, |
| 148 REAL-BUFFER says what to do with standard output, as above, | |
| 149 while STDERR-FILE says what to do with standard error in the child. | |
| 150 STDERR-FILE may be nil (discard standard error output), | |
| 853 | 151 t (mix it with ordinary output), a file name string, or (XEmacs feature) |
| 152 a buffer object. If STDERR-FILE is a buffer object (but not the name of | |
| 153 a buffer, since that would be interpreted as a file), the standard error | |
| 154 output will be inserted into the buffer before point. | |
| 428 | 155 |
| 156 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted. | |
| 157 Remaining args are passed to PROGRAM at startup as command args. | |
| 158 | |
| 159 If BUFFER is 0, returns immediately with value nil. | |
| 853 | 160 Otherwise waits for PROGRAM to terminate and returns a numeric exit status |
| 161 or a signal description string. If you quit, the process is first killed | |
| 162 with SIGINT, then with SIGKILL if you quit again before the process exits. | |
| 163 | |
| 164 The read/write coding systems used for process I/O on the process are | |
| 165 the same as for `call-process'." | |
| 2356 | 166 |
| 167 ;; We can't delete the region before feeding it to `call-process', so we | |
| 168 ;; take care not to delete the insertion when we delete the region. START | |
| 169 ;; and END may not be markers; copy them. (point) will end up after the | |
| 170 ;; insertion. A copy of (point) tracks the beginning of the insertion. | |
| 171 | |
| 172 (let ((s (and deletep (copy-marker start))) ; Only YOU can | |
| 173 (e (and deletep (copy-marker end t))) ; prevent | |
| 174 (p (and deletep (copy-marker (point)))) ; excess consing! | |
| 175 (retval | |
| 176 (apply #'call-process program (list (current-buffer) start end) | |
| 177 buffer displayp args))) | |
| 178 (when deletep | |
| 179 (if (<= s p e) | |
| 180 ;; region was split by insertion | |
| 181 ;; the order checks are gilt lilies | |
| 182 (progn (when (< (point) e) (delete-region (point) e)) | |
| 183 (when (< s p) (delete-region s p))) | |
| 184 ;; insertion was outside of region | |
| 185 (delete-region s e))) | |
| 186 retval)) | |
| 428 | 187 |
| 188 (defun start-process (name buffer program &rest program-args) | |
| 189 "Start a program in a subprocess. Return the process object for it. | |
| 190 NAME is name for process. It is modified if necessary to make it unique. | |
| 191 BUFFER is the buffer or (buffer-name) to associate with the process. | |
| 853 | 192 Process output goes at end of that buffer, unless you specify |
| 193 an output stream or filter function to handle the output. | |
| 194 BUFFER may be also nil, meaning that this process is not associated | |
| 195 with any buffer. | |
| 196 BUFFER can also have the form (REAL-BUFFER STDERR-BUFFER); in that case, | |
| 197 REAL-BUFFER says what to do with standard output, as above, | |
| 198 while STDERR-BUFFER says what to do with standard error in the child. | |
| 199 STDERR-BUFFER may be nil (discard standard error output, unless a stderr | |
| 200 filter is set). Note that if you do not use this form at process creation, | |
| 201 stdout and stderr will be mixed in the output buffer, and this cannot be | |
| 202 changed, even by setting a stderr filter. | |
| 428 | 203 Third arg is program file name. It is searched for as in the shell. |
| 204 Remaining arguments are strings to give program as arguments. | |
| 853 | 205 |
| 206 The read/write coding systems used for process I/O on the process are | |
| 207 determined as follows: | |
| 208 | |
| 209 1. `coding-system-for-read', `coding-system-for-write', if non-nil. | |
| 210 (Intended as a temporary overriding mechanism for use by Lisp | |
| 211 code.) | |
| 212 2. The matching value for the process name from `process-coding-system-alist', | |
| 213 if any, and if non-nil. The value may be either a single coding | |
| 214 system, used for both read and write; or a cons of read/write; or a | |
| 215 function, called to get one of the other two values. | |
| 216 3. The value of `default-process-coding-system', which should be a cons | |
| 217 of read/write coding systems, if the values are non-nil. | |
| 218 4. The coding system `undecided' for read, and `raw-text' for write. | |
| 219 | |
| 220 Note that the processes of determining the read and write coding systems | |
| 221 proceed essentially independently one from the other. For example, a value | |
| 222 determined from `process-coding-system-alist' might specify a read coding | |
| 223 system but not a write coding system, in which the read coding system is as | |
| 224 specified and the write coding system comes from proceeding to step 3 (and | |
| 225 looking in `default-process-coding-system'). | |
| 226 | |
| 227 You can change the coding systems later on using | |
| 228 `set-process-coding-system', `set-process-input-coding-system', or | |
| 229 `set-process-output-coding-system'. | |
| 230 | |
| 231 See also `set-process-filter' and `set-process-stderr-filter'." | |
| 428 | 232 (let (cs-r cs-w) |
| 233 (let (ret) | |
| 234 (catch 'found | |
| 235 (let ((alist process-coding-system-alist) | |
| 236 (case-fold-search nil)) | |
| 237 (while alist | |
| 238 (if (string-match (car (car alist)) program) | |
| 239 (throw 'found (setq ret (cdr (car alist))))) | |
| 240 (setq alist (cdr alist)) | |
| 241 ))) | |
| 242 (if (functionp ret) | |
| 243 (setq ret (funcall ret 'start-process program))) | |
| 244 (cond ((consp ret) | |
| 245 (setq cs-r (car ret) | |
| 246 cs-w (cdr ret))) | |
| 853 | 247 ((and ret (find-coding-system ret)) |
| 428 | 248 (setq cs-r ret |
| 249 cs-w ret)))) | |
| 250 (let ((coding-system-for-read | |
| 771 | 251 (or coding-system-for-read cs-r |
| 853 | 252 (car default-process-coding-system) 'undecided)) |
| 428 | 253 (coding-system-for-write |
| 771 | 254 (or coding-system-for-write cs-w |
| 853 | 255 (cdr default-process-coding-system) 'raw-text))) |
| 428 | 256 (apply 'start-process-internal name buffer program program-args) |
| 257 ))) | |
| 258 | |
| 259 (defvar network-coding-system-alist nil | |
| 260 "Alist to decide a coding system to use for a network I/O operation. | |
| 261 The format is ((PATTERN . VAL) ...), | |
| 262 where PATTERN is a regular expression matching a network service name | |
| 263 or is a port number to connect to, | |
| 264 VAL is a coding system, a cons of coding systems, or a function symbol. | |
| 265 If VAL is a coding system, it is used for both decoding what received | |
| 266 from the network stream and encoding what sent to the network stream. | |
| 267 If VAL is a cons of coding systems, the car part is used for decoding, | |
| 268 and the cdr part is used for encoding. | |
| 269 If VAL is a function symbol, the function must return a coding system | |
| 270 or a cons of coding systems which are used as above. | |
| 271 | |
| 272 See also the function `find-operation-coding-system'.") | |
| 273 | |
|
5814
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
274 (defun network-stream-get-response (stream start end-of-command) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
275 (when end-of-command |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
276 (with-current-buffer (process-buffer stream) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
277 (save-excursion |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
278 (goto-char start) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
279 (while (and (memq (process-status stream) '(open run)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
280 (not (re-search-forward end-of-command nil t))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
281 (accept-process-output stream 0 50) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
282 (goto-char start)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
283 ;; Return the data we got back, or nil if the process died. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
284 (unless (= start (point)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
285 (buffer-substring start (point))))))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
286 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
287 (defun network-stream-command (stream command eoc) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
288 (when command |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
289 (let ((start (point-max (process-buffer stream)))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
290 (process-send-string stream command) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
291 (network-stream-get-response stream start eoc)))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
292 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
293 (defun network-stream-open-plain (name buffer host service parameters) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
294 (let ((start (point buffer)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
295 (stream |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
296 (open-network-stream-internal name buffer host service |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
297 (plist-get parameters :protocol)))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
298 (list stream |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
299 (network-stream-get-response stream start |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
300 (plist-get parameters :end-of-command)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
301 nil |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
302 'plain))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
303 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
304 (defun network-stream-open-tls (name buffer host service parameters) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
305 (with-current-buffer buffer |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
306 (let* ((start (point-max)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
307 (stream |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
308 (open-network-stream-internal name buffer host service |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
309 (plist-get parameters :protocol) t))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
310 (if (null stream) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
311 (list nil nil nil 'plain) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
312 (let ((eoc (plist-get parameters :end-of-command)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
313 (capability-command (plist-get parameters :capability-command))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
314 (list stream |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
315 (network-stream-get-response stream start eoc) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
316 (network-stream-command stream capability-command eoc) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
317 'tls)))))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
318 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
319 (defun network-stream-certificate (host service parameters) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
320 (let ((spec (plist-get :client-certificate parameters))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
321 (cond |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
322 ((listp spec) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
323 ;; Either nil or a list with a key/certificate pair. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
324 spec) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
325 ((eq spec t) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
326 (when (fboundp 'auth-source-search) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
327 (let* ((auth-info |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
328 (car (auth-source-search :max 1 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
329 :host host |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
330 :port service))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
331 (key (plist-get auth-info :key)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
332 (cert (plist-get auth-info :cert))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
333 (and key cert |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
334 (list key cert)))))))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
335 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
336 (defun network-stream-open-starttls (name buffer host service parameters) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
337 (let* ((start (point buffer)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
338 (require-tls (eq (plist-get parameters :type) 'starttls)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
339 (starttls-function (plist-get parameters :starttls-function)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
340 (success-string (plist-get parameters :success)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
341 (capability-command (plist-get parameters :capability-command)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
342 (eoc (plist-get parameters :end-of-command)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
343 (eo-capa (or (plist-get parameters :end-of-capability) eoc)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
344 (protocol (plist-get parameters :protocol)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
345 ;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
346 (stream (open-network-stream-internal name buffer host service |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
347 protocol)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
348 (greeting (and (not (plist-get parameters :nogreeting)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
349 (network-stream-get-response stream start eoc))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
350 (capabilities (network-stream-command stream capability-command |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
351 eo-capa)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
352 (resulting-type 'plain) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
353 starttls-available starttls-command error) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
354 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
355 ;; First check whether the server supports STARTTLS at all. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
356 (when (and capabilities success-string starttls-function) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
357 (setq starttls-command |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
358 (funcall starttls-function capabilities))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
359 ;; If we have built-in STARTTLS support, try to upgrade the |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
360 ;; connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
361 (when (and starttls-command |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
362 (setq starttls-available t) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
363 (not (eq (plist-get parameters :type) 'plain))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
364 (when (let ((response |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
365 (network-stream-command stream starttls-command eoc))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
366 (and response (string-match success-string response))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
367 ;; The server said it was OK to begin STARTTLS negotiations. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
368 (let ((cert (network-stream-certificate host service parameters))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
369 (condition-case nil |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
370 (tls-negotiate stream host (and cert (list cert))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
371 ;; If we get a tls-specific error (for instance if the |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
372 ;; certificate the server gives us is completely syntactically |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
373 ;; invalid), then close the connection and possibly (further |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
374 ;; down) try to create a non-encrypted connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
375 (gnutls-error (delete-process stream)))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
376 (if (memq (process-status stream) '(open run)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
377 (setq resulting-type 'tls) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
378 ;; We didn't successfully negotiate STARTTLS; if TLS |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
379 ;; isn't demanded, reopen an unencrypted connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
380 (unless require-tls |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
381 (setq stream |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
382 (make-network-process :name name :buffer buffer |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
383 :host host :service service)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
384 (network-stream-get-response stream start eoc))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
385 ;; Re-get the capabilities, which may have now changed. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
386 (setq capabilities |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
387 (network-stream-command stream capability-command eo-capa)))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
388 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
389 ;; If TLS is mandatory, close the connection if it's unencrypted. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
390 (when (and require-tls |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
391 ;; ... but Emacs wasn't able to -- either no built-in |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
392 ;; support, or no gnutls-cli installed. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
393 (eq resulting-type 'plain)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
394 (setq error |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
395 (if (or (null starttls-command) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
396 starttls-available) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
397 "Server does not support TLS" |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
398 ;; See `starttls-available-p'. If this predicate |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
399 ;; changes to allow running under Windows, the error |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
400 ;; message below should be amended. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
401 (if (memq system-type '(windows-nt ms-dos)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
402 (concat "Emacs does not support TLS") |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
403 (concat "Emacs does not support TLS, and no external `" |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
404 (if starttls-use-gnutls |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
405 starttls-gnutls-program |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
406 starttls-program) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
407 "' program was found")))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
408 (delete-process stream) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
409 (setq stream nil)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
410 ;; Return value: |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
411 (list stream greeting capabilities resulting-type error))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
412 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
413 ;; Requires that format-spec.el from gnus be loaded |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
414 (defun network-stream-open-shell (name buffer host service parameters) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
415 (require 'format-spec) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
416 (let* ((capability-command (plist-get parameters :capability-command)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
417 (eo-capa (plist-get parameters :end-of-capability)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
418 (eoc (plist-get parameters :end-of-command)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
419 (start (point buffer)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
420 (stream (let ((process-connection-type nil)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
421 (start-process name buffer shell-file-name |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
422 shell-command-switch |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
423 (format-spec |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
424 (plist-get parameters :shell-command) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
425 (format-spec-make |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
426 ?s host |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
427 ?p service)))))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
428 (list stream |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
429 (network-stream-get-response stream start eoc) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
430 (network-stream-command stream capability-command (or eo-capa eoc)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
431 'plain))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
432 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
433 (defun open-network-stream (name buffer host service &rest parameters) |
| 428 | 434 "Open a TCP connection for a service to a host. |
|
5814
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
435 Normally, return a process object to represent the connection. If the |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
436 :return-list parameter is non-NIL, instead return a list; see below. |
| 428 | 437 Input and output work as for subprocesses; `delete-process' closes it. |
| 438 NAME is name for process. It is modified if necessary to make it unique. | |
| 439 BUFFER is the buffer (or buffer-name) to associate with the process. | |
| 440 Process output goes at end of that buffer, unless you specify | |
| 441 an output stream or filter function to handle the output. | |
| 442 BUFFER may be also nil, meaning that this process is not associated | |
| 853 | 443 with any buffer. |
| 428 | 444 Third arg is name of the host to connect to, or its IP address. |
| 445 Fourth arg SERVICE is name of the service desired, or an integer | |
| 446 specifying a port number to connect to. | |
|
5814
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
447 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
448 The remaining PARAMETERS should be a sequence of keywords and values: |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
449 - :protocol is a network protocol. Currently 'tcp (Transmission Control |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
450 Protocol) and 'udp (User Datagram Protocol) are supported. When |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
451 omitted, 'tcp is assumed. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
452 - :type specifies the connection type; it is one of the following: |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
453 nil or `network': begin with an ordinary network connection, and if |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
454 the parameters :success and :capability-command are also |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
455 supplied, try to upgrade to an encrypted connection via |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
456 STARTTLS. If that fails (e.g., HOST does not support TLS), |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
457 retain an unencrypted connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
458 `plain': an ordinary, unencrypted network connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
459 `starttls': begin with an ordinary network connection and try to |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
460 upgrade via STARTTLS. If that fails, drop the connection |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
461 and return a killed process object. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
462 `tls': a TLS connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
463 `ssl': a synonym for `tls'. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
464 `shell': a shell connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
465 - :return-list specifies this function's return value. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
466 If omitted or nil, return a process object as usual. Otherwise, return |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
467 (PROC . PROPS), where PROC is a process object and PROPS is a plist of |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
468 connection properties, with these keywords: |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
469 :greeting: the greeting returned by HOST (a string), or nil. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
470 :capabilities: a string representing HOST's capabilities, or nil if none |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
471 could be found. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
472 :type: the resulting connection type, `plain' (unencrypted) or `tls' |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
473 (encrypted). |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
474 - :end-of-command specifies a regexp matching the end of a command. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
475 - :end-of-capability specifies a regexp matching the end of the response |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
476 to the command specified for :capability-command. It defaults to the |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
477 regexp specified for :end-of-command. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
478 - :success specifies a regexp matching a message indicating a successful |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
479 STARTTLS negotiation. For example, the default should be \"^3\" for an |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
480 NNTP connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
481 - :capability-command specifies a command used to query HOST for its |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
482 capabilities. For example, this should be \"1 CAPABILITY\\r\\n\" for |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
483 IMAP. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
484 - :starttls-function specifies a function for handling STARTTLS. This |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
485 function should take one parameter, the response to the capability |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
486 command, and should return the command to switch on STARTTLS if the |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
487 server supports it, or nil otherwise. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
488 - :always-query-capabilities, if non-nil, indicates that the server should |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
489 be queried for capabilities even if constructing a `plain' network |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
490 connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
491 - :client-certificate is either a list (certificate-key-filename |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
492 certificate-filename), or `t', meaning that `auth-source' will be |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
493 queried for the key and certificate. This parameter is used only when |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
494 constructing a TLS or STARTTLS connection. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
495 - :use-starttls-if-possible, if non-nil, indicates that STARTTLS should |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
496 be used even if TLS support is not compiled in to XEmacs. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
497 - :nogreeting, if non-nil, indicates that we should not wait for a |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
498 greeting from the server. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
499 - :nowait, if non-nil, indicates that an asynchronous connection should be |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
500 made, if possible. NOTE: this is currently unimplemented. |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
501 |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
502 For backwards compatibility, if exactly five arguments are given, the fifth |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
503 must be one of nil, 'tcp, or 'udp. Both nil and 'tcp select TCP (Transmission |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
504 Control Protocol) and 'udp selects UDP (User Datagram Protocol). |
| 428 | 505 |
| 442 | 506 Output via `process-send-string' and input via buffer or filter (see |
| 428 | 507 `set-process-filter') are stream-oriented. That means UDP datagrams are |
| 508 not guaranteed to be sent and received in discrete packets. (But small | |
| 509 datagrams around 500 bytes that are not truncated by `process-send-string' | |
| 510 are usually fine.) Note further that UDP protocol does not guard against | |
| 853 | 511 lost packets. |
| 512 | |
| 513 The read/write coding systems used for process I/O on the process are | |
| 514 determined as follows: | |
| 515 | |
| 516 1. `coding-system-for-read', `coding-system-for-write', if non-nil. | |
| 517 (Intended as a temporary overriding mechanism for use by Lisp | |
| 518 code.) | |
| 519 2. The matching value for the service from `network-coding-system-alist', | |
| 520 if any, and if non-nil. The value may be either a single coding | |
| 521 system, used for both read and write; or a cons of read/write; or a | |
| 522 function, called to get one of the other two values. | |
| 523 3. The value of `default-network-coding-system', which should be a cons | |
| 524 of read/write coding systems, if the values are non-nil. | |
| 525 4. The coding system `undecided' for read, and `raw-text' for write. | |
| 526 | |
| 527 Note that the processes of determining the read and write coding systems | |
| 528 proceed essentially independently one from the other, as in `start-process'. | |
| 529 | |
| 530 You can change the coding systems later on using | |
| 531 `set-process-coding-system', `set-process-input-coding-system', or | |
| 532 `set-process-output-coding-system'." | |
|
5814
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
533 (when (and (car parameters) (not (cdr parameters))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
534 (setq parameters (list :protocol (car parameters)))) |
| 428 | 535 (let (cs-r cs-w) |
| 536 (let (ret) | |
| 537 (catch 'found | |
| 538 (let ((alist network-coding-system-alist) | |
| 539 (case-fold-search nil) | |
| 540 pattern) | |
| 541 (while alist | |
| 542 (setq pattern (car (car alist))) | |
| 543 (and | |
| 544 (cond ((numberp pattern) | |
| 545 (and (numberp service) | |
| 546 (eq pattern service))) | |
| 547 ((stringp pattern) | |
| 548 (or (and (stringp service) | |
| 549 (string-match pattern service)) | |
| 550 (and (numberp service) | |
| 551 (string-match pattern | |
| 552 (number-to-string service)))))) | |
| 553 (throw 'found (setq ret (cdr (car alist))))) | |
| 554 (setq alist (cdr alist)) | |
| 555 ))) | |
| 556 (if (functionp ret) | |
| 557 (setq ret (funcall ret 'open-network-stream service))) | |
| 558 (cond ((consp ret) | |
| 559 (setq cs-r (car ret) | |
| 560 cs-w (cdr ret))) | |
| 853 | 561 ((and ret (find-coding-system ret)) |
| 428 | 562 (setq cs-r ret |
| 563 cs-w ret)))) | |
| 564 (let ((coding-system-for-read | |
| 853 | 565 (or coding-system-for-read cs-r |
| 566 (car default-network-coding-system) | |
| 567 'undecided)) | |
| 428 | 568 (coding-system-for-write |
| 853 | 569 (or coding-system-for-write cs-w |
| 570 (cdr default-network-coding-system) | |
|
5814
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
571 'raw-text)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
572 (type (plist-get parameters :type)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
573 (return-list (plist-get parameters :return-list)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
574 (capability-command (plist-get parameters :capability-command))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
575 (if (and (not return-list) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
576 (or (eq type 'plain) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
577 (and (or (null type) (eq type 'network)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
578 (not (and (plist-get parameters :success) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
579 capability-command))))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
580 ;; The simplest case: a plain connection |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
581 (open-network-stream-internal name buffer host service |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
582 (plist-get parameters :protocol)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
583 (let ((work-buffer (or buffer |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
584 (generate-new-buffer " *stream buffer*"))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
585 (fun (cond ((and (eq type 'plain) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
586 (not (plist-get parameters |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
587 :always-query-capabilities))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
588 #'network-stream-open-plain) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
589 ((memq type '(nil network starttls plain)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
590 #'network-stream-open-starttls) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
591 ((memq type '(tls ssl)) #'network-stream-open-tls) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
592 ((eq type 'shell) 'network-stream-open-shell) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
593 (t (error "Invalid connection type" type)))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
594 result) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
595 (unwind-protect |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
596 (setq result |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
597 (funcall fun name work-buffer host service parameters)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
598 (unless buffer |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
599 (and (processp (car result)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
600 (set-process-buffer (car result) nil)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
601 (kill-buffer work-buffer))) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
602 (if return-list |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
603 (list (car result) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
604 :greeting (nth 1 result) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
605 :capabilities (nth 2 result) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
606 :type (nth 3 result) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
607 :error (nth 4 result)) |
|
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5404
diff
changeset
|
608 (car result))))))) |
| 428 | 609 |
| 771 | 610 (defun set-buffer-process-coding-system (decoding encoding) |
| 611 "Set coding systems for the process associated with the current buffer. | |
| 612 DECODING is the coding system to be used to decode input from the process, | |
| 613 ENCODING is the coding system to be used to encode output to the process. | |
| 614 | |
| 853 | 615 For a list of possible values of CODING-SYSTEM, use \\[coding-system-list]." |
| 771 | 616 (interactive |
| 617 "zCoding-system for process input: \nzCoding-system for process output: ") | |
| 618 (let ((proc (get-buffer-process (current-buffer)))) | |
| 619 (if (null proc) | |
| 620 (error "no process") | |
| 621 (get-coding-system decoding) | |
| 622 (get-coding-system encoding) | |
| 623 (set-process-coding-system proc decoding encoding))) | |
| 624 (force-mode-line-update)) | |
| 625 | |
| 440 | 626 ;;; code-process.el ends here |