bug-gnu-emacs
[Top][All Lists]
Advanced

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

Feature suggestion: server sockets


From: Helmut Eller
Subject: Feature suggestion: server sockets
Date: Sun, 17 Feb 2002 00:52:11 +0100

Dear Emacs Developers,

Emacs has currently no support for server sockets.  Server sockets
(sometimes called passive sockets) would be useful for packages like
emacserver, gnuserv, or EmacsHttpd.  Such "server like" packages are
currently somewhat hard to write, because they must use an external
program that opens the server socket and forwards the input to Emacs.
With the patch below, Emacs would be able to open server sockets
itself.

I propose the following Lisp level interface to server sockets:

Server sockets, like network connections, are represented as
processes.  The only purpose of a "server socket process" is to handle
incoming connections.  Server socket processes work asynchronous: the
process waits for an incoming connection and passes the connection to
the filter function.  The new connection is treated afterwards exactly
like a connection created with `open-network-stream'.  Two new
primitives are needed for server sockets:

  - Function: open-server-socket NAME PORT -> PROCESS

    This function opens a TCP server socket on the given port and
    returns a process object.  NAME is the name for the process.

Incoming connections are accepted one at a time with the second new
primitive: accept-connection.  accept-connection allows the server
socket process to accept the next connection.  accept-connection is
non-blocking and returns nil.

  - Function: accept-connection PROCESS NAME -> nil 

    PROCESS is a server socket process.  NAME is the name for the
    incoming connection that will be passed to the process filter.

Server sockets can be closed with delete-process.  The process-status
of a server socket process is either `listen' or `closed'.  The
process-buffer slot is unused for server sockets.  

I hope the following example helps to clarify a bit; it implements an
echo server:

  (defun server-socket-filter (server-socket client-socket)
    (set-process-filter client-socket #'send-string)
    (accept-connection server-socket "client-socket")) 
    
  (defun start-echo-server ()
    (let ((server-socket (open-server-socket "server-socket" 7)))
      (set-process-filter server-socket #'server-socket-filter)
      (accept-connection server-socket "client-socket")))

We open a server socket on port 7; install a filter function and allow
the process to accept the next connection.  When the next request
arrives, Emacs will create a network stream with name "client-socket"
and pass it along with the server socket to server-socket-filter.  In
server-socket-filter we set #'send-string as filter function (to
perform the actual echoing) and accept the the next connection (to
handle multiple connections in parallel).

Note that filter functions are called only when Emacs is idle or
waiting for something.


The patch affects the files process.c and process.h (a comment).  I
have tested it only on my GNU/Linux box.

Let me know if you decide to integrate the patch in the standard
Emacs.

Thank you for your attention, and thank you for writing the best piece
of software in existence.

helmut.



--------------------------------------------------------------------
The Changlog entry:

        * process.h: Document extended use of childp.  

        * process.c (SERVER_SOCKET_P): New macro.
        (delete-process, process-status, list_processes_1,
        kill_buffer_processes): Treat server sockets much like network
        connections.
        (open-network-stream): Split up into open-network-stream,
        make_socket_process, select_coding_system, register_fd_for_input.
        (make_socket_process): See above.
        (select_coding_system): See above. (Just moved upward.)
        (register_fd_for_input): See above.
        (open_listen_fd): New function.
        (open-server-socket): New function.
        (call_filter): New function.
        (accept_client): New function. Called in wait_reading_process_input.
        (accept-connection): New function.
        (wait_reading_process_input): Handle server socket case.
        (send_process, process-send-eof): Don't allow these operations on
        server sockets.
        (syms_of_process): New symbol Qlisten.  New subrs
        Sopen_server_socket, Saccept_connection.


[I made two patches: 
  diff -c -F'^[_a-zA-Z0-9$]+ *(' process.h.old process.h.new > process.h.patch
  diff -c -F'^[_a-zA-Z0-9$]+ *(' process.c.old process.c.new > process.c.patch
 Sorry, if this is inconvenient for you.]

process.h.patch:

*** process.h.old       Sat Feb 16 23:35:17 2002
--- process.h.new       Thu Feb 14 15:05:32 2002
***************
*** 54,60 ****
      /* Non-nil if this is really a command channel */
      Lisp_Object command_channel_p;
      /* t if this is a real child process.
!        For a net connection, it is (HOST SERVICE).  */
      Lisp_Object childp;
      /* Marker set to end of last buffer-inserted output from this process */
      Lisp_Object mark;
--- 54,61 ----
      /* Non-nil if this is really a command channel */
      Lisp_Object command_channel_p;
      /* t if this is a real child process.
!        (HOST SERVICE) for a net connection. 
!        PORT-NUMBER for a server socket. */
      Lisp_Object childp;
      /* Marker set to end of last buffer-inserted output from this process */
      Lisp_Object mark;
***************
*** 65,71 ****
      Lisp_Object raw_status_low;
      Lisp_Object raw_status_high;
      /* Symbol indicating status of process.
!        This may be a symbol: run, open, or closed.
         Or it may be a list, whose car is stop, exit or signal
         and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG)
         or (SIGNAL_NUMBER . COREDUMP_FLAG).  */
--- 66,72 ----
      Lisp_Object raw_status_low;
      Lisp_Object raw_status_high;
      /* Symbol indicating status of process.
!        This may be a symbol: run, open, closed, or listen.
         Or it may be a list, whose car is stop, exit or signal
         and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG)
         or (SIGNAL_NUMBER . COREDUMP_FLAG).  */

--------------------------------------------------------------------
process.c.patch:


*** process.c.old       Tue Feb 12 13:53:11 2002
--- process.c.new       Sat Feb 16 17:50:32 2002
***************
*** 112,118 ****
  #include "atimer.h"
  
  Lisp_Object Qprocessp;
! Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
  Lisp_Object Qlast_nonmenu_event;
  /* Qexit is declared and initialized in eval.c.  */
  
--- 112,118 ----
  #include "atimer.h"
  
  Lisp_Object Qprocessp;
! Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed, Qlisten;
  Lisp_Object Qlast_nonmenu_event;
  /* Qexit is declared and initialized in eval.c.  */
  
***************
*** 121,128 ****
--- 121,130 ----
  
  #ifdef HAVE_SOCKETS
  #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
+ #define SERVER_SOCKET_P(p) (GC_INTEGERP (XPROCESS (p)->childp))
  #else
  #define NETCONN_P(p) 0
+ #define SERVER_SOCKET_P(p) 0
  #endif /* HAVE_SOCKETS */
  
  /* Define first descriptor number available for subprocesses.  */
*************** DEFUN ("delete-process", Fdelete_process
*** 572,577 ****
--- 574,585 ----
        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 
+       = Fcons (Qexit, Fcons (make_number (0), Qnil));
+       XSETINT (XPROCESS (process)->tick, ++process_tick);
+     }
    else if (XINT (XPROCESS (process)->infd) >= 0)
      {
        Fkill_process (process, Qnil);
*************** DEFUN ("process-status", Fprocess_status
*** 594,599 ****
--- 602,608 ----
  signal -- for a process that has got a fatal signal.
  open -- for a network stream connection that is open.
  closed -- for a network stream connection that is closed.
+ 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.  */)
*************** DEFUN ("process-status", Fprocess_status
*** 624,629 ****
--- 633,645 ----
        else if (EQ (status, Qexit))
        status = Qclosed;
      }
+   if (SERVER_SOCKET_P (process))
+     {
+       if (EQ (status, Qrun))
+       status = Qlisten;
+       else if (EQ (status, Qexit))
+       status = Qclosed;
+     }
    return status;
  }
  
*************** list_processes_1 ()
*** 954,959 ****
--- 970,984 ----
          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);
  
*************** list_processes_1 ()
*** 994,999 ****
--- 1019,1029 ----
                   XSTRING (XCAR (p->childp))->data);
          insert_string (tembuf);
          }
+       else if (SERVER_SOCKET_P (proc))
+       {
+         sprintf (tembuf, "(server socket on port %d)\n", XINT (p->childp));
+         insert_string (tembuf);
+         }
        else 
        {
          tem = p->command;
*************** create_process (process, new_argv, curre
*** 1734,1739 ****
--- 1764,1897 ----
  
  #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;
+ {
+   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
*************** DEFUN ("open-network-stream", Fopen_netw
*** 1772,1778 ****
    IN_ADDR numeric_addr;
    int port;
  #endif /* HAVE_GETADDRINFO */
!   int s = -1, outch, inch;
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
    int retry = 0;
    int count = specpdl_ptr - specpdl;
--- 1930,1936 ----
    IN_ADDR numeric_addr;
    int port;
  #endif /* HAVE_GETADDRINFO */
!   int s = -1; 
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
    int retry = 0;
    int count = specpdl_ptr - specpdl;
*************** DEFUN ("open-network-stream", Fopen_netw
*** 2048,2164 ****
    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 = Qnil;
!   XPROCESS (proc)->filter = Qnil;
!   XPROCESS (proc)->command = Qnil;
!   XPROCESS (proc)->pid = Qnil;
!   XSETINT (XPROCESS (proc)->infd, inch);
!   XSETINT (XPROCESS (proc)->outfd, outch);
!   XPROCESS (proc)->status = Qrun;
!   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
--- 2206,2373 ----
    send_command (s, C_DUMB, 1, 0);
  #endif /* TERM */
  
    if (!NILP (buffer))
      buffer = Fget_buffer_create (buffer);
  
!   proc = make_socket_process (s, 
!                             name, 
!                             Fcons (host, Fcons (service, Qnil)),
!                             Qrun,
!                             buffer);
!   select_coding_system (proc);  
!   register_fd_for_input (s);
  
!   UNGCPRO;
!   return proc;
! }
  
! /* Open a server socket on PORT and return the socket descriptor. */
! static int 
! open_listen_fd (port)
!      int port;
! {
!   struct sockaddr_in servaddr;
!   int fd = socket (PF_INET, SOCK_STREAM, 0);
!   if (fd <= 0) goto error; 
!   bzero (&servaddr, sizeof servaddr);
!   servaddr.sin_family = AF_INET;
!   servaddr.sin_port = htons (port);
!   servaddr.sin_addr.s_addr = htonl (INADDR_ANY);
!   { 
!     int err;
!     int optval = 1;  
!     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, 1);
!     if (err != 0) goto error;
!     return fd;
    }
+   error:
+     if (fd > 0) 
+       close (fd);
+     report_file_error ("open-server-socket", Qnil);
+ }
+ 
+ /* 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,
+        2, 2, 0, 
+        doc: /* Open a server socket on a port.
+ 
+ Returns a subprocess-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.
+ PORT is the port number. */ )
+      (name, port)
+      Lisp_Object name, port; 
+ {
+   CHECK_STRING (name);
+   CHECK_NATNUM (port);
+   if ((XINT (port) <= 0) || ((1 << 16) <= XINT (port)))
+     error ("Port number out of range");
+   { 
+     int fd = open_listen_fd (XINT (port));
+     return make_socket_process (fd, name, port, Qrun, Qnil);
+   }
+ }
  
! static void exec_sentinel ();
! static Lisp_Object read_process_output_error_handler ();
! static Lisp_Object read_process_output_call ();
! 
! /* Create a process for the connection and call PROCESS's filter
!    function with the new process. */
! static void 
! call_filter (process, fd, peer, port)
!      Lisp_Object process; 
!      int fd, port;
!      char* peer;
! {
!   struct gcpro gcpro1;
!   Lisp_Object proc =
!     make_socket_process (fd, 
!                        XPROCESS (process)->mark, 
!                        Fcons (build_string (peer), 
!                               Fcons (make_number (port), Qnil)),
!                        Qrun,
!                        Qnil);
!   GCPRO1 (proc);
!   select_coding_system (proc);
!   register_fd_for_input (fd);
!   internal_condition_case_1 (read_process_output_call,
!                            Fcons( XPROCESS (process)->filter,
!                                   Fcons (process, Fcons (proc, Qnil))),
!                            NILP (Vdebug_on_error) ? Qerror : Qnil,
!                            read_process_output_error_handler);
!   UNGCPRO;
! }
  
! /* 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 sockaddr_in clientaddr;
!   socklen_t length;
!   int fd = accept (server_socket, (struct sockaddr*)&clientaddr, &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 
!     {
!       char buffer[INET_ADDRSTRLEN+1];
!       call_filter (process, 
!                  fd, 
!                  inet_ntop (AF_INET, &clientaddr.sin_addr,
!                             buffer, INET_ADDRSTRLEN),
!                  clientaddr.sin_port);
!     }
! }
  
! 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;
!   }
  }
+ 
  #endif        /* HAVE_SOCKETS */
  
  void
*************** wait_reading_process_input (time_limit, 
*** 2767,2772 ****
--- 2976,2986 ----
              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.  */
*************** send_process (proc, buf, len, object)
*** 3267,3272 ****
--- 3481,3488 ----
    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;
*************** DEFUN ("process-send-eof", Fprocess_send
*** 4044,4049 ****
--- 4260,4267 ----
      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))
      {
*************** kill_buffer_processes (buffer)
*** 4109,4114 ****
--- 4327,4334 ----
        {
          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);
        }
*************** syms_of_process ()
*** 4654,4659 ****
--- 4874,4882 ----
    Qclosed = intern ("closed");
    staticpro (&Qclosed);
  
+   Qlisten = intern ("listen");
+   staticpro (&Qlisten);
+ 
    Qlast_nonmenu_event = intern ("last-nonmenu-event");
    staticpro (&Qlast_nonmenu_event);
  
*************** syms_of_process ()
*** 4700,4705 ****
--- 4923,4930 ----
    defsubr (&Sstart_process);
  #ifdef HAVE_SOCKETS
    defsubr (&Sopen_network_stream);
+   defsubr (&Sopen_server_socket);
+   defsubr (&Saccept_connection);
  #endif /* HAVE_SOCKETS */
    defsubr (&Saccept_process_output);
    defsubr (&Sprocess_send_region);



reply via email to

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