/[emacs]/emacs/src/process.c
ViewVC logotype

Diff of /emacs/src/process.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.355 by kfstorm, Sun Mar 3 00:31:22 2002 UTC revision 1.356 by kfstorm, Sun Mar 17 20:20:33 2002 UTC
# Line 57  Boston, MA 02111-1307, USA.  */ Line 57  Boston, MA 02111-1307, USA.  */
57  #ifdef NEED_NET_ERRNO_H  #ifdef NEED_NET_ERRNO_H
58  #include <net/errno.h>  #include <net/errno.h>
59  #endif /* NEED_NET_ERRNO_H */  #endif /* NEED_NET_ERRNO_H */
60    
61    /* Are local (unix) sockets supported?  */
62    #ifndef NO_SOCKETS_IN_FILE_SYSTEM
63    #if !defined (AF_LOCAL) && defined (AF_UNIX)
64    #define AF_LOCAL AF_UNIX
65    #endif
66    #ifdef AF_LOCAL
67    #define HAVE_LOCAL_SOCKETS
68    #include <sys/un.h>
69    #endif
70    #endif
71  #endif /* HAVE_SOCKETS */  #endif /* HAVE_SOCKETS */
72    
73  /* TERM is a poor-man's SLIP, used on GNU/Linux.  */  /* TERM is a poor-man's SLIP, used on GNU/Linux.  */
# Line 113  Boston, MA 02111-1307, USA.  */ Line 124  Boston, MA 02111-1307, USA.  */
124    
125  Lisp_Object Qprocessp;  Lisp_Object Qprocessp;
126  Lisp_Object Qrun, Qstop, Qsignal;  Lisp_Object Qrun, Qstop, Qsignal;
127  Lisp_Object Qopen, Qclosed, Qconnect, Qfailed;  Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
128    Lisp_Object Qlocal;
129    Lisp_Object QCname, QCbuffer, QChost, QCservice, QCfamily;
130    Lisp_Object QClocal, QCremote, QCcoding;
131    Lisp_Object QCserver, QCdatagram, QCnowait, QCnoquery, QCstop;
132    Lisp_Object QCfilter, QCsentinel, QClog, QCoptions, QCfeature;
133  Lisp_Object Qlast_nonmenu_event;  Lisp_Object Qlast_nonmenu_event;
134  /* Qexit is declared and initialized in eval.c.  */  /* Qexit is declared and initialized in eval.c.  */
135    
# Line 122  Lisp_Object Qlast_nonmenu_event; Line 138  Lisp_Object Qlast_nonmenu_event;
138    
139  #ifdef HAVE_SOCKETS  #ifdef HAVE_SOCKETS
140  #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))  #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
141    #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
142  #else  #else
143  #define NETCONN_P(p) 0  #define NETCONN_P(p) 0
144    #define NETCONN1_P(p) 0
145  #endif /* HAVE_SOCKETS */  #endif /* HAVE_SOCKETS */
146    
147  /* Define first descriptor number available for subprocesses.  */  /* Define first descriptor number available for subprocesses.  */
# Line 194  int update_tick; Line 212  int update_tick;
212  #endif /* NON_BLOCKING_CONNECT */  #endif /* NON_BLOCKING_CONNECT */
213  #endif /* BROKEN_NON_BLOCKING_CONNECT */  #endif /* BROKEN_NON_BLOCKING_CONNECT */
214    
215    /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
216       this system.  We need to read full packets, so we need a
217       "non-destructive" select.  So we require either native select,
218       or emulation of select using FIONREAD.  */
219    
220    #ifdef GNU_LINUX
221    /* These are not yet in configure.in (they will be eventually)
222       -- so add them here temporarily.  ++kfs */
223    #define HAVE_RECVFROM
224    #define HAVE_SENDTO
225    #define HAVE_GETSOCKNAME
226    #endif
227    
228    #ifdef BROKEN_DATAGRAM_SOCKETS
229    #undef DATAGRAM_SOCKETS
230    #else
231    #ifndef DATAGRAM_SOCKETS
232    #ifdef HAVE_SOCKETS
233    #if defined (HAVE_SELECT) || defined (FIONREAD)
234    #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
235    #define DATAGRAM_SOCKETS
236    #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
237    #endif /* HAVE_SELECT || FIONREAD */
238    #endif /* HAVE_SOCKETS */
239    #endif /* DATAGRAM_SOCKETS */
240    #endif /* BROKEN_DATAGRAM_SOCKETS */
241    
242  #ifdef TERM  #ifdef TERM
243  #undef NON_BLOCKING_CONNECT  #undef NON_BLOCKING_CONNECT
244    #undef DATAGRAM_SOCKETS
245  #endif  #endif
246    
247    
248  #include "sysselect.h"  #include "sysselect.h"
249    
250  extern int keyboard_bit_set P_ ((SELECT_TYPE *));  extern int keyboard_bit_set P_ ((SELECT_TYPE *));
# Line 257  int proc_buffered_char[MAXDESC]; Line 304  int proc_buffered_char[MAXDESC];
304  static struct coding_system *proc_decode_coding_system[MAXDESC];  static struct coding_system *proc_decode_coding_system[MAXDESC];
305  static struct coding_system *proc_encode_coding_system[MAXDESC];  static struct coding_system *proc_encode_coding_system[MAXDESC];
306    
307    #ifdef DATAGRAM_SOCKETS
308    /* Table of `partner address' for datagram sockets.  */
309    struct sockaddr_and_len {
310      struct sockaddr *sa;
311      int len;
312    } datagram_address[MAXDESC];
313    #define DATAGRAM_CHAN_P(chan)   (datagram_address[chan].sa != 0)
314    #define DATAGRAM_CONN_P(proc)   (datagram_address[XPROCESS (proc)->infd].sa != 0)
315    #else
316    #define DATAGRAM_CHAN_P(chan)   (0)
317    #define DATAGRAM_CONN_P(proc)   (0)
318    #endif
319    
320  static Lisp_Object get_process ();  static Lisp_Object get_process ();
321  static void exec_sentinel ();  static void exec_sentinel ();
322    
# Line 367  status_message (status) Line 427  status_message (status)
427          return build_string ("finished\n");          return build_string ("finished\n");
428        string = Fnumber_to_string (make_number (code));        string = Fnumber_to_string (make_number (code));
429        string2 = build_string (coredump ? " (core dumped)\n" : "\n");        string2 = build_string (coredump ? " (core dumped)\n" : "\n");
430        return concat2 (build_string ("exited abnormally with code "),        return concat3 (build_string ("exited abnormally with code "),
431                        concat2 (string, string2));                        string, string2);
432      }      }
433    else if (EQ (symbol, Qfailed))    else if (EQ (symbol, Qfailed))
434      {      {
435        string = Fnumber_to_string (make_number (code));        string = Fnumber_to_string (make_number (code));
436        string2 = build_string ("\n");        string2 = build_string ("\n");
437        return concat2 (build_string ("failed with code "),        return concat3 (build_string ("failed with code "),
438                        concat2 (string, string2));                        string, string2);
439      }      }
440    else    else
441      return Fcopy_sequence (Fsymbol_name (symbol));      return Fcopy_sequence (Fsymbol_name (symbol));
# Line 635  stop -- for a process stopped but contin Line 695  stop -- for a process stopped but contin
695  exit -- for a process that has exited.  exit -- for a process that has exited.
696  signal -- for a process that has got a fatal signal.  signal -- for a process that has got a fatal signal.
697  open -- for a network stream connection that is open.  open -- for a network stream connection that is open.
698    listen -- for a network stream server that is listening.
699  closed -- for a network stream connection that is closed.  closed -- for a network stream connection that is closed.
700  connect -- when waiting for a non-blocking connection to complete.  connect -- when waiting for a non-blocking connection to complete.
701  failed -- when a non-blocking connection has failed.  failed -- when a non-blocking connection has failed.
# Line 661  nil, indicating the current buffer's pro Line 722  nil, indicating the current buffer's pro
722    status = p->status;    status = p->status;
723    if (CONSP (status))    if (CONSP (status))
724      status = XCAR (status);      status = XCAR (status);
725    if (NETCONN_P (process))    if (NETCONN1_P (p))
726      {      {
727        if (EQ (status, Qrun))        if (EQ (status, Qexit))
         status = Qopen;  
       else if (EQ (status, Qexit))  
728          status = Qclosed;          status = Qclosed;
729          else if (EQ (p->command, Qt))
730            status = Qstop;
731          else if (EQ (status, Qrun))
732            status = Qopen;
733      }      }
734    return status;    return status;
735  }  }
# Line 737  DEFUN ("set-process-buffer", Fset_proces Line 800  DEFUN ("set-process-buffer", Fset_proces
800       (process, buffer)       (process, buffer)
801       register Lisp_Object process, buffer;       register Lisp_Object process, buffer;
802  {  {
803      struct Lisp_Process *p;
804    
805    CHECK_PROCESS (process);    CHECK_PROCESS (process);
806    if (!NILP (buffer))    if (!NILP (buffer))
807      CHECK_BUFFER (buffer);      CHECK_BUFFER (buffer);
808    XPROCESS (process)->buffer = buffer;    p = XPROCESS (process);
809      p->buffer = buffer;
810      if (NETCONN1_P (p))
811        p->childp = Fplist_put (p->childp, QCbuffer, buffer);
812    return buffer;    return buffer;
813  }  }
814    
# Line 791  If the process has a filter, its buffer Line 859  If the process has a filter, its buffer
859        
860    if (XINT (p->infd) >= 0)    if (XINT (p->infd) >= 0)
861      {      {
862        if (EQ (filter, Qt))        if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
863          {          {
864            FD_CLR (XINT (p->infd), &input_wait_mask);            FD_CLR (XINT (p->infd), &input_wait_mask);
865            FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);            FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
866          }          }
867        else if (EQ (XPROCESS (process)->filter, Qt))        else if (EQ (p->filter, Qt)
868                   && !EQ (p->command, Qt)) /* Network process not stopped. */
869          {          {
870            FD_SET (XINT (p->infd), &input_wait_mask);            FD_SET (XINT (p->infd), &input_wait_mask);
871            FD_SET (XINT (p->infd), &non_keyboard_wait_mask);            FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
# Line 804  If the process has a filter, its buffer Line 873  If the process has a filter, its buffer
873      }      }
874        
875    p->filter = filter;    p->filter = filter;
876      if (NETCONN1_P (p))
877        p->childp = Fplist_put (p->childp, QCfilter, filter);
878    return filter;    return filter;
879  }  }
880    
# Line 899  the process output.  */) Line 970  the process output.  */)
970    return XPROCESS (process)->inherit_coding_system_flag;    return XPROCESS (process)->inherit_coding_system_flag;
971  }  }
972    
973  DEFUN ("process-kill-without-query", Fprocess_kill_without_query,  DEFUN ("set-process-query-on-exit-flag",
974         Sprocess_kill_without_query, 1, 2, 0,         Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
975         doc: /* Say no query needed if PROCESS is running when Emacs is exited.         2, 2, 0,
976  Optional second argument if non-nil says to require a query.         doc: /* Specify if query is needed for PROCESS when Emacs is exited.
977  Value is t if a query was formerly required.  */)  If the second argument FLAG is non-nil, emacs will query the user before
978       (process, value)  exiting if PROCESS is running.  */)
979       register Lisp_Object process, value;       (process, flag)
980         register Lisp_Object process, flag;
981  {  {
   Lisp_Object tem;  
   
982    CHECK_PROCESS (process);    CHECK_PROCESS (process);
983    tem = XPROCESS (process)->kill_without_query;    XPROCESS (process)->kill_without_query = Fnull (flag);
984    XPROCESS (process)->kill_without_query = Fnull (value);    return flag;
   
   return Fnull (tem);  
985  }  }
986    
987  DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,  DEFUN ("process-query-on-exit-flag",
988           Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
989         1, 1, 0,         1, 1, 0,
990         doc: /* Return the contact info of PROCESS; t for a real child.         doc: /* Return the current value of query on exit flag for PROCESS.  */)
 For a net connection, the value is a cons cell of the form (HOST SERVICE).  */)  
991       (process)       (process)
992       register Lisp_Object process;       register Lisp_Object process;
993  {  {
994    CHECK_PROCESS (process);    CHECK_PROCESS (process);
995    return XPROCESS (process)->childp;    return Fnull (XPROCESS (process)->kill_without_query);
996    }
997    
998    #ifdef DATAGRAM_SOCKETS
999    Lisp_Object Fprocess_datagram_address ();
1000    #endif
1001    
1002    DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1003           1, 2, 0,
1004           doc: /* Return the contact info of PROCESS; t for a real child.
1005    For a net connection, the value depends on the optional KEY arg.
1006    If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1007    if KEY is t, the complete contact information for the connection is
1008    returned, else the specific value for the keyword KEY is returned.
1009    See `make-network-process' for a list of keywords.  */)
1010         (process, key)
1011         register Lisp_Object process, key;
1012    {
1013      Lisp_Object contact;
1014    
1015      CHECK_PROCESS (process);
1016      contact = XPROCESS (process)->childp;
1017    
1018    #ifdef DATAGRAM_SOCKETS
1019      if (DATAGRAM_CONN_P (process)
1020          && (EQ (key, Qt) || EQ (key, QCremote)))
1021        contact = Fplist_put (contact, QCremote,
1022                              Fprocess_datagram_address (process));
1023    #endif
1024    
1025      if (!NETCONN_P (process) || EQ (key, Qt))
1026        return contact;
1027      if (NILP (key))
1028        return Fcons (Fplist_get (contact, QChost),
1029                      Fcons (Fplist_get (contact, QCservice), Qnil));
1030      return Fplist_get (contact, key);
1031  }  }
1032    
1033  #if 0 /* Turned off because we don't currently record this info  #if 0 /* Turned off because we don't currently record this info
# Line 941  a socket connection.  */) Line 1044  a socket connection.  */)
1044  #endif  #endif
1045    
1046  Lisp_Object  Lisp_Object
1047  list_processes_1 ()  list_processes_1 (query_only)
1048         Lisp_Object query_only;
1049  {  {
1050    register Lisp_Object tail, tem;    register Lisp_Object tail, tem;
1051    Lisp_Object proc, minspace, tem1;    Lisp_Object proc, minspace, tem1;
1052    register struct Lisp_Process *p;    register struct Lisp_Process *p;
1053    char tembuf[80];    char tembuf[300];
1054      int w_proc, w_buffer, w_tty;
1055      Lisp_Object i_status, i_buffer, i_tty, i_command;
1056    
1057      w_proc = 4;    /* Proc   */
1058      w_buffer = 6;  /* Buffer */
1059      w_tty = 0;     /* Omit if no ttys */
1060    
1061      for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
1062        {
1063          int i;
1064    
1065          proc = Fcdr (Fcar (tail));
1066          p = XPROCESS (proc);
1067          if (NILP (p->childp))
1068            continue;
1069          if (!NILP (query_only) && !NILP (p->kill_without_query))
1070            continue;
1071          if (STRINGP (p->name)
1072              && ( i = XSTRING (p->name)->size, (i > w_proc)))
1073            w_proc = i;
1074          if (!NILP (p->buffer))
1075            {
1076              if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
1077                w_buffer = 8;  /* (Killed) */
1078              else if ((i = XSTRING (XBUFFER (p->buffer)->name)->size, (i > w_buffer)))
1079                w_buffer = i;
1080            }
1081          if (STRINGP (p->tty_name)
1082              && (i = XSTRING (p->tty_name)->size, (i > w_tty)))
1083            w_tty = i;
1084        }
1085    
1086      XSETFASTINT (i_status, w_proc + 1);
1087      XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
1088      if (w_tty)
1089        {
1090          XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
1091          XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1);
1092        } else {
1093          i_tty = Qnil;
1094          XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
1095        }
1096    
1097    XSETFASTINT (minspace, 1);    XSETFASTINT (minspace, 1);
1098    
# Line 955  list_processes_1 () Line 1101  list_processes_1 ()
1101    
1102    current_buffer->truncate_lines = Qt;    current_buffer->truncate_lines = Qt;
1103    
1104    write_string ("\    write_string ("Proc", -1);
1105  Proc         Status   Buffer         Tty         Command\n\    Findent_to (i_status, minspace); write_string ("Status", -1);
1106  ----         ------   ------         ---         -------\n", -1);    Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
1107      if (!NILP (i_tty))
1108        {
1109          Findent_to (i_tty, minspace); write_string ("Tty", -1);
1110        }
1111      Findent_to (i_command, minspace); write_string ("Command", -1);
1112      write_string ("\n", -1);
1113    
1114      write_string ("----", -1);
1115      Findent_to (i_status, minspace); write_string ("------", -1);
1116      Findent_to (i_buffer, minspace); write_string ("------", -1);
1117      if (!NILP (i_tty))
1118        {
1119          Findent_to (i_tty, minspace); write_string ("---", -1);
1120        }
1121      Findent_to (i_command, minspace); write_string ("-------", -1);
1122      write_string ("\n", -1);
1123    
1124    for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))    for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
1125      {      {
# Line 967  Proc         Status   Buffer         Tty Line 1129  Proc         Status   Buffer         Tty
1129        p = XPROCESS (proc);        p = XPROCESS (proc);
1130        if (NILP (p->childp))        if (NILP (p->childp))
1131          continue;          continue;
1132          if (!NILP (query_only) && !NILP (p->kill_without_query))
1133            continue;
1134    
1135        Finsert (1, &p->name);        Finsert (1, &p->name);
1136        Findent_to (make_number (13), minspace);        Findent_to (i_status, minspace);
1137    
1138        if (!NILP (p->raw_status_low))        if (!NILP (p->raw_status_low))
1139          update_status (p);          update_status (p);
# Line 989  Proc         Status   Buffer         Tty Line 1153  Proc         Status   Buffer         Tty
1153  #endif  #endif
1154              Fprinc (symbol, Qnil);              Fprinc (symbol, Qnil);
1155          }          }
1156        else if (NETCONN_P (proc))        else if (NETCONN1_P (p))
1157          {          {
1158            if (EQ (symbol, Qrun))            if (EQ (symbol, Qexit))
             write_string ("open", -1);  
           else if (EQ (symbol, Qexit))  
1159              write_string ("closed", -1);              write_string ("closed", -1);
1160              else if (EQ (p->command, Qt))
1161                write_string ("stopped", -1);
1162              else if (EQ (symbol, Qrun))
1163                write_string ("open", -1);
1164            else            else
1165              Fprinc (symbol, Qnil);              Fprinc (symbol, Qnil);
1166          }          }
# Line 1015  Proc         Status   Buffer         Tty Line 1181  Proc         Status   Buffer         Tty
1181        if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))        if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
1182          remove_process (proc);          remove_process (proc);
1183    
1184        Findent_to (make_number (22), minspace);        Findent_to (i_buffer, minspace);
1185        if (NILP (p->buffer))        if (NILP (p->buffer))
1186          insert_string ("(none)");          insert_string ("(none)");
1187        else if (NILP (XBUFFER (p->buffer)->name))        else if (NILP (XBUFFER (p->buffer)->name))
# Line 1023  Proc         Status   Buffer         Tty Line 1189  Proc         Status   Buffer         Tty
1189        else        else
1190          Finsert (1, &XBUFFER (p->buffer)->name);          Finsert (1, &XBUFFER (p->buffer)->name);
1191    
1192        Findent_to (make_number (37), minspace);        if (!NILP (i_tty))
1193            {
1194        if (STRINGP (p->tty_name))            Findent_to (i_tty, minspace);
1195          Finsert (1, &p->tty_name);            if (STRINGP (p->tty_name))
1196        else              Finsert (1, &p->tty_name);
1197          insert_string ("(none)");          }
1198    
1199        Findent_to (make_number (49), minspace);        Findent_to (i_command, minspace);
1200    
1201        if (NETCONN_P (proc))        if (EQ (p->status, Qlisten))
1202            {
1203              Lisp_Object port = Fplist_get (p->childp, QCservice);
1204              if (INTEGERP (port))
1205                port = Fnumber_to_string (port);
1206              sprintf (tembuf, "(network %s server on %s)\n",
1207                       (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
1208                       XSTRING (port)->data);
1209              insert_string (tembuf);
1210            }
1211          else if (NETCONN1_P (p))
1212          {          {
1213            sprintf (tembuf, "(network stream connection to %s)\n",            /* For a local socket, there is no host name,
1214                     XSTRING (XCAR (p->childp))->data);               so display service instead.  */
1215              Lisp_Object host = Fplist_get (p->childp, QChost);
1216              if (!STRINGP (host))
1217                {
1218                  host = Fplist_get (p->childp, QCservice);
1219                  if (INTEGERP (host))
1220                    host = Fnumber_to_string (host);
1221                }
1222              sprintf (tembuf, "(network %s connection to %s)\n",
1223                       (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
1224                       XSTRING (host)->data);
1225            insert_string (tembuf);            insert_string (tembuf);
1226          }          }
1227        else        else
# Line 1056  Proc         Status   Buffer         Tty Line 1242  Proc         Status   Buffer         Tty
1242    return Qnil;    return Qnil;
1243  }  }
1244    
1245  DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",  DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
1246         doc: /* Display a list of all processes.         doc: /* Display a list of all processes.
1247    If optional argument QUERY-ONLY is non-nil, only processes with
1248    the query-on-exit flag set will be listed.
1249  Any process listed as exited or signaled is actually eliminated  Any process listed as exited or signaled is actually eliminated
1250  after the listing is made.  */)  after the listing is made.  */)
1251       ()       (query_only)
1252         Lisp_Object query_only;
1253  {  {
1254    internal_with_output_to_temp_buffer ("*Process List*",    internal_with_output_to_temp_buffer ("*Process List*",
1255                                         list_processes_1, Qnil);                                         list_processes_1, query_only);
1256    return Qnil;    return Qnil;
1257  }  }
1258    
# Line 1776  create_process (process, new_argv, curre Line 1965  create_process (process, new_argv, curre
1965  }  }
1966  #endif /* not VMS */  #endif /* not VMS */
1967    
1968    
1969  #ifdef HAVE_SOCKETS  #ifdef HAVE_SOCKETS
1970    
1971  /* open a TCP network connection to a given HOST/SERVICE.  Treated  /* Convert an internal struct sockaddr to a lisp object (vector or string).
1972     exactly like a normal process when reading and writing.  Only     The address family of sa is not included in the result.  */
1973    
1974    static Lisp_Object
1975    conv_sockaddr_to_lisp (sa, len)
1976         struct sockaddr *sa;
1977         int len;
1978    {
1979      Lisp_Object address;
1980      int i;
1981      unsigned char *cp;
1982      register struct Lisp_Vector *p;
1983    
1984      switch (sa->sa_family)
1985        {
1986        case AF_INET:
1987          {
1988            struct sockaddr_in *sin = (struct sockaddr_in *) sa;
1989            len = sizeof (sin->sin_addr) + 1;
1990            address = Fmake_vector (make_number (len), Qnil);
1991            p = XVECTOR (address);
1992            p->contents[--len] = make_number (ntohs (sin->sin_port));
1993            cp = (unsigned char *)&sin->sin_addr;
1994            break;
1995          }
1996    #ifdef HAVE_LOCAL_SOCKETS
1997        case AF_LOCAL:
1998          {
1999            struct sockaddr_un *sun = (struct sockaddr_un *) sa;
2000            for (i = 0; i < sizeof (sun->sun_path); i++)
2001              if (sun->sun_path[i] == 0)
2002                break;
2003            return make_unibyte_string (sun->sun_path, i);
2004          }
2005    #endif
2006        default:
2007          len -= sizeof (sa->sa_family);
2008          address = Fcons (make_number (sa->sa_family),
2009                           Fmake_vector (make_number (len), Qnil));
2010          p = XVECTOR (XCDR (address));
2011          cp = (unsigned char *) sa + sizeof (sa->sa_family);
2012          break;
2013        }
2014    
2015      i = 0;
2016      while (i < len)
2017        p->contents[i++] = make_number (*cp++);
2018    
2019      return address;
2020    }
2021    
2022    
2023    /* Get family and required size for sockaddr structure to hold ADDRESS.  */
2024    
2025    static int
2026    get_lisp_to_sockaddr_size (address, familyp)
2027         Lisp_Object address;
2028         int *familyp;
2029    {
2030      register struct Lisp_Vector *p;
2031    
2032      if (VECTORP (address))
2033        {
2034          p = XVECTOR (address);
2035          if (p->size == 5)
2036            {
2037              *familyp = AF_INET;
2038              return sizeof (struct sockaddr_in);
2039            }
2040        }
2041    #ifdef HAVE_LOCAL_SOCKETS
2042      else if (STRINGP (address))
2043        {
2044          *familyp = AF_LOCAL;
2045          return sizeof (struct sockaddr_un);
2046        }
2047    #endif
2048      else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
2049        {
2050          struct sockaddr *sa;
2051          *familyp = XINT (XCAR (address));
2052          p = XVECTOR (XCDR (address));
2053          return p->size + sizeof (sa->sa_family);
2054        }
2055      return 0;
2056    }
2057    
2058    /* Convert an address object (vector or string) to an internal sockaddr.
2059       Format of address has already been validated by size_lisp_to_sockaddr.  */
2060    
2061    static void
2062    conv_lisp_to_sockaddr (family, address, sa, len)
2063         int family;
2064         Lisp_Object address;
2065         struct sockaddr *sa;
2066         int len;
2067    {
2068      register struct Lisp_Vector *p;
2069      register unsigned char *cp;
2070      register int i;
2071    
2072      bzero (sa, len);
2073      sa->sa_family = family;
2074    
2075      if (VECTORP (address))
2076        {
2077          p = XVECTOR (address);
2078          if (family == AF_INET)
2079            {
2080              struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2081              len = sizeof (sin->sin_addr) + 1;
2082              i = XINT (p->contents[--len]);
2083              sin->sin_port = htons (i);
2084              cp = (unsigned char *)&sin->sin_addr;
2085            }
2086        }
2087      else if (STRINGP (address))
2088        {
2089    #ifdef HAVE_LOCAL_SOCKETS
2090          if (family == AF_LOCAL)
2091            {
2092              struct sockaddr_un *sun = (struct sockaddr_un *) sa;
2093              cp = XSTRING (address)->data;
2094              for (i = 0; i < sizeof (sun->sun_path) && *cp; i++)
2095                sun->sun_path[i] = *cp++;
2096            }
2097    #endif
2098          return;
2099        }
2100      else
2101        {
2102          p = XVECTOR (XCDR (address));
2103          cp = (unsigned char *)sa + sizeof (sa->sa_family);
2104        }
2105    
2106      for (i = 0; i < len; i++)
2107        if (INTEGERP (p->contents[i]))
2108          *cp++ = XFASTINT (p->contents[i]) & 0xff;
2109    }
2110    
2111    #ifdef DATAGRAM_SOCKETS
2112    DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2113           1, 1, 0,
2114           doc: /* Get the current datagram address associated with PROCESS.  */)
2115           (process)
2116           Lisp_Object process;
2117    {
2118      int channel;
2119    
2120      CHECK_PROCESS (process);
2121    
2122      if (!DATAGRAM_CONN_P (process))
2123        return Qnil;
2124    
2125      channel = XPROCESS (process)->infd;
2126      return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2127                                    datagram_address[channel].len);
2128    }
2129    
2130    DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2131           2, 2, 0,
2132           doc: /* Set the datagram address for PROCESS to ADDRESS.
2133    Returns nil upon error setting address, ADDRESS otherwise.  */)
2134           (process, address)
2135           Lisp_Object process, address;
2136    {
2137      int channel;
2138      int family, len;
2139    
2140      CHECK_PROCESS (process);
2141    
2142      if (!DATAGRAM_CONN_P (process))
2143        return Qnil;
2144    
2145      channel = XPROCESS (process)->infd;
2146    
2147      len = get_lisp_to_sockaddr_size (address, &family);
2148      if (datagram_address[channel].len != len)
2149        return Qnil;
2150      conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2151      return address;
2152    }
2153    #endif
2154    
2155    
2156    static struct socket_options {
2157      /* The name of this option.  Should be lowercase version of option
2158         name without SO_ prefix. */
2159      char *name;
2160      /* Length of name.  */
2161      int nlen;
2162      /* Option level SOL_... */
2163      int optlevel;
2164      /* Option number SO_... */
2165      int optnum;
2166      enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_STR, SOPT_LINGER } opttype;
2167    } socket_options[] =
2168      {
2169    #ifdef SO_BINDTODEVICE
2170        { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
2171    #endif
2172    #ifdef SO_BROADCAST
2173        { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
2174    #endif
2175    #ifdef SO_DONTROUTE
2176        { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
2177    #endif
2178    #ifdef SO_KEEPALIVE
2179        { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
2180    #endif
2181    #ifdef SO_LINGER
2182        { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
2183    #endif
2184    #ifdef SO_OOBINLINE
2185        { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
2186    #endif
2187    #ifdef SO_PRIORITY
2188        { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
2189    #endif
2190    #ifdef SO_REUSEADDR
2191        { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
2192    #endif
2193        { 0, 0, 0, 0, SOPT_UNKNOWN }
2194      };
2195    
2196    /* Process list of socket options OPTS on socket S.
2197       Only check if options are supported is S < 0.
2198       If NO_ERROR is non-zero, continue silently if an option
2199       cannot be set.
2200    
2201       Each element specifies one option.  An element is either a string
2202       "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
2203       or a symbol.  */
2204    
2205    static int
2206    set_socket_options (s, opts, no_error)
2207         int s;
2208         Lisp_Object opts;
2209         int no_error;
2210    {
2211      if (!CONSP (opts))
2212        opts = Fcons (opts, Qnil);
2213    
2214      while (CONSP (opts))
2215        {
2216          Lisp_Object opt;
2217          Lisp_Object val;
2218          char *name, *arg;
2219          struct socket_options *sopt;
2220          int optnum, opttype;
2221          int ret = 0;
2222    
2223          opt = XCAR (opts);
2224          opts = XCDR (opts);
2225    
2226          name = 0;
2227          val = Qt;
2228          if (CONSP (opt))
2229            {
2230              val = XCDR (opt);
2231              opt = XCAR (opt);
2232            }
2233          if (STRINGP (opt))
2234            name = (char *) XSTRING (opt)->data;
2235          else if (SYMBOLP (opt))
2236            name = (char *) XSYMBOL (opt)->name->data;
2237          else {
2238            error ("Mal-formed option list");
2239            return 0;
2240          }
2241    
2242          if (strncmp (name, "no", 2) == 0)
2243            {
2244              val = Qnil;
2245              name += 2;
2246            }
2247    
2248          arg = 0;
2249          for (sopt = socket_options; sopt->name; sopt++)
2250            if (strncmp (name, sopt->name, sopt->nlen) == 0)
2251              {
2252                if (name[sopt->nlen] == 0)
2253                  break;
2254                if (name[sopt->nlen] == '=')
2255                  {
2256                    arg = name + sopt->nlen + 1;
2257                    break;
2258                  }
2259              }
2260    
2261          switch (sopt->opttype)
2262            {
2263            case SOPT_BOOL:
2264              {
2265                int optval;
2266                if (s < 0)
2267                  return 1;
2268                if (arg)
2269                  optval = (*arg == '0' || *arg == 'n') ? 0 : 1;
2270                else if (INTEGERP (val))
2271                  optval = XINT (val) == 0 ? 0 : 1;
2272                else
2273                  optval = NILP (val) ? 0 : 1;
2274                ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2275                                  &optval, sizeof (optval));
2276                break;
2277              }
2278    
2279            case SOPT_INT:
2280              {
2281                int optval;
2282                if (arg)
2283                  optval = atoi(arg);
2284                else if (INTEGERP (val))
2285                  optval = XINT (val);
2286                else
2287                  error ("Bad option argument for %s", name);
2288                if (s < 0)
2289                  return 1;
2290                ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2291                                  &optval, sizeof (optval));
2292                break;
2293              }
2294    
2295            case SOPT_STR:
2296              {
2297                if (!arg)
2298                  {
2299                    if (NILP (val))
2300                      arg = "";
2301                    else if (STRINGP (val))
2302                      arg = (char *) XSTRING (val)->data;
2303                    else if (XSYMBOL (val))
2304                      arg = (char *) XSYMBOL (val)->name->data;
2305                    else
2306                      error ("Invalid argument to %s option", name);
2307                  }
2308                ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2309                                  arg, strlen (arg));
2310              }
2311    
2312    #ifdef SO_LINGER            
2313            case SOPT_LINGER:
2314              {
2315                struct linger linger;
2316    
2317                linger.l_onoff = 1;
2318                linger.l_linger = 0;
2319    
2320                if (s < 0)
2321                  return 1;
2322    
2323                if (arg)
2324                  {
2325                    if (*arg == 'n' || *arg == 't' || *arg == 'y')
2326                      linger.l_onoff = (*arg == 'n') ? 0 : 1;
2327                    else
2328                      linger.l_linger = atoi(arg);
2329                  }
2330                else if (INTEGERP (val))
2331                  linger.l_linger = XINT (val);
2332                else
2333                  linger.l_onoff = NILP (val) ? 0 : 1;
2334                ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2335                                  &linger, sizeof (linger));
2336                break;
2337              }
2338    #endif
2339            default:
2340              if (s < 0)
2341                return 0;
2342              if (no_error)
2343                continue;
2344              error ("Unsupported option: %s", name);
2345            }
2346          if (ret < 0 && ! no_error)
2347              report_file_error ("Cannot set network option: %s", opt);
2348        }
2349      return 1;
2350    }
2351    
2352    DEFUN ("set-network-process-options",
2353           Fset_network_process_options, Sset_network_process_options,
2354           1, MANY, 0,
2355           doc: /* Set one or more options for network process PROCESS.
2356    Arguments are PROCESS &rest OPTIONS.
2357    Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
2358    A boolean value is false if it either zero or nil, true otherwise.
2359    
2360    The following options are known.  Consult the relevant system manual
2361    pages for more information.
2362    
2363    bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
2364    broadcast=BOOL -- Allow send and receive of datagram broadcasts.
2365    dontroute=BOOL -- Only send to directly connected hosts.
2366    keepalive=BOOL -- Send keep-alive messages on network stream.
2367    linger=BOOL or TIMEOUT -- Send queued messages before closing.
2368    oobinline=BOOL -- Place out-of-band data in receive data stream.
2369    priority=INT -- Set protocol defined priority for sent packets.
2370    reuseaddr=BOOL -- Allow reusing a recently used address.  */)
2371         (nargs, args)
2372         int nargs;
2373         Lisp_Object *args;
2374    {
2375      Lisp_Object process;
2376      Lisp_Object opts;
2377    
2378      process = args[0];
2379      CHECK_PROCESS (process);
2380      if (nargs > 1 && XPROCESS (process)->infd >= 0)
2381        {
2382          opts = Flist (nargs, args);
2383          set_socket_options (XPROCESS (process)->infd, opts, 0);
2384        }
2385      return process;
2386    }
2387    
2388    /* Check whether a given KEY VALUE pair is supported on this system.  */
2389    
2390    static int
2391    network_process_featurep (key, value)
2392           Lisp_Object key, value;
2393    {
2394    
2395      if (EQ (key, QCnowait))
2396        {
2397    #ifdef NON_BLOCKING_CONNECT
2398          return 1;
2399    #else
2400          return NILP (value);
2401    #endif
2402        }
2403    
2404      if (EQ (key, QCdatagram))
2405        {
2406    #ifdef DATAGRAM_SOCKETS
2407          return 1;
2408    #else
2409          return NILP (value);
2410    #endif
2411        }
2412    
2413      if (EQ (key, QCfamily))
2414        {
2415          if (NILP (value))
2416            return 1;
2417    #ifdef HAVE_LOCAL_SOCKETS
2418          if (EQ (key, Qlocal))
2419            return 1;
2420    #endif
2421          return 0;
2422        }
2423    
2424      if (EQ (key, QCname))
2425        return STRINGP (value);
2426    
2427      if (EQ (key, QCbuffer))
2428        return (NILP (value) || STRINGP (value) || BUFFERP (value));
2429    
2430      if (EQ (key, QClocal) || EQ (key, QCremote))
2431        {
2432          int family;
2433          return get_lisp_to_sockaddr_size (value, &family);
2434        }
2435    
2436      if (EQ (key, QChost))
2437        return (NILP (value) || STRINGP (value));
2438    
2439      if (EQ (key, QCservice))
2440        {
2441    #ifdef HAVE_GETSOCKNAME
2442          if (EQ (value, Qt))
2443            return 1;
2444    #endif
2445          return (INTEGERP (value) || STRINGP (value));
2446        }
2447    
2448      if (EQ (key, QCserver))
2449        {
2450    #ifndef TERM
2451          return 1;
2452    #else
2453          return NILP (value);
2454    #endif
2455        }
2456    
2457      if (EQ (key, QCoptions))
2458        return set_socket_options (-1, value, 0);
2459    
2460      if (EQ (key, QCcoding))
2461        return 1;
2462      if (EQ (key, QCsentinel))
2463        return 1;
2464      if (EQ (key, QCfilter))
2465        return 1;
2466      if (EQ (key, QClog))
2467        return 1;
2468      if (EQ (key, QCnoquery))
2469        return 1;
2470      if (EQ (key, QCstop))
2471        return 1;
2472    
2473      return 0;
2474    }
2475    
2476    /* A version of request_sigio suitable for a record_unwind_protect.  */
2477    
2478    Lisp_Object
2479    unwind_request_sigio (dummy)
2480         Lisp_Object dummy;
2481    {
2482      if (interrupt_input)
2483        request_sigio ();
2484      return Qnil;
2485    }
2486    
2487    /* Create a network stream/datagram client/server process.  Treated
2488       exactly like a normal process when reading and writing.  Primary
2489     differences are in status display and process deletion.  A network     differences are in status display and process deletion.  A network
2490     connection has no PID; you cannot signal it.  All you can do is     connection has no PID; you cannot signal it.  All you can do is
2491     deactivate and close it via delete-process */     stop/continue it and deactivate/close it via delete-process */
   
 DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,  
        4, 7, 0,  
        doc: /* Open a TCP connection for a service to a host.  
 Returns a subprocess-object to represent the connection.  
 Returns nil if a non-blocking connect is attempted on a system which  
 cannot support that; in that case, the caller should attempt a  
 normal connect instead.  
2492    
2493  Input and output work as for subprocesses; `delete-process' closes it.  DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
2494  Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING.         0, MANY, 0,
2495  NAME is name for process.  It is modified if necessary to make it unique.         doc: /* Create and return a network server or client process.
2496  BUFFER is the buffer (or buffer-name) to associate with the process.  
2497   Process output goes at end of that buffer, unless you specify  In emacs, network connections are represented by process objects, so
2498   an output stream or filter function to handle the output.  input and output work as for subprocesses and `delete-process' closes
2499   BUFFER may be also nil, meaning that this process is not associated  a network connection.  However, a network process has no process id,
2500   with any buffer.  it cannot be signalled, and the status codes are different from normal
2501  HOST is name of the host to connect to, or its IP address.  processes.
2502  SERVICE is name of the service desired, or an integer specifying a  
2503   port number to connect to.    Arguments are specified as keyword/argument pairs.  The following
2504  FILTER and SENTINEL are optional args specifying the filter and  arguments are defined:
2505   sentinel functions associated with the network stream.  
2506  NON-BLOCKING is optional arg requesting an non-blocking connect.  :name NAME -- NAME is name for process.  It is modified if necessary
2507   When non-nil, open-network-stream will return immediately without  to make it unique.
2508   waiting for the connection to be made.  Instead, the sentinel function  
2509   will be called with second matching "open" (if successful) or  :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2510   "failed" when the connect completes.  */)  with the process.  Process output goes at end of that buffer, unless
2511       (name, buffer, host, service, filter, sentinel, non_blocking)  you specify an output stream or filter function to handle the output.
2512        Lisp_Object name, buffer, host, service, filter, sentinel, non_blocking;  BUFFER may be also nil, meaning that this process is not associated
2513    with any buffer.
2514    
2515    :host HOST -- HOST is name of the host to connect to, or its IP
2516    address.  The symbol `local' specifies the local host.  If specified
2517    for a server process, it must be a valid name or address for the local
2518    host, and only clients connecting to that address will be accepted.
2519    
2520    :service SERVICE -- SERVICE is name of the service desired, or an
2521    integer specifying a port number to connect to.  If SERVICE is t,
2522    a random port number is selected for the server.
2523    
2524    :family FAMILY -- FAMILY is the address (and protocol) family for the
2525    service specified by HOST and SERVICE.  The default address family is
2526    Inet (or IPv4) for the host and port number specified by HOST and
2527    SERVICE.  Other address families supported are:
2528      local -- for a local (i.e. UNIX) address specified by SERVICE.
2529    
2530    :local ADDRESS -- ADDRESS is the local address used for the connection.
2531    This parameter is ignored when opening a client process. When specified
2532    for a server process, the FAMILY, HOST and SERVICE args are ignored.
2533    
2534    :remote ADDRESS -- ADDRESS is the remote partner's address for the
2535    connection.  This parameter is ignored when opening a stream server
2536    process.  For a datagram server process, it specifies the initial
2537    setting of the remote datagram address.  When specified for a client
2538    process, the FAMILY, HOST, and SERVICE args are ignored.
2539    
2540    The format of ADDRESS depends on the address family:
2541    - An IPv4 address is represented as an vector of integers [A B C D P]
2542    corresponding to numeric IP address A.B.C.D and port number P.
2543    - A local address is represented as a string with the address in the
2544    local address space.
2545    - An "unsupported family" address is represented by a cons (F . AV)
2546    where F is the family number and AV is a vector containing the socket
2547    address data with one element per address data byte.  Do not rely on
2548    this format in portable code, as it may depend on implementation
2549    defined constants, data sizes, and data structure alignment.
2550    
2551    :coding CODING -- CODING is coding system for this process.
2552    
2553    :datagram BOOL -- Create a datagram type connection if BOOL is
2554    non-nil.  Default is a stream type connection.
2555    
2556    :options OPTIONS -- Set the specified options for the network process.
2557    See `set-process-options' for details.
2558    
2559    :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2560    return without waiting for the connection to complete; instead, the
2561    sentinel function will be called with second arg matching "open" (if
2562    successful) or "failed" when the connect completes.  Default is to use
2563    a blocking connect (i.e. wait) for stream type connections.
2564    
2565    :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2566    running when emacs is exited.
2567    
2568    :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2569    In the stopped state, a server process does not accept new
2570    connections, and a client process does not handle incoming traffic.
2571    The stopped state is cleared by `continue-process' and set by
2572    `stop-process'.
2573    
2574    :filter FILTER -- Install FILTER as the process filter.
2575    
2576    :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2577    
2578    :log LOG -- Install LOG as the server process log function.  This
2579    function is called as when the server accepts a network connection from a
2580    client.  The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2581    is the server process, CLIENT is the new process for the connection,
2582    and MESSAGE is a string.
2583    
2584    :server BOOL -- if BOOL is non-nil, create a server process for the
2585    specified FAMILY, SERVICE, and connection type (stream or datagram).
2586    Default is a client process.
2587    
2588    A server process will listen for and accept connections from
2589    clients.  When a client connection is accepted, a new network process
2590    is created for the connection with the following parameters:
2591    - The client's process name is constructed by concatenating the server
2592    process' NAME and a client identification string.
2593    - If the FILTER argument is non-nil, the client process will not get a
2594    separate process buffer; otherwise, the client's process buffer is a newly
2595    created buffer named after the server process' BUFFER name or process
2596    NAME concatenated with the client identification string.  
2597    - The connection type and the process filter and sentinel parameters are
2598    inherited from the server process' TYPE, FILTER and SENTINEL.
2599    - The client process' contact info is set according to the client's
2600    addressing information (typically an IP address and a port number).
2601    
2602    Notice that the FILTER and SENTINEL args are never used directly by
2603    the server process.  Also, the BUFFER argument is not used directly by
2604    the server process, but via `network-server-log-function' hook, a log
2605    of the accepted (and failed) connections may be recorded in the server
2606    process' buffer.
2607    
2608    The following special call returns t iff a given KEY VALUE
2609    pair is supported on this system:
2610      (make-network-process :feature KEY VALUE)  */)
2611         (nargs, args)
2612         int nargs;
2613         Lisp_Object *args;
2614  {  {
2615    Lisp_Object proc;    Lisp_Object proc;
2616      Lisp_Object contact;
2617      struct Lisp_Process *p;
2618  #ifdef HAVE_GETADDRINFO  #ifdef HAVE_GETADDRINFO
2619    struct addrinfo hints, *res, *lres;    struct addrinfo ai, *res, *lres;
2620    char *portstring, portbuf[128];        struct addrinfo hints;
2621          char *portstring, portbuf[128];
2622  #else /* HAVE_GETADDRINFO */  #else /* HAVE_GETADDRINFO */
   struct sockaddr_in address;  
   struct servent *svc_info;  
   struct hostent *host_info_ptr, host_info;  
   char *(addr_list[2]);  
   IN_ADDR numeric_addr;  
   int port;  
2623    struct _emacs_addrinfo    struct _emacs_addrinfo
2624    {    {
2625      int ai_family;      int ai_family;
# Line 1834  NON-BLOCKING is optional arg requesting Line 2630  NON-BLOCKING is optional arg requesting
2630      struct _emacs_addrinfo *ai_next;      struct _emacs_addrinfo *ai_next;
2631    } ai, *res, *lres;    } ai, *res, *lres;
2632  #endif /* HAVE_GETADDRINFO */  #endif /* HAVE_GETADDRINFO */
2633      struct sockaddr *sa = 0;
2634      struct sockaddr_in address_in;
2635    #ifdef HAVE_LOCAL_SOCKETS
2636      struct sockaddr_un address_un;
2637    #endif
2638      int port;
2639    int ret = 0;    int ret = 0;
2640    int xerrno = 0;    int xerrno = 0;
2641    int s = -1, outch, inch;    int s = -1, outch, inch;
2642    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;    struct gcpro gcpro1;
2643    int retry = 0;    int retry = 0;
2644    int count = specpdl_ptr - specpdl;    int count = specpdl_ptr - specpdl;
2645    int count1;    int count1;
2646    int is_non_blocking = 0;    Lisp_Object QCaddress;  /* one of QClocal or QCremote */
2647      Lisp_Object tem;
2648      Lisp_Object name, buffer, host, service, address;
2649      Lisp_Object filter, sentinel;
2650      int is_non_blocking_client = 0;
2651      int is_server = 0;
2652      int socktype = SOCK_STREAM;
2653      int family = -1;
2654    
2655    if (!NILP (non_blocking))    if (nargs == 0)
2656        return Qnil;
2657    
2658      /* Handle :feature KEY VALUE query.  */
2659      if (EQ (args[0], QCfeature))
2660      {      {
2661  #ifndef NON_BLOCKING_CONNECT        if (nargs != 3)
2662        return Qnil;          return Qnil;
2663  #else        return network_process_featurep (args[1], args[2]) ? Qt : Qnil;
       non_blocking = Qt;  /* Instead of GCPRO */  
       is_non_blocking = 1;  
 #endif  
2664      }      }
2665    
2666      /* Save arguments for process-contact and clone-process.  */
2667      contact = Flist (nargs, args);
2668      GCPRO1 (contact);
2669    
2670  #ifdef WINDOWSNT  #ifdef WINDOWSNT
2671    /* Ensure socket support is loaded if available. */    /* Ensure socket support is loaded if available. */
2672    init_winsock (TRUE);    init_winsock (TRUE);
2673  #endif  #endif
2674    
2675    /* Can only GCPRO 5 variables */    /* :datagram BOOL */
2676    GCPRO6 (name, buffer, host, service, sentinel, filter);    tem = Fplist_get (contact, QCdatagram);
2677    CHECK_STRING (name);    if (!NILP (tem))
2678    CHECK_STRING (host);      {
2679    #ifndef DATAGRAM_SOCKETS
2680          error ("Datagram connections not supported");
2681    #else
2682          socktype = SOCK_DGRAM;
2683    #endif
2684        }
2685    
2686  #ifdef HAVE_GETADDRINFO    /* :server BOOL */
2687    /* SERVICE can either be a string or int.    tem = Fplist_get (contact, QCserver);
2688       Convert to a C string for later use by getaddrinfo.  */    if (!NILP (tem))
   if (INTEGERP (service))  
2689      {      {
2690        sprintf (portbuf, "%ld", (long) XINT (service));  #ifdef TERM
2691        portstring = portbuf;        error ("Network servers not supported");
2692    #else
2693          is_server = 1;
2694    #endif
2695      }      }
2696    else  
2697      /* Make QCaddress an alias for :local (server) or :remote (client).  */
2698      QCaddress = is_server ? QClocal : QCremote;
2699    
2700      /* :wait BOOL */
2701      if (!is_server && socktype == SOCK_STREAM
2702          && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
2703      {      {
2704        CHECK_STRING (service);  #ifndef NON_BLOCKING_CONNECT
2705        portstring = XSTRING (service)->data;        error ("Non-blocking connect not supported");
2706    #else
2707          is_non_blocking_client = 1;
2708    #endif
2709      }      }
2710  #else /* HAVE_GETADDRINFO */  
2711      name = Fplist_get (contact, QCname);
2712      buffer = Fplist_get (contact, QCbuffer);
2713      filter = Fplist_get (contact, QCfilter);
2714      sentinel = Fplist_get (contact, QCsentinel);
2715    
2716      CHECK_STRING (name);
2717    
2718    #ifdef TERM
2719      /* Let's handle TERM before things get complicated ...   */
2720      host = Fplist_get (contact, QChost);
2721      CHECK_STRING (host);
2722      
2723      service = Fplist_get (contact, QCservice);
2724    if (INTEGERP (service))    if (INTEGERP (service))
2725      port = htons ((unsigned short) XINT (service));      port = htons ((unsigned short) XINT (service));
2726    else    else
2727      {      {
2728          struct servent *svc_info;
2729        CHECK_STRING (service);        CHECK_STRING (service);
2730        svc_info = getservbyname (XSTRING (service)->data, "tcp");        svc_info = getservbyname (XSTRING (service)->data, "tcp");
2731        if (svc_info == 0)        if (svc_info == 0)
2732          error ("Unknown service \"%s\"", XSTRING (service)->data);          error ("Unknown service: %s", XSTRING (service)->data);
2733        port = svc_info->s_port;        port = svc_info->s_port;
2734      }      }
 #endif /* HAVE_GETADDRINFO */  
2735    
2736      s = connect_server (0);
2737      if (s < 0)
2738        report_file_error ("error creating socket", Fcons (name, Qnil));
2739      send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
2740      send_command (s, C_DUMB, 1, 0);
2741    
2742    #else  /* not TERM */
2743    
2744      /* Initialize addrinfo structure in case we don't use getaddrinfo.  */
2745      ai.ai_socktype = socktype;
2746      ai.ai_protocol = 0;
2747      ai.ai_next = NULL;
2748      res = &ai;
2749    
2750      /* :local ADDRESS or :remote ADDRESS */
2751      address = Fplist_get (contact, QCaddress);
2752      if (!NILP (address))
2753        {
2754          host = service = Qnil;
2755    
2756          if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
2757            error ("Malformed :address");
2758          ai.ai_family = family;
2759          ai.ai_addr = alloca (ai.ai_addrlen);
2760          conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
2761          goto open_socket;
2762        }
2763    
2764      /* :family FAMILY -- nil (for Inet), local, or integer.  */
2765      tem = Fplist_get (contact, QCfamily);
2766      if (INTEGERP (tem))
2767        family = XINT (tem);
2768      else
2769        {
2770          if (NILP (tem))
2771            family = AF_INET;
2772    #ifdef HAVE_LOCAL_SOCKETS
2773          else if (EQ (tem, Qlocal))
2774            family = AF_LOCAL;
2775    #endif
2776        }
2777      if (family < 0)
2778        error ("Unknown address family");
2779      ai.ai_family = family;
2780    
2781      /* :service SERVICE -- string, integer (port number), or t (random port).  */
2782      service = Fplist_get (contact, QCservice);
2783    
2784    #ifdef HAVE_LOCAL_SOCKETS
2785      if (family == AF_LOCAL)
2786        {
2787          /* Host is not used.  */
2788          host = Qnil;
2789          CHECK_STRING (service);
2790          bzero (&address_un, sizeof address_un);
2791          address_un.sun_family = AF_LOCAL;
2792          strncpy (address_un.sun_path, XSTRING (service)->data, sizeof address_un.sun_path);
2793          ai.ai_addr = (struct sockaddr *) &address_un;
2794          ai.ai_addrlen = sizeof address_un;
2795          goto open_socket;
2796        }
2797    #endif
2798    
2799      /* :host HOST -- hostname, ip address, or 'local for localhost.  */
2800      host = Fplist_get (contact, QChost);
2801      if (!NILP (host))
2802        {
2803          if (EQ (host, Qlocal))
2804            host = build_string ("localhost");
2805          CHECK_STRING (host);
2806        }
2807    
2808    /* Slow down polling to every ten seconds.    /* Slow down polling to every ten seconds.
2809       Some kernels have a bug which causes retrying connect to fail       Some kernels have a bug which causes retrying connect to fail
2810       after a connect.  Polling can interfere with gethostbyname too.  */       after a connect.  Polling can interfere with gethostbyname too.  */
2811  #ifdef POLL_FOR_INPUT  #ifdef POLL_FOR_INPUT
2812    record_unwind_protect (unwind_stop_other_atimers, Qnil);    if (socktype == SOCK_STREAM)
2813    bind_polling_period (10);      {
2814          record_unwind_protect (unwind_stop_other_atimers, Qnil);
2815          bind_polling_period (10);
2816        }
2817  #endif  #endif
2818    
 #ifndef TERM  
2819  #ifdef HAVE_GETADDRINFO  #ifdef HAVE_GETADDRINFO
2820    immediate_quit = 1;    /* If we have a host, use getaddrinfo to resolve both host and service.
2821    QUIT;       Otherwise, use getservbyname to lookup the service.  */
2822    memset (&hints, 0, sizeof (hints));    if (!NILP (host))
2823    hints.ai_flags = 0;      {
2824    hints.ai_family = AF_UNSPEC;  
2825    hints.ai_socktype = SOCK_STREAM;        /* SERVICE can either be a string or int.
2826    hints.ai_protocol = 0;           Convert to a C string for later use by getaddrinfo.  */
2827    ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);        if (EQ (service, Qt))
2828    if (ret)          portstring = "0";
2829          else if (INTEGERP (service))
2830            {
2831              sprintf (portbuf, "%ld", (long) XINT (service));
2832              portstring = portbuf;
2833            }
2834          else
2835            {
2836              CHECK_STRING (service);
2837              portstring = XSTRING (service)->data;
2838            }
2839    
2840          immediate_quit = 1;
2841          QUIT;
2842          memset (&hints, 0, sizeof (hints));
2843          hints.ai_flags = 0;
2844          hints.ai_family = NILP (Fplist_member (contact, QCfamily)) ? AF_UNSPEC : family;
2845          hints.ai_socktype = socktype;
2846          hints.ai_protocol = 0;
2847          ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
2848          if (ret)
2849  #ifdef HAVE_GAI_STRERROR  #ifdef HAVE_GAI_STRERROR
2850      error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));          error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
2851  #else  #else
2852      error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring,          error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, ret);
            ret);  
2853  #endif  #endif
2854    immediate_quit = 0;        immediate_quit = 0;
2855    
2856  #else /* not HAVE_GETADDRINFO */        goto open_socket;
2857        }
2858    #endif /* HAVE_GETADDRINFO */
2859    
2860    while (1)    /* We end up here if getaddrinfo is not defined, or in case no hostname
2861         has been specified (e.g. for a local server process).  */
2862    
2863      if (EQ (service, Qt))
2864        port = 0;
2865      else if (INTEGERP (service))
2866        port = htons ((unsigned short) XINT (service));
2867      else
2868      {      {
2869  #if 0        struct servent *svc_info;
2870  #ifdef TRY_AGAIN        CHECK_STRING (service);
2871        h_errno = 0;        svc_info = getservbyname (XSTRING (service)->data,
2872  #endif                                  (socktype == SOCK_DGRAM ? "udp" : "tcp"));
2873  #endif        if (svc_info == 0)
2874            error ("Unknown service: %s", XSTRING (service)->data);
2875          port = svc_info->s_port;
2876        }
2877    
2878      bzero (&address_in, sizeof address_in);
2879      address_in.sin_family = family;
2880      address_in.sin_addr.s_addr = INADDR_ANY;
2881      address_in.sin_port = port;
2882    
2883    #ifndef HAVE_GETADDRINFO
2884      if (!NILP (host))
2885        {
2886          struct hostent *host_info_ptr;
2887    
2888          /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2889             as it may `hang' emacs for a very long time.  */
2890        immediate_quit = 1;        immediate_quit = 1;
2891        QUIT;        QUIT;
2892        host_info_ptr = gethostbyname (XSTRING (host)->data);        host_info_ptr = gethostbyname (XSTRING (host)->data);
2893        immediate_quit = 0;        immediate_quit = 0;
 #if 0  
 #ifdef TRY_AGAIN  
       if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))  
 #endif  
 #endif  
         break;  
       Fsleep_for (make_number (1), Qnil);  
     }  
2894        
2895    if (host_info_ptr == 0)        if (host_info_ptr)
2896      /* Attempt to interpret host as numeric inet address */          {
2897      {            bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
2898        numeric_addr = inet_addr ((char *) XSTRING (host)->data);                   host_info_ptr->h_length);
2899        if (NUMERIC_ADDR_ERROR)            family = host_info_ptr->h_addrtype;
2900          error ("Unknown host \"%s\"", XSTRING (host)->data);            address_in.sin_family = family;
2901            }
2902        host_info_ptr = &host_info;        else
2903        host_info.h_name = 0;          /* Attempt to interpret host as numeric inet address */
2904        host_info.h_aliases = 0;          {
2905        host_info.h_addrtype = AF_INET;            IN_ADDR numeric_addr;
2906  #ifdef h_addr            numeric_addr = inet_addr ((char *) XSTRING (host)->data);
2907        /* Older machines have only one address slot called h_addr.            if (NUMERIC_ADDR_ERROR)
2908           Newer machines have h_addr_list, but #define h_addr to              error ("Unknown host \"%s\"", XSTRING (host)->data);
2909           be its first element.  */  
2910        host_info.h_addr_list = &(addr_list[0]);            bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
2911  #endif                   sizeof (address_in.sin_addr));
2912        host_info.h_addr = (char*)(&numeric_addr);          }
2913        addr_list[1] = 0;  
2914        /* numeric_addr isn't null-terminated; it has fixed length.  */      }
       host_info.h_length = sizeof (numeric_addr);  
     }  
   
   bzero (&address, sizeof address);  
   bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,  
          host_info_ptr->h_length);  
   address.sin_family = host_info_ptr->h_addrtype;  
   address.sin_port = port;  
   
   /* Emulate HAVE_GETADDRINFO for the loop over `res' below.  */  
   ai.ai_family = host_info_ptr->h_addrtype;  
   ai.ai_socktype = SOCK_STREAM;  
   ai.ai_protocol = 0;  
   ai.ai_addr = (struct sockaddr *) &address;  
   ai.ai_addrlen = sizeof address;  
   ai.ai_next = NULL;  
   res = &ai;  
2915  #endif /* not HAVE_GETADDRINFO */  #endif /* not HAVE_GETADDRINFO */
2916    
2917      ai.ai_family = family;
2918      ai.ai_addr = (struct sockaddr *) &address_in;
2919      ai.ai_addrlen = sizeof address_in;
2920    
2921     open_socket:
2922    
2923      /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2924         when connect is interrupted.  So let's not let it get interrupted.
2925         Note we do not turn off polling, because polling is only used
2926         when not interrupt_input, and thus not normally used on the systems
2927         which have this bug.  On systems which use polling, there's no way
2928         to quit if polling is turned off.  */
2929      if (interrupt_input
2930          && !is_server && socktype == SOCK_STREAM)
2931        {
2932          /* Comment from KFS: The original open-network-stream code
2933             didn't unwind protect this, but it seems like the proper
2934             thing to do.  In any case, I don't see how it could harm to
2935             do this -- and it makes cleanup (using unbind_to) easier.  */
2936          record_unwind_protect (unwind_request_sigio, Qnil);
2937          unrequest_sigio ();
2938        }
2939    
2940    /* Do this in case we never enter the for-loop below.  */    /* Do this in case we never enter the for-loop below.  */
2941    count1 = specpdl_ptr - specpdl;    count1 = specpdl_ptr - specpdl;
2942    s = -1;    s = -1;
# Line 1991  NON-BLOCKING is optional arg requesting Line 2950  NON-BLOCKING is optional arg requesting
2950            continue;            continue;
2951          }          }
2952    
2953    #ifdef DATAGRAM_SOCKETS
2954          if (!is_server && socktype == SOCK_DGRAM)
2955            break;
2956    #endif /* DATAGRAM_SOCKETS */
2957    
2958  #ifdef NON_BLOCKING_CONNECT  #ifdef NON_BLOCKING_CONNECT
2959        if (is_non_blocking)        if (is_non_blocking_client)
2960          {          {
2961  #ifdef O_NONBLOCK  #ifdef O_NONBLOCK
2962            ret = fcntl (s, F_SETFL, O_NONBLOCK);            ret = fcntl (s, F_SETFL, O_NONBLOCK);
# Line 2008  NON-BLOCKING is optional arg requesting Line 2972  NON-BLOCKING is optional arg requesting
2972              }              }
2973          }          }
2974  #endif  #endif
2975          
       /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)  
          when connect is interrupted.  So let's not let it get interrupted.  
          Note we do not turn off polling, because polling is only used  
          when not interrupt_input, and thus not normally used on the systems  
          which have this bug.  On systems which use polling, there's no way  
          to quit if polling is turned off.  */  
       if (interrupt_input)  
         unrequest_sigio ();  
   
2976        /* Make us close S if quit.  */        /* Make us close S if quit.  */
       count1 = specpdl_ptr - specpdl;  
2977        record_unwind_protect (close_file_unwind, make_number (s));        record_unwind_protect (close_file_unwind, make_number (s));
2978    
2979      loop:        if (is_server)
2980            {
2981              /* Configure as a server socket.  */
2982    #ifdef HAVE_LOCAL_SOCKETS
2983              if (family != AF_LOCAL)
2984    #endif
2985                {
2986                  int optval = 1;
2987                  if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
2988                    report_file_error ("Cannot set reuse option on server socket.", Qnil);
2989                }
2990          
2991              if (bind (s, lres->ai_addr, lres->ai_addrlen))
2992                report_file_error ("Cannot bind server socket", Qnil);
2993    
2994    #ifdef HAVE_GETSOCKNAME
2995              if (EQ (service, Qt))
2996                {
2997                  struct sockaddr_in sa1;
2998                  int len1 = sizeof (sa1);
2999                  if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3000                    {
3001                      ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
3002                      service = make_number (sa1.sin_port);
3003                      contact = Fplist_put (contact, QCservice, service);
3004                    }
3005                }
3006    #endif
3007    
3008              if (socktype == SOCK_STREAM && listen (s, 5))
3009                report_file_error ("Cannot listen on server socket", Qnil);
3010    
3011              break;
3012            }
3013    
3014        retry_connect:
3015    
3016        immediate_quit = 1;        immediate_quit = 1;
3017        QUIT;        QUIT;
# Line 2046  NON-BLOCKING is optional arg requesting Line 3035  NON-BLOCKING is optional arg requesting
3035    
3036        if (ret == 0 || xerrno == EISCONN)        if (ret == 0 || xerrno == EISCONN)
3037          {          {
           is_non_blocking = 0;  
3038            /* The unwind-protect will be discarded afterwards.            /* The unwind-protect will be discarded afterwards.
3039               Likewise for immediate_quit.  */               Likewise for immediate_quit.  */
3040            break;            break;
# Line 2054  NON-BLOCKING is optional arg requesting Line 3042  NON-BLOCKING is optional arg requesting
3042    
3043  #ifdef NON_BLOCKING_CONNECT  #ifdef NON_BLOCKING_CONNECT
3044  #ifdef EINPROGRESS  #ifdef EINPROGRESS
3045        if (is_non_blocking && xerrno == EINPROGRESS)        if (is_non_blocking_client && xerrno == EINPROGRESS)
3046          break;          break;
3047  #else  #else
3048  #ifdef EWOULDBLOCK  #ifdef EWOULDBLOCK
3049        if (is_non_blocking && xerrno == EWOULDBLOCK)        if (is_non_blocking_client && xerrno == EWOULDBLOCK)
3050          break;          break;
3051  #endif  #endif
3052  #endif  #endif
# Line 2067  NON-BLOCKING is optional arg requesting Line 3055  NON-BLOCKING is optional arg requesting
3055        immediate_quit = 0;        immediate_quit = 0;
3056    
3057        if (xerrno == EINTR)        if (xerrno == EINTR)
3058          goto loop;          goto retry_connect;
3059        if (xerrno == EADDRINUSE && retry < 20)        if (xerrno == EADDRINUSE && retry < 20)
3060          {          {
3061            /* A delay here is needed on some FreeBSD systems,            /* A delay here is needed on some FreeBSD systems,
# Line 2075  NON-BLOCKING is optional arg requesting Line 3063  NON-BLOCKING is optional arg requesting
3063               and should be infrequent.  */               and should be infrequent.  */
3064            Fsleep_for (make_number (1), Qnil);            Fsleep_for (make_number (1), Qnil);
3065            retry++;            retry++;
3066            goto loop;            goto retry_connect;
3067          }          }
3068    
3069        /* Discard the unwind protect closing S.  */        /* Discard the unwind protect closing S.  */
3070        specpdl_ptr = specpdl + count1;        specpdl_ptr = specpdl + count1;
       count1 = specpdl_ptr - specpdl;  
         
3071        emacs_close (s);        emacs_close (s);
3072        s = -1;        s = -1;
3073      }      }
3074    
3075      if (s >= 0)
3076        {
3077    #ifdef DATAGRAM_SOCKETS
3078          if (socktype == SOCK_DGRAM)
3079            {
3080              if (datagram_address[s].sa)
3081                abort ();
3082              datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
3083              datagram_address[s].len = lres->ai_addrlen;
3084              if (is_server)
3085                {
3086                  Lisp_Object remote;
3087                  bzero (datagram_address[s].sa, lres->ai_addrlen);
3088                  if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3089                    {
3090                      int rfamily, rlen;
3091                      rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3092                      if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
3093                        conv_lisp_to_sockaddr (rfamily, remote,
3094                                               datagram_address[s].sa, rlen);
3095                    }
3096                }
3097              else
3098                bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
3099            }
3100    #endif
3101          contact = Fplist_put (contact, QCaddress,
3102                                conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
3103        }
3104    
3105  #ifdef HAVE_GETADDRINFO  #ifdef HAVE_GETADDRINFO
3106    freeaddrinfo (res);    if (res != &ai)
3107        freeaddrinfo (res);
3108  #endif  #endif
3109    
3110      immediate_quit = 0;
3111    
3112      /* Discard the unwind protect for closing S, if any.  */
3113      specpdl_ptr = specpdl + count1;
3114    
3115      /* Unwind bind_polling_period and request_sigio.  */
3116      unbind_to (count, Qnil);
3117    
3118    if (s < 0)    if (s < 0)
3119      {      {
       if (interrupt_input)  
         request_sigio ();  
   
3120        /* If non-blocking got this far - and failed - assume non-blocking is        /* If non-blocking got this far - and failed - assume non-blocking is
3121           not supported after all.  This is probably a wrong assumption, but           not supported after all.  This is probably a wrong assumption, but
3122           the normal blocking calls to open-network-stream handles this error           the normal blocking calls to open-network-stream handles this error
3123           better.  */           better.  */
3124        if (is_non_blocking)        if (is_non_blocking_client)
         {  
 #ifdef POLL_FOR_INPUT  
           unbind_to (count, Qnil);  
 #endif  
3125            return Qnil;            return Qnil;
         }  
3126    
3127        errno = xerrno;        errno = xerrno;
3128        report_file_error ("connection failed",        if (is_server)
3129                           Fcons (host, Fcons (name, Qnil)));          report_file_error ("make server process failed", contact);
3130          else
3131            report_file_error ("make client process failed", contact);
3132      }      }
     
   immediate_quit = 0;  
   
   /* Discard the unwind protect, if any.  */  
   specpdl_ptr = specpdl + count1;  
3133    
3134  #ifdef POLL_FOR_INPUT    tem = Fplist_get (contact, QCoptions);
3135    unbind_to (count, Qnil);    if (!NILP (tem))
3136  #endif      set_socket_options (s, tem, 1);
   
   if (interrupt_input)  
     request_sigio ();  
3137    
3138  #else /* TERM */  #endif /* not TERM */
   s = connect_server (0);  
   if (s < 0)  
     report_file_error ("error creating socket", Fcons (name, Qnil));  
   send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));  
   send_command (s, C_DUMB, 1, 0);  
 #endif /* TERM */  
3139    
3140    inch = s;    inch = s;
3141    outch = s;    outch = s;
# Line 2149  NON-BLOCKING is optional arg requesting Line 3154  NON-BLOCKING is optional arg requesting
3154  #endif  #endif
3155  #endif  #endif
3156    
3157    XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));    p = XPROCESS (proc);
3158    XPROCESS (proc)->command_channel_p = Qnil;  
3159    XPROCESS (proc)->buffer = buffer;    p->childp = contact;
3160    XPROCESS (proc)->sentinel = sentinel;    p->buffer = buffer;
3161    XPROCESS (proc)->filter = filter;    p->sentinel = sentinel;
3162    XPROCESS (proc)->command = Qnil;    p->filter = filter;
3163    XPROCESS (proc)->pid = Qnil;    p->log = Fplist_get (contact, QClog);
3164    XSETINT (XPROCESS (proc)->infd, inch);    if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3165    XSETINT (XPROCESS (proc)->outfd, outch);      p->kill_without_query = Qt;
3166    XPROCESS (proc)->status = Qrun;    if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
3167        p->command = Qt;
3168      p->pid = Qnil;
3169      XSETINT (p->infd, inch);
3170      XSETINT (p->outfd, outch);
3171      if (is_server && socktype == SOCK_STREAM)
3172        p->status = Qlisten;
3173    
3174  #ifdef NON_BLOCKING_CONNECT  #ifdef NON_BLOCKING_CONNECT
3175    if (!NILP (non_blocking))    if (is_non_blocking_client)
3176      {      {
3177        /* We may get here if connect did succeed immediately.  However,        /* We may get here if connect did succeed immediately.  However,
3178           in that case, we still need to signal this like a non-blocking           in that case, we still need to signal this like a non-blocking
3179           connection.  */           connection.  */
3180        XPROCESS (proc)->status = Qconnect;        p->status = Qconnect;
3181        if (!FD_ISSET (inch, &connect_wait_mask))        if (!FD_ISSET (inch, &connect_wait_mask))
3182          {          {
3183            FD_SET (inch, &connect_wait_mask);            FD_SET (inch, &connect_wait_mask);
# Line 2175  NON-BLOCKING is optional arg requesting Line 3186  NON-BLOCKING is optional arg requesting
3186      }      }
3187    else    else
3188  #endif  #endif
3189      if (!EQ (XPROCESS (proc)->filter, Qt))      /* A server may have a client filter setting of Qt, but it must
3190           still listen for incoming connects unless it is stopped.  */
3191        if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3192            || (EQ (p->status, Qlisten) && NILP (p->command)))
3193        {        {
3194          FD_SET (inch, &input_wait_mask);          FD_SET (inch, &input_wait_mask);
3195          FD_SET (inch, &non_keyboard_wait_mask);          FD_SET (inch, &non_keyboard_wait_mask);
# Line 2184  NON-BLOCKING is optional arg requesting Line 3198  NON-BLOCKING is optional arg requesting
3198    if (inch > max_process_desc)    if (inch > max_process_desc)
3199      max_process_desc = inch;      max_process_desc = inch;
3200    
3201      tem = Fplist_member (contact, QCcoding);
3202      if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3203        tem = Qnil;  /* No error message (too late!).  */
3204    
3205    {    {
3206      /* Setup coding systems for communicating with the network stream.  */      /* Setup coding systems for communicating with the network stream.  */
3207      struct gcpro gcpro1;      struct gcpro gcpro1;
# Line 2191  NON-BLOCKING is optional arg requesting Line 3209  NON-BLOCKING is optional arg requesting
3209      Lisp_Object coding_systems = Qt;      Lisp_Object coding_systems = Qt;
3210      Lisp_Object args[5], val;      Lisp_Object args[5], val;
3211    
3212      if (!NILP (Vcoding_system_for_read))      if (!NILP (tem))
3213          val = XCAR (XCDR (tem));
3214        else if (!NILP (Vcoding_system_for_read))
3215        val = Vcoding_system_for_read;        val = Vcoding_system_for_read;
3216      else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))      else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
3217               || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))               || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
# Line 2214  NON-BLOCKING is optional arg requesting Line 3234  NON-BLOCKING is optional arg requesting
3234          else          else
3235            val = Qnil;            val = Qnil;
3236        }        }
3237      XPROCESS (proc)->decode_coding_system = val;      p->decode_coding_system = val;
3238    
3239      if (!NILP (Vcoding_system_for_write))      if (!NILP (tem))
3240          val = XCAR (XCDR (tem));
3241        else if (!NILP (Vcoding_system_for_write))
3242        val = Vcoding_system_for_write;        val = Vcoding_system_for_write;
3243      else if (NILP (current_buffer->enable_multibyte_characters))      else if (NILP (current_buffer->enable_multibyte_characters))
3244        val = Qnil;        val = Qnil;
# Line 2237  NON-BLOCKING is optional arg requesting Line 3259  NON-BLOCKING is optional arg requesting
3259          else          else
3260            val = Qnil;            val = Qnil;
3261        }        }
3262      XPROCESS (proc)->encode_coding_system = val;      p->encode_coding_system = val;
3263    }    }
3264    
3265    if (!proc_decode_coding_system[inch])    if (!proc_decode_coding_system[inch])
3266      proc_decode_coding_system[inch]      proc_decode_coding_system[inch]
3267        = (struct coding_system *) xmalloc (sizeof (struct coding_system));        = (struct coding_system *) xmalloc (sizeof (struct coding_system));
3268    setup_coding_system (XPROCESS (proc)->decode_coding_system,    setup_coding_system (p->decode_coding_system,
3269                         proc_decode_coding_system[inch]);                         proc_decode_coding_system[inch]);
3270    if (!proc_encode_coding_system[outch])    if (!proc_encode_coding_system[outch])
3271      proc_encode_coding_system[outch]      proc_encode_coding_system[outch]
3272        = (struct coding_system *) xmalloc (sizeof (struct coding_system));        = (struct coding_system *) xmalloc (sizeof (struct coding_system));
3273    setup_coding_system (XPROCESS (proc)->encode_coding_system,    setup_coding_system (p->encode_coding_system,
3274                         proc_encode_coding_system[outch]);                         proc_encode_coding_system[outch]);
3275    
3276    XPROCESS (proc)->decoding_buf = make_uninit_string (0);    p->decoding_buf = make_uninit_string (0);
3277    XPROCESS (proc)->decoding_carryover = make_number (0);    p->decoding_carryover = make_number (0);
3278    XPROCESS (proc)->encoding_buf = make_uninit_string (0);    p->encoding_buf = make_uninit_string (0);
3279    XPROCESS (proc)->encoding_carryover = make_number (0);    p->encoding_carryover = make_number (0);
3280    
3281    XPROCESS (proc)->inherit_coding_system_flag    p->inherit_coding_system_flag
3282      = (NILP (buffer) || !inherit_process_coding_system      = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system
3283         ? Qnil : Qt);         ? Qnil : Qt);
3284    
3285    UNGCPRO;    UNGCPRO;
# Line 2295  deactivate_process (proc) Line 3317  deactivate_process (proc)
3317    
3318        XSETINT (p->infd, -1);        XSETINT (p->infd, -1);
3319        XSETINT (p->outfd, -1);        XSETINT (p->outfd, -1);
3320    #ifdef DATAGRAM_SOCKETS
3321          if (DATAGRAM_CHAN_P (inchannel))
3322            {
3323              xfree (datagram_address[inchannel].sa);
3324              datagram_address[inchannel].sa = 0;
3325              datagram_address[inchannel].len = 0;
3326            }
3327    #endif
3328        chan_process[inchannel] = Qnil;        chan_process[inchannel] = Qnil;
3329        FD_CLR (inchannel, &input_wait_mask);        FD_CLR (inchannel, &input_wait_mask);
3330        FD_CLR (inchannel, &non_keyboard_wait_mask);        FD_CLR (inchannel, &non_keyboard_wait_mask);
# Line 2411  Return non-nil iff we received any outpu Line 3441  Return non-nil iff we received any outpu
3441       ? Qt : Qnil);       ? Qt : Qnil);
3442  }  }
3443    
3444    /* Accept a connection for server process SERVER on CHANNEL.  */
3445    
3446    static int connect_counter = 0;
3447    
3448    static void
3449    server_accept_connection (server, channel)
3450         Lisp_Object server;
3451         int channel;
3452    {
3453      Lisp_Object proc, caller, name, buffer;
3454      Lisp_Object contact, host, service;
3455      struct Lisp_Process *ps= XPROCESS (server);
3456      struct Lisp_Process *p;
3457      int s;
3458      union u_sockaddr {
3459        struct sockaddr sa;
3460        struct sockaddr_in in;
3461    #ifdef HAVE_LOCAL_SOCKETS
3462        struct sockaddr_un un;
3463    #endif
3464      } saddr;
3465      int len = sizeof saddr;
3466    
3467      s = accept (channel, &saddr.sa, &len);
3468    
3469      if (s < 0)
3470        {
3471          int code = errno;
3472    
3473          if (code == EAGAIN)
3474            return;
3475    #ifdef EWOULDBLOCK
3476          if (code == EWOULDBLOCK)
3477            return;
3478    #endif
3479    
3480          if (!NILP (ps->log))
3481            call3 (ps->log, server, Qnil,
3482                   concat3 (build_string ("accept failed with code"),
3483                            Fnumber_to_string (make_number (code)),
3484                            build_string ("\n")));
3485          return;
3486        }
3487    
3488      connect_counter++;
3489    
3490      /* Setup a new process to handle the connection.  */
3491    
3492      /* Generate a unique identification of the caller, and build contact
3493         information for this process.  */
3494      host = Qt;
3495      service = Qnil;
3496      switch (saddr.sa.sa_family)
3497        {
3498        case AF_INET:
3499          {
3500            Lisp_Object args[5];
3501            unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
3502            args[0] = build_string ("%d.%d.%d.%d");
3503            args[1] = make_number (*ip++);
3504            args[2] = make_number (*ip++);
3505            args[3] = make_number (*ip++);
3506            args[4] = make_number (*ip++);
3507            host = Fformat (5, args);
3508            service = make_number (ntohs (saddr.in.sin_port));
3509    
3510            args[0] = build_string (" <%s:%d>");
3511            args[1] = host;
3512            args[2] = service;
3513            caller = Fformat (3, args);
3514          }
3515          break;
3516    
3517    #ifdef HAVE_LOCAL_SOCKETS
3518        case AF_LOCAL:
3519    #endif
3520        default:
3521          caller = Fnumber_to_string (make_number (connect_counter));
3522          caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
3523          break;
3524        }
3525    
3526      /* Create a new buffer name for this process if it doesn't have a
3527         filter.  The new buffer name is based on the buffer name or
3528         process name of the server process concatenated with the caller
3529         identification.  */
3530    
3531      if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
3532        buffer = Qnil;
3533      else
3534        {
3535          buffer = ps->buffer;
3536          if (!NILP (buffer))
3537            buffer = Fbuffer_name (buffer);
3538          else
3539            buffer = ps->name;
3540          if (!NILP (buffer))
3541            {
3542              buffer = concat2 (buffer, caller);
3543              buffer = Fget_buffer_create (buffer);
3544            }
3545        }
3546    
3547      /* Generate a unique name for the new server process.  Combine the
3548         server process name with the caller identification.  */
3549    
3550      name = concat2 (ps->name, caller);
3551      proc = make_process (name);
3552    
3553      chan_process[s] = proc;
3554    
3555    #ifdef O_NONBLOCK
3556      fcntl (s, F_SETFL, O_NONBLOCK);
3557    #else
3558    #ifdef O_NDELAY
3559      fcntl (s, F_SETFL, O_NDELAY);
3560    #endif
3561    #endif
3562    
3563      p = XPROCESS (proc);
3564    
3565      /* Build new contact information for this setup.  */
3566      contact = Fcopy_sequence (ps->childp);
3567      contact = Fplist_put (contact, QCserver, Qnil);
3568      contact = Fplist_put (contact, QChost, host);
3569      if (!NILP (service))
3570        contact = Fplist_put (contact, QCservice, service);
3571      contact = Fplist_put (contact, QCremote,
3572                            conv_sockaddr_to_lisp (&saddr.sa, len));
3573    #ifdef HAVE_GETSOCKNAME
3574      len = sizeof saddr;
3575      if (getsockname (channel, &saddr.sa, &len) == 0)
3576        contact = Fplist_put (contact, QClocal,
3577                              conv_sockaddr_to_lisp (&saddr.sa, len));
3578    #endif
3579    
3580      p->childp = contact;
3581      p->buffer = buffer;
3582      p->sentinel = ps->sentinel;
3583      p->filter = ps->filter;
3584      p->command = Qnil;
3585      p->pid = Qnil;
3586      XSETINT (p->infd, s);
3587      XSETINT (p->outfd, s);
3588      p->status = Qrun;
3589    
3590      /* Client processes for accepted connections are not stopped initially.  */
3591      if (!EQ (p->filter, Qt))
3592        {
3593          FD_SET (s, &input_wait_mask);
3594          FD_SET (s, &non_keyboard_wait_mask);
3595        }
3596    
3597      if (s > max_process_desc)
3598        max_process_desc = s;
3599    
3600      /* Setup coding system for new process based on server process.  
3601         This seems to be the proper thing to do, as the coding system
3602         of the new process should reflect the settings at the time the
3603         server socket was opened; not the current settings. */
3604    
3605      p->decode_coding_system = ps->decode_coding_system;
3606      p->encode_coding_system = ps->encode_coding_system;
3607    
3608      if (!proc_decode_coding_system[s])
3609        proc_decode_coding_system[s]
3610          = (struct coding_system *) xmalloc (sizeof (struct coding_system));
3611      setup_coding_system (p->decode_coding_system,
3612                           proc_decode_coding_system[s]);
3613      if (!proc_encode_coding_system[s])
3614        proc_encode_coding_system[s]
3615          = (struct coding_system *) xmalloc (sizeof (struct coding_system));
3616      setup_coding_system (p->encode_coding_system,
3617                           proc_encode_coding_system[s]);
3618    
3619      p->decoding_buf = make_uninit_string (0);
3620      p->decoding_carryover = make_number (0);
3621      p->encoding_buf = make_uninit_string (0);
3622      p->encoding_carryover = make_number (0);
3623    
3624      p->inherit_coding_system_flag
3625        = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag);
3626    
3627      if (!NILP (ps->log))
3628          call3 (ps->log, server, proc,
3629                 concat3 (build_string ("accept from "),
3630                          (STRINGP (host) ? host : build_string ("-")),
3631                          build_string ("\n")));
3632    
3633      if (p->sentinel)
3634        exec_sentinel (proc,
3635                       concat3 (build_string ("open from "),
3636                                (STRINGP (host) ? host : build_string ("-")),
3637                                build_string ("\n")));
3638    }
3639    
3640  /* This variable is different from waiting_for_input in keyboard.c.  /* This variable is different from waiting_for_input in keyboard.c.
3641     It is used to communicate to a lisp process-filter/sentinel (via the     It is used to communicate to a lisp process-filter/sentinel (via the
3642     function Fwaiting_for_user_input_p below) whether emacs was waiting     function Fwaiting_for_user_input_p below) whether emacs was waiting
# Line 2909  wait_reading_process_input (time_limit, Line 4135  wait_reading_process_input (time_limit,
4135                if (NILP (proc))                if (NILP (proc))
4136                  continue;                  continue;
4137    
4138                  /* If this is a server stream socket, accept connection.  */
4139                  if (EQ (XPROCESS (proc)->status, Qlisten))
4140                    {
4141                      server_accept_connection (proc, channel);
4142                      continue;
4143                    }
4144    
4145                /* Read data from the process, starting with our                /* Read data from the process, starting with our
4146                   buffered-ahead character if we have one.  */                   buffered-ahead character if we have one.  */
4147    
# Line 2983  wait_reading_process_input (time_limit, Line 4216  wait_reading_process_input (time_limit,
4216              {              {
4217                struct Lisp_Process *p;                struct Lisp_Process *p;
4218                struct sockaddr pname;                struct sockaddr pname;
4219                socklen_t pnamelen = sizeof(pname);                int pnamelen = sizeof(pname);
4220    
4221                FD_CLR (channel, &connect_wait_mask);                FD_CLR (channel, &connect_wait_mask);
4222                if (--num_pending_connects < 0)                if (--num_pending_connects < 0)
# Line 2999  wait_reading_process_input (time_limit, Line 4232  wait_reading_process_input (time_limit,
4232                /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.                /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4233                   So only use it on systems where it is known to work.  */                   So only use it on systems where it is known to work.  */
4234                {                {
4235                  socklen_t xlen = sizeof(xerrno);                  int xlen = sizeof(xerrno);
4236                  if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))                  if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
4237                    xerrno = errno;                    xerrno = errno;
4238                }                }
# Line 3028  wait_reading_process_input (time_limit, Line 4261  wait_reading_process_input (time_limit,
4261                       status_notify to do it later, it will read input                       status_notify to do it later, it will read input
4262                       from the process before calling the sentinel.  */                       from the process before calling the sentinel.  */
4263                    exec_sentinel (proc, build_string ("open\n"));                    exec_sentinel (proc, build_string ("open\n"));
4264                    if (!EQ (p->filter, Qt))                    if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
4265                      {                      {
4266                        FD_SET (XINT (p->infd), &input_wait_mask);                        FD_SET (XINT (p->infd), &input_wait_mask);
4267                        FD_SET (XINT (p->infd), &non_keyboard_wait_mask);                        FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
# Line 3106  read_process_output (proc, channel) Line 4339  read_process_output (proc, channel)
4339    register int opoint;    register int opoint;
4340    struct coding_system *coding = proc_decode_coding_system[channel];    struct coding_system *coding = proc_decode_coding_system[channel];
4341    int carryover = XINT (p->decoding_carryover);    int carryover = XINT (p->decoding_carryover);
4342      int readmax = 1024;
4343    
4344  #ifdef VMS  #ifdef VMS
4345    VMS_PROC_STUFF *vs, *get_vms_process_pointer();    VMS_PROC_STUFF *vs, *get_vms_process_pointer();
# Line 3137  read_process_output (proc, channel) Line 4371  read_process_output (proc, channel)
4371        bcopy (vs->inputBuffer, chars + carryover, nbytes);        bcopy (vs->inputBuffer, chars + carryover, nbytes);
4372      }      }
4373  #else /* not VMS */  #else /* not VMS */
4374    chars = (char *) alloca (carryover + 1024);  
4375    #ifdef DATAGRAM_SOCKETS
4376      /* A datagram is one packet; allow at least 1500+ bytes of data
4377         corresponding to the typical Ethernet frame size.  */
4378      if (DATAGRAM_CHAN_P (channel))
4379        {
4380          /* carryover = 0; */  /* Does carryover make sense for datagrams? */
4381          readmax += 1024;
4382        }
4383    #endif
4384    
4385      chars = (char *) alloca (carryover + readmax);
4386    if (carryover)    if (carryover)
4387      /* See the comment above.  */      /* See the comment above.  */
4388      bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);      bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
4389    
4390    #ifdef DATAGRAM_SOCKETS
4391      /* We have a working select, so proc_buffered_char is always -1.  */
4392      if (DATAGRAM_CHAN_P (channel))
4393        {
4394          int len = datagram_address[channel].len;
4395          nbytes = recvfrom (channel, chars + carryover, readmax - carryover,
4396                             0, datagram_address[channel].sa, &len);
4397        }
4398      else
4399    #endif
4400    if (proc_buffered_char[channel] < 0)    if (proc_buffered_char[channel] < 0)
4401      nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);      nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
4402    else    else
4403      {      {
4404        chars[carryover] = proc_buffered_char[channel];        chars[carryover] = proc_buffered_char[channel];
4405        proc_buffered_char[channel] = -1;        proc_buffered_char[channel] = -1;
4406        nbytes = emacs_read (channel, chars + carryover + 1,  1023 - carryover);        nbytes = emacs_read (channel, chars + carryover + 1,  readmax - 1 - carryover);
4407        if (nbytes < 0)        if (nbytes < 0)
4408          nbytes = 1;          nbytes = 1;
4409        else        else
# Line 3614  send_process (proc, buf, len, object) Line 4869  send_process (proc, buf, len, object)
4869            /* Send this batch, using one or more write calls.  */            /* Send this batch, using one or more write calls.  */
4870            while (this > 0)            while (this > 0)
4871              {              {
4872                  int outfd = XINT (XPROCESS (proc)->outfd);
4873                old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);                old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
4874                rv = emacs_write (XINT (XPROCESS (proc)->outfd),  #ifdef DATAGRAM_SOCKETS
4875                                  (char *) buf, this);                if (DATAGRAM_CHAN_P (outfd))
4876                    {
4877                      rv = sendto (outfd, (char *) buf, this,
4878                                   0, datagram_address[outfd].sa,
4879                                   datagram_address[outfd].len);
4880                      if (rv < 0 && errno == EMSGSIZE)
4881                        report_file_error ("sending datagram", Fcons (proc, Qnil));
4882                    }
4883                  else
4884    #endif
4885                    rv = emacs_write (outfd, (char *) buf, this);
4886                signal (SIGPIPE, old_sigpipe);                signal (SIGPIPE, old_sigpipe);
4887    
4888                if (rv < 0)                if (rv < 0)
# Line 4071  See function `interrupt-process' for mor Line 5337  See function `interrupt-process' for mor
5337    
5338  DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,  DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
5339         doc: /* Stop process PROCESS.  May be process or name of one.         doc: /* Stop process PROCESS.  May be process or name of one.
5340  See function `interrupt-process' for more details on usage.  */)  See function `interrupt-process' for more details on usage.  
5341    If PROCESS is a network process, inhibit handling of incoming traffic.  */)
5342       (process, current_group)       (process, current_group)
5343       Lisp_Object process, current_group;       Lisp_Object process, current_group;
5344  {  {
5345    #ifdef HAVE_SOCKETS
5346      if (PROCESSP (process) && NETCONN_P (process))
5347        {
5348          struct Lisp_Process *p;
5349      
5350          p = XPROCESS (process);
5351          if (NILP (p->command)
5352              && XINT (p->infd) >= 0)
5353            {
5354              FD_CLR (XINT (p->infd), &input_wait_mask);
5355              FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
5356            }
5357          p->command = Qt;
5358          return process;
5359        }
5360    #endif
5361  #ifndef SIGTSTP  #ifndef SIGTSTP
5362    error ("no SIGTSTP support");    error ("no SIGTSTP support");
5363  #else  #else
# Line 4085  See function `interrupt-process' for mor Line 5368  See function `interrupt-process' for mor
5368    
5369  DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,  DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
5370         doc: /* Continue process PROCESS.  May be process or name of one.         doc: /* Continue process PROCESS.  May be process or name of one.
5371  See function `interrupt-process' for more details on usage.  */)  See function `interrupt-process' for more details on usage.  
5372    If PROCESS is a network process, resume handling of incoming traffic.  */)
5373       (process, current_group)       (process, current_group)
5374       Lisp_Object process, current_group;       Lisp_Object process, current_group;
5375  {  {
5376    #ifdef HAVE_SOCKETS
5377      if (PROCESSP (process) && NETCONN_P (process))
5378        {
5379          struct Lisp_Process *p;
5380    
5381          p = XPROCESS (process);
5382          if (EQ (p->command, Qt)
5383              && XINT (p->infd) >= 0
5384              && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
5385            {
5386              FD_SET (XINT (p->infd), &input_wait_mask);
5387              FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
5388            }
5389          p->command = Qnil;
5390          return process;
5391        }
5392    #endif
5393  #ifdef SIGCONT  #ifdef SIGCONT
5394      process_send_signal (process, SIGCONT, current_group, 0);      process_send_signal (process, SIGCONT, current_group, 0);
5395  #else  #else
# Line 4235  text to PROCESS after you call this func Line 5536  text to PROCESS after you call this func
5536    Lisp_Object proc;    Lisp_Object proc;
5537    struct coding_system *coding;    struct coding_system *coding;
5538    
5539      if (DATAGRAM_CONN_P (process))
5540        return process;
5541    
5542    proc = get_process (process);    proc = get_process (process);
5543    coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];    coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
5544    
# Line 4619  status_notify () Line 5923  status_notify ()
5923            /* If process is still active, read any output that remains.  */            /* If process is still active, read any output that remains.  */
5924            while (! EQ (p->filter, Qt)            while (! EQ (p->filter, Qt)
5925                   && ! EQ (p->status, Qconnect)                   && ! EQ (p->status, Qconnect)
5926                     && ! EQ (p->status, Qlisten)
5927                     && ! EQ (p->command, Qt)  /* Network process not stopped.  */
5928                   && XINT (p->infd) >= 0                   && XINT (p->infd) >= 0
5929                   && read_process_output (proc, XINT (p->infd)) > 0);                   && read_process_output (proc, XINT (p->infd)) > 0);
5930    
# Line 4829  init_process () Line 6135  init_process ()
6135      }      }
6136    bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);    bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
6137    bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);    bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
6138    #ifdef DATAGRAM_SOCKETS
6139      bzero (datagram_address, sizeof datagram_address);
6140    #endif
6141  }  }
6142    
6143  void  void
# Line 4857  syms_of_process () Line 6166  syms_of_process ()
6166    staticpro (&Qconnect);    staticpro (&Qconnect);
6167    Qfailed = intern ("failed");    Qfailed = intern ("failed");
6168    staticpro (&Qfailed);    staticpro (&Qfailed);
6169      Qlisten = intern ("listen");
6170      staticpro (&Qlisten);
6171      Qlocal = intern ("local");
6172      staticpro (&Qlocal);
6173    
6174      QCname = intern (":name");
6175      staticpro (&QCname);
6176      QCbuffer = intern (":buffer");
6177      staticpro (&QCbuffer);
6178      QChost = intern (":host");
6179      staticpro (&QChost);
6180      QCservice = intern (":service");
6181      staticpro (&QCservice);
6182      QCfamily = intern (":family");
6183      staticpro (&QCfamily);
6184      QClocal = intern (":local");
6185      staticpro (&QClocal);
6186      QCremote = intern (":remote");
6187      staticpro (&QCremote);
6188      QCcoding = intern (":coding");
6189      staticpro (&QCcoding);
6190      QCserver = intern (":server");
6191      staticpro (&QCserver);
6192      QCdatagram = intern (":datagram");
6193      staticpro (&QCdatagram);
6194      QCnowait = intern (":nowait");
6195      staticpro (&QCnowait);
6196      QCfilter = intern (":filter");
6197      staticpro (&QCfilter);
6198      QCsentinel = intern (":sentinel");
6199      staticpro (&QCsentinel);
6200      QClog = intern (":log");
6201      staticpro (&QClog);
6202      QCnoquery = intern (":noquery");
6203      staticpro (&QCnoquery);
6204      QCstop = intern (":stop");
6205      staticpro (&QCstop);
6206      QCoptions = intern (":options");
6207      staticpro (&QCoptions);
6208      QCfeature = intern (":feature");
6209      staticpro (&QCfeature);
6210        
6211    Qlast_nonmenu_event = intern ("last-nonmenu-event");    Qlast_nonmenu_event = intern ("last-nonmenu-event");
6212    staticpro (&Qlast_nonmenu_event);    staticpro (&Qlast_nonmenu_event);
6213    
# Line 4897  The value takes effect when `start-proce Line 6247  The value takes effect when `start-proce
6247    defsubr (&Sset_process_window_size);    defsubr (&Sset_process_window_size);
6248    defsubr (&Sset_process_inherit_coding_system_flag);    defsubr (&Sset_process_inherit_coding_system_flag);
6249    defsubr (&Sprocess_inherit_coding_system_flag);    defsubr (&Sprocess_inherit_coding_system_flag);
6250    defsubr (&Sprocess_kill_without_query);    defsubr (&Sset_process_query_on_exit_flag);
6251      defsubr (&Sprocess_query_on_exit_flag);
6252    defsubr (&Sprocess_contact);    defsubr (&Sprocess_contact);
6253    defsubr (&Slist_processes);    defsubr (&Slist_processes);
6254    defsubr (&Sprocess_list);    defsubr (&Sprocess_list);
6255    defsubr (&Sstart_process);    defsubr (&Sstart_process);
6256  #ifdef HAVE_SOCKETS  #ifdef HAVE_SOCKETS
6257    defsubr (&Sopen_network_stream);    defsubr (&Sset_network_process_options);
6258      defsubr (&Smake_network_process);
6259  #endif /* HAVE_SOCKETS */  #endif /* HAVE_SOCKETS */
6260    #ifdef DATAGRAM_SOCKETS
6261      defsubr (&Sprocess_datagram_address);
6262      defsubr (&Sset_process_datagram_address);
6263    #endif
6264    defsubr (&Saccept_process_output);    defsubr (&Saccept_process_output);
6265    defsubr (&Sprocess_send_region);    defsubr (&Sprocess_send_region);
6266    defsubr (&Sprocess_send_string);    defsubr (&Sprocess_send_string);

Legend:
Removed from v.1.355  
changed lines
  Added in v.1.356

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26