emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Non-blocking open-network-stream


From: Helmut Eller
Subject: Re: Non-blocking open-network-stream
Date: Sun, 3 Mar 2002 11:46:42 +0100

address@hidden (Kim F. Storm) writes:

> I intent do rename the NON-BLOCKING argument to a more generic TYPE
> argument.  Eventually, it could be things like:
> 
> If HOST specified - connect to that host:
> 
> nil - blocking connect (tcp) to SERVICE on HOST
> t   - non-blocking connect (tcp) to SERVICE on HOST
> udp - open udp socket with target SERVICE on HOST
> unix - connect to unix socket on address SERVICE
> 
> If HOST is nil - open a server socket:
> 
> nil - open tcp socket listning on SERVICE port
> t   - same as nil
> udp - open udp socket bound to SERVICE port
> unix - open unix socket bound to address SERVICE

If you overload NON-BLOCKING in this way, you lose the ability to make
a non-blocking connects to Unix sockets.  The distinction between INET
or Unix sockets should be made with an optional PROTOCOL-FAMILY
argument.  

Also, mixing up UDP with Unix sockets is not a good idea.  The main
difference between TCP and UPD is that UDP is packet oriented and TCP
is stream oriented.  You can also have packet oriented Unix sockets.
Packet or stream orientedness should probably be specified with a
separate STYLE argument.

> See above.  (IIRC, Your patch didn't cover unix sockets)

I added Unix sockets when RMS said that Unix sockets are required to
replace emacsserver.

> >  - open-network-stream takes already 7 arguments.  Putting even more
> >    functionality in makes it hard to document.
>
> I don't agree.  Renaming NON-BLOCKING to TYPE and switching on
> whether HOST is non-nil (connect) or nil (start server) seems
> fairly clean and simple to me.

I cannot help, but your TYPE argument looks like a kludge to me.

The HOST, BUFFER, and NON-BLOCKING arguments are not even used for
server sockets.

> > Server sockets are IMHO different enough to merit a separate
> > function.  What is the advantage of merging those concepts?
> > 
> 
> Most of the necessary functionality is already in open-network-stream,
> so adding the server part there is pretty orthogonal I think.

I think there is not much shared functionality.  open-network-stream
does basically this:

    gethostbyname/socket/connect/coding-system-magic

For the server socket case it should do:
    
    socket/bind/listen

Only the call to socket could be shared.


Below is my updated patch that supports Unix sockets.  Perhaps you can
reuse some parts.


Index: process.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/process.c,v
retrieving revision 1.353
diff -c -r1.353 process.c
*** process.c   28 Feb 2002 23:59:19 -0000      1.353
--- process.c   3 Mar 2002 10:36:17 -0000
***************
*** 51,59 ****
--- 51,69 ----
  
  #ifdef HAVE_SOCKETS   /* TCP connection support, if kernel can do it */
  #include <sys/socket.h>
+ #include <sys/un.h>
  #include <netdb.h>
  #include <netinet/in.h>
  #include <arpa/inet.h>
+ 
+ /* Union of all socket address types we support. */
+ union sockaddr_union 
+ {
+   struct sockaddr sa;
+   struct sockaddr_in sin;
+   struct sockaddr_un sun;
+ };
+ 
  #ifdef NEED_NET_ERRNO_H
  #include <net/errno.h>
  #endif /* NEED_NET_ERRNO_H */
***************
*** 114,119 ****
--- 124,130 ----
  Lisp_Object Qprocessp;
  Lisp_Object Qrun, Qstop, Qsignal;
  Lisp_Object Qopen, Qclosed, Qconnect, Qfailed;
+ Lisp_Object Qserver_socket, Qlisten, Qinet, Qunix;
  Lisp_Object Qlast_nonmenu_event;
  /* Qexit is declared and initialized in eval.c.  */
  
***************
*** 122,129 ****
--- 133,142 ----
  
  #ifdef HAVE_SOCKETS
  #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
+ #define SERVER_SOCKET_P(p) ((XPROCESS (p)->childp) == Qserver_socket)
  #else
  #define NETCONN_P(p) 0
+ #define SERVER_SOCKET_P(p) 0
  #endif /* HAVE_SOCKETS */
  
  /* Define first descriptor number available for subprocesses.  */
***************
*** 258,264 ****
  static struct coding_system *proc_encode_coding_system[MAXDESC];
  
  static Lisp_Object get_process ();
! static void exec_sentinel ();
  
  extern EMACS_TIME timer_check ();
  extern int timers_run;
--- 271,282 ----
  static struct coding_system *proc_encode_coding_system[MAXDESC];
  
  static Lisp_Object get_process ();
! static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);
! static Lisp_Object read_process_output_error_handler (Lisp_Object error);
! static Lisp_Object read_process_output_call (Lisp_Object fun_and_args);
! #ifdef HAVE_SOCKETS
! static Lisp_Object decode_sockaddr_union (union sockaddr_union *u);
! #endif
  
  extern EMACS_TIME timer_check ();
  extern int timers_run;
***************
*** 614,619 ****
--- 632,642 ----
        XPROCESS (process)->status = Fcons (Qexit, Fcons (make_number (0), 
Qnil));
        XSETINT (XPROCESS (process)->tick, ++process_tick);
      }
+   else if (SERVER_SOCKET_P (process))
+     {
+       XPROCESS (process)->status = list2 (Qexit, make_number (0));
+       XSETINT (XPROCESS (process)->tick, ++process_tick);
+     }
    else if (XINT (XPROCESS (process)->infd) >= 0)
      {
        Fkill_process (process, Qnil);
***************
*** 638,643 ****
--- 661,667 ----
  closed -- for a network stream connection that is closed.
  connect -- when waiting for a non-blocking connection to complete.
  failed -- when a non-blocking connection has failed.
+ listen -- for a server socket that is listening.
  nil -- if arg is a process name and no such process exists.
  PROCESS may be a process, a buffer, the name of a process, or
  nil, indicating the current buffer's process.  */)
***************
*** 668,673 ****
--- 692,706 ----
        else if (EQ (status, Qexit))
        status = Qclosed;
      }
+   else if (SERVER_SOCKET_P (process))
+     {
+       if (EQ (status, Qrun))
+       status = Qlisten;
+       else if (EQ (status, Qexit))
+       status = Qclosed;
+       else
+       abort ();
+     }
    return status;
  }
  
***************
*** 919,930 ****
  DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
         1, 1, 0,
         doc: /* Return the contact info of PROCESS; t for a real child.
! For a net connection, the value is a cons cell of the form (HOST SERVICE).  
*/)
       (process)
       register Lisp_Object process;
  {
    CHECK_PROCESS (process);
!   return XPROCESS (process)->childp;
  }
  
  #if 0 /* Turned off because we don't currently record this info
--- 952,974 ----
  DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
         1, 1, 0,
         doc: /* Return the contact info of PROCESS; t for a real child.
! For a net connection, the value is a cons cell of the form (HOST SERVICE). 
! For a server socket a cons cell of the form (server-socket . ADDRESS). */)
       (process)
       register Lisp_Object process;
  {
    CHECK_PROCESS (process);
! #ifdef HAVE_SOCKETS
!   if (SERVER_SOCKET_P (process))
!     {
!       union sockaddr_union u;
!       socklen_t length = sizeof u;
!       getsockname (XPROCESS (process)->infd, &u.sa, &length);
!       return Fcons (Qserver_socket, decode_sockaddr_union (&u));
!     }
!   else 
! #endif
!     return XPROCESS (process)->childp;
  }
  
  #if 0 /* Turned off because we don't currently record this info
***************
*** 998,1003 ****
--- 1042,1056 ----
          else
            Fprinc (symbol, Qnil);
        }
+       else if (SERVER_SOCKET_P (proc))
+       {
+         if (EQ (symbol, Qrun))
+           write_string ("listen", -1);
+         else if (EQ (symbol, Qexit))
+           write_string ("closed", -1);
+         else
+           Fprinc (symbol, Qnil);
+       }
        else
        Fprinc (symbol, Qnil);
  
***************
*** 1038,1043 ****
--- 1091,1115 ----
                   XSTRING (XCAR (p->childp))->data);
          insert_string (tembuf);
          }
+       else if (SERVER_SOCKET_P (proc))
+       {
+         union sockaddr_union u;
+         socklen_t length = sizeof u;
+         getsockname (p->infd, &u.sa, &length);
+         switch (u.sa.sa_family) 
+           {
+           case AF_INET:
+             sprintf (tembuf, "(inet socket on port %d)\n", 
+                      ntohs (u.sin.sin_port));
+             break;
+           case AF_LOCAL:
+             sprintf (tembuf, "(unix socket %s)\n", u.sun.sun_path);
+             break;
+           default:
+             abort ();
+           }
+         insert_string (tembuf);
+         }
        else 
        {
          tem = p->command;
***************
*** 1778,1783 ****
--- 1850,1986 ----
  
  #ifdef HAVE_SOCKETS
  
+ /* Setup coding systems for communicating with the network stream.  */
+ static void 
+ select_coding_system (proc) 
+      Lisp_Object proc;
+ {
+   Lisp_Object buffer = XPROCESS (proc)->buffer;
+   Lisp_Object name = XPROCESS (proc)->name;
+   Lisp_Object host = XCAR (XPROCESS (proc)->childp);
+   Lisp_Object service = XCAR (XCDR (XPROCESS (proc)->childp));
+   int inch = XINT (XPROCESS (proc)->infd);
+   int outch = XINT (XPROCESS (proc)->outfd);
+   { 
+     struct gcpro gcpro1;
+     /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
+     Lisp_Object coding_systems = Qt;
+     Lisp_Object args[5], val;
+ 
+     if (!NILP (Vcoding_system_for_read))
+       val = Vcoding_system_for_read;
+     else if ((!NILP (buffer) && NILP (XBUFFER 
(buffer)->enable_multibyte_characters))
+            || (NILP (buffer) && NILP 
(buffer_defaults.enable_multibyte_characters)))
+       /* We dare not decode end-of-line format by setting VAL to
+        Qraw_text, because the existing Emacs Lisp libraries
+        assume that they receive bare code including a sequene of
+        CR LF.  */
+       val = Qnil;
+     else
+       {
+       args[0] = Qopen_network_stream, args[1] = name,
+         args[2] = buffer, args[3] = host, args[4] = service;
+       GCPRO1 (proc);
+       coding_systems = Ffind_operation_coding_system (5, args);
+       UNGCPRO;
+       if (CONSP (coding_systems))
+         val = XCAR (coding_systems);
+       else if (CONSP (Vdefault_process_coding_system))
+         val = XCAR (Vdefault_process_coding_system);
+       else
+         val = Qnil;
+       }
+     XPROCESS (proc)->decode_coding_system = val;
+ 
+     if (!NILP (Vcoding_system_for_write))
+       val = Vcoding_system_for_write;
+     else if (NILP (current_buffer->enable_multibyte_characters))
+       val = Qnil;
+     else
+       {
+       if (EQ (coding_systems, Qt))
+         {
+           args[0] = Qopen_network_stream, args[1] = name,
+             args[2] = buffer, args[3] = host, args[4] = service;
+           GCPRO1 (proc);
+           coding_systems = Ffind_operation_coding_system (5, args);
+           UNGCPRO;
+         }
+       if (CONSP (coding_systems))
+         val = XCDR (coding_systems);
+       else if (CONSP (Vdefault_process_coding_system))
+         val = XCDR (Vdefault_process_coding_system);
+       else
+         val = Qnil;
+       }
+     XPROCESS (proc)->encode_coding_system = val;
+   }
+ 
+   if (!proc_decode_coding_system[inch])
+     proc_decode_coding_system[inch]
+       = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+   setup_coding_system (XPROCESS (proc)->decode_coding_system,
+                      proc_decode_coding_system[inch]);
+   if (!proc_encode_coding_system[outch])
+     proc_encode_coding_system[outch]
+       = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+   setup_coding_system (XPROCESS (proc)->encode_coding_system,
+                      proc_encode_coding_system[outch]);
+ 
+   XPROCESS (proc)->decoding_buf = make_uninit_string (0);
+   XPROCESS (proc)->decoding_carryover = make_number (0);
+   XPROCESS (proc)->encoding_buf = make_uninit_string (0);
+   XPROCESS (proc)->encoding_carryover = make_number (0);
+ 
+   XPROCESS (proc)->inherit_coding_system_flag
+     = (NILP (buffer) || !inherit_process_coding_system
+        ? Qnil : Qt);
+ 
+ }
+ 
+ /* create and initialize a process representing a socket. */
+ static Lisp_Object 
+ make_socket_process (fd, name, childp, status, buffer) 
+      int fd; 
+      Lisp_Object name, childp, status, buffer;
+ {
+   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+   GCPRO4 (name, childp, status, buffer);
+   { 
+     Lisp_Object proc = make_process (name);
+     chan_process[fd] = proc;
+     XPROCESS (proc)->childp = childp;
+     XPROCESS (proc)->command_channel_p = Qnil;
+     XPROCESS (proc)->buffer = buffer;
+     XPROCESS (proc)->sentinel = Qnil;
+     XPROCESS (proc)->filter = Qnil;
+     XPROCESS (proc)->command = Qnil;
+     XPROCESS (proc)->pid = Qnil;
+     XSETINT (XPROCESS (proc)->infd, fd);
+     XSETINT (XPROCESS (proc)->outfd, fd);
+     XPROCESS (proc)->status = status;
+     if (fd > max_process_desc)
+       max_process_desc = fd;
+     return proc;
+   }
+ }
+ 
+ /* Make FD non-blocking and add it to the input fd-sets.  */
+ static void 
+ register_fd_for_input (fd)  
+      int fd;
+ {
+ #ifdef O_NONBLOCK
+   fcntl (fd, F_SETFL, O_NONBLOCK);
+ #else
+ #ifdef O_NDELAY
+   fcntl (fd, F_SETFL, O_NDELAY);
+ #endif
+ #endif
+   FD_SET (fd, &input_wait_mask);
+   FD_SET (fd, &non_keyboard_wait_mask);
+ }
+ 
  /* open a TCP network connection to a given HOST/SERVICE.  Treated
     exactly like a normal process when reading and writing.  Only
     differences are in status display and process deletion.  A network
***************
*** 1836,1842 ****
  #endif /* HAVE_GETADDRINFO */
    int ret = 0;
    int xerrno = 0;
!   int s = -1, outch, inch;
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
    int retry = 0;
    int count = specpdl_ptr - specpdl;
--- 2039,2045 ----
  #endif /* HAVE_GETADDRINFO */
    int ret = 0;
    int xerrno = 0;
!   int s = -1;
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
    int retry = 0;
    int count = specpdl_ptr - specpdl;
***************
*** 2135,2167 ****
    send_command (s, C_DUMB, 1, 0);
  #endif /* TERM */
  
-   inch = s;
-   outch = s;
- 
    if (!NILP (buffer))
      buffer = Fget_buffer_create (buffer);
-   proc = make_process (name);
- 
-   chan_process[inch] = proc;
- 
- #ifdef O_NONBLOCK
-   fcntl (inch, F_SETFL, O_NONBLOCK);
- #else
- #ifdef O_NDELAY
-   fcntl (inch, F_SETFL, O_NDELAY);
- #endif
- #endif
  
!   XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
!   XPROCESS (proc)->command_channel_p = Qnil;
!   XPROCESS (proc)->buffer = buffer;
    XPROCESS (proc)->sentinel = XCAR (sentinel);
    XPROCESS (proc)->filter = XCDR (sentinel);
-   XPROCESS (proc)->command = Qnil;
-   XPROCESS (proc)->pid = Qnil;
-   XSETINT (XPROCESS (proc)->infd, inch);
-   XSETINT (XPROCESS (proc)->outfd, outch);
-   XPROCESS (proc)->status = Qrun;
  
  #ifdef NON_BLOCKING_CONNECT
    if (!NILP (non_blocking))
--- 2338,2349 ----
    send_command (s, C_DUMB, 1, 0);
  #endif /* TERM */
  
    if (!NILP (buffer))
      buffer = Fget_buffer_create (buffer);
  
!   proc = make_socket_process (s, name, list2 (host, service), Qrun, buffer);
    XPROCESS (proc)->sentinel = XCAR (sentinel);
    XPROCESS (proc)->filter = XCDR (sentinel);
  
  #ifdef NON_BLOCKING_CONNECT
    if (!NILP (non_blocking))
***************
*** 2170,2271 ****
         in that case, we still need to signal this like a non-blocking
         connection.  */
        XPROCESS (proc)->status = Qconnect;
!       if (!FD_ISSET (inch, &connect_wait_mask))
!       {
!         FD_SET (inch, &connect_wait_mask);
          num_pending_connects++;
        }
      }
    else
  #endif
!     if (!EQ (XPROCESS (proc)->filter, Qt))
        {
!       FD_SET (inch, &input_wait_mask);
!       FD_SET (inch, &non_keyboard_wait_mask);
        }
  
!   if (inch > max_process_desc)
!     max_process_desc = inch;
  
    {
!     /* Setup coding systems for communicating with the network stream.  */
!     struct gcpro gcpro1;
!     /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
!     Lisp_Object coding_systems = Qt;
!     Lisp_Object args[5], val;
  
!     if (!NILP (Vcoding_system_for_read))
!       val = Vcoding_system_for_read;
!     else if ((!NILP (buffer) && NILP (XBUFFER 
(buffer)->enable_multibyte_characters))
!            || (NILP (buffer) && NILP 
(buffer_defaults.enable_multibyte_characters)))
!       /* We dare not decode end-of-line format by setting VAL to
!        Qraw_text, because the existing Emacs Lisp libraries
!        assume that they receive bare code including a sequene of
!        CR LF.  */
!       val = Qnil;
!     else
!       {
!       args[0] = Qopen_network_stream, args[1] = name,
!         args[2] = buffer, args[3] = host, args[4] = service;
!       GCPRO1 (proc);
!       coding_systems = Ffind_operation_coding_system (5, args);
!       UNGCPRO;
!       if (CONSP (coding_systems))
!         val = XCAR (coding_systems);
!       else if (CONSP (Vdefault_process_coding_system))
!         val = XCAR (Vdefault_process_coding_system);
!       else
!         val = Qnil;
!       }
!     XPROCESS (proc)->decode_coding_system = val;
  
!     if (!NILP (Vcoding_system_for_write))
!       val = Vcoding_system_for_write;
!     else if (NILP (current_buffer->enable_multibyte_characters))
!       val = Qnil;
!     else
        {
!       if (EQ (coding_systems, Qt))
          {
!           args[0] = Qopen_network_stream, args[1] = name,
!             args[2] = buffer, args[3] = host, args[4] = service;
!           GCPRO1 (proc);
!           coding_systems = Ffind_operation_coding_system (5, args);
!           UNGCPRO;
          }
-       if (CONSP (coding_systems))
-         val = XCDR (coding_systems);
-       else if (CONSP (Vdefault_process_coding_system))
-         val = XCDR (Vdefault_process_coding_system);
-       else
-         val = Qnil;
        }
!     XPROCESS (proc)->encode_coding_system = val;
!   }
! 
!   if (!proc_decode_coding_system[inch])
!     proc_decode_coding_system[inch]
!       = (struct coding_system *) xmalloc (sizeof (struct coding_system));
!   setup_coding_system (XPROCESS (proc)->decode_coding_system,
!                      proc_decode_coding_system[inch]);
!   if (!proc_encode_coding_system[outch])
!     proc_encode_coding_system[outch]
!       = (struct coding_system *) xmalloc (sizeof (struct coding_system));
!   setup_coding_system (XPROCESS (proc)->encode_coding_system,
!                      proc_encode_coding_system[outch]);
! 
!   XPROCESS (proc)->decoding_buf = make_uninit_string (0);
!   XPROCESS (proc)->decoding_carryover = make_number (0);
!   XPROCESS (proc)->encoding_buf = make_uninit_string (0);
!   XPROCESS (proc)->encoding_carryover = make_number (0);
! 
!   XPROCESS (proc)->inherit_coding_system_flag
!     = (NILP (buffer) || !inherit_process_coding_system
!        ? Qnil : Qt);
! 
!   UNGCPRO;
!   return proc;
  }
  #endif        /* HAVE_SOCKETS */
  
  void
--- 2352,2618 ----
         in that case, we still need to signal this like a non-blocking
         connection.  */
        XPROCESS (proc)->status = Qconnect;
!       if (!FD_ISSET (s, &connect_wait_mask))
!       { 
!         FD_SET (s, &connect_wait_mask);
          num_pending_connects++;
        }
      }
    else
  #endif
!     register_fd_for_input (s);
! 
!   select_coding_system (proc);  
! 
!   UNGCPRO;
!   return proc;
! }
! 
! #define BACKLOG 5
! 
! /* Open a listening socket on PORT and return the socket descriptor. */
! static int 
! open_inet_socket (int port)
! {
!   int fd = socket (PF_INET, SOCK_STREAM, 0);
!   if (fd <= 0) goto error; 
!   { 
!     int err;
!     int optval = 1;  
!     struct sockaddr_in servaddr;
!     bzero (&servaddr, sizeof servaddr);
!     servaddr.sin_family = AF_INET;
!     servaddr.sin_port = htons (port);
!     servaddr.sin_addr.s_addr = htonl (INADDR_ANY);
!     err = setsockopt (fd, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval);
!     if (err != 0) goto error;
!     err = bind (fd, (struct sockaddr *)&servaddr, sizeof servaddr);
!     if (err != 0) goto error;
!     err = listen (fd, BACKLOG);
!     if (err != 0) goto error;
!     return fd;
!   }
!   error:
!     if (fd > 0) 
!       close (fd);
!     report_file_error ("open-server-socket", Qnil);
!     abort ();
! }
! 
! static int 
! open_unix_socket (char *filename)
! {
!   int fd = socket (PF_LOCAL, SOCK_STREAM, 0);
!   if (fd <= 0) goto error; 
!   { 
!     int err;
!     struct sockaddr_un servaddr;
!     bzero (&servaddr, sizeof servaddr);
!     servaddr.sun_family = AF_LOCAL;
!     strncpy (servaddr.sun_path, filename, sizeof servaddr.sun_path);
!     err = bind (fd, (struct sockaddr *)&servaddr, sizeof servaddr);
!     if (err != 0) goto error;
!     err = listen (fd, BACKLOG);
!     if (err != 0) goto error;
!     return fd;
!   }
!   error:
!     if (fd > 0) 
!       close (fd);
!     report_file_error ("open-server-socket", Qnil);
!     abort ();
! }
! 
! /* Open a server socket on a given port.  The filter function must be
!    set before accepting connections with `accept-connection'.  The
!    process-buffer is not used. */
! 
! DEFUN ("open-server-socket", Fopen_server_socket, Sopen_server_socket,
!        3, 3, 0, 
!        doc: /* Open a server socket on a port.
! 
! Returns a process object to represent the socket.  The filter function
! can be used to accept connections.  See `accept-connection'.
! `delete-process' closes the server socket.
! 
! NAME is the name for the process.
! PROTOCOL either 'inet or 'unix.
! PORT is the port number resp. filename for the socket.  */ )
!      (name, protocol, port)
!      Lisp_Object name, protocol, port; 
! {
!   int fd;
!   CHECK_STRING (name);
!   CHECK_SYMBOL (protocol);
!   if (protocol == Qinet)
!     {
!       CHECK_NATNUM (port);
!       if ((XINT (port) < 0) || ((1 << 16) <= XINT (port)))
!       error ("Port number out of range");
!       fd = open_inet_socket (XINT (port));
!     }
!   else if (protocol == Qunix)
!     {
!       CHECK_STRING (port);
!       fd = open_unix_socket (XSTRING (port)->data);
!     }
!   else 
!     error ("Unsupported protocol %s", XSYMBOL (protocol)->name->data);
!   return make_socket_process (fd, name, Qserver_socket, Qrun, Qnil);
! }
! 
! /* return a Lisp representation for U: 
!    (HOST PORT) for AF_INET
!    (unix FILENAME) for AF_UNIX.  */
! static Lisp_Object
! decode_sockaddr_union (union sockaddr_union *u) 
! {
!   switch (u->sa.sa_family) 
!     {
!     case AF_INET: 
        {
!       char string[INET_ADDRSTRLEN];
!       inet_ntop (AF_INET, &u->sin.sin_addr, string, sizeof string);
!       return list2 (build_string (string),
!                     make_number (ntohs (u->sin.sin_port)));
        }
+     case AF_LOCAL:
+       return list2 (Qunix, build_string (u->sun.sun_path));
+     default:
+       abort ();
+     }
+ }
+ 
+ /* Accept a connection on SERVER_SOCKET.  Remove SERVER_SOCKET from
+    the input fd-set so that only the first waiting client is accepted.
+    Then create a process representing the new connection and pass it
+    to PROCESS's filter function. */
+ static void
+ accept_client (process, server_socket)
+      Lisp_Object process;
+      int server_socket; 
+ {
+   struct gcpro gcpro1, gcpro2;
+   union sockaddr_union u;
+   socklen_t length = sizeof u;
+   int fd = accept (server_socket, (struct sockaddr*)&u, &length);
+   FD_CLR (server_socket, &input_wait_mask);
+   FD_CLR (server_socket, &non_keyboard_wait_mask);
+   if (fd == -1) 
+     { 
+       if (NILP (XPROCESS (process)->sentinel))
+       report_file_error ("accept", process);
+       else 
+       exec_sentinel (process, build_string (emacs_strerror (errno)));
+     } 
+   else 
+     {
+       Lisp_Object childp = decode_sockaddr_union (&u);
+       Lisp_Object proc = make_socket_process (fd, XPROCESS (process)->mark,
+                                             childp, Qrun, Qnil);
+       GCPRO2 (process, proc);
+       select_coding_system (proc);
+       register_fd_for_input (fd);
+       internal_condition_case_1 (read_process_output_call,
+                                list3 (XPROCESS (process)->filter,
+                                       process, 
+                                       proc),
+                                NILP (Vdebug_on_error) ? Qerror : Qnil,
+                                read_process_output_error_handler);
+       UNGCPRO;
+     }
+ }
  
! DEFUN ("accept-connection", Faccept_connection, Saccept_connection, 
!        2, 2, 0,
!        doc: /* Accept a connection on the server socket. 
  
+ This function is non-blocking and returns nil.  The next incoming
+ connection will be accepted and passed to the process filter.  The
+ process filter function receives 2 arguments: the server socket and a
+ process representing the new connection.  The new process is treated
+ exactly like a network connection opened with `open-network-stream'.
+ 
+ PROCESS a process representing a server socket.
+ NAME is the name for the new connection.  */ )
+      (process, name)
+      Lisp_Object process, name;
+ {
+   CHECK_PROCESS (process);
+   if (! (SERVER_SOCKET_P (process)))
+     error ("Process %s is not a server socket process",
+          XSTRING (XPROCESS (process)->name)->data);
+   CHECK_STRING (name);
    {
!     int fd = XINT (XPROCESS (process)->infd);
!     XPROCESS (process)->mark = name; /* kludge: field is otherwise unused */
!     register_fd_for_input (fd);
!     return Qnil;
!   }
! }
  
! DEFUN ("gethostbyname", Fgethostbyname, Sgethostbyname,
!        1, 1, 0,
!        doc: /* Look up a host by name.  
  
! Return the IP address and aliases for NAME.  The result is a vector of
! this form: [hostent CANONICAL-NAME ALIASES ADDRTYPE ADDRLIST]
! 
! CANONICAL-NAME is a string.
! ALIASES is a list of strings.
! ADDRTYPE is the symbol inet.
! ADDRLIST is a list of this form ((INT INT INT INT)* )
!  each INT correspond to 1 byte of the 32 bit address. */)
!      (name)
!      Lisp_Object name;
! {
!   int gcpro1;
!   struct hostent *hostent;
!   CHECK_STRING (name);
!   hostent = gethostbyname (XSTRING (name)->data);
!   if (hostent == 0) 
!     error ("%s", hstrerror (h_errno));
!   else 
!     {
!       Lisp_Object host_info = Fmake_vector (make_number (5), Qnil);
!       Lisp_Object *vector = XVECTOR (host_info)->contents;
!       GCPRO1 (host_info);
!       vector[0] = intern ("hostent");
!       vector[1] = build_string (hostent->h_name);
        {
!       char **p = hostent->h_aliases;
!       while (*p != 0) 
          {
!           vector[2] = Fcons (build_string (*p), vector[2]);
!           p++;
          }
        }
!       switch (hostent->h_addrtype) 
!       {
!       case AF_INET:
!         { 
!           struct in_addr **p = (struct in_addr **)hostent->h_addr_list;
!           vector[3] = Qinet;
!           while (*p != 0) 
!             {
!               uint32_t a = ntohl ((**p).s_addr);
!               vector[4] = Fcons (list4 (make_number ((a >> 24) & 0xff), 
!                                         make_number ((a >> 16) & 0xff), 
!                                         make_number ((a >>  8) & 0xff), 
!                                         make_number ((a >>  0) & 0xff)),
!                                  vector[4]);
!               p++;
!             }
!           break;
!         }
!       default:
!         abort ();
!       }
!       UNGCPRO;
!       return host_info;
!     }
  }
+ 
  #endif        /* HAVE_SOCKETS */
  
  void
***************
*** 2911,2916 ****
--- 3258,3268 ----
              proc = chan_process[channel];
              if (NILP (proc))
                continue;
+             if (SERVER_SOCKET_P (proc)) 
+               {
+                 accept_client (proc, channel);
+                 continue;
+               }
  
              /* Read data from the process, starting with our
                 buffered-ahead character if we have one.  */
***************
*** 3469,3474 ****
--- 3821,3828 ----
    if (XINT (XPROCESS (proc)->outfd) < 0)
      error ("Output file descriptor of %s is closed",
           XSTRING (XPROCESS (proc)->name)->data);
+   if (SERVER_SOCKET_P (proc))
+     error ("Cannot write to server socket");
  
    coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
    Vlast_coding_system_used = coding->symbol;
***************
*** 4246,4251 ****
--- 4600,4607 ----
      update_status (XPROCESS (proc));
    if (! EQ (XPROCESS (proc)->status, Qrun))
      error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
+   if (SERVER_SOCKET_P (proc))
+     error ("Cannot write to server socket", XSTRING (XPROCESS (proc)->name));
  
    if (CODING_REQUIRE_FLUSHING (coding))
      {
***************
*** 4311,4316 ****
--- 4667,4674 ----
        {
          if (NETCONN_P (proc))
            Fdelete_process (proc);
+         else if (SERVER_SOCKET_P (proc))
+           Fdelete_process (proc);
          else if (XINT (XPROCESS (proc)->infd) >= 0)
            process_send_signal (proc, SIGHUP, Qnil, 1);
        }
***************
*** 4861,4866 ****
--- 5219,5234 ----
    Qfailed = intern ("failed");
    staticpro (&Qfailed);
  
+   Qlisten = intern ("listen");
+   staticpro (&Qlisten);
+ 
+   Qserver_socket = intern ("server-socket");
+   staticpro (&Qserver_socket);
+   Qinet = intern ("inet");
+   staticpro (&Qinet);
+   Qunix = intern ("unix");
+   staticpro (&Qunix);
+   
    Qlast_nonmenu_event = intern ("last-nonmenu-event");
    staticpro (&Qlast_nonmenu_event);
  
***************
*** 4907,4912 ****
--- 5275,5283 ----
    defsubr (&Sstart_process);
  #ifdef HAVE_SOCKETS
    defsubr (&Sopen_network_stream);
+   defsubr (&Sopen_server_socket);
+   defsubr (&Saccept_connection);
+   defsubr (&Sgethostbyname);
  #endif /* HAVE_SOCKETS */
    defsubr (&Saccept_process_output);
    defsubr (&Sprocess_send_region);





reply via email to

[Prev in Thread] Current Thread [Next in Thread]