1 /* Asynchronous subprocess control for SXEmacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995, 2003
3 Free Software Foundation, Inc.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996 Ben Wing.
7 This file is part of SXEmacs
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. */
23 /* This file has been Mule-ized except for `start-process-internal',
24 `open-network-stream-internal' and `open-multicast-group-internal'. */
26 /* This file has been split into process.c and process-unix.c by
27 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not
28 the original author(s) */
32 #if !defined (NO_SUBPROCESSES)
34 /* The entire file is within this conditional */
40 #include "events/events.h"
43 #include "ui/insdel.h"
48 #include "ui/window.h"
50 #include "mule/file-coding.h"
56 #include "syssignal.h" /* Always include before systty.h */
57 #include "ui/TTY/systty.h"
60 #if defined(HAVE_OPENSSL) && defined(OPENSSL_SSL)
65 Lisp_Object Qprocessp, Qprocess_live_p, Qprocess_readable_p;
68 struct process_methods the_process_methods;
70 /* a process object is a network connection when its pid field a cons
71 (name of name of port we are connected to . foreign host name) */
73 /* valid objects to server stream host parameter */
74 Lisp_Object Qip_any, Qlocalhost;
77 /* Valid values of process->status_symbol */
78 Lisp_Object Qrun, Qstop;
79 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */
80 Lisp_Object Qopen, Qclosed;
81 /* Protocol families */
82 Lisp_Object Qtcp, Qudp;
85 Lisp_Object Qmulticast; /* Will be used for occasional warnings */
88 /* t means use pty, nil means use a pipe,
89 maybe other values to come. */
90 Lisp_Object Vprocess_connection_type;
92 /* Read comments to DEFVAR of this */
93 int windowed_process_io;
95 #ifdef PROCESS_IO_BLOCKING
96 /* List of port numbers or port names to set a blocking I/O mode.
97 Nil means set a non-blocking I/O mode [default]. */
98 Lisp_Object network_stream_blocking_port_list;
99 #endif /* PROCESS_IO_BLOCKING */
101 /* Number of events of change of status of a process. */
102 volatile int process_tick;
104 /* Number of events for which the user or sentinel has been notified. */
105 static int update_tick;
107 /* Nonzero means delete a process right away if it exits. */
108 int delete_exited_processes;
110 /* Hash table which maps USIDs as returned by create_stream_pair_cb to
111 process objects. Processes are not GC-protected through this! */
112 struct hash_table *usid_to_process;
113 Lisp_Object Vusid_to_process;
115 /* List of process objects. */
116 Lisp_Object Vprocess_list;
118 extern Lisp_Object Vlisp_EXEC_SUFFIXES;
119 Lisp_Object Vnull_device;
121 static Lisp_Object mark_process(Lisp_Object object)
123 Lisp_Process *process = XPROCESS(object);
124 MAYBE_PROCMETH(mark_process_data, (process));
125 mark_object(process->name);
126 mark_object(process->command);
127 mark_object(process->filter);
128 mark_object(process->sentinel);
129 mark_object(process->buffer);
130 mark_object(process->mark);
131 mark_object(process->pid);
132 mark_object(process->pipe_instream);
133 mark_object(process->pipe_outstream);
135 mark_object(process->coding_instream);
136 mark_object(process->coding_outstream);
138 mark_object(process->process_type_data);
139 return process->status_symbol;
143 print_process(Lisp_Object object, Lisp_Object printcharfun, int escapeflag)
145 Lisp_Process *process = XPROCESS(object);
148 error("printing unreadable object #<process %s>",
149 XSTRING_DATA(process->name));
152 print_internal(process->name, printcharfun, 0);
154 /* int netp = network_connection_p(object); */
155 int netp = ((process->process_type == PROCESS_TYPE_NETWORK) ||
156 (process->process_type == PROCESS_TYPE_MULTICAST) ||
157 (process->process_type == PROCESS_TYPE_SSL) ||
158 (process->process_type == PROCESS_TYPE_NETWORK_SERVER_LISTEN));
159 switch (process->process_type) {
160 case PROCESS_TYPE_NETWORK:
162 GETTEXT("#<network connection "),
165 case PROCESS_TYPE_NETWORK_SERVER_LISTEN:
167 GETTEXT("#<network server accepting connections "),
170 case PROCESS_TYPE_MULTICAST:
172 GETTEXT("#<multicast network connection "),
175 case PROCESS_TYPE_SSL:
177 GETTEXT("#<secure network connection "),
180 case PROCESS_TYPE_PROC:
183 GETTEXT("#<process "),
187 print_internal(process->name, printcharfun, 1);
188 write_c_string((netp ? " " : " pid "), printcharfun);
189 print_internal(process->pid, printcharfun, 1);
190 write_c_string(" state:", printcharfun);
191 print_internal(process->status_symbol, printcharfun, 1);
192 MAYBE_PROCMETH(print_process_data, (process, printcharfun));
193 write_c_string(">", printcharfun);
197 #ifdef HAVE_WINDOW_SYSTEM
198 extern void debug_process_finalization(Lisp_Process * p);
199 #endif /* HAVE_WINDOW_SYSTEM */
201 static void finalize_process(void *header, int for_disksave)
203 /* #### this probably needs to be tied into the tty event loop */
204 /* #### when there is one */
205 Lisp_Process *p = (Lisp_Process *) header;
206 #ifdef HAVE_WINDOW_SYSTEM
208 debug_process_finalization(p);
210 #endif /* HAVE_WINDOW_SYSTEM */
212 if (p->process_data) {
213 MAYBE_PROCMETH(finalize_process_data, (p, for_disksave));
215 xfree(p->process_data);
219 DEFINE_LRECORD_IMPLEMENTATION("process", process,
220 mark_process, print_process, finalize_process,
221 0, 0, 0, Lisp_Process);
223 /************************************************************************/
224 /* basic process accessors */
225 /************************************************************************/
227 /* Under FILE_CODING, this function returns low-level streams, connected
228 directly to the child process, rather than en/decoding FILE_CODING
231 get_process_streams(Lisp_Process * p, Lisp_Object * instr, Lisp_Object * outstr)
234 assert(NILP(p->pipe_instream) || LSTREAMP(p->pipe_instream));
235 assert(NILP(p->pipe_outstream) || LSTREAMP(p->pipe_outstream));
236 *instr = p->pipe_instream;
237 *outstr = p->pipe_outstream;
240 Lisp_Process *get_process_from_usid(USID usid)
244 assert(usid != USID_ERROR && usid != USID_DONTHASH);
246 if (gethash((const void *)usid, usid_to_process, &vval)) {
248 CVOID_TO_LISP(process, vval);
249 return XPROCESS(process);
254 int get_process_selected_p(Lisp_Process * p)
259 void set_process_selected_p(Lisp_Process * p, int selected_p)
261 p->selected = !!selected_p;
264 int connected_via_filedesc_p(Lisp_Process * p)
266 /* In the bad old days of tooltalk this would return non-0 if
267 * there was a tooltalk connection. So that really means that
268 * in 101 times out of 100 this would return 0 because nobody
269 * ever used tooltalk. It is possible that one day this might
270 * need some d-bus love. */
275 int network_connection_p(Lisp_Object process)
277 return CONSP(XPROCESS(process)->pid);
281 DEFUN("processp", Fprocessp, 1, 1, 0, /*
282 Return t if OBJECT is a process.
286 return PROCESSP(object) ? Qt : Qnil;
289 DEFUN("process-live-p", Fprocess_live_p, 1, 1, 0, /*
290 Return t if OBJECT is a process that is alive.
294 return PROCESSP(object) && PROCESS_LIVE_P(XPROCESS(object))
299 /* This is a reasonable definition for this new primitive. Kyle sez:
301 "The patch looks OK to me except for the creation and exporting of the
302 Fprocess_readable_p function. I don't think a new Lisp function
303 should be created until we know something actually needs it. If
304 we later want to give process-readable-p different semantics it
305 may be hard to do it and stay compatible with what we hastily
308 He's right, not yet. Let's discuss the semantics on XEmacs Design
309 before enabling this.
311 DEFUN("process-readable-p", Fprocess_readable_p, 1, 1, 0, /*
312 Return t if OBJECT is a process from which input may be available.
316 return PROCESSP(object) && PROCESS_READABLE_P(XPROCESS(object))
321 DEFUN("process-list", Fprocess_list, 0, 0, 0, /*
322 Return a list of all processes.
326 return Fcopy_sequence(Vprocess_list);
329 DEFUN("get-process", Fget_process, 1, 1, 0, /*
330 Return the process named PROCESS-NAME (a string), or nil if there is none.
331 PROCESS-NAME may also be a process; if so, the value is that process.
335 if (PROCESSP(process_name))
339 /* this only gets called during GC when emacs is going away as a result
340 of a signal or crash. */
341 CHECK_STRING(process_name);
344 LIST_LOOP_2(process, Vprocess_list)
346 (process_name, XPROCESS(process)->name, 0))
352 DEFUN("get-buffer-process", Fget_buffer_process, 1, 1, 0, /*
353 Return the (or, a) process associated with BUFFER.
354 BUFFER may be a buffer or the name of one.
360 buffer = Fget_buffer(buffer);
365 LIST_LOOP_2(process, Vprocess_list)
366 if (EQ(XPROCESS(process)->buffer, buffer))
372 /* This is how commands for the user decode process arguments. It
373 accepts a process, a process name, a buffer, a buffer name, or nil.
374 Buffers denote the first process in the buffer, and nil denotes the
377 static Lisp_Object get_process(Lisp_Object name)
382 /* #### Look more closely into translating process names. */
385 /* This may be called during a GC from process_send_signal() from
386 kill_buffer_processes() if emacs decides to abort(). */
389 else if (STRINGP(name)) {
390 Lisp_Object object = Fget_process(name);
391 if (PROCESSP(object))
394 buffer = Fget_buffer(name);
396 goto have_buffer_object;
398 error("Process %s does not exist", XSTRING_DATA(name));
399 } else if (NILP(name)) {
400 buffer = Fcurrent_buffer();
401 goto have_buffer_object;
402 } else if (BUFFERP(name)) {
407 process = Fget_buffer_process(buffer);
408 if (PROCESSP(process))
411 error("Buffer %s has no process",
412 XSTRING_DATA(XBUFFER(buffer)->name));
414 return get_process(Fsignal(Qwrong_type_argument,
417 ("process or buffer or nil"),
421 DEFUN("process-id", Fprocess_id, 1, 1, 0, /*
422 Return the process id of PROCESS.
423 This is the pid of the Unix process which PROCESS uses or talks to.
424 For a network connection, this value is a cons of
425 (foreign-network-port . foreign-host-name).
430 CHECK_PROCESS(process);
432 pid = XPROCESS(process)->pid;
433 if (network_connection_p(process))
435 return Fcons(Fcar(pid), Fcdr(pid));
440 DEFUN("process-name", Fprocess_name, 1, 1, 0, /*
441 Return the name of PROCESS, as a string.
442 This is the name of the program invoked in PROCESS,
443 possibly modified to make it unique among process names.
447 CHECK_PROCESS(process);
448 return XPROCESS(process)->name;
451 DEFUN("process-command", Fprocess_command, 1, 1, 0, /*
452 Return the command that was executed to start PROCESS.
453 This is a list of strings, the first string being the program executed
454 and the rest of the strings being the arguments given to it.
458 CHECK_PROCESS(process);
459 return XPROCESS(process)->command;
462 /************************************************************************/
463 /* creating a process */
464 /************************************************************************/
466 Lisp_Object make_process_internal(Lisp_Object name)
468 Lisp_Object val, name1;
470 Lisp_Process *p = alloc_lcrecord_type(Lisp_Process, &lrecord_process);
472 /* If name is already in use, modify it until it is unused. */
477 Lisp_Object tem = Fget_process(name1);
480 sz = snprintf(suffix, sizeof(suffix), "<%d>", i);
481 assert(sz>=0 && (size_t)sz<sizeof(suffix));
482 name1 = concat2(name, build_string(suffix));
491 p->mark = Fmake_marker();
493 p->status_symbol = Qrun;
496 p->filter_does_read = 0;
497 p->kill_without_query = 0;
501 p->pipe_instream = Qnil;
502 p->pipe_outstream = Qnil;
504 p->coding_instream = Qnil;
505 p->coding_outstream = Qnil;
507 p->process_type = PROCESS_TYPE_PROC;
508 p->process_type_data = Qnil;
511 MAYBE_PROCMETH(alloc_process_data, (p));
515 Vprocess_list = Fcons(val, Vprocess_list);
519 void init_process_io_handles(Lisp_Process * p, void *in, void *out, int flags)
521 USID usid = event_stream_create_stream_pair(in, out,
526 if (usid == USID_ERROR)
527 report_file_error("Setting up communication with subprocess",
530 if (usid != USID_DONTHASH) {
531 Lisp_Object process = Qnil;
532 XSETPROCESS(process, p);
533 puthash((const void *)usid, LISP_TO_VOID(process),
537 MAYBE_PROCMETH(init_process_io_handles, (p, in, out, flags));
540 p->coding_instream = make_decoding_input_stream
541 (XLSTREAM(p->pipe_instream),
542 Fget_coding_system(Vcoding_system_for_read));
543 Lstream_set_character_mode(XLSTREAM(p->coding_instream));
544 p->coding_outstream = make_encoding_output_stream
545 (XLSTREAM(p->pipe_outstream),
546 Fget_coding_system(Vcoding_system_for_write));
547 /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!####
548 What's going on here? */
549 #endif /* FILE_CODING */
553 create_process(Lisp_Object process, Lisp_Object * argv, int nargv,
554 Lisp_Object program, Lisp_Object cur_dir)
556 Lisp_Process *p = XPROCESS(process);
559 /* *_create_process may change status_symbol, if the process
560 is a kind of "fire-and-forget" (no I/O, unwaitable) */
561 p->status_symbol = Qrun;
564 pid = PROCMETH(create_process, (p, argv, nargv, program, cur_dir));
566 p->pid = make_int(pid);
567 if (PROCESS_READABLE_P(p))
568 event_stream_select_process(p);
571 /* This function is the unwind_protect form for Fstart_process_internal. If
572 PROCESS doesn't have its pid set, then we know someone has signalled
573 an error and the process wasn't started successfully, so we should
574 remove it from the process list. */
575 static void remove_process(Lisp_Object process);
576 static Lisp_Object start_process_unwind(Lisp_Object process)
578 /* Was PROCESS started successfully? */
579 if (EQ(XPROCESS(process)->pid, Qnil))
580 remove_process(process);
584 DEFUN("start-process-internal", Fstart_process_internal, 3, MANY, 0, /*
585 Start a program in a subprocess. Return the process object for it.
586 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
587 NAME is name for process. It is modified if necessary to make it unique.
588 BUFFER is the buffer or (buffer-name) to associate with the process.
589 Process output goes at end of that buffer, unless you specify
590 an output stream or filter function to handle the output.
591 BUFFER may be also nil, meaning that this process is not associated
593 Third arg is program file name. It is searched for as in the shell.
594 Remaining arguments are strings to give program as arguments.
595 If bound, `coding-system-for-read' and `coding-system-for-write' specify
596 the coding-system objects used in input from and output to the process.
598 (int nargs, Lisp_Object * args))
600 /* This function can call lisp */
601 /* !!#### This function has not been Mule-ized */
602 Lisp_Object buffer, name, program, process, current_dir;
605 int speccount = specpdl_depth();
606 struct gcpro gcpro1, gcpro2, gcpro3;
613 /* Protect against various file handlers doing GCs below. */
614 GCPRO3(buffer, program, current_dir);
617 buffer = Fget_buffer_create(buffer);
620 CHECK_STRING(program);
621 for (i = 3; i < nargs; ++i)
622 CHECK_STRING(args[i]);
624 /* Make sure that the child will be able to chdir to the current
625 buffer's current directory, or its unhandled equivalent. We
626 can't just have the child check for an error when it does the
627 chdir, since it's in a vfork.
629 Note: these assignments and calls are like this in order to insure
630 "caller protects args" GC semantics. */
631 current_dir = current_buffer->directory;
632 current_dir = Funhandled_file_name_directory(current_dir);
633 current_dir = expand_and_dir_to_file(current_dir, Qnil);
635 #if 0 /* This loser breaks ange-ftp */
636 /* dmoore - if you re-enable this code, you have to gcprotect
637 current_buffer through the above calls. */
638 if (NILP(Ffile_accessible_directory_p(current_dir)))
639 report_file_error("Setting current directory",
640 list1(current_buffer->directory));
643 /* If program file name is not absolute, search our path for it */
644 if (!IS_DIRECTORY_SEP(XSTRING_BYTE(program, 0))
645 && !(XSTRING_LENGTH(program) > 1
646 && IS_DEVICE_SEP(XSTRING_BYTE(program, 1)))) {
647 struct gcpro ngcpro1;
651 locate_file(Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem,
654 report_file_error("Searching for program",
656 program = Fexpand_file_name(tem, Qnil);
659 /* we still need to canonicalize it and ensure it has the proper
661 struct gcpro ngcpro1;
665 locate_file(list1(build_string("")), program,
666 Vlisp_EXEC_SUFFIXES, &tem, X_OK);
668 report_file_error("Searching for program",
674 if (!NILP(Ffile_directory_p(program)))
676 ("Specified program for new process is a directory",
679 process = make_process_internal(name);
681 XPROCESS(process)->buffer = buffer;
682 XPROCESS(process)->command = Flist(nargs - 2, args + 2);
684 /* Make the process marker point into the process buffer (if any). */
686 Fset_marker(XPROCESS(process)->mark,
687 make_int(BUF_ZV(XBUFFER(buffer))), buffer);
689 /* If an error occurs and we can't start the process, we want to
690 remove it from the process list. This means that each error
691 check in create_process doesn't need to call remove_process
692 itself; it's all taken care of here. */
693 record_unwind_protect(start_process_unwind, process);
695 create_process(process, args + 3, nargs - 3, program, current_dir);
698 return unbind_to(speccount, process);
703 /* #### The network support is fairly synthetical. What we actually
704 need is a single function, which supports all datagram, stream and
705 packet stream connections, arbitrary protocol families should they
706 be supported by the target system, multicast groups, in both data
707 and control rooted/nonrooted flavors, service quality etc whatever
708 is supported by the underlying network.
710 It must accept a property list describing the connection. The current
711 functions must then go to lisp and provide a suitable list for the
712 generalized connection function.
714 All modern UNIX other OSs support BSD sockets, and there are many
715 extensions available (Sockets 2 spec).
717 A todo is define a consistent set of properties abstracting a
718 network connection. -kkm
723 DEFUN("network-process-listener", Fnetwork_process_listener, 1, 1, 0, /*
724 Returns the process that listened and accepted the given
725 network-process. Returns nil if process is closed or was not accepted
726 through a network server stream.
730 PROCESS should be a network-stream process accepted through a network
735 CHECK_PROCESS(process);
736 return MAYBE_LISP_PROCMETH(network_process_listener, (process));
740 /* Listen for a TCP network connection to a given SERVICE. Treated
741 exactly like a normal process when reading and writing. Only
742 differences are in status display and process deletion. A network
743 connection has no PID; you cannot signal it. All you can do is
744 deactivate and close it via delete-process. You must provide a
746 DEFUN("open-network-server-stream-internal", Fopen_network_server_stream_internal, 4, 8, 0, /*
747 Returns a process object to represent the listening connection. When a
748 new connection request arrives, it is automatically accepted. A
749 network-stream process is automatically created for that
750 connection. If needed a new buffer is also created. If given the
751 acceptor function is called. If defined filter and sentinel are set
752 for the new connection process .
754 Input and output work as for subprocesses; `delete-process' closes it.
756 Args are NAME BUFFER HOST SERVICE &optional PROTOCOL ACCEPTOR .
758 NAME is name for process. It is modified if necessary to make it
761 BUFFER is the buffer (or buffer-name) to associate with the process.
762 Listening Process output goes at end of that buffer, unless you
763 specify an output stream or filter function to handle the output. No
764 real process output of listening process is expected. However the
765 name of this buffer will be used as a base for generating a new
766 buffer name for the accepted connections.
767 The BUFFER may be also nil, meaning that this process is not
768 associated with any buffer. In this case a filter should be specified
769 otherwise there will be no way to retrieve the process output.
770 BUFFER may also be 'auto in which case a buffer is automatically
771 created for the accepted connection.
773 Third arg HOST (a string) is the name of the IP to bind to, or its
774 IP address, If nil or ip_any will bind to all addresses on the
775 machine. When HOST is 'localhost listening connection will listen
776 to connections from the local machine only.
777 Fourth arg SERVICE is name of the service desired, or an integer
778 specifying a port number to connect to.
779 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
780 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
781 supported. When omitted, 'tcp is assumed.
782 Sixt argument ACCEPTOR is a function which will be called upon connection
783 acceptance with the accepted connection process as the single argument.
784 Seventh argument FILTER is a function which will be set as filter for
785 the accepted connections automatically. See `set-process-filter' for
787 Eight argument SENTINEL is a function which will be set as sentinel
788 the accepted connections automatically. see `set-process-sentinel'
791 Output via `process-send-string' and input via buffer or filter (see
792 `set-process-filter') are stream-oriented. That means UDP datagrams are
793 not guaranteed to be sent and received in discrete packets. (But small
794 datagrams around 500 bytes that are not truncated by `process-send-string'
795 are usually fine.) Note further that UDP protocol does not guard against
798 In the ACCEPTOR you can use `network-process-listener' to get the original
799 listen process, and `process-buffer' to retrieve the associated
800 buffers. If sentinels and/or filters are set in the ACCEPTOR they
801 will override the FILTER and SENTINEL args to this function.
803 (name, buffer, host, service, protocol, acceptor, filter, sentinel))
806 /* !!#### This function has not been Mule-ized */
807 /* This function can GC */
808 Lisp_Object process = Qnil;
809 Lisp_Object bufname = Qnil;
810 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7, gcpro8, ngcpro1, ngcpro2;
813 GCPRO8(name, buffer, host, service, protocol, acceptor, filter, sentinel);
819 CHECK_SYMBOL(protocol);
824 /* Since this code is inside HAVE_SOCKETS, existence of
825 open_network_stream is mandatory */
826 PROCMETH(open_network_server_stream, (name, host, service, protocol,
829 NGCPRO2(process,bufname);
830 if (!NILP(buffer) && !SYMBOLP(buffer)) {
831 buffer = Fget_buffer_create(buffer);
832 bufname = Fbuffer_name(buffer);
833 } else if (SYMBOLP(buffer) && !NILP(buffer) && ! EQ(Qauto,buffer) ) {
834 error("unknown buffer symbol %s",
835 string_data(symbol_name(XSYMBOL(buffer))));
839 Lisp_Object args[] = {
840 build_string("<listen proc:%S host:%S service:%S protocol:%S>"),
841 name, host, service, protocol
843 bufname = Fformat( 5, args );
846 process = make_process_internal(name);
848 XPROCESS(process)->pid = Fcons(service, host);
849 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK_SERVER_LISTEN;
850 XPROCESS(process)->buffer = buffer;
852 /* Just opened a scope because I like to keep definitions close to
853 usage specially temporary ones... */
854 Lisp_Object args[] = { acceptor, filter, sentinel, bufname };
855 XPROCESS(process)->process_type_data = Flist(4,args);
857 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
858 STREAM_NETWORK_SERVER_CONNECTION);
860 event_stream_select_process(XPROCESS(process));
868 /* open a TCP network connection to a given HOST/SERVICE. Treated
869 exactly like a normal process when reading and writing. Only
870 differences are in status display and process deletion. A network
871 connection has no PID; you cannot signal it. All you can do is
872 deactivate and close it via delete-process */
874 DEFUN("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /*
875 Open a TCP connection for a service to a host.
876 Return a process object to represent the connection.
877 Input and output work as for subprocesses; `delete-process' closes it.
879 NAME is name for process. It is modified if necessary to make it unique.
880 BUFFER is the buffer (or buffer-name) to associate with the process.
881 Process output goes at end of that buffer, unless you specify
882 an output stream or filter function to handle the output.
883 BUFFER may also be nil, meaning that this process is not associated
885 Third arg HOST (a string) is the name of the host to connect to,
887 Fourth arg SERVICE is the name of the service desired (a string),
888 or an integer specifying a port number to connect to.
889 Optional fifth arg PROTOCOL is a network protocol. Currently only 'tcp
890 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
891 supported. When omitted, 'tcp is assumed.
893 Output via `process-send-string' and input via buffer or filter (see
894 `set-process-filter') are stream-oriented. That means UDP datagrams are
895 not guaranteed to be sent and received in discrete packets. (But small
896 datagrams around 500 bytes that are not truncated by `process-send-string'
897 are usually fine.) Note further that the UDP protocol does not guard
898 against lost packets.
900 (name, buffer, host, service, protocol))
902 /* !!#### This function has not been Mule-ized */
903 /* This function can GC */
904 Lisp_Object process = Qnil;
905 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
908 GCPRO5(name, buffer, host, service, protocol);
914 CHECK_SYMBOL(protocol);
916 /* Since this code is inside HAVE_SOCKETS, existence of
917 open_network_stream is mandatory */
918 PROCMETH(open_network_stream, (name, host, service, protocol,
922 buffer = Fget_buffer_create(buffer);
923 process = make_process_internal(name);
926 XPROCESS(process)->pid = Fcons(service, host);
927 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
928 XPROCESS(process)->buffer = buffer;
929 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
930 STREAM_NETWORK_CONNECTION);
932 event_stream_select_process(XPROCESS(process));
939 DEFUN("connect-file-descriptor", Fconnect_file_descriptor, 4, 4, 0, /*
940 Connect to an existing file descriptor.
941 Return a subprocess-object to represent the connection.
942 Input and output work as for subprocesses; `delete-process' closes it.
943 Args are NAME BUFFER INFD OUTFD.
944 NAME is name for process. It is modified if necessary to make it unique.
945 BUFFER is the buffer (or buffer-name) to associate with the process.
946 Process output goes at end of that buffer, unless you specify
947 an output stream or filter function to handle the output.
948 BUFFER may also be nil, meaning that this process is not associated
950 INFD and OUTFD specify the file descriptors to use for input and
951 output, respectively.
953 (name, buffer, infd, outfd))
955 return connect_to_file_descriptor(name, buffer, infd, outfd);
958 #ifdef HAVE_MULTICAST
960 DEFUN("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
961 Open a multicast connection on the specified dest/port/ttl.
962 Return a process object to represent the connection.
963 Input and output work as for subprocesses; `delete-process' closes it.
965 NAME is name for process. It is modified if necessary to make it unique.
966 BUFFER is the buffer (or buffer-name) to associate with the process.
967 Process output goes at end of that buffer, unless you specify
968 an output stream or filter function to handle the output.
969 BUFFER may also be nil, meaning that this process is not associated
971 Third, fourth and fifth args are the multicast destination group, port and ttl.
972 dest must be an internet address between 224.0.0.0 and 239.255.255.255
973 port is a communication port like in traditional unicast
974 ttl is the time-to-live (15 for site, 63 for region and 127 for world)
976 (name, buffer, dest, port, ttl))
978 /* !!#### This function has not been Mule-ized */
979 /* This function can GC */
980 Lisp_Object process = Qnil;
986 /* Since this code is inside HAVE_MULTICAST, existence of
987 open_network_stream is mandatory */
988 PROCMETH(open_multicast_group, (name, dest, port, ttl, &inch, &outch));
991 buffer = Fget_buffer_create(buffer);
993 process = make_process_internal(name);
996 XPROCESS(process)->pid = Fcons(port, dest);
997 XPROCESS(process)->process_type = PROCESS_TYPE_MULTICAST;
998 XPROCESS(process)->buffer = buffer;
999 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
1000 STREAM_NETWORK_CONNECTION);
1002 event_stream_select_process(XPROCESS(process));
1007 #endif /* HAVE_MULTICAST */
1009 #endif /* HAVE_SOCKETS */
1011 Lisp_Object canonicalize_host_name(Lisp_Object host)
1013 return PROCMETH_OR_GIVEN(canonicalize_host_name, (host), host);
1016 DEFUN("set-process-window-size", Fset_process_window_size, 3, 3, 0, /*
1017 Tell PROCESS that it has logical window size HEIGHT and WIDTH.
1019 (process, height, width))
1021 CHECK_PROCESS(process);
1022 CHECK_NATNUM(height);
1023 CHECK_NATNUM(width);
1025 MAYBE_INT_PROCMETH(set_window_size,
1026 (XPROCESS(process), XINT(height),
1027 XINT(width))) <= 0 ? Qnil : Qt;
1030 /************************************************************************/
1032 /************************************************************************/
1034 /* Read pending output from the process channel,
1035 starting with our buffered-ahead character if we have one.
1036 Yield number of characters read.
1038 This function reads at most 1024 bytes.
1039 If you want to read all available subprocess output,
1040 you must call it repeatedly until it returns zero. */
1042 Charcount read_process_output(Lisp_Object process)
1044 /* This function can GC */
1045 Bytecount nbytes, nchars;
1046 Bufbyte chars[1024];
1047 Lisp_Object outstream;
1048 Lisp_Process *p = XPROCESS(process);
1050 /* If there is a lot of output from the subprocess, the loop in
1051 execute_internal_event() might call read_process_output() more
1052 than once. If the filter that was executed from one of these
1053 calls set the filter to t, we have to stop now. Return -1 rather
1054 than 0 so execute_internal_event() doesn't close the process.
1055 Really, the loop in execute_internal_event() should check itself
1056 for a process-filter change, like in status_notify(); but the
1057 struct Lisp_Process is not exported outside of this file. */
1058 if (!PROCESS_READABLE_P(p))
1059 return -1; /* already closed */
1061 if (!NILP(p->filter) && (p->filter_does_read)) {
1062 Lisp_Object filter_result;
1064 /* Some weird FSFmacs crap here with
1065 Vdeactivate_mark and current_buffer->keymap */
1066 running_asynch_code = 1;
1067 filter_result = call2_trapping_errors("Error in process filter",
1068 p->filter, process, Qnil);
1069 running_asynch_code = 0;
1070 restore_match_data();
1071 CHECK_INT(filter_result);
1072 return XINT(filter_result);
1075 switch (p->process_type) {
1076 case PROCESS_TYPE_NETWORK_SERVER_LISTEN:
1077 /* We must have add a connect... We should accept and call
1079 PROCMETH(network_server_accept, (wrap_object(p)));
1082 case PROCESS_TYPE_PROC:
1083 case PROCESS_TYPE_NETWORK:
1084 case PROCESS_TYPE_MULTICAST:
1085 case PROCESS_TYPE_SSL:
1087 nbytes = Lstream_read(XLSTREAM(DATA_INSTREAM(p)),
1088 chars, sizeof(chars));
1095 nchars = bytecount_to_charcount(chars, nbytes);
1096 outstream = p->filter;
1097 if (!NILP(outstream)) {
1098 /* We used to bind inhibit-quit to t here, but
1099 call2_trapping_errors() does that for us. */
1100 running_asynch_code = 1;
1101 call2_trapping_errors("Error in process filter",
1102 outstream, process, make_string(chars,
1104 running_asynch_code = 0;
1105 restore_match_data();
1109 /* If no filter, write into buffer if it isn't dead. */
1110 if (!NILP(p->buffer) && BUFFER_LIVE_P(XBUFFER(p->buffer))) {
1111 Lisp_Object old_read_only = Qnil;
1115 int old_zmacs_region_stays = zmacs_region_stays;
1116 struct gcpro gcpro1, gcpro2;
1117 struct buffer *buf = XBUFFER(p->buffer);
1119 GCPRO2(process, old_read_only);
1121 old_point = BUF_PT(buf);
1122 old_begv = BUF_BEGV(buf);
1123 old_zv = BUF_ZV(buf);
1124 old_read_only = buf->read_only;
1125 buf->read_only = Qnil;
1127 /* Insert new output into buffer
1128 at the current end-of-output marker,
1129 thus preserving logical ordering of input and output. */
1130 if (XMARKER(p->mark)->buffer)
1132 bufpos_clip_to_bounds(old_begv,
1137 BUF_SET_PT(buf, old_zv);
1139 /* If the output marker is outside of the visible region, save
1140 the restriction and widen. */
1141 if (!(BUF_BEGV(buf) <= BUF_PT(buf) &&
1142 BUF_PT(buf) <= BUF_ZV(buf)))
1145 /* Make sure opoint floats ahead of any new text, just as point
1147 if (BUF_PT(buf) <= old_point)
1148 old_point += nchars;
1150 /* Insert after old_begv, but before old_zv. */
1151 if (BUF_PT(buf) < old_begv)
1153 if (BUF_PT(buf) <= old_zv)
1157 /* This screws up initial display of the window. jla */
1159 /* Insert before markers in case we are inserting where
1160 the buffer's mark is, and the user's next command is Meta-y. */
1161 buffer_insert_raw_string_1(buf, -1, chars,
1162 nbytes, INSDEL_BEFORE_MARKERS);
1164 buffer_insert_raw_string(buf, chars, nbytes);
1167 Fset_marker(p->mark, make_int(BUF_PT(buf)), p->buffer);
1169 MARK_MODELINE_CHANGED;
1171 /* If the restriction isn't what it should be, set it. */
1172 if (old_begv != BUF_BEGV(buf) || old_zv != BUF_ZV(buf)) {
1174 old_begv = bufpos_clip_to_bounds(BUF_BEG(buf),