(U-000200B0): Add `<-denotational' for BUCS+864E.
[chise/xemacs-chise.git.1] / src / process-unix.c
1 /* Asynchronous subprocess implementation for UNIX
2    Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
3    Free Software Foundation, Inc.
4    Copyright (C) 1995 Sun Microsystems, Inc.
5    Copyright (C) 1995, 1996 Ben Wing.
6
7 This file is part of XEmacs.
8
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
12 later version.
13
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
17 for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING.  If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA.  */
23
24 /* This file has been Mule-ized except for `start-process-internal',
25    `open-network-stream-internal' and `open-multicast-group-internal'. */
26
27 /* This file has been split into process.c and process-unix.c by
28    Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not
29    the original author(s) */
30
31 /* The IPv6 support is derived from the code for GNU Emacs-20.3
32    written by Wolfgang S. Rupprecht */
33
34 #include <config.h>
35
36 #if !defined (NO_SUBPROCESSES)
37
38 /* The entire file is within this conditional */
39
40 #include "lisp.h"
41
42 #include "buffer.h"
43 #include "events.h"
44 #include "frame.h"
45 #include "hash.h"
46 #include "lstream.h"
47 #include "opaque.h"
48 #include "process.h"
49 #include "procimpl.h"
50 #include "sysdep.h"
51 #include "window.h"
52 #ifdef FILE_CODING
53 #include "file-coding.h"
54 #endif
55
56 #include <setjmp.h>
57 #include "sysfile.h"
58 #include "sysproc.h"
59 #include "systime.h"
60 #include "syssignal.h" /* Always include before systty.h */
61 #include "systty.h"
62 #include "syswait.h"
63
64 #ifdef HPUX
65 #include <grp.h>                /* See grantpt fixups for HPUX below. */
66 #endif
67
68 /*
69  * Implementation-specific data. Pointed to by Lisp_Process->process_data
70  */
71
72 struct unix_process_data
73 {
74   /* Non-0 if this is really a ToolTalk channel. */
75   int connected_via_filedesc_p;
76   /* Descriptor by which we read from this process.  -1 for dead process */
77   int infd;
78   /* Descriptor for the tty which this process is using.
79      -1 if we didn't record it (on some systems, there's no need).  */
80   int subtty;
81   /* Name of subprocess terminal. */
82   Lisp_Object tty_name;
83   /* Non-false if communicating through a pty.  */
84   char pty_flag;
85 };
86
87 #define UNIX_DATA(p) ((struct unix_process_data*)((p)->process_data))
88
89
90 \f
91 /**********************************************************************/
92 /*                    Static helper routines                          */
93 /**********************************************************************/
94
95 static SIGTYPE
96 close_safely_handler (int signo)
97 {
98   EMACS_REESTABLISH_SIGNAL (signo, close_safely_handler);
99   SIGRETURN;
100 }
101
102 static void
103 close_safely (int fd)
104 {
105   stop_interrupts ();
106   signal (SIGALRM, close_safely_handler);
107   alarm (1);
108   close (fd);
109   alarm (0);
110   start_interrupts ();
111 }
112
113 static void
114 close_descriptor_pair (int in, int out)
115 {
116   if (in >= 0)
117     close (in);
118   if (out != in && out >= 0)
119     close (out);
120 }
121
122 /* Close all descriptors currently in use for communication
123    with subprocess.  This is used in a newly-forked subprocess
124    to get rid of irrelevant descriptors.  */
125
126 static int
127 close_process_descs_mapfun (const void* key, void* contents, void* arg)
128 {
129   Lisp_Object proc;
130   CVOID_TO_LISP (proc, contents);
131   event_stream_delete_stream_pair (XPROCESS(proc)->pipe_instream,
132                                    XPROCESS(proc)->pipe_outstream);
133   return 0;
134 }
135
136 /* #### This function is currently called from child_setup
137    in callproc.c. It should become static though - kkm */
138 void
139 close_process_descs (void)
140 {
141   maphash (close_process_descs_mapfun, usid_to_process, 0);
142 }
143
144 /* connect to an existing file descriptor.  This is very similar to
145    open-network-stream except that it assumes that the connection has
146    already been initialized.  It is currently used for ToolTalk
147    communication. */
148
149 /* This function used to be visible on the Lisp level, but there is no
150    real point in doing that.  Here is the doc string:
151
152   "Connect to an existing file descriptor.
153 Return a subprocess-object to represent the connection.
154 Input and output work as for subprocesses; `delete-process' closes it.
155 Args are NAME BUFFER INFD OUTFD.
156 NAME is name for process.  It is modified if necessary to make it unique.
157 BUFFER is the buffer (or buffer-name) to associate with the process.
158  Process output goes at end of that buffer, unless you specify
159  an output stream or filter function to handle the output.
160  BUFFER may also be nil, meaning that this process is not associated
161  with any buffer.
162 INFD and OUTFD specify the file descriptors to use for input and
163  output, respectively."
164 */
165
166 Lisp_Object
167 connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer,
168                             Lisp_Object infd, Lisp_Object outfd)
169 {
170   /* This function can GC */
171   Lisp_Object proc;
172   int inch;
173
174   CHECK_STRING (name);
175   CHECK_INT (infd);
176   CHECK_INT (outfd);
177
178   inch = XINT (infd);
179   if (get_process_from_usid (FD_TO_USID (inch)))
180     invalid_operation ("There is already a process connected to fd", infd);
181   if (!NILP (buffer))
182     buffer = Fget_buffer_create (buffer);
183   proc = make_process_internal (name);
184
185   XPROCESS (proc)->pid = Fcons (infd, name);
186   XPROCESS (proc)->buffer = buffer;
187   init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)XINT (outfd),
188                            0);
189   UNIX_DATA (XPROCESS (proc))->connected_via_filedesc_p = 1;
190
191   event_stream_select_process (XPROCESS (proc));
192
193   return proc;
194 }
195
196 #ifdef HAVE_PTYS
197 static int allocate_pty_the_old_fashioned_way (void);
198
199 /* The file name of the (slave) pty opened by allocate_pty().  */
200 #ifndef MAX_PTYNAME_LEN
201 #define MAX_PTYNAME_LEN 64
202 #endif
203 static char pty_name[MAX_PTYNAME_LEN];
204
205 /* Open an available pty, returning a file descriptor.
206    Return -1 on failure.
207    The file name of the terminal corresponding to the pty
208    is left in the variable `pty_name'.  */
209
210 static int
211 allocate_pty (void)
212 {
213   /* Unix98 standardized grantpt, unlockpt, and ptsname, but not the
214      functions required to open a master pty in the first place :-(
215
216      Modern Unix systems all seems to have convenience methods to open
217      a master pty fd in one function call, but there is little
218      agreement on how to do it.
219
220      allocate_pty() tries all the different known easy ways of opening
221      a pty.  In case of failure, we resort to the old BSD-style pty
222      grovelling code in allocate_pty_the_old_fashioned_way(). */
223 #ifndef FORCE_ALLOCATE_PTY_THE_OLD_FASHIONED_WAY
224   int master_fd = -1;
225   const char *slave_name = NULL;
226   const char *clone = NULL;
227   static const char * const clones[] = /* Different pty master clone devices */
228     {
229       "/dev/ptmx",      /* Various systems */
230       "/dev/ptm/clone", /* HPUX */
231       "/dev/ptc",       /* AIX */
232       "/dev/ptmx_bsd"   /* Tru64 */
233     };
234
235 #ifdef HAVE_GETPT /* glibc */
236   master_fd = getpt ();
237   if (master_fd >= 0)
238     goto have_master;
239 #endif /* HAVE_GETPT */
240
241
242 #if defined(HAVE_OPENPTY) /* BSD, Tru64, glibc */
243   {
244     int slave_fd = -1;
245     int rc;
246     EMACS_BLOCK_SIGNAL (SIGCHLD);
247     rc = openpty (&master_fd, &slave_fd, NULL, NULL, NULL);
248     EMACS_UNBLOCK_SIGNAL (SIGCHLD);
249     if (rc == 0)
250       {
251         slave_name = ttyname (slave_fd);
252         close (slave_fd);
253         goto have_slave_name;
254       }
255     else
256       {
257         if (master_fd >= 0)
258           close (master_fd);
259         if (slave_fd >= 0)
260           close (slave_fd);
261       }
262   }
263 #endif /* HAVE_OPENPTY */
264
265 #if defined(HAVE__GETPTY) && defined (O_NDELAY) /* SGI */
266   master_fd = -1;
267   EMACS_BLOCK_SIGNAL (SIGCHLD);
268   slave_name = _getpty (&master_fd, O_RDWR | O_NDELAY, 0600, 0);
269   EMACS_UNBLOCK_SIGNAL (SIGCHLD);
270   if (master_fd >= 0 && slave_name != NULL)
271     goto have_slave_name;
272 #endif /* HAVE__GETPTY */
273
274   /* Master clone devices are available on most systems */
275   {
276     int i;
277     for (i = 0; i < countof (clones); i++)
278       {
279         clone = clones[i];
280         master_fd = open (clone, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
281         if (master_fd >= 0)
282           goto have_master;
283       }
284     clone = NULL;
285   }
286
287   goto lose;
288
289  have_master:
290
291 #if defined (HAVE_PTSNAME)
292   slave_name = ptsname (master_fd);
293   if (slave_name)
294     goto have_slave_name;
295 #endif
296
297   /* AIX docs say to use ttyname, not ptsname, to get slave_name */
298   if (clone
299       && !strcmp (clone, "/dev/ptc")
300       && (slave_name = ttyname (master_fd)) != NULL)
301     goto have_slave_name;
302
303   goto lose;
304
305  have_slave_name:
306   strncpy (pty_name, slave_name, sizeof (pty_name));
307   pty_name[sizeof (pty_name) - 1] = '\0';
308   setup_pty (master_fd);
309
310   /* We jump through some hoops to frob the pty.
311      It's not obvious that checking the return code here is useful. */
312
313   /* "The grantpt() function will fail if it is unable to successfully
314       invoke the setuid root program.  It may also fail if the
315       application has installed a signal handler to catch SIGCHLD
316       signals." */
317 #if defined (HAVE_GRANTPT) || defined (HAVE_UNLOCKPT)
318   EMACS_BLOCK_SIGNAL (SIGCHLD);
319
320 #if defined (HAVE_GRANTPT)
321   grantpt (master_fd);
322 #ifdef HPUX
323   /* grantpt() behavior on some versions of HP-UX differs from what's
324      specified in the man page: the group of the slave PTY is set to
325      the user's primary group, and we fix that. */
326   {
327     struct group *tty_group = getgrnam ("tty");
328     if (tty_group != NULL)
329       chown (pty_name, (uid_t) -1, tty_group->gr_gid);
330   }
331 #endif /* HPUX has broken grantpt() */
332 #endif /* HAVE_GRANTPT */
333
334 #if defined (HAVE_UNLOCKPT)
335   unlockpt (master_fd);
336 #endif
337
338   EMACS_UNBLOCK_SIGNAL (SIGCHLD);
339 #endif /* HAVE_GRANTPT || HAVE_UNLOCKPT */
340
341   return master_fd;
342
343  lose:
344   if (master_fd >= 0)
345     close (master_fd);
346 #endif /* ndef FORCE_ALLOCATE_PTY_THE_OLD_FASHIONED_WAY */
347   return allocate_pty_the_old_fashioned_way ();
348 }
349
350 /* This function tries to allocate a pty by iterating through file
351    pairs with names like /dev/ptyp1 and /dev/ttyp1. */
352 static int
353 allocate_pty_the_old_fashioned_way (void)
354 {
355   struct stat stb;
356
357   /* Some systems name their pseudoterminals so that there are gaps in
358      the usual sequence - for example, on HP9000/S700 systems, there
359      are no pseudoterminals with names ending in 'f'.  So we wait for
360      three failures in a row before deciding that we've reached the
361      end of the ptys.  */
362   int failed_count = 0;
363   int fd;
364   int i;
365   int c;
366
367 #ifdef PTY_ITERATION
368   PTY_ITERATION
369 #else
370 # ifndef FIRST_PTY_LETTER
371 # define FIRST_PTY_LETTER 'p'
372 # endif
373   for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
374     for (i = 0; i < 16; i++)
375 #endif /* PTY_ITERATION */
376
377       {
378 #ifdef PTY_NAME_SPRINTF
379         PTY_NAME_SPRINTF
380 #else
381         sprintf (pty_name, "/dev/pty%c%x", c, i);
382 #endif /* no PTY_NAME_SPRINTF */
383
384         if (xemacs_stat (pty_name, &stb) < 0)
385           {
386             if (++failed_count >= 3)
387               return -1;
388           }
389         else
390           failed_count = 0;
391         fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
392
393         if (fd >= 0)
394           {
395 #ifdef PTY_TTY_NAME_SPRINTF
396             PTY_TTY_NAME_SPRINTF
397 #else
398             sprintf (pty_name, "/dev/tty%c%x", c, i);
399 #endif /* no PTY_TTY_NAME_SPRINTF */
400             if (access (pty_name, R_OK | W_OK) == 0)
401               {
402                 setup_pty (fd);
403                 return fd;
404               }
405             close (fd);
406           }
407       } /* iteration */
408   return -1;
409 }
410 #endif /* HAVE_PTYS */
411
412 static int
413 create_bidirectional_pipe (int *inchannel, int *outchannel,
414                            volatile int *forkin, volatile int *forkout)
415 {
416   int sv[2];
417
418 #ifdef SKTPAIR
419   if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
420     return -1;
421   *outchannel = *inchannel = sv[0];
422   *forkout = *forkin = sv[1];
423 #else /* not SKTPAIR */
424   int temp;
425   temp = pipe (sv);
426   if (temp < 0) return -1;
427   *inchannel = sv[0];
428   *forkout = sv[1];
429   temp = pipe (sv);
430   if (temp < 0) return -1;
431   *outchannel = sv[1];
432   *forkin = sv[0];
433 #endif /* not SKTPAIR */
434   return 0;
435 }
436
437
438 #ifdef HAVE_SOCKETS
439
440 #if !(defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO))
441 static int
442 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
443                       Error_behavior errb)
444 {
445   struct hostent *host_info_ptr = NULL;
446 #ifdef TRY_AGAIN
447   int count = 0;
448 #endif
449
450   xzero (*address);
451
452   while (1)
453     {
454 #ifdef TRY_AGAIN
455       if (count++ > 10) break;
456 #ifndef BROKEN_CYGWIN
457       h_errno = 0;
458 #endif
459 #endif
460       /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */
461       slow_down_interrupts ();
462       host_info_ptr = gethostbyname ((char *) XSTRING_DATA (host));
463       speed_up_interrupts ();
464 #ifdef TRY_AGAIN
465       if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
466 #endif
467         break;
468       Fsleep_for (make_int (1));
469     }
470   if (host_info_ptr)
471     {
472       address->sin_family = host_info_ptr->h_addrtype;
473       memcpy (&address->sin_addr, host_info_ptr->h_addr, host_info_ptr->h_length);
474     }
475   else
476     {
477       IN_ADDR numeric_addr;
478       /* Attempt to interpret host as numeric inet address */
479       numeric_addr = inet_addr ((char *) XSTRING_DATA (host));
480       if (NUMERIC_ADDR_ERROR)
481         {
482           maybe_error (Qprocess, errb,
483                        "Unknown host \"%s\"", XSTRING_DATA (host));
484           return 0;
485         }
486
487       /* There was some broken code here that called strlen() here
488          on (char *) &numeric_addr and even sometimes accessed
489          uninitialized data. */
490       address->sin_family = AF_INET;
491       * (IN_ADDR *) &address->sin_addr = numeric_addr;
492     }
493
494   return 1;
495 }
496 #endif /*  !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */
497
498 static void
499 set_socket_nonblocking_maybe (int fd, int port, const char* proto)
500 {
501 #ifdef PROCESS_IO_BLOCKING
502   Lisp_Object tail;
503
504   for (tail = network_stream_blocking_port_list; CONSP (tail); tail = XCDR (tail))
505     {
506       Lisp_Object tail_port = XCAR (tail);
507
508       if (STRINGP (tail_port))
509         {
510           struct servent *svc_info;
511           CHECK_STRING (tail_port);
512           svc_info = getservbyname ((char *) XSTRING_DATA (tail_port), proto);
513           if ((svc_info != 0) && (svc_info->s_port == port))
514             break;
515           else
516             continue;
517         }
518       else if (INTP (tail_port) && (htons ((unsigned short) XINT (tail_port)) == port))
519         break;
520     }
521
522   if (!CONSP (tail))
523     {
524       set_descriptor_non_blocking (fd);
525     }
526 #else
527   set_descriptor_non_blocking (fd);
528 #endif  /* PROCESS_IO_BLOCKING */
529 }
530
531 #endif /* HAVE_SOCKETS */
532
533 /* Compute the Lisp form of the process status from
534    the numeric status that was returned by `wait'.  */
535
536 static void
537 update_status_from_wait_code (Lisp_Process *p, int *w_fmh)
538 {
539   /* C compiler lossage when attempting to pass w directly */
540   int w = *w_fmh;
541
542   if (WIFSTOPPED (w))
543     {
544       p->status_symbol = Qstop;
545       p->exit_code = WSTOPSIG (w);
546       p->core_dumped = 0;
547     }
548   else if (WIFEXITED (w))
549     {
550       p->status_symbol = Qexit;
551       p->exit_code = WEXITSTATUS (w);
552       p->core_dumped = 0;
553     }
554   else if (WIFSIGNALED (w))
555     {
556       p->status_symbol = Qsignal;
557       p->exit_code = WTERMSIG (w);
558       p->core_dumped = WCOREDUMP (w);
559     }
560   else
561     {
562       p->status_symbol = Qrun;
563       p->exit_code = 0;
564     }
565 }
566
567 #ifdef SIGCHLD
568
569 #define MAX_EXITED_PROCESSES 1000
570 static volatile pid_t exited_processes[MAX_EXITED_PROCESSES];
571 static volatile int exited_processes_status[MAX_EXITED_PROCESSES];
572 static volatile int exited_processes_index;
573
574 static volatile int sigchld_happened;
575
576 /* On receipt of a signal that a child status has changed,
577  loop asking about children with changed statuses until
578  the system says there are no more.  All we do is record
579  the processes and wait status.
580
581  This function could be called from within the SIGCHLD
582  handler, so it must be completely reentrant.  When
583  not called from a SIGCHLD handler, BLOCK_SIGCHLD should
584  be non-zero so that SIGCHLD is blocked while this
585  function is running. (This is necessary so avoid
586  race conditions with the SIGCHLD_HAPPENED flag). */
587
588 static void
589 record_exited_processes (int block_sigchld)
590 {
591   if (!sigchld_happened)
592     {
593       return;
594     }
595
596 #ifdef EMACS_BLOCK_SIGNAL
597   if (block_sigchld)
598     EMACS_BLOCK_SIGNAL (SIGCHLD);
599 #endif
600
601   while (sigchld_happened)
602     {
603       int pid;
604       int w;
605
606       /* Keep trying to get a status until we get a definitive result.  */
607       do
608         {
609           errno = 0;
610 #ifdef WNOHANG
611 #  ifndef WUNTRACED
612 #    define WUNTRACED 0
613 #  endif /* not WUNTRACED */
614 #  ifdef HAVE_WAITPID
615           pid = waitpid ((pid_t) -1, &w, WNOHANG | WUNTRACED);
616 #  else
617           pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
618 #  endif
619 #else /* not WNOHANG */
620           pid = wait (&w);
621 #endif /* not WNOHANG */
622         }
623       while (pid <= 0 && errno == EINTR);
624
625       if (pid <= 0)
626         break;
627
628       if (exited_processes_index < MAX_EXITED_PROCESSES)
629         {
630           exited_processes[exited_processes_index] = pid;
631           exited_processes_status[exited_processes_index] = w;
632           exited_processes_index++;
633         }
634
635       /* On systems with WNOHANG, we just ignore the number
636          of times that SIGCHLD was signalled, and keep looping
637          until there are no more processes to wait on.  If we
638          don't have WNOHANG, we have to rely on the count in
639          SIGCHLD_HAPPENED. */
640 #ifndef WNOHANG
641       sigchld_happened--;
642 #endif /* not WNOHANG */
643     }
644
645   sigchld_happened = 0;
646
647   if (block_sigchld)
648     EMACS_UNBLOCK_SIGNAL (SIGCHLD);
649 }
650
651 /* For any processes that have changed status and are recorded
652    and such, update the corresponding Lisp_Process.
653    We separate this from record_exited_processes() so that
654    we never have to call this function from within a signal
655    handler.  We block SIGCHLD in case record_exited_processes()
656    is called from a signal handler. */
657
658 /** USG WARNING:  Although it is not obvious from the documentation
659  in signal(2), on a USG system the SIGCLD handler MUST NOT call
660  signal() before executing at least one wait(), otherwise the handler
661  will be called again, resulting in an infinite loop.  The relevant
662  portion of the documentation reads "SIGCLD signals will be queued
663  and the signal-catching function will be continually reentered until
664  the queue is empty".  Invoking signal() causes the kernel to reexamine
665  the SIGCLD queue.   Fred Fish, UniSoft Systems Inc.
666
667  (Note that now this only applies in SYS V Release 2 and before.
668  On SYS V Release 3, we use sigset() to set the signal handler for
669  the first time, and so we don't have to reestablish the signal handler
670  in the handler below.  On SYS V Release 4, we don't get this weirdo
671  behavior when we use sigaction(), which we do use.) */
672
673 static SIGTYPE
674 sigchld_handler (int signo)
675 {
676 #ifdef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR
677   int old_errno = errno;
678
679   sigchld_happened++;
680   record_exited_processes (0);
681   errno = old_errno;
682 #else
683   sigchld_happened++;
684 #endif
685 #ifdef HAVE_UNIXOID_EVENT_LOOP
686   signal_fake_event ();
687 #endif
688   /* WARNING - must come after wait3() for USG systems */
689   EMACS_REESTABLISH_SIGNAL (signo, sigchld_handler);
690   SIGRETURN;
691 }
692
693 #endif /* SIGCHLD */
694
695 #ifdef SIGNALS_VIA_CHARACTERS
696 /* Get signal character to send to process if SIGNALS_VIA_CHARACTERS */
697
698 static int
699 process_signal_char (int tty_fd, int signo)
700 {
701   /* If it's not a tty, pray that these default values work */
702   if (! isatty (tty_fd)) {
703 #define CNTL(ch) (037 & (ch))
704     switch (signo)
705       {
706       case SIGINT:  return CNTL ('C');
707       case SIGQUIT: return CNTL ('\\');
708 #ifdef SIGTSTP
709       case SIGTSTP: return CNTL ('Z');
710 #endif
711       }
712   }
713
714 #ifdef HAVE_TERMIOS
715   /* TERMIOS is the latest and bestest, and seems most likely to work.
716      If the system has it, use it. */
717   {
718     struct termios t;
719     tcgetattr (tty_fd, &t);
720     switch (signo)
721       {
722       case SIGINT:  return t.c_cc[VINTR];
723       case SIGQUIT: return t.c_cc[VQUIT];
724 #if defined(SIGTSTP) && defined(VSUSP)
725       case SIGTSTP: return t.c_cc[VSUSP];
726 #endif
727       }
728   }
729
730 # elif defined (TIOCGLTC) && defined (TIOCGETC) /* not HAVE_TERMIOS */
731   {
732     /* On Berkeley descendants, the following IOCTL's retrieve the
733        current control characters.  */
734     struct tchars c;
735     struct ltchars lc;
736     switch (signo)
737       {
738       case SIGINT:  ioctl (tty_fd, TIOCGETC, &c);  return c.t_intrc;
739       case SIGQUIT: ioctl (tty_fd, TIOCGETC, &c);  return c.t_quitc;
740 #  ifdef SIGTSTP
741       case SIGTSTP: ioctl (tty_fd, TIOCGLTC, &lc); return lc.t_suspc;
742 #  endif /* SIGTSTP */
743       }
744   }
745
746 # elif defined (TCGETA) /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
747   {
748     /* On SYSV descendants, the TCGETA ioctl retrieves the current
749        control characters.  */
750     struct termio t;
751     ioctl (tty_fd, TCGETA, &t);
752     switch (signo) {
753     case SIGINT:  return t.c_cc[VINTR];
754     case SIGQUIT: return t.c_cc[VQUIT];
755 #  ifdef SIGTSTP
756     case SIGTSTP: return t.c_cc[VSWTCH];
757 #  endif /* SIGTSTP */
758     }
759   }
760 # else /* ! defined (TCGETA) */
761 #error ERROR! Using SIGNALS_VIA_CHARACTERS, but not HAVE_TERMIOS || (TIOCGLTC && TIOCGETC) || TCGETA
762   /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
763      you'd better be using one of the alternatives above!  */
764 # endif /* ! defined (TCGETA) */
765   return '\0';
766 }
767 #endif /* SIGNALS_VIA_CHARACTERS */
768
769
770
771 \f
772 /**********************************************************************/
773 /*              Process implementation methods                        */
774 /**********************************************************************/
775
776 /*
777  * Allocate and initialize Lisp_Process->process_data
778  */
779
780 static void
781 unix_alloc_process_data (Lisp_Process *p)
782 {
783   p->process_data = xnew (struct unix_process_data);
784
785   UNIX_DATA(p)->connected_via_filedesc_p = 0;
786   UNIX_DATA(p)->infd   = -1;
787   UNIX_DATA(p)->subtty = -1;
788   UNIX_DATA(p)->tty_name = Qnil;
789   UNIX_DATA(p)->pty_flag = 0;
790 }
791
792 /*
793  * Mark any Lisp objects in Lisp_Process->process_data
794  */
795
796 static void
797 unix_mark_process_data (Lisp_Process *proc)
798 {
799   mark_object (UNIX_DATA(proc)->tty_name);
800 }
801
802 /*
803  * Initialize XEmacs process implementation once
804  */
805
806 #ifdef SIGCHLD
807 static void
808 unix_init_process (void)
809 {
810 #ifndef CANNOT_DUMP
811   if (! noninteractive || initialized)
812 #endif
813     signal (SIGCHLD, sigchld_handler);
814 }
815 #endif /* SIGCHLD */
816
817 /*
818  * Initialize any process local data. This is called when newly
819  * created process is connected to real OS file handles. The
820  * handles are generally represented by void* type, but are
821  * of type int (file descriptors) for UNIX.
822  */
823
824 static void
825 unix_init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags)
826 {
827   UNIX_DATA(p)->infd = (int)in;
828 }
829
830 /*
831  * Fork off a subprocess. P is a pointer to a newly created subprocess
832  * object. If this function signals, the caller is responsible for
833  * deleting (and finalizing) the process object.
834  *
835  * The method must return PID of the new process, a (positive??? ####) number
836  * which fits into Lisp_Int. No return value indicates an error, the method
837  * must signal an error instead.
838  */
839
840 static int
841 unix_create_process (Lisp_Process *p,
842                      Lisp_Object *argv, int nargv,
843                      Lisp_Object program, Lisp_Object cur_dir)
844 {
845   int pid;
846   int inchannel  = -1;
847   int outchannel = -1;
848   /* Use volatile to protect variables from being clobbered by longjmp.  */
849   volatile int forkin   = -1;
850   volatile int forkout  = -1;
851   volatile int pty_flag = 0;
852
853 #ifdef HAVE_PTYS
854   if (!NILP (Vprocess_connection_type))
855     {
856       /* find a new pty, open the master side, return the opened
857          file handle, and store the name of the corresponding slave
858          side in global variable pty_name. */
859       outchannel = inchannel = allocate_pty ();
860     }
861
862   if (inchannel >= 0)
863     {
864       /* You're "supposed" to now open the slave in the child.
865          On some systems, we can open it here; this allows for
866          better error checking. */
867 #if !defined(USG)
868       /* On USG systems it does not work to open the pty's tty here
869          and then close and reopen it in the child.  */
870 #ifdef O_NOCTTY
871       /* Don't let this terminal become our controlling terminal
872          (in case we don't have one).  */
873       forkout = forkin = open (pty_name, O_RDWR | O_NOCTTY | OPEN_BINARY, 0);
874 #else
875       forkout = forkin = open (pty_name, O_RDWR | OPEN_BINARY, 0);
876 #endif
877       if (forkin < 0)
878         goto io_failure;
879 #endif /* not USG */
880       UNIX_DATA(p)->pty_flag = pty_flag = 1;
881     }
882   else
883 #endif /* HAVE_PTYS */
884     if (create_bidirectional_pipe (&inchannel, &outchannel,
885                                    &forkin, &forkout) < 0)
886       goto io_failure;
887
888 #if 0
889   /* Replaced by close_process_descs */
890   set_exclusive_use (inchannel);
891   set_exclusive_use (outchannel);
892 #endif
893
894   set_descriptor_non_blocking (inchannel);
895   set_descriptor_non_blocking (outchannel);
896
897   /* Record this as an active process, with its channels.
898      As a result, child_setup will close Emacs's side of the pipes.  */
899   init_process_io_handles (p, (void*)inchannel, (void*)outchannel,
900                            pty_flag ? STREAM_PTY_FLUSHING : 0);
901   /* Record the tty descriptor used in the subprocess.  */
902   UNIX_DATA(p)->subtty = forkin;
903
904   {
905 #if !defined(CYGWIN)
906     /* child_setup must clobber environ on systems with true vfork.
907        Protect it from permanent change.  */
908     char **save_environ = environ;
909 #endif
910
911     pid = fork ();
912     if (pid == 0)
913       {
914         /**** Now we're in the child process ****/
915         int xforkin = forkin;
916         int xforkout = forkout;
917
918         /* Checking for quit in the child is bad because that will 
919            cause I/O, and that, in turn, can confuse the X connection. */
920         begin_dont_check_for_quit();
921
922         /* Disconnect the current controlling terminal, pursuant to
923            making the pty be the controlling terminal of the process.
924            Also put us in our own process group. */
925
926         disconnect_controlling_terminal ();
927
928 #ifdef HAVE_PTYS
929         if (pty_flag)
930           {
931             /* Open the pty connection and make the pty's terminal
932                our controlling terminal.
933
934                On systems with TIOCSCTTY, we just use it to set
935                the controlling terminal.  On other systems, the
936                first TTY we open becomes the controlling terminal.
937                So, we end up with four possibilities:
938
939                (1) on USG and TIOCSCTTY systems, we open the pty
940                    and use TIOCSCTTY.
941                (2) on other USG systems, we just open the pty.
942                (3) on non-USG systems with TIOCSCTTY, we
943                    just use TIOCSCTTY. (On non-USG systems, we
944                    already opened the pty in the parent process.)
945                (4) on non-USG systems without TIOCSCTTY, we
946                    close the pty and reopen it.
947
948                This would be cleaner if we didn't open the pty
949                in the parent process, but doing it that way
950                makes it possible to trap error conditions.
951                It's harder to convey an error from the child
952                process, and I don't feel like messing with
953                this now. */
954
955             /* There was some weirdo, probably wrong,
956                conditionalization on RTU and UNIPLUS here.
957                I deleted it.  So sue me. */
958
959             /* SunOS has TIOCSCTTY but the close/open method
960                also works. */
961
962 #  if defined (USG) || !defined (TIOCSCTTY)
963             /* Now close the pty (if we had it open) and reopen it.
964                This makes the pty the controlling terminal of the
965                subprocess.  */
966             /* I wonder if close (open (pty_name, ...)) would work?  */
967             if (xforkin >= 0)
968               close (xforkin);
969             xforkout = xforkin = open (pty_name, O_RDWR | OPEN_BINARY, 0);
970             if (xforkin < 0)
971               {
972                 write (1, "Couldn't open the pty terminal ", 31);
973                 write (1, pty_name, strlen (pty_name));
974                 write (1, "\n", 1);
975                 _exit (1);
976               }
977 #  endif /* USG or not TIOCSCTTY */
978
979             /* Miscellaneous setup required for some systems.
980                Must be done before using tc* functions on xforkin.
981                This guarantees that isatty(xforkin) is true. */
982
983 #  if defined (HAVE_ISASTREAM) && defined (I_PUSH)
984             if (isastream (xforkin))
985               {
986 #    if defined (I_FIND)
987 #      define stream_module_pushed(fd, module) (ioctl (fd, I_FIND, module) == 1)
988 #    else
989 #      define stream_module_pushed(fd, module) 0
990 #    endif
991                 if (! stream_module_pushed (xforkin, "ptem"))
992                   ioctl (xforkin, I_PUSH, "ptem");
993                 if (! stream_module_pushed (xforkin, "ldterm"))
994                   ioctl (xforkin, I_PUSH, "ldterm");
995                 if (! stream_module_pushed (xforkin, "ttcompat"))
996                   ioctl (xforkin, I_PUSH, "ttcompat");
997               }
998 #  endif /* HAVE_ISASTREAM */
999
1000 #  ifdef TIOCSCTTY
1001             /* We ignore the return value
1002                because faith@cs.unc.edu says that is necessary on Linux.  */
1003             assert (isatty (xforkin));
1004             ioctl (xforkin, TIOCSCTTY, 0);
1005 #  endif /* TIOCSCTTY */
1006
1007             /* Change the line discipline. */
1008
1009 # if defined (HAVE_TERMIOS) && defined (LDISC1)
1010             {
1011               struct termios t;
1012               assert (isatty (xforkin));
1013               tcgetattr (xforkin, &t);
1014               t.c_lflag = LDISC1;
1015               if (tcsetattr (xforkin, TCSANOW, &t) < 0)
1016                 perror ("create_process/tcsetattr LDISC1 failed\n");
1017             }
1018 # elif defined (NTTYDISC) && defined (TIOCSETD)
1019             {
1020               /* Use new line discipline.  TIOCSETD is accepted and
1021                  ignored on Sys5.4 systems with ttcompat. */
1022               int ldisc = NTTYDISC;
1023               assert (isatty (xforkin));
1024               ioctl (xforkin, TIOCSETD, &ldisc);
1025             }
1026 # endif /* TIOCSETD & NTTYDISC */
1027
1028             /* Make our process group be the foreground group
1029                of our new controlling terminal. */
1030
1031             {
1032               pid_t piddly = EMACS_GET_PROCESS_GROUP ();
1033               EMACS_SET_TTY_PROCESS_GROUP (xforkin, &piddly);
1034             }
1035
1036             /* On AIX, we've disabled SIGHUP above once we start a
1037                child on a pty.  Now reenable it in the child, so it
1038                will die when we want it to.
1039                JV: This needs to be done ALWAYS as we might have inherited
1040                a SIG_IGN handling from our parent (nohup) and we are in new
1041                process group.
1042             */
1043             signal (SIGHUP, SIG_DFL);
1044           }
1045
1046         if (pty_flag)
1047           /* Set up the terminal characteristics of the pty. */
1048           child_setup_tty (xforkout);
1049
1050 #endif /* HAVE_PTYS */
1051
1052         signal (SIGINT,  SIG_DFL);
1053         signal (SIGQUIT, SIG_DFL);
1054
1055         {
1056           char *current_dir;
1057           char **new_argv = alloca_array (char *, nargv + 2);
1058           int i;
1059
1060           /* Nothing below here GCs so our string pointers shouldn't move. */
1061           new_argv[0] = (char *) XSTRING_DATA (program);
1062           for (i = 0; i < nargv; i++)
1063             {
1064               CHECK_STRING (argv[i]);
1065               new_argv[i + 1] = (char *) XSTRING_DATA (argv[i]);
1066             }
1067           new_argv[i + 1] = 0;
1068
1069           LISP_STRING_TO_EXTERNAL (cur_dir, current_dir, Qfile_name);
1070
1071           child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
1072         }
1073
1074       } /**** End of child code ****/
1075
1076     /**** Back in parent process ****/
1077 #if !defined(CYGWIN)
1078     environ = save_environ;
1079 #endif
1080   }
1081
1082   if (pid < 0)
1083     {
1084       int save_errno = errno;
1085       close_descriptor_pair (forkin, forkout);
1086       errno = save_errno;
1087       report_file_error ("Doing fork", Qnil);
1088     }
1089
1090   /* #### dmoore - why is this commented out, otherwise we leave
1091      subtty = forkin, but then we close forkin just below. */
1092   /* UNIX_DATA(p)->subtty = -1; */
1093
1094   /* If the subfork execv fails, and it exits,
1095      this close hangs.  I don't know why.
1096      So have an interrupt jar it loose.  */
1097   if (forkin >= 0)
1098     close_safely (forkin);
1099   if (forkin != forkout && forkout >= 0)
1100     close (forkout);
1101
1102 #ifdef HAVE_PTYS
1103   if (pty_flag)
1104     UNIX_DATA (p)->tty_name = build_string (pty_name);
1105   else
1106 #endif
1107     UNIX_DATA (p)->tty_name = Qnil;
1108
1109   /* Notice that SIGCHLD was not blocked. (This is not possible on
1110      some systems.) No biggie if SIGCHLD occurs right around the
1111      time that this call happens, because SIGCHLD() does not actually
1112      deselect the process (that doesn't occur until the next time
1113      we're waiting for an event, when status_notify() is called). */
1114   return pid;
1115
1116 io_failure:
1117   {
1118     int save_errno = errno;
1119     close_descriptor_pair (forkin, forkout);
1120     close_descriptor_pair (inchannel, outchannel);
1121     errno = save_errno;
1122     report_file_error ("Opening pty or pipe", Qnil);
1123     return 0; /* not reached */
1124   }
1125 }
1126
1127 /* Return nonzero if this process is a ToolTalk connection. */
1128
1129 static int
1130 unix_tooltalk_connection_p (Lisp_Process *p)
1131 {
1132   return UNIX_DATA(p)->connected_via_filedesc_p;
1133 }
1134
1135 /* This is called to set process' virtual terminal size */
1136
1137 static int
1138 unix_set_window_size (Lisp_Process* p, int cols, int rows)
1139 {
1140   return set_window_size (UNIX_DATA(p)->infd, cols, rows);
1141 }
1142
1143 /*
1144  * This method is called to update status fields of the process
1145  * structure. If the process has not existed, this method is
1146  * expected to do nothing.
1147  *
1148  * The method is called only for real child processes.
1149  */
1150
1151 #ifdef HAVE_WAITPID
1152 static void
1153 unix_update_status_if_terminated (Lisp_Process* p)
1154 {
1155   int w;
1156 #ifdef SIGCHLD
1157   EMACS_BLOCK_SIGNAL (SIGCHLD);
1158 #endif
1159   if (waitpid (XINT (p->pid), &w, WNOHANG) == XINT (p->pid))
1160     {
1161       p->tick++;
1162       update_status_from_wait_code (p, &w);
1163     }
1164 #ifdef SIGCHLD
1165   EMACS_UNBLOCK_SIGNAL (SIGCHLD);
1166 #endif
1167 }
1168 #endif
1169
1170 /*
1171  * Update status of all exited processes. Called when SIGCLD has signaled.
1172  */
1173
1174 #ifdef SIGCHLD
1175 static void
1176 unix_reap_exited_processes (void)
1177 {
1178   int i;
1179   Lisp_Process *p;
1180
1181 #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR
1182   record_exited_processes (1);
1183 #endif
1184
1185   if (exited_processes_index <= 0)
1186     {
1187       return;
1188     }
1189
1190 #ifdef  EMACS_BLOCK_SIGNAL
1191   EMACS_BLOCK_SIGNAL (SIGCHLD);
1192 #endif
1193   for (i = 0; i < exited_processes_index; i++)
1194     {
1195       int pid = exited_processes[i];
1196       int w = exited_processes_status[i];
1197
1198       /* Find the process that signaled us, and record its status.  */
1199
1200       p = 0;
1201       {
1202         Lisp_Object tail;
1203         LIST_LOOP (tail, Vprocess_list)
1204           {
1205             Lisp_Object proc = XCAR (tail);
1206             p = XPROCESS (proc);
1207             if (INTP (p->pid) && XINT (p->pid) == pid)
1208               break;
1209             p = 0;
1210           }
1211       }
1212
1213       if (p)
1214         {
1215           /* Change the status of the process that was found.  */
1216           p->tick++;
1217           process_tick++;
1218           update_status_from_wait_code (p, &w);
1219
1220           /* If process has terminated, stop waiting for its output.  */
1221           if (WIFSIGNALED (w) || WIFEXITED (w))
1222             {
1223               if (!NILP(p->pipe_instream))
1224                 {
1225                   /* We can't just call event_stream->unselect_process_cb (p)
1226                      here, because that calls XtRemoveInput, which is not
1227                      necessarily reentrant, so we can't call this at interrupt
1228                      level.
1229                    */
1230                 }
1231             }
1232         }
1233       else
1234         {
1235           /* There was no asynchronous process found for that id.  Check
1236              if we have a synchronous process. Only set sync process status
1237              if there is one, so we work OK with the waitpid() call in
1238              wait_for_termination(). */
1239           if (synch_process_alive != 0)
1240             { /* Set the global sync process status variables. */
1241               synch_process_alive = 0;
1242
1243               /* Report the status of the synchronous process.  */
1244               if (WIFEXITED (w))
1245                 synch_process_retcode = WEXITSTATUS (w);
1246               else if (WIFSIGNALED (w))
1247                 synch_process_death = signal_name (WTERMSIG (w));
1248             }
1249         }
1250     }
1251
1252   exited_processes_index = 0;
1253
1254   EMACS_UNBLOCK_SIGNAL (SIGCHLD);
1255 }
1256 #endif /* SIGCHLD */
1257
1258 /*
1259  * Stuff the entire contents of LSTREAM to the process output pipe
1260  */
1261
1262 static JMP_BUF send_process_frame;
1263
1264 static SIGTYPE
1265 send_process_trap (int signum)
1266 {
1267   EMACS_REESTABLISH_SIGNAL (signum, send_process_trap);
1268   EMACS_UNBLOCK_SIGNAL (signum);
1269   LONGJMP (send_process_frame, 1);
1270 }
1271
1272 static void
1273 unix_send_process (Lisp_Object proc, struct lstream* lstream)
1274 {
1275   /* Use volatile to protect variables from being clobbered by longjmp.  */
1276   SIGTYPE (*volatile old_sigpipe) (int) = 0;
1277   volatile Lisp_Object vol_proc = proc;
1278   Lisp_Process *volatile p = XPROCESS (proc);
1279
1280   /* #### JV: layering violation?
1281
1282      This function knows too much about the relation between the encoding
1283      stream (DATA_OUTSTREAM) and the actual output stream p->output_stream.
1284
1285      If encoding streams properly forwarded all calls, we could simply
1286      use DATA_OUTSTREAM everywhere. */
1287
1288   if (!SETJMP (send_process_frame))
1289     {
1290       /* use a reasonable-sized buffer (somewhere around the size of the
1291          stream buffer) so as to avoid inundating the stream with blocked
1292          data. */
1293       Bufbyte chunkbuf[512];
1294       Bytecount chunklen;
1295
1296       do
1297         {
1298           Lstream_data_count writeret;
1299
1300           chunklen = Lstream_read (lstream, chunkbuf, 512);
1301           old_sigpipe =
1302             (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
1303           if (chunklen > 0)
1304             {
1305               int save_errno;
1306
1307               /* Lstream_write() will never successfully write less than
1308                  the amount sent in.  In the worst case, it just buffers
1309                  the unwritten data. */
1310               writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf,
1311                                         chunklen);
1312               save_errno = errno;
1313               signal (SIGPIPE, old_sigpipe);
1314               errno = save_errno;
1315               if (writeret < 0)
1316                 /* This is a real error.  Blocking errors are handled
1317                    specially inside of the filedesc stream. */
1318                 report_file_error ("writing to process", list1 (proc));
1319             }
1320           else
1321             {
1322               /* Need to make sure that everything up to and including the
1323                  last chunk is flushed, even when the pipe is currently
1324                  blocked. */
1325               Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
1326               signal (SIGPIPE, old_sigpipe);
1327             }
1328           while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
1329             {
1330               /* Buffer is full.  Wait, accepting input;
1331                  that may allow the program
1332                  to finish doing output and read more.  */
1333               Faccept_process_output (Qnil, make_int (1), Qnil);
1334               /* It could have *really* finished, deleting the process */
1335               if (NILP(p->pipe_outstream))
1336                 return;
1337               old_sigpipe =
1338                 (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
1339               Lstream_flush (XLSTREAM (p->pipe_outstream));
1340               signal (SIGPIPE, old_sigpipe);
1341             }
1342           /* Perhaps should abort() if < 0?  This should never happen. */
1343         }
1344       while (chunklen > 0);
1345     }
1346   else
1347     { /* We got here from a longjmp() from the SIGPIPE handler */
1348       signal (SIGPIPE, old_sigpipe);
1349       /* Close the file lstream so we don't attempt to write to it further */
1350       /* #### There is controversy over whether this might cause fd leakage */
1351       /*      my tests say no. -slb */
1352       XLSTREAM (p->pipe_outstream)->flags &= ~LSTREAM_FL_IS_OPEN;
1353 #ifdef FILE_CODING
1354       XLSTREAM (p->coding_outstream)->flags &= ~LSTREAM_FL_IS_OPEN;
1355 #endif
1356       p->status_symbol = Qexit;
1357       p->exit_code = 256; /* #### SIGPIPE ??? */
1358       p->core_dumped = 0;
1359       p->tick++;
1360       process_tick++;
1361       deactivate_process (*((Lisp_Object *) (&vol_proc)));
1362       invalid_operation ("SIGPIPE raised on process; closed it", p->name);
1363     }
1364
1365   old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap);
1366   Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
1367   signal (SIGPIPE, old_sigpipe);
1368 }
1369
1370 /*
1371  * Send EOF to the process. The default implementation simply
1372  * closes the output stream. The method must return 0 to call
1373  * the default implementation, or 1 if it has taken all care about
1374  * sending EOF to the process.
1375  */
1376
1377 static int
1378 unix_process_send_eof (Lisp_Object proc)
1379 {
1380   if (!UNIX_DATA (XPROCESS (proc))->pty_flag)
1381     return 0;
1382
1383   /* #### get_eof_char simply doesn't return the correct character
1384      here.  Maybe it is needed to determine the right eof
1385      character in init_process_io_handles but here it simply screws
1386      things up. */
1387 #if 0
1388   Bufbyte eof_char = get_eof_char (XPROCESS (proc));
1389   send_process (proc, Qnil, &eof_char, 0, 1);
1390 #else
1391   send_process (proc, Qnil, (const Bufbyte *) "\004", 0, 1);
1392 #endif
1393   return 1;
1394 }
1395
1396 /*
1397  * Called before the process is deactivated. The process object
1398  * is not immediately finalized, just undergoes a transition to
1399  * inactive state.
1400  *
1401  * The return value is a unique stream ID, as returned by
1402  * event_stream_delete_stream_pair
1403  *
1404  * In the lack of this method, only event_stream_delete_stream_pair
1405  * is called on both I/O streams of the process.
1406  *
1407  * The UNIX version guards this by ignoring possible SIGPIPE.
1408  */
1409
1410 static USID
1411 unix_deactivate_process (Lisp_Process *p)
1412 {
1413   SIGTYPE (*old_sigpipe) (int) = 0;
1414   USID usid;
1415
1416   if (UNIX_DATA(p)->infd >= 0)
1417     flush_pending_output (UNIX_DATA(p)->infd);
1418
1419   /* closing the outstream could result in SIGPIPE, so ignore it. */
1420   old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, SIG_IGN);
1421   usid = event_stream_delete_stream_pair (p->pipe_instream, p->pipe_outstream);
1422   signal (SIGPIPE, old_sigpipe);
1423
1424   UNIX_DATA(p)->infd  = -1;
1425
1426   return usid;
1427 }
1428
1429 /* If the subtty field of the process data is not filled in, do so now. */
1430 static void
1431 try_to_initialize_subtty (struct unix_process_data *upd)
1432 {
1433   if (upd->pty_flag
1434       && (upd->subtty == -1 || ! isatty (upd->subtty))
1435       && STRINGP (upd->tty_name))
1436     upd->subtty = open ((char *) XSTRING_DATA (upd->tty_name), O_RDWR, 0);
1437 }
1438
1439 /* Send signal number SIGNO to PROCESS.
1440    CURRENT_GROUP means send to the process group that currently owns
1441    the terminal being used to communicate with PROCESS.
1442    This is used for various commands in shell mode.
1443    If NOMSG is zero, insert signal-announcements into process's buffers
1444    right away.
1445
1446    If we can, we try to signal PROCESS by sending control characters
1447    down the pty.  This allows us to signal inferiors who have changed
1448    their uid, for which killpg would return an EPERM error,
1449    or processes running on other machines via remote login.
1450
1451    The method signals an error if the given SIGNO is not valid. */
1452
1453 static void
1454 unix_kill_child_process (Lisp_Object proc, int signo,
1455                          int current_group, int nomsg)
1456 {
1457   pid_t pgid = -1;
1458   Lisp_Process *p = XPROCESS (proc);
1459   struct unix_process_data *d = UNIX_DATA (p);
1460
1461   switch (signo)
1462     {
1463 #ifdef SIGCONT
1464     case SIGCONT:
1465       p->status_symbol = Qrun;
1466       p->exit_code = 0;
1467       p->tick++;
1468       process_tick++;
1469       if (!nomsg)
1470         status_notify ();
1471       break;
1472 #endif /* ! defined (SIGCONT) */
1473     case SIGINT:
1474     case SIGQUIT:
1475     case SIGKILL:
1476       flush_pending_output (d->infd);
1477       break;
1478     }
1479
1480   if (! d->pty_flag)
1481     current_group = 0;
1482
1483   /* If current_group is true, we want to send a signal to the
1484      foreground process group of the terminal our child process is
1485      running on.  You would think that would be easy.
1486
1487      The BSD people invented the TIOCPGRP ioctl to get the foreground
1488      process group of a tty.  That, combined with killpg, gives us
1489      what we want.
1490
1491      However, the POSIX standards people, in their infinite wisdom,
1492      have seen fit to only allow this for processes which have the
1493      terminal as controlling terminal, which doesn't apply to us.
1494
1495      Sooo..., we have to do something non-standard.  The ioctls
1496      TIOCSIGNAL, TIOCSIG, and TIOCSIGSEND send the signal directly on
1497      many systems.  POSIX tcgetpgrp(), since it is *documented* as not
1498      doing what we want, is actually less likely to work than the BSD
1499      ioctl TIOCGPGRP it is supposed to obsolete.  Sometimes we have to
1500      use TIOCGPGRP on the master end, sometimes the slave end
1501      (probably an AIX bug).  So we better get a fd for the slave if we
1502      haven't got it yet.
1503
1504      Anal operating systems like SGI Irix and Compaq Tru64 adhere
1505      strictly to the letter of the law, so our hack doesn't work.
1506      The following fragment from an Irix header file is suggestive:
1507
1508      #ifdef __notdef__
1509      // this is not currently supported
1510      #define TIOCSIGNAL      (tIOC|31)       // pty: send signal to slave
1511      #endif
1512
1513      On those systems where none of our tricks work, we just fall back
1514      to the non-current_group behavior and kill the process group of
1515      the child.
1516   */
1517   if (current_group)
1518     {
1519       try_to_initialize_subtty (d);
1520
1521 #ifdef SIGNALS_VIA_CHARACTERS
1522       /* If possible, send signals to the entire pgrp
1523          by sending an input character to it.  */
1524       {
1525         char sigchar = process_signal_char (d->subtty, signo);
1526         if (sigchar)
1527           {
1528             send_process (proc, Qnil, (Bufbyte *) &sigchar, 0, 1);
1529             return;
1530           }
1531       }
1532 #endif /* SIGNALS_VIA_CHARACTERS */
1533
1534 #ifdef TIOCGPGRP
1535       if (pgid == -1)
1536         ioctl (d->infd, TIOCGPGRP, &pgid); /* BSD */
1537       if (pgid == -1 && d->subtty != -1)
1538         ioctl (d->subtty, TIOCGPGRP, &pgid); /* Only this works on AIX! */
1539 #endif /* TIOCGPGRP */
1540
1541       if (pgid == -1)
1542         {
1543           /* Many systems provide an ioctl to send a signal directly */
1544 #ifdef TIOCSIGNAL /* Solaris, HP-UX */
1545           if (ioctl (d->infd, TIOCSIGNAL, signo) != -1)
1546             return;
1547 #endif /* TIOCSIGNAL */
1548
1549 #ifdef TIOCSIG /* BSD */
1550           if (ioctl (d->infd, TIOCSIG, signo) != -1)
1551             return;
1552 #endif /* TIOCSIG */
1553         }
1554     } /* current_group */
1555
1556   if (pgid == -1)
1557     /* Either current_group is 0, or we failed to get the foreground
1558        process group using the trickery above.  So we fall back to
1559        sending the signal to the process group of our child process.
1560        Since this is often a shell that ignores signals like SIGINT,
1561        the shell's subprocess is killed, which is the desired effect.
1562        The process group of p->pid is always p->pid, since it was
1563        created as a process group leader. */
1564     pgid = XINT (p->pid);
1565
1566   /* Finally send the signal. */
1567   if (EMACS_KILLPG (pgid, signo) == -1)
1568     {
1569       /* It's not an error if our victim is already dead.
1570          And we can't rely on the result of killing a zombie, since
1571          XPG 4.2 requires that killing a zombie fail with ESRCH,
1572          while FIPS 151-2 requires that it succeeds! */
1573 #ifdef ESRCH
1574       if (errno != ESRCH)
1575 #endif
1576         error ("kill (%ld, %ld) failed: %s",
1577                (long) pgid, (long) signo, strerror (errno));
1578     }
1579 }
1580
1581 /* Send signal SIGCODE to any process in the system given its PID.
1582    Return zero if successful, a negative number upon failure. */
1583
1584 static int
1585 unix_kill_process_by_pid (int pid, int sigcode)
1586 {
1587   return kill (pid, sigcode);
1588 }
1589
1590 /* Return TTY name used to communicate with subprocess. */
1591
1592 static Lisp_Object
1593 unix_get_tty_name (Lisp_Process *p)
1594 {
1595   return UNIX_DATA (p)->tty_name;
1596 }
1597
1598 /* Canonicalize host name HOST, and return its canonical form.
1599    The default implementation just takes HOST for a canonical name. */
1600
1601 #ifdef HAVE_SOCKETS
1602 static Lisp_Object
1603 unix_canonicalize_host_name (Lisp_Object host)
1604 {
1605 #if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)
1606   struct addrinfo hints, *res;
1607   static char addrbuf[NI_MAXHOST];
1608   Lisp_Object canonname;
1609   int retval;
1610   char *ext_host;
1611
1612   xzero (hints);
1613   hints.ai_flags = AI_CANONNAME;
1614 #ifdef IPV6_CANONICALIZE
1615   hints.ai_family = AF_UNSPEC;
1616 #else
1617   hints.ai_family = PF_INET;
1618 #endif
1619   hints.ai_socktype = SOCK_STREAM;
1620   hints.ai_protocol = 0;
1621   LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative);
1622   retval = getaddrinfo (ext_host, NULL, &hints, &res);
1623   if (retval != 0)
1624     {
1625       char *gai_error;
1626
1627       EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative);
1628       maybe_error (Qprocess, ERROR_ME_NOT,
1629                    "%s \"%s\"", gai_error, XSTRING_DATA (host));
1630       canonname = host;
1631     }
1632   else
1633     {
1634       int gni = getnameinfo (res->ai_addr, res->ai_addrlen,
1635                              addrbuf, sizeof(addrbuf),
1636                              NULL, 0, NI_NUMERICHOST);
1637       canonname = gni ? host : build_ext_string (addrbuf, Qnative);
1638
1639       freeaddrinfo (res);
1640     }
1641
1642   return canonname;
1643 #else /* ! HAVE_GETADDRINFO */
1644   struct sockaddr_in address;
1645
1646   if (!get_internet_address (host, &address, ERROR_ME_NOT))
1647     return host;
1648
1649   if (address.sin_family == AF_INET)
1650     return build_string (inet_ntoa (address.sin_addr));
1651   else
1652     /* #### any clue what to do here? */
1653     return host;
1654 #endif /* ! HAVE_GETADDRINFO */
1655 }
1656
1657 /* Open a TCP network connection to a given HOST/SERVICE.
1658    Treated exactly like a normal process when reading and writing.
1659    Only differences are in status display and process deletion.
1660    A network connection has no PID; you cannot signal it.  All you can
1661    do is deactivate and close it via delete-process. */
1662
1663 static void
1664 unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
1665                           Lisp_Object protocol, void** vinfd, void** voutfd)
1666 {
1667   int inch;
1668   int outch;
1669   volatile int s;
1670   volatile int port;
1671   volatile int retry = 0;
1672   int retval;
1673
1674   CHECK_STRING (host);
1675
1676   if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp))
1677     invalid_argument ("Unsupported protocol", protocol);
1678
1679   {
1680 #if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)
1681     struct addrinfo hints, *res;
1682     struct addrinfo * volatile lres;
1683     char *portstring;
1684     volatile int xerrno = 0;
1685     volatile int failed_connect = 0;
1686     char *ext_host;
1687     char portbuf[sizeof(long)*3 + 2];
1688     /*
1689      * Caution: service can either be a string or int.
1690      * Convert to a C string for later use by getaddrinfo.
1691      */
1692     if (INTP (service))
1693       {
1694         snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service));
1695         portstring = portbuf;
1696         port = htons ((unsigned short) XINT (service));
1697       }
1698     else
1699       {
1700         CHECK_STRING (service);
1701         LISP_STRING_TO_EXTERNAL (service, portstring, Qnative);
1702         port = 0;
1703       }
1704
1705     xzero (hints);
1706     hints.ai_flags = 0;
1707     hints.ai_family = AF_UNSPEC;
1708     if (EQ (protocol, Qtcp))
1709       hints.ai_socktype = SOCK_STREAM;
1710     else /* EQ (protocol, Qudp) */
1711       hints.ai_socktype = SOCK_DGRAM;
1712     hints.ai_protocol = 0;
1713     LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative);
1714     retval = getaddrinfo (ext_host, portstring, &hints, &res);
1715     if (retval != 0)
1716       {
1717         char *gai_error;
1718
1719         EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative);
1720         error ("%s/%s %s", XSTRING_DATA (host), portstring, gai_error);
1721       }
1722
1723     /* address loop */
1724     for (lres = res; lres ; lres = lres->ai_next)
1725       {
1726         if (EQ (protocol, Qtcp))
1727           s = socket (lres->ai_family, SOCK_STREAM, 0);
1728         else /* EQ (protocol, Qudp) */
1729           s = socket (lres->ai_family, SOCK_DGRAM, 0);
1730
1731         if (s < 0)
1732           continue;
1733
1734         /* Turn off interrupts here -- see comments below.  There used to
1735            be code which called bind_polling_period() to slow the polling
1736            period down rather than turn it off, but that seems rather
1737            bogus to me.  Best thing here is to use a non-blocking connect
1738            or something, to check for QUIT. */
1739
1740         /* Comments that are not quite valid: */
1741
1742         /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1743            when connect is interrupted.  So let's not let it get interrupted.
1744            Note we do not turn off polling, because polling is only used
1745            when not interrupt_input, and thus not normally used on the systems
1746            which have this bug.  On systems which use polling, there's no way
1747            to quit if polling is turned off.  */
1748
1749         /* Slow down polling.  Some kernels have a bug which causes retrying
1750            connect to fail after a connect.  */
1751
1752         slow_down_interrupts ();
1753
1754       loop:
1755
1756         /* A system call interrupted with a SIGALRM or SIGIO comes back
1757            here, with can_break_system_calls reset to 0. */
1758         SETJMP (break_system_call_jump);
1759         if (QUITP)
1760           {
1761             speed_up_interrupts ();
1762             REALLY_QUIT;
1763             /* In case something really weird happens ... */
1764             slow_down_interrupts ();
1765           }
1766
1767         /* Break out of connect with a signal (it isn't otherwise possible).
1768            Thus you don't get screwed with a hung network. */
1769         can_break_system_calls = 1;
1770         retval = connect (s, lres->ai_addr, lres->ai_addrlen);
1771         can_break_system_calls = 0;
1772         if (retval == -1)
1773           {
1774             xerrno = errno;
1775             if (errno != EISCONN)
1776               {
1777                 if (errno == EINTR)
1778                   goto loop;
1779                 if (errno == EADDRINUSE && retry < 20)
1780                   {
1781                     /* A delay here is needed on some FreeBSD systems,
1782                        and it is harmless, since this retrying takes time anyway
1783                        and should be infrequent.
1784                        `sleep-for' allowed for quitting this loop with interrupts
1785                        slowed down so it can't be used here.  Async timers should
1786                        already be disabled at this point so we can use `sleep'. */
1787                     sleep (1);
1788                     retry++;
1789                     goto loop;
1790                   }
1791               }
1792
1793             failed_connect = 1;
1794             close (s);
1795             s = -1;
1796
1797             speed_up_interrupts ();
1798
1799             continue;
1800           }
1801
1802         if (port == 0)
1803           {
1804             int gni;
1805             char servbuf[NI_MAXSERV];
1806
1807             if (EQ (protocol, Qtcp))
1808               gni = getnameinfo (lres->ai_addr, lres->ai_addrlen,
1809                                  NULL, 0, servbuf, sizeof(servbuf),
1810                                  NI_NUMERICSERV);
1811             else /* EQ (protocol, Qudp) */
1812               gni = getnameinfo (lres->ai_addr, lres->ai_addrlen,
1813                                  NULL, 0, servbuf, sizeof(servbuf),
1814                                  NI_NUMERICSERV | NI_DGRAM);
1815
1816             if (gni == 0)
1817               port = strtol (servbuf, NULL, 10);
1818           }
1819
1820         break;
1821       } /* address loop */
1822
1823     speed_up_interrupts ();
1824
1825     freeaddrinfo (res);
1826     if (s < 0)
1827       {
1828         errno = xerrno;
1829
1830         if (failed_connect)
1831           report_file_error ("connection failed", list2 (host, name));
1832         else
1833           report_file_error ("error creating socket", list1 (name));
1834       }
1835 #else /* ! HAVE_GETADDRINFO */
1836     struct sockaddr_in address;
1837
1838     if (INTP (service))
1839       port = htons ((unsigned short) XINT (service));
1840     else
1841       {
1842         struct servent *svc_info;
1843         CHECK_STRING (service);
1844
1845         if (EQ (protocol, Qtcp))
1846           svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
1847         else /* EQ (protocol, Qudp) */
1848           svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp");
1849
1850         if (svc_info == 0)
1851           invalid_argument ("Unknown service", service);
1852         port = svc_info->s_port;
1853       }
1854
1855     get_internet_address (host, &address, ERROR_ME);
1856     address.sin_port = port;
1857
1858     if (EQ (protocol, Qtcp))
1859       s = socket (address.sin_family, SOCK_STREAM, 0);
1860     else /* EQ (protocol, Qudp) */
1861       s = socket (address.sin_family, SOCK_DGRAM, 0);
1862
1863     if (s < 0)
1864       report_file_error ("error creating socket", list1 (name));
1865
1866     /* Turn off interrupts here -- see comments below.  There used to
1867        be code which called bind_polling_period() to slow the polling
1868        period down rather than turn it off, but that seems rather
1869        bogus to me.  Best thing here is to use a non-blocking connect
1870        or something, to check for QUIT. */
1871
1872     /* Comments that are not quite valid: */
1873
1874     /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1875        when connect is interrupted.  So let's not let it get interrupted.
1876        Note we do not turn off polling, because polling is only used
1877        when not interrupt_input, and thus not normally used on the systems
1878        which have this bug.  On systems which use polling, there's no way
1879        to quit if polling is turned off.  */
1880
1881     /* Slow down polling.  Some kernels have a bug which causes retrying
1882        connect to fail after a connect.  */
1883
1884     slow_down_interrupts ();
1885
1886   loop:
1887
1888     /* A system call interrupted with a SIGALRM or SIGIO comes back
1889        here, with can_break_system_calls reset to 0. */
1890     SETJMP (break_system_call_jump);
1891     if (QUITP)
1892       {
1893         speed_up_interrupts ();
1894         REALLY_QUIT;
1895         /* In case something really weird happens ... */
1896         slow_down_interrupts ();
1897       }
1898
1899     /* Break out of connect with a signal (it isn't otherwise possible).
1900        Thus you don't get screwed with a hung network. */
1901     can_break_system_calls = 1;
1902     retval = connect (s, (struct sockaddr *) &address, sizeof (address));
1903     can_break_system_calls = 0;
1904     if (retval == -1 && errno != EISCONN)
1905       {
1906         int xerrno = errno;
1907         if (errno == EINTR)
1908           goto loop;
1909         if (errno == EADDRINUSE && retry < 20)
1910           {
1911             /* A delay here is needed on some FreeBSD systems,
1912                and it is harmless, since this retrying takes time anyway
1913                and should be infrequent.
1914                `sleep-for' allowed for quitting this loop with interrupts
1915                slowed down so it can't be used here.  Async timers should
1916                already be disabled at this point so we can use `sleep'. */
1917             sleep (1);
1918             retry++;
1919             goto loop;
1920           }
1921
1922         close (s);
1923
1924         speed_up_interrupts ();
1925
1926         errno = xerrno;
1927         report_file_error ("connection failed", list2 (host, name));
1928       }
1929
1930     speed_up_interrupts ();
1931 #endif /* ! HAVE_GETADDRINFO */
1932   }
1933
1934   inch = s;
1935   outch = dup (s);
1936   if (outch < 0)
1937     {
1938       close (s); /* this used to be leaked; from Kyle Jones */
1939       report_file_error ("error duplicating socket", list1 (name));
1940     }
1941
1942   set_socket_nonblocking_maybe (inch, port, "tcp");
1943
1944   *vinfd = (void*)inch;
1945   *voutfd = (void*)outch;
1946 }
1947
1948
1949 #ifdef HAVE_MULTICAST
1950
1951 /* Didier Verna <didier@xemacs.org> Nov. 28 1997.
1952
1953    This function is similar to open-network-stream-internal, but provides a
1954    mean to open an UDP multicast connection instead of a TCP one. Like in the
1955    TCP case, the multicast connection will be seen as a sub-process,
1956
1957    Some notes:
1958    - Normally, we should use sendto and recvfrom with non connected
1959    sockets. The current code doesn't allow us to do this. In the future, it
1960    would be a good idea to extend the process data structure in order to deal
1961    properly with the different types network connections.
1962    - For the same reason, when leaving a multicast group, it is better to make
1963    a setsockopt - IP_DROP_MEMBERSHIP before closing the descriptors.
1964    Unfortunately, this can't be done here because delete_process doesn't know
1965    about the kind of connection we have. However, this is not such an
1966    important issue.
1967 */
1968
1969 static void
1970 unix_open_multicast_group (Lisp_Object name, Lisp_Object dest,
1971                            Lisp_Object port, Lisp_Object ttl, void** vinfd,
1972                            void** voutfd)
1973 {
1974   struct ip_mreq imr;
1975   struct sockaddr_in sa;
1976   struct protoent *udp;
1977   int ws, rs;
1978   int theport;
1979   unsigned char thettl;
1980   int one = 1; /* For REUSEADDR */
1981   int ret;
1982   volatile int retry = 0;
1983
1984   CHECK_STRING (dest);
1985
1986   CHECK_NATNUM (port);
1987   theport = htons ((unsigned short) XINT (port));
1988
1989   CHECK_NATNUM (ttl);
1990   thettl = (unsigned char) XINT (ttl);
1991
1992   if ((udp = getprotobyname ("udp")) == NULL)
1993     type_error (Qinvalid_operation, "No info available for UDP protocol");
1994
1995   /* Init the sockets. Yes, I need 2 sockets. I couldn't duplicate one. */
1996   if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0)
1997     report_file_error ("error creating socket", list1(name));
1998   if ((ws = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0)
1999     {
2000       close (rs);
2001       report_file_error ("error creating socket", list1(name));
2002     }
2003
2004   /* This will be used for both sockets */
2005   memset (&sa, 0, sizeof(sa));
2006   sa.sin_family = AF_INET;
2007   sa.sin_port = theport;
2008   sa.sin_addr.s_addr = inet_addr ((char *) XSTRING_DATA (dest));
2009
2010   /* Socket configuration for reading ------------------------ */
2011
2012   /* Multiple connections from the same machine. This must be done before
2013      bind. If it fails, it shouldn't be fatal. The only consequence is that
2014      people won't be able to connect twice from the same machine. */
2015   if (setsockopt (rs, SOL_SOCKET, SO_REUSEADDR, (char *) &one, sizeof (one))
2016       < 0)
2017     warn_when_safe (Qmulticast, Qwarning, "Cannot reuse socket address");
2018
2019   /* bind socket name */
2020   if (bind (rs, (struct sockaddr *)&sa, sizeof(sa)))
2021     {
2022       close (rs);
2023       close (ws);
2024       report_file_error ("error binding socket", list2(name, port));
2025     }
2026
2027   /* join multicast group */
2028   imr.imr_multiaddr.s_addr = inet_addr ((char *) XSTRING_DATA (dest));
2029   imr.imr_interface.s_addr = htonl (INADDR_ANY);
2030   if (setsockopt (rs, IPPROTO_IP, IP_ADD_MEMBERSHIP,
2031                   &imr, sizeof (struct ip_mreq)) < 0)
2032     {
2033       close (ws);
2034       close (rs);
2035       report_file_error ("error adding membership", list2(name, dest));
2036     }
2037
2038   /* Socket configuration for writing ----------------------- */
2039
2040   /* Normally, there's no 'connect' in multicast, since we prefer to use
2041      'sendto' and 'recvfrom'. However, in order to handle this connection in
2042      the process-like way it is done for TCP, we must be able to use 'write'
2043      instead of 'sendto'. Consequently, we 'connect' this socket. */
2044
2045   /* See open-network-stream-internal for comments on this part of the code */
2046   slow_down_interrupts ();
2047
2048  loop:
2049
2050   /* A system call interrupted with a SIGALRM or SIGIO comes back
2051      here, with can_break_system_calls reset to 0. */
2052   SETJMP (break_system_call_jump);
2053   if (QUITP)
2054     {
2055       speed_up_interrupts ();
2056       REALLY_QUIT;
2057       /* In case something really weird happens ... */
2058       slow_down_interrupts ();
2059     }
2060
2061   /* Break out of connect with a signal (it isn't otherwise possible).
2062      Thus you don't get screwed with a hung network. */
2063   can_break_system_calls = 1;
2064   ret = connect (ws, (struct sockaddr *) &sa, sizeof (sa));
2065   can_break_system_calls = 0;
2066   if (ret == -1 && errno != EISCONN)
2067     {
2068       int xerrno = errno;
2069
2070       if (errno == EINTR)
2071         goto loop;
2072       if (errno == EADDRINUSE && retry < 20)
2073         {
2074           /* A delay here is needed on some FreeBSD systems,
2075              and it is harmless, since this retrying takes time anyway
2076              and should be infrequent.
2077              `sleep-for' allowed for quitting this loop with interrupts
2078              slowed down so it can't be used here.  Async timers should
2079              already be disabled at this point so we can use `sleep'. */
2080           sleep (1);
2081           retry++;
2082           goto loop;
2083         }
2084
2085       close (rs);
2086       close (ws);
2087       speed_up_interrupts ();
2088
2089       errno = xerrno;
2090       report_file_error ("error connecting socket", list2(name, port));
2091     }
2092
2093   speed_up_interrupts ();
2094
2095   /* scope */
2096   if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL,
2097                   &thettl, sizeof (thettl)) < 0)
2098     {
2099       close (rs);
2100       close (ws);
2101       report_file_error ("error setting ttl", list2(name, ttl));
2102     }
2103
2104   set_socket_nonblocking_maybe (rs, theport, "udp");
2105
2106   *vinfd = (void*)rs;
2107   *voutfd = (void*)ws;
2108 }
2109
2110 #endif /* HAVE_MULTICAST */
2111
2112 #endif /* HAVE_SOCKETS */
2113
2114 \f
2115 /**********************************************************************/
2116 /*                            Initialization                          */
2117 /**********************************************************************/
2118
2119 void
2120 process_type_create_unix (void)
2121 {
2122   PROCESS_HAS_METHOD (unix, alloc_process_data);
2123   PROCESS_HAS_METHOD (unix, mark_process_data);
2124 #ifdef SIGCHLD
2125   PROCESS_HAS_METHOD (unix, init_process);
2126   PROCESS_HAS_METHOD (unix, reap_exited_processes);
2127 #endif
2128   PROCESS_HAS_METHOD (unix, init_process_io_handles);
2129   PROCESS_HAS_METHOD (unix, create_process);
2130   PROCESS_HAS_METHOD (unix, tooltalk_connection_p);
2131   PROCESS_HAS_METHOD (unix, set_window_size);
2132 #ifdef HAVE_WAITPID
2133   PROCESS_HAS_METHOD (unix, update_status_if_terminated);
2134 #endif
2135   PROCESS_HAS_METHOD (unix, send_process);
2136   PROCESS_HAS_METHOD (unix, process_send_eof);
2137   PROCESS_HAS_METHOD (unix, deactivate_process);
2138   PROCESS_HAS_METHOD (unix, kill_child_process);
2139   PROCESS_HAS_METHOD (unix, kill_process_by_pid);
2140   PROCESS_HAS_METHOD (unix, get_tty_name);
2141 #ifdef HAVE_SOCKETS
2142   PROCESS_HAS_METHOD (unix, canonicalize_host_name);
2143   PROCESS_HAS_METHOD (unix, open_network_stream);
2144 #ifdef HAVE_MULTICAST
2145   PROCESS_HAS_METHOD (unix, open_multicast_group);
2146 #endif
2147 #endif
2148 }
2149
2150 void
2151 vars_of_process_unix (void)
2152 {
2153   Fprovide (intern ("unix-processes"));
2154 }
2155
2156 #endif /* !defined (NO_SUBPROCESSES) */