emacs-devel
[Top][All Lists]
Advanced

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

New patch for server sockets and datagram (UDP) support.


From: Kim F. Storm
Subject: New patch for server sockets and datagram (UDP) support.
Date: 07 Mar 2002 01:08:28 +0100
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2.50

Richard Stallman <address@hidden> writes:

>     If the HOST argument is nil, a server socket is opened which
>     accepts connections.  The sentinel is called - with a newly
>     created process - whenever a connections is accepted.
> 
> That sounds good to me in principle, if the details work ok.

The following patch adds server socket support via open-network-stream.
If the HOST is nil, a server socket for SERVICE is opened in listening
state.

When a connection is accepted, a new process is created with a
name (and buffer) named according to the original process combined
with the caller's address, e.g. if the server process is named "p1",
the new process will be called something like "p1 <1.2.3.4:928>"
Likewise for the buffer.

I have removed the NON-BLOCKING argument, and instead added a new TYPE
argument, which specifies the type of connection (blocking connect,
non-blocking connect, or datagram), and may optionally specify the
address family (inet or local [aka. unix]).

To open a TCP server socket for "telnet", where client
processes have no buffer, do

 (open-network-stream "telnetd" nil nil "telnet" nil 
        telnetd-filter telnetd-sentinel)

To open a UDP (datagram) server socket for "dns", do

 (open-network-stream "dns" nil nil "dns" 'datagram
        dns-filter dns-sentinel)

Notice that datagram server sockets do not get separate processes for
each caller.  Instead, there is a new `process-datagram-address'
function to get (and set) the client address for the next
process-send-... call.

To open a LOCAL (UNIX) server socket for "/tmp/xyz", where
client processes do have a buffer, do

 (open-network-stream "xyz" "XYZ" nil "/tmp/xyz" (local)
        xyz-filter xyz-sentinel)

To connect to each of these services, simply specify the hostname
instead of nil as the third argument.

See also the documentation for the variable `network-server-log-function'.
To get a log of accept calls, the following setting can be used:

  (defun logf (s p m)
    (if (process-buffer s)
        (with-current-buffer (process-buffer s)
          (insert (process-name s) ">>" m))))
  (setq network-server-log-function 'logf))

I have tried to make the additions fail-safe by conditioning on
AF_LOCAL (or AF_UNIX), and a new DATAGRAM_SOCKETS define.
The latter requires that sendto and recvfrom are added to
the functions detected by configure.

If datagrams are not supported, open-network-stream will return nil
when requesting a datagram connection.

Index: process.c
===================================================================
RCS file: /cvs/emacs/src/process.c,v
retrieving revision 1.355
diff -c -r1.355 process.c
*** process.c   3 Mar 2002 00:31:22 -0000       1.355
--- process.c   6 Mar 2002 23:40:07 -0000
***************
*** 54,59 ****
--- 54,67 ----
  #include <netdb.h>
  #include <netinet/in.h>
  #include <arpa/inet.h>
+ #ifndef AF_LOCAL
+ #ifdef AF_UNIX
+ #define AF_LOCAL AF_UNIX
+ #endif
+ #endif
+ #ifdef AF_LOCAL
+ #include <sys/un.h>
+ #endif
  #ifdef NEED_NET_ERRNO_H
  #include <net/errno.h>
  #endif /* NEED_NET_ERRNO_H */
***************
*** 113,119 ****
  
  Lisp_Object Qprocessp;
  Lisp_Object Qrun, Qstop, Qsignal;
! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed;
  Lisp_Object Qlast_nonmenu_event;
  /* Qexit is declared and initialized in eval.c.  */
  
--- 121,128 ----
  
  Lisp_Object Qprocessp;
  Lisp_Object Qrun, Qstop, Qsignal;
! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
! Lisp_Object Qlocal, Qdatagram;
  Lisp_Object Qlast_nonmenu_event;
  /* Qexit is declared and initialized in eval.c.  */
  
***************
*** 198,203 ****
--- 207,235 ----
  #undef NON_BLOCKING_CONNECT
  #endif
  
+ /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
+    this system.  We need to read full packets, so we need a
+    "non-destructive" select.  So we require either native select,
+    or emulation of select using FIONREAD.  */
+ 
+ #ifdef GNU_LINUX
+ #define DATAGRAM_SOCKETS
+ #endif
+ 
+ #ifdef BROKEN_DATAGRAM_SOCKETS
+ #undef DATAGRAM_SOCKETS
+ #else
+ #ifndef DATAGRAM_SOCKETS
+ #ifdef HAVE_SOCKETS
+ #if defined (HAVE_SELECT) || defined (FIONREAD)
+ #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
+ #define DATAGRAM_SOCKETS
+ #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
+ #endif /* HAVE_SELECT || FIONREAD */
+ #endif /* HAVE_SOCKETS */
+ #endif /* DATAGRAM_SOCKETS */
+ #endif /* BROKEN_DATAGRAM_SOCKETS */
+ 
  #include "sysselect.h"
  
  extern int keyboard_bit_set P_ ((SELECT_TYPE *));
***************
*** 257,262 ****
--- 289,310 ----
  static struct coding_system *proc_decode_coding_system[MAXDESC];
  static struct coding_system *proc_encode_coding_system[MAXDESC];
  
+ #ifdef DATAGRAM_SOCKETS
+ /* Table of `client address' for datagram sockets.  */
+ struct sockaddr_and_len {
+   struct sockaddr *sa;
+   int len;
+ } datagram_address[MAXDESC];
+ #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
+ #define DATAGRAM_CONN_P(proc) (datagram_address[XPROCESS (proc)->infd].sa != 
0)
+ #else
+ #define DATAGRAM_CHAN_P(chan) (0)
+ #define DATAGRAM_CONN_P(proc) (0)
+ #endif
+ 
+ /* Hook function to call when accepting network connection.  */
+ Lisp_Object Vnetwork_server_log_function;
+ 
  static Lisp_Object get_process ();
  static void exec_sentinel ();
  
***************
*** 367,381 ****
        return build_string ("finished\n");
        string = Fnumber_to_string (make_number (code));
        string2 = build_string (coredump ? " (core dumped)\n" : "\n");
!       return concat2 (build_string ("exited abnormally with code "),
!                     concat2 (string, string2));
      }
    else if (EQ (symbol, Qfailed))
      {
        string = Fnumber_to_string (make_number (code));
        string2 = build_string ("\n");
!       return concat2 (build_string ("failed with code "),
!                     concat2 (string, string2));
      }
    else
      return Fcopy_sequence (Fsymbol_name (symbol));
--- 415,429 ----
        return build_string ("finished\n");
        string = Fnumber_to_string (make_number (code));
        string2 = build_string (coredump ? " (core dumped)\n" : "\n");
!       return concat3 (build_string ("exited abnormally with code "),
!                     string, string2);
      }
    else if (EQ (symbol, Qfailed))
      {
        string = Fnumber_to_string (make_number (code));
        string2 = build_string ("\n");
!       return concat3 (build_string ("failed with code "),
!                     string, string2);
      }
    else
      return Fcopy_sequence (Fsymbol_name (symbol));
***************
*** 946,952 ****
    register Lisp_Object tail, tem;
    Lisp_Object proc, minspace, tem1;
    register struct Lisp_Process *p;
!   char tembuf[80];
  
    XSETFASTINT (minspace, 1);
  
--- 994,1000 ----
    register Lisp_Object tail, tem;
    Lisp_Object proc, minspace, tem1;
    register struct Lisp_Process *p;
!   char tembuf[300];
  
    XSETFASTINT (minspace, 1);
  
***************
*** 1032,1041 ****
  
        Findent_to (make_number (49), minspace);
  
!       if (NETCONN_P (proc))
          {
!         sprintf (tembuf, "(network stream connection to %s)\n",
!                  XSTRING (XCAR (p->childp))->data);
          insert_string (tembuf);
          }
        else 
--- 1080,1109 ----
  
        Findent_to (make_number (49), minspace);
  
!       if (EQ (XPROCESS (proc)->status, Qlisten))
!       {
!         Lisp_Object port = XCAR (XCDR (p->childp));
!         if (INTEGERP (port))
!           port = Fnumber_to_string (port);
!         sprintf (tembuf, "(network %s server on %s)\n",
!                  (DATAGRAM_CONN_P(proc) ? "datagram" : "stream"),
!                  XSTRING (port)->data);
!         insert_string (tembuf);
!       }
!       else if (NETCONN_P (proc))
          {
!         /* For a local socket, there is no host name,
!            so display service instead.  */
!         Lisp_Object host = XCAR (p->childp);
!         if (!STRINGP (host))
!           {
!             host = XCAR (XCDR (p->childp));
!             if (INTEGERP (host))
!               host = Fnumber_to_string (host);
!           }
!         sprintf (tembuf, "(network %s connection to %s)\n",
!                  (DATAGRAM_CONN_P(proc) ? "datagram" : "stream"),
!                  XSTRING (host)->data);
          insert_string (tembuf);
          }
        else 
***************
*** 1793,1799 ****
  normal connect instead.
  
  Input and output work as for subprocesses; `delete-process' closes it.
! Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING.
  NAME is name for process.  It is modified if necessary to make it unique.
  BUFFER is the buffer (or buffer-name) to associate with the process.
   Process output goes at end of that buffer, unless you specify
--- 1861,1867 ----
  normal connect instead.
  
  Input and output work as for subprocesses; `delete-process' closes it.
! Args are NAME BUFFER HOST SERVICE TYPE FILTER SENTINEL.
  NAME is name for process.  It is modified if necessary to make it unique.
  BUFFER is the buffer (or buffer-name) to associate with the process.
   Process output goes at end of that buffer, unless you specify
***************
*** 1801,1829 ****
   BUFFER may be also nil, meaning that this process is not associated
   with any buffer.
  HOST is name of the host to connect to, or its IP address.
  SERVICE is name of the service desired, or an integer specifying a
!  port number to connect to.   
  FILTER and SENTINEL are optional args specifying the filter and
   sentinel functions associated with the network stream.
! NON-BLOCKING is optional arg requesting an non-blocking connect.
!  When non-nil, open-network-stream will return immediately without
!  waiting for the connection to be made.  Instead, the sentinel function
!  will be called with second matching "open" (if successful) or
!  "failed" when the connect completes.  */)
!      (name, buffer, host, service, filter, sentinel, non_blocking)
!       Lisp_Object name, buffer, host, service, filter, sentinel, non_blocking;
  {
    Lisp_Object proc;
  #ifdef HAVE_GETADDRINFO
!   struct addrinfo hints, *res, *lres;
    char *portstring, portbuf[128];
  #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;
    struct _emacs_addrinfo
    {
      int ai_family;
--- 1869,1926 ----
   BUFFER may be also nil, meaning that this process is not associated
   with any buffer.
  HOST is name of the host to connect to, or its IP address.
+  If the HOST arg is nil, a server socket is opened listening on the
+  specified service (see below).
  SERVICE is name of the service desired, or an integer specifying a
!  port number to connect to.
! The fifth optional arg specifies the type of connection being made.
!  It is either a symbol TYPE, or a cons cell (FAMILY . TYPE).
! TYPE is one of the following symbols (default is nil):
!  nil -- opens a stream connection; returns when connection is completed.
!  t   -- opens a non-blocking stream connection; returns immediately
!         without waiting for the connection to complete.  Instead, the
!         sentinel function will be called with second matching "open"
!         (if successful) or "failed" when the connect completes.
!  datagram -- opens a connection-less datagram socket (typically UDP).
! FAMILY specifies the address family for the connection:
!  nil -- Inet (IPv4) address family.
!  local -- local (UNIX) address family.
  FILTER and SENTINEL are optional args specifying the filter and
   sentinel functions associated with the network stream.
! 
! When the HOST is nil, a server process for the specified SERVICE and
! TYPE is created.  The server process will listen for and accept
! connections from clients.  When a client connection is accepted, a new
! network process is created for the connection with the following
! parameters:
! The client's process name is constructed by concatenating the server
! process' NAME and a client identification string.
! If the FILTER argument is non-nil, the client process will not get a
! separate process buffer; otherwise, the client's process buffer is a
! newly created buffer named after the server process' BUFFER name or
! process NAME concatenated with the client identification string.
! The client process' contact info is set according to the client's
! addressing information (typically an IP address and a port number). 
! The connection type and the process filter and sentinel parameters
! are inherited from the server process' TYPE, FILTER and SENTINEL.
! 
! Notice that the FILTER and SENTINEL args are never used directly by
! the server process.  Also, the BUFFER argument is not used directly by
! the server process, but via `network-server-log-function' hook, a log
! of the accepted (and failed) connections may be recorded in the server
! process' buffer.  */)
!      (name, buffer, host, service, type, filter, sentinel)
!       Lisp_Object name, buffer, host, service, type, filter, sentinel;
  {
    Lisp_Object proc;
+   Lisp_Object contact;
  #ifdef HAVE_GETADDRINFO
!   struct addrinfo ai, hints, *res, *lres;
    char *portstring, portbuf[128];
  #else /* HAVE_GETADDRINFO */
    struct hostent *host_info_ptr, host_info;
    char *(addr_list[2]);
    IN_ADDR numeric_addr;
    struct _emacs_addrinfo
    {
      int ai_family;
***************
*** 1834,1911 ****
      struct _emacs_addrinfo *ai_next;
    } ai, *res, *lres;
  #endif /* HAVE_GETADDRINFO */
    int ret = 0;
    int xerrno = 0;
    int s = -1, outch, inch;
!   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
    int retry = 0;
    int count = specpdl_ptr - specpdl;
    int count1;
    int is_non_blocking = 0;
  
!   if (!NILP (non_blocking))
      {
  #ifndef NON_BLOCKING_CONNECT
        return Qnil;
  #else
-       non_blocking = Qt;  /* Instead of GCPRO */
        is_non_blocking = 1;
  #endif
      }
  
  #ifdef WINDOWSNT
    /* Ensure socket support is loaded if available. */
    init_winsock (TRUE);
  #endif
  
!   /* Can only GCPRO 5 variables */
!   GCPRO6 (name, buffer, host, service, sentinel, filter);
    CHECK_STRING (name);
-   CHECK_STRING (host);
  
! #ifdef HAVE_GETADDRINFO
!   /* SERVICE can either be a string or int.
!      Convert to a C string for later use by getaddrinfo.  */
!   if (INTEGERP (service))
!     {
!       sprintf (portbuf, "%ld", (long) XINT (service));
!       portstring = portbuf;
!     }
!   else
      {
        CHECK_STRING (service);
!       portstring = XSTRING (service)->data;
      }
! #else /* HAVE_GETADDRINFO */
!   if (INTEGERP (service))
!     port = htons ((unsigned short) XINT (service));
!   else
      {
!       CHECK_STRING (service);
!       svc_info = getservbyname (XSTRING (service)->data, "tcp");
!       if (svc_info == 0)
!       error ("Unknown service \"%s\"", XSTRING (service)->data);
!       port = svc_info->s_port;
!     }
! #endif /* HAVE_GETADDRINFO */
  
  
    /* Slow down polling to every ten seconds.
       Some kernels have a bug which causes retrying connect to fail
       after a connect.  Polling can interfere with gethostbyname too.  */
  #ifdef POLL_FOR_INPUT
!   record_unwind_protect (unwind_stop_other_atimers, Qnil);
!   bind_polling_period (10);
  #endif
  
  #ifndef TERM
  #ifdef HAVE_GETADDRINFO
    immediate_quit = 1;
    QUIT;
    memset (&hints, 0, sizeof (hints));
    hints.ai_flags = 0;
!   hints.ai_family = AF_UNSPEC;
!   hints.ai_socktype = SOCK_STREAM;
    hints.ai_protocol = 0;
    ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
    if (ret)
--- 1931,2160 ----
      struct _emacs_addrinfo *ai_next;
    } ai, *res, *lres;
  #endif /* HAVE_GETADDRINFO */
+   struct sockaddr_in address;
+ #ifdef AF_LOCAL
+   struct sockaddr_un address_un;
+ #endif
+   struct servent *svc_info;
+   int port;
    int ret = 0;
    int xerrno = 0;
    int s = -1, outch, inch;
!   struct gcpro gcpro1, gcpro2, gcpro3;
    int retry = 0;
    int count = specpdl_ptr - specpdl;
    int count1;
    int is_non_blocking = 0;
+   int socktype = SOCK_STREAM;
+   int family = -1;
+ 
+ 
+   /* Save arguments for process-contact and clone-process.  */
+   contact = list5 (host, service, type, filter, sentinel);
  
!   if (CONSP (type))
!     {
!       Lisp_Object tem = CAR (type);
!       type = CDR (type);
!       if (INTEGERP (tem))
!       family = XINT (tem);
!       else
!       {
!         CHECK_SYMBOL (tem);
!         if (NILP (tem))
!           family = AF_INET;
! #ifdef AF_LOCAL
!         else if (EQ (tem, Qlocal))
!           family = AF_LOCAL;
! #endif
!       }
!       if (family < 0)
!       error ("Unknown address family");
!     }
! 
!   CHECK_SYMBOL (type);
!   if (NILP (host) && EQ (type, Qt))
!     type = Qnil;
!   if (EQ (type, Qt))
      {
  #ifndef NON_BLOCKING_CONNECT
        return Qnil;
  #else
        is_non_blocking = 1;
  #endif
      }
+   else if (EQ (type, Qdatagram))
+     {
+ #ifndef DATAGRAM_SOCKETS
+       return Qnil;
+ #else
+       socktype = SOCK_DGRAM;
+ #endif
+     }
+   else if (!NILP (type))
+     error ("Unknown connection type");
  
  #ifdef WINDOWSNT
    /* Ensure socket support is loaded if available. */
    init_winsock (TRUE);
  #endif
  
!   GCPRO3 (name, buffer, contact);
    CHECK_STRING (name);
  
!   /* Parse SERVICE argument.  It is an integer or a string.  */
!   switch (family)
      {
+ #ifdef AF_LOCAL
+     case AF_LOCAL:
        CHECK_STRING (service);
! 
!       bzero (&address_un, sizeof address_un);
!       address_un.sun_family = AF_LOCAL;
!       strncpy (address_un.sun_path, XSTRING (service)->data, sizeof 
address_un.sun_path);
!       break;
! #endif
! 
!     default:
! #ifdef HAVE_GETADDRINFO
!       /* We don't use getaddrinfo when opening a server socket.  */
!       if (!NILP (host))
!       {
!         /* SERVICE can either be a string or int.
!            Convert to a C string for later use by getaddrinfo.  */
!         if (INTEGERP (service))
!           {
!             sprintf (portbuf, "%ld", (long) XINT (service));
!             portstring = portbuf;
!           }
!         else
!           {
!             CHECK_STRING (service);
!             portstring = XSTRING (service)->data;
!           }
!         break;
!       }
! #endif /* HAVE_GETADDRINFO */
!       if (INTEGERP (service))
!       port = htons ((unsigned short) XINT (service));
!       else
!       {
!         CHECK_STRING (service);
!         svc_info = getservbyname (XSTRING (service)->data, 
!                                   (socktype == SOCK_DGRAM ? "udp" : "tcp"));
!         if (svc_info == 0)
!           report_file_error ("Unknown service", Fcons (service, Qnil));
!         port = svc_info->s_port;
!       }
!       break;
      }
! 
!   /* Open a server socket if no HOST is specified.  */
!   if (NILP (host))
      {
!       struct sockaddr *addrp;
!       int addrlen;
!       int optval = 1;
! 
!       if (family < 0)
!       family = AF_INET;
!       s = socket (family, socktype, 0);
!       if (s < 0)
!       report_file_error ("Cannot create server socket", Qnil);
! 
!       count1 = specpdl_ptr - specpdl;
!       record_unwind_protect (close_file_unwind, make_number (s));
! 
!       switch (family)
!       {
!       case AF_LOCAL:
!         /* address_un was initialized above.  */
!         addrp = (struct sockaddr *)&address_un;
!         addrlen = sizeof address_un;
!         break;
!       default:
!         bzero (&address, sizeof address);
!         address.sin_family = AF_INET;
!         address.sin_port = port;
!         address.sin_addr.s_addr = INADDR_ANY;
!         addrp = (struct sockaddr *)&address;
!         addrlen = sizeof address;
! 
!         if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
!           report_file_error ("Cannot set reuse option on server socket.", 
Qnil);
!         break;
!       }
!       
!       if (bind (s, addrp, addrlen))
!       report_file_error ("Cannot bind server socket", Qnil);
! 
! #ifdef DATAGRAM_SOCKETS
!       if (socktype == SOCK_DGRAM)
!       {
!         if (!datagram_address[s].sa || datagram_address[s].len != addrlen)
!           {
!             if (datagram_address[s].sa)
!               xfree (datagram_address[s].sa);
!             datagram_address[s].sa = (struct sockaddr *) xmalloc (addrlen);
!             bzero (datagram_address[s].sa, addrlen);
!             datagram_address[s].sa->sa_family = addrp->sa_family;
!             datagram_address[s].len = addrlen;
!           }
!       }
!       else
!       if (datagram_address[s].sa)
!         {
!           xfree (datagram_address[s].sa);
!           datagram_address[s].sa = 0;
!           datagram_address[s].len = 0;
!           }
! #endif
! 
!       if (socktype == SOCK_STREAM && listen (s, 5))
!       report_file_error ("Cannot listen on server socket", Qnil);
! 
!       /* Discard the unwind protect closing S.  */
!       specpdl_ptr = specpdl + count1;
  
+       goto socket_opened;
+     }
  
    /* Slow down polling to every ten seconds.
       Some kernels have a bug which causes retrying connect to fail
       after a connect.  Polling can interfere with gethostbyname too.  */
  #ifdef POLL_FOR_INPUT
!   if (socktype == SOCK_STREAM)
!     {
!       record_unwind_protect (unwind_stop_other_atimers, Qnil);
!       bind_polling_period (10);
!     }
  #endif
  
  #ifndef TERM
+ #ifdef AF_LOCAL
+   if (family == AF_LOCAL)
+     {
+       /* Emulate HAVE_GETADDRINFO for the loop over `res' below.  */
+       ai.ai_family = AF_LOCAL;
+       ai.ai_socktype = socktype;
+       ai.ai_protocol = 0;
+       ai.ai_addr = (struct sockaddr *) &address_un;
+       ai.ai_addrlen = sizeof address_un;
+       ai.ai_next = NULL;
+       res = &ai;
+       goto open_client_socket;
+     }
+ #endif
+ 
+   CHECK_STRING (host);
+ 
  #ifdef HAVE_GETADDRINFO
    immediate_quit = 1;
    QUIT;
    memset (&hints, 0, sizeof (hints));
    hints.ai_flags = 0;
!   hints.ai_family = family == -1 ? AF_UNSPEC : family;
!   hints.ai_socktype = socktype;
    hints.ai_protocol = 0;
    ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
    if (ret)
***************
*** 1919,1943 ****
  
  #else /* not HAVE_GETADDRINFO */
  
!   while (1)
!     {
! #if 0
! #ifdef TRY_AGAIN
!       h_errno = 0;
! #endif
! #endif
!       immediate_quit = 1;
!       QUIT;
!       host_info_ptr = gethostbyname (XSTRING (host)->data);
!       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);
!     }
    
    if (host_info_ptr == 0)
      /* Attempt to interpret host as numeric inet address */
--- 2168,2180 ----
  
  #else /* not HAVE_GETADDRINFO */
  
!   /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
!      as it may `hang' emacs for a very long time.  */
! 
!   immediate_quit = 1;
!   QUIT;
!   host_info_ptr = gethostbyname (XSTRING (host)->data);
!   immediate_quit = 0;
    
    if (host_info_ptr == 0)
      /* Attempt to interpret host as numeric inet address */
***************
*** 1949,1955 ****
        host_info_ptr = &host_info;
        host_info.h_name = 0;
        host_info.h_aliases = 0;
!       host_info.h_addrtype = AF_INET;
  #ifdef h_addr
        /* Older machines have only one address slot called h_addr.
         Newer machines have h_addr_list, but #define h_addr to
--- 2186,2192 ----
        host_info_ptr = &host_info;
        host_info.h_name = 0;
        host_info.h_aliases = 0;
!       host_info.h_addrtype = family == -1 ? AF_INET : family;
  #ifdef h_addr
        /* Older machines have only one address slot called h_addr.
         Newer machines have h_addr_list, but #define h_addr to
***************
*** 1970,1976 ****
  
    /* 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;
--- 2207,2213 ----
  
    /* Emulate HAVE_GETADDRINFO for the loop over `res' below.  */
    ai.ai_family = host_info_ptr->h_addrtype;
!   ai.ai_socktype = socktype;
    ai.ai_protocol = 0;
    ai.ai_addr = (struct sockaddr *) &address;
    ai.ai_addrlen = sizeof address;
***************
*** 1978,1983 ****
--- 2215,2221 ----
    res = &ai;
  #endif /* not HAVE_GETADDRINFO */
  
+  open_client_socket:
    /* Do this in case we never enter the for-loop below.  */
    count1 = specpdl_ptr - specpdl;
    s = -1;
***************
*** 1991,1996 ****
--- 2229,2255 ----
          continue;
        }
  
+ #ifdef DATAGRAM_SOCKETS
+       if (socktype == SOCK_DGRAM)
+       {
+         if (!datagram_address[s].sa || datagram_address[s].len != 
lres->ai_addrlen)
+           {
+             if (datagram_address[s].sa)
+               xfree (datagram_address[s].sa);
+             datagram_address[s].sa = (struct sockaddr *) xmalloc 
(lres->ai_addrlen);
+           }
+         bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
+         datagram_address[s].len = lres->ai_addrlen;
+ #ifdef HAVE_GETADDRINFO
+ #ifdef AF_LOCAL
+         if (family != AF_LOCAL)
+ #endif
+           freeaddrinfo (res);
+ #endif
+         goto socket_opened;
+       }
+ #endif
+ 
  #ifdef NON_BLOCKING_CONNECT
        if (is_non_blocking)
        {
***************
*** 2111,2117 ****
        report_file_error ("connection failed",
                         Fcons (host, Fcons (name, Qnil)));
      }
!   
    immediate_quit = 0;
  
    /* Discard the unwind protect, if any.  */
--- 2370,2385 ----
        report_file_error ("connection failed",
                         Fcons (host, Fcons (name, Qnil)));
      }
! 
! #ifdef DATAGRAM_SOCKETS
!   if (datagram_address[s].sa)
!     {
!       xfree (datagram_address[s].sa);
!       datagram_address[s].sa = 0;
!       datagram_address[s].len = 0;
!     }
! #endif
! 
    immediate_quit = 0;
  
    /* Discard the unwind protect, if any.  */
***************
*** 2132,2137 ****
--- 2400,2407 ----
    send_command (s, C_DUMB, 1, 0);
  #endif /* TERM */
  
+  socket_opened:
+ 
    inch = s;
    outch = s;
  
***************
*** 2149,2155 ****
  #endif
  #endif
  
!   XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
    XPROCESS (proc)->command_channel_p = Qnil;
    XPROCESS (proc)->buffer = buffer;
    XPROCESS (proc)->sentinel = sentinel;
--- 2419,2425 ----
  #endif
  #endif
  
!   XPROCESS (proc)->childp = contact;
    XPROCESS (proc)->command_channel_p = Qnil;
    XPROCESS (proc)->buffer = buffer;
    XPROCESS (proc)->sentinel = sentinel;
***************
*** 2158,2167 ****
    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))
      {
        /* We may get here if connect did succeed immediately.  However,
         in that case, we still need to signal this like a non-blocking
--- 2428,2438 ----
    XPROCESS (proc)->pid = Qnil;
    XSETINT (XPROCESS (proc)->infd, inch);
    XSETINT (XPROCESS (proc)->outfd, outch);
!   XPROCESS (proc)->status 
!     = (NILP (host) && !DATAGRAM_CHAN_P (inch)) ? Qlisten : Qrun;
  
  #ifdef NON_BLOCKING_CONNECT
!   if (EQ (type, Qt))
      {
        /* We may get here if connect did succeed immediately.  However,
         in that case, we still need to signal this like a non-blocking
***************
*** 2175,2181 ****
      }
    else
  #endif
!     if (!EQ (XPROCESS (proc)->filter, Qt))
        {
        FD_SET (inch, &input_wait_mask);
        FD_SET (inch, &non_keyboard_wait_mask);
--- 2446,2453 ----
      }
    else
  #endif
!     if (NILP (host) ||
!       !EQ (XPROCESS (proc)->filter, Qt))
        {
        FD_SET (inch, &input_wait_mask);
        FD_SET (inch, &non_keyboard_wait_mask);
***************
*** 2343,2348 ****
--- 2615,2701 ----
  #endif
  }
  
+ DEFUN ("process-datagram-address", Fprocess_datagram_address, 
Sprocess_datagram_address,
+        1, 3, 0,
+        doc: /* Get the current datagram address associated with PROCESS.
+ If optional arg NEW-ADDRESS is non-nil, set that as a new datagram
+ address for PROCESS.  The old datagram address is still returned,
+ unless the third argument IGNORE-OLD is non-nil.  */)
+        (process, new_address, ignore_old)
+        Lisp_Object process, new_address, ignore_old;
+ {
+   Lisp_Object address;
+   int channel, i, len;
+   unsigned char *cp;
+   register struct Lisp_Vector *p;
+   struct sockaddr *sa;
+ 
+   CHECK_PROCESS (process);
+ 
+ #ifndef DATAGRAM_SOCKETS
+   return Qnil;
+ #else
+   if (!DATAGRAM_CONN_P (process))
+     return Qnil;
+ 
+   channel = XPROCESS (process)->infd;
+   sa = datagram_address[channel].sa; 
+   if (sa->sa_family == AF_INET)
+     len = 6;
+   else
+     len = datagram_address[channel].len - sizeof(sa->sa_family) + 1;
+ 
+   if (!NILP (new_address))
+     if (!VECTORP (new_address) ||
+       XVECTOR (new_address)->size != len ||
+       XFASTINT (XVECTOR (new_address)->contents[0]) != sa->sa_family)
+       wrong_type_argument (Qvectorp, new_address);
+ 
+   if (!NILP (ignore_old))
+     address = Qnil;
+   else
+     {
+       address = Fmake_vector (make_number (len), Qnil);
+       p = XVECTOR (address);
+       i = 0;
+       p->contents[i++] = make_number (sa->sa_family);
+       if (sa->sa_family == AF_INET)
+       {
+         struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+         p->contents[i++] = make_number (ntohs (sin->sin_port));
+         cp = (unsigned char *)&sin->sin_addr;
+       }
+       else
+       cp = (unsigned char *)datagram_address[channel].sa + sizeof 
(sa->sa_family);
+       while (i < len)
+       p->contents[i++] = make_number (*cp++);
+     }
+ 
+   if (!NILP (new_address))
+     {
+       p = XVECTOR (new_address);
+       len = p->size;
+       i = 0;
+       if (sa->sa_family == AF_INET)
+       {
+         Lisp_Object port = p->contents[++i];
+         struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+         sin->sin_port = htons (XFASTINT (port));
+         cp = (unsigned char *)&sin->sin_addr;
+       }
+       else
+       cp = (unsigned char *)datagram_address[channel].sa + sizeof 
(sa->sa_family);
+       while (++i < len)
+       /* result is undefined if vector contains something
+          other than integers.  But then it's messed up anyway.  */
+       *cp++ = XFASTINT (p->contents[i]) & 0xff;
+     }
+ 
+   return address;
+ #endif
+ }
+ 
+ 
  DEFUN ("accept-process-output", Faccept_process_output, 
Saccept_process_output,
         0, 3, 0,
         doc: /* Allow any pending output from subprocesses to be read by Emacs.
***************
*** 2411,2416 ****
--- 2764,2956 ----
       ? Qt : Qnil);
  }
  
+ /* Accept a connection for server process SERVER on CHANNEL.  */
+ 
+ static int connect_counter = 0;
+ 
+ static void
+ server_accept_connection (server, channel)
+      Lisp_Object server;
+      int channel;
+ {
+   Lisp_Object proc, caller, name, buffer;
+   Lisp_Object host, service;
+   int s;
+   union u_sockaddr {
+     struct sockaddr sa;
+     struct sockaddr_in in;
+ #ifdef AF_LOCAL
+     struct sockaddr_un un;
+ #endif
+   } saddr;
+   int len = sizeof saddr;
+ 
+   /* TODO: Add GCPRO if necessary.  */
+ 
+   s = accept (channel, &saddr.sa, &len);
+ 
+   if (s < 0)
+     {
+       int code = errno;
+ 
+       if (code == EAGAIN)
+       return;
+ #ifdef EWOULDBLOCK
+       if (code == EWOULDBLOCK)
+       return;
+ #endif
+ 
+       if (!NILP (Vnetwork_server_log_function))
+       apply1 (Vnetwork_server_log_function,
+               list3 (server, Qnil,
+                      concat3 (build_string ("accept failed with code"),
+                               Fnumber_to_string (make_number (code)),
+                               build_string ("\n"))));
+       return;
+     }
+ 
+   connect_counter++;
+ 
+   /* Setup a new process to handle the connection.  */
+ 
+   /* Generate a unique identification of the caller, and build contact
+      information for this process.  */
+   host = Qt;
+   service = Qnil;
+   switch (saddr.sa.sa_family)
+     {
+     case AF_INET:
+       {
+       Lisp_Object args[5];
+       unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
+       args[0] = build_string ("%d.%d.%d.%d");
+       args[1] = make_number (*ip++);
+       args[2] = make_number (*ip++);
+       args[3] = make_number (*ip++);
+       args[4] = make_number (*ip++);
+       host = Fformat (5, args);
+       service = make_number (ntohs (saddr.in.sin_port));
+ 
+       args[0] = build_string (" <%s:%d>");
+       args[1] = host;
+       args[2] = service;
+       caller = Fformat (3, args);
+       }
+       break;
+ 
+ #ifdef AF_LOCAL
+     case AF_LOCAL:
+ #endif
+     default:
+       caller = Fnumber_to_string (make_number (connect_counter));
+       caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
+       break;
+     }
+ 
+   /* Create a new buffer name for this process if it doesn't have a
+      filter.  The new buffer name is based on the buffer name or
+      process name of the server process concatenated with the caller
+      identification.  */
+ 
+   if (!NILP (XPROCESS (server)->filter))
+     buffer = Qnil;
+   else
+     {
+       buffer = XPROCESS (server)->buffer;
+       if (!NILP (buffer))
+       buffer = Fbuffer_name (buffer);
+       else
+       buffer = XPROCESS (server)->name;
+       if (!NILP (buffer))
+       {
+         buffer = concat2 (buffer, caller);
+         buffer = Fget_buffer_create (buffer);
+       }
+     }
+ 
+   /* Generate a unique name for the new server process.  Combine the
+      server process name with the caller identification.  */
+ 
+   name = concat2 (XPROCESS (server)->name, caller);
+   proc = make_process (name);
+ 
+   chan_process[s] = proc;
+ 
+ #ifdef O_NONBLOCK
+   fcntl (s, F_SETFL, O_NONBLOCK);
+ #else
+ #ifdef O_NDELAY
+   fcntl (s, F_SETFL, O_NDELAY);
+ #endif
+ #endif
+ 
+   /* Build new contact information for this setup.  */
+   XPROCESS (proc)->childp = Fcopy_sequence (XPROCESS (server)->childp);
+   XSETCAR (XPROCESS (proc)->childp, host);
+   if (!NILP (service))
+     XSETCAR (CDR (XPROCESS (proc)->childp), service);
+ 
+   XPROCESS (proc)->command_channel_p = Qnil;
+   XPROCESS (proc)->buffer = buffer;
+   XPROCESS (proc)->sentinel = XPROCESS (server)->sentinel;
+   XPROCESS (proc)->filter = XPROCESS (server)->filter;
+   XPROCESS (proc)->command = Qnil;
+   XPROCESS (proc)->pid = Qnil;
+   XSETINT (XPROCESS (proc)->infd, s);
+   XSETINT (XPROCESS (proc)->outfd, s);
+   XPROCESS (proc)->status = Qrun;
+ 
+   if (!EQ (XPROCESS (proc)->filter, Qt))
+     {
+       FD_SET (s, &input_wait_mask);
+       FD_SET (s, &non_keyboard_wait_mask);
+     }
+ 
+   if (s > max_process_desc)
+     max_process_desc = s;
+ 
+   /* Setup coding system for new process based on server process.  
+      This seems to be the proper thing to do, as the coding system
+      of the new process should reflect the settings at the time the
+      server socket was opened; not the current settings. */
+ 
+   XPROCESS (proc)->decode_coding_system = XPROCESS 
(server)->decode_coding_system;
+   XPROCESS (proc)->encode_coding_system = XPROCESS 
(server)->encode_coding_system;
+ 
+   if (!proc_decode_coding_system[s])
+     proc_decode_coding_system[s]
+       = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+   setup_coding_system (XPROCESS (proc)->decode_coding_system,
+                      proc_decode_coding_system[s]);
+   if (!proc_encode_coding_system[s])
+     proc_encode_coding_system[s]
+       = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+   setup_coding_system (XPROCESS (proc)->encode_coding_system,
+                      proc_encode_coding_system[s]);
+ 
+   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)
+        ? Qnil : XPROCESS (server)->inherit_coding_system_flag);
+ 
+   if (!NILP (Vnetwork_server_log_function))
+     apply1 (Vnetwork_server_log_function,
+           list3 (server, proc,
+                  concat3 (build_string ("accept from "),
+                           (STRINGP (host) ? host : build_string ("-")),
+                           build_string ("\n"))));
+ 
+   if (XPROCESS (proc)->sentinel)
+     exec_sentinel (proc, 
+                  concat3 (build_string ("open from "),
+                           (STRINGP (host) ? host : build_string ("-")),
+                           build_string ("\n")));
+ }
+ 
  /* This variable is different from waiting_for_input in keyboard.c.
     It is used to communicate to a lisp process-filter/sentinel (via the
     function Fwaiting_for_user_input_p below) whether emacs was waiting
***************
*** 2909,2914 ****
--- 3449,3462 ----
              if (NILP (proc))
                continue;
  
+             /* If this is a server stream socket, accept connection.  */
+             if (EQ (XPROCESS (proc)->status, Qlisten)
+                 && !DATAGRAM_CHAN_P (channel))
+               {
+                 server_accept_connection (proc, channel);
+                 continue;
+               }
+ 
              /* Read data from the process, starting with our
                 buffered-ahead character if we have one.  */
  
***************
*** 2983,2989 ****
            {
              struct Lisp_Process *p;
              struct sockaddr pname;
!             socklen_t pnamelen = sizeof(pname);
  
              FD_CLR (channel, &connect_wait_mask);
              if (--num_pending_connects < 0)
--- 3531,3537 ----
            {
              struct Lisp_Process *p;
              struct sockaddr pname;
!             int pnamelen = sizeof(pname);
  
              FD_CLR (channel, &connect_wait_mask);
              if (--num_pending_connects < 0)
***************
*** 2999,3005 ****
              /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
                 So only use it on systems where it is known to work.  */
              {
!               socklen_t xlen = sizeof(xerrno);
                if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
                  xerrno = errno;
              }
--- 3547,3553 ----
              /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
                 So only use it on systems where it is known to work.  */
              {
!               int xlen = sizeof(xerrno);
                if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
                  xerrno = errno;
              }
***************
*** 3106,3111 ****
--- 3654,3660 ----
    register int opoint;
    struct coding_system *coding = proc_decode_coding_system[channel];
    int carryover = XINT (p->decoding_carryover);
+   int readmax = 1024;
  
  #ifdef VMS
    VMS_PROC_STUFF *vs, *get_vms_process_pointer();
***************
*** 3137,3154 ****
        bcopy (vs->inputBuffer, chars + carryover, nbytes);
      }
  #else /* not VMS */
!   chars = (char *) alloca (carryover + 1024);
    if (carryover)
      /* See the comment above.  */
      bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
  
    if (proc_buffered_char[channel] < 0)
!     nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
    else
      {
        chars[carryover] = proc_buffered_char[channel];
        proc_buffered_char[channel] = -1;
!       nbytes = emacs_read (channel, chars + carryover + 1,  1023 - carryover);
        if (nbytes < 0)
        nbytes = 1;
        else
--- 3686,3724 ----
        bcopy (vs->inputBuffer, chars + carryover, nbytes);
      }
  #else /* not VMS */
! 
! #ifdef DATAGRAM_SOCKETS
!   /* A datagram is one packet; allow at least 1500+ bytes of data
!      corresponding to the typical Ethernet frame size.  */
!   if (DATAGRAM_CHAN_P (channel))
!     {
!       /* carryover = 0; */  /* Does carryover make sense for datagrams? */
!       readmax += 1024;
!     }
! #endif
! 
!   chars = (char *) alloca (carryover + readmax);
    if (carryover)
      /* See the comment above.  */
      bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
  
+ #ifdef DATAGRAM_SOCKETS
+   /* We have a working select, so proc_buffered_char is always -1.  */
+   if (DATAGRAM_CHAN_P (channel))
+     {
+       int len = datagram_address[channel].len;
+       nbytes = recvfrom (channel, chars + carryover, readmax - carryover,
+                        0, datagram_address[channel].sa, &len);
+     }
+   else
+ #endif
    if (proc_buffered_char[channel] < 0)
!     nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
    else
      {
        chars[carryover] = proc_buffered_char[channel];
        proc_buffered_char[channel] = -1;
!       nbytes = emacs_read (channel, chars + carryover + 1,  readmax - 1 - 
carryover);
        if (nbytes < 0)
        nbytes = 1;
        else
***************
*** 3614,3622 ****
          /* Send this batch, using one or more write calls.  */
          while (this > 0)
            {
              old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, 
send_process_trap);
!             rv = emacs_write (XINT (XPROCESS (proc)->outfd),
!                               (char *) buf, this);
              signal (SIGPIPE, old_sigpipe);
  
              if (rv < 0)
--- 4184,4203 ----
          /* Send this batch, using one or more write calls.  */
          while (this > 0)
            {
+             int outfd = XINT (XPROCESS (proc)->outfd);
              old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, 
send_process_trap);
! #ifdef DATAGRAM_SOCKETS
!             if (DATAGRAM_CHAN_P (outfd))
!               {
!                 rv = sendto (outfd, (char *) buf, this,
!                              0, datagram_address[outfd].sa,
!                              datagram_address[outfd].len);
!                 if (rv < 0 && errno == EMSGSIZE)
!                   report_file_error ("sending datagram", Fcons (proc, Qnil));
!               }
!             else
! #endif
!               rv = emacs_write (outfd, (char *) buf, this);
              signal (SIGPIPE, old_sigpipe);
  
              if (rv < 0)
***************
*** 4235,4240 ****
--- 4816,4824 ----
    Lisp_Object proc;
    struct coding_system *coding;
  
+   if (DATAGRAM_CONN_P (process))
+     return process;
+ 
    proc = get_process (process);
    coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
  
***************
*** 4829,4834 ****
--- 5413,5421 ----
      }
    bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
    bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
+ #ifdef DATAGRAM_SOCKETS
+   bzero (datagram_address, sizeof datagram_address);
+ #endif
  }
  
  void
***************
*** 4857,4862 ****
--- 5444,5455 ----
    staticpro (&Qconnect);
    Qfailed = intern ("failed");
    staticpro (&Qfailed);
+   Qlisten = intern ("listen");
+   staticpro (&Qlisten);
+   Qlocal = intern ("local");
+   staticpro (&Qlocal);
+   Qdatagram = intern ("datagram");
+   staticpro (&Qdatagram);
  
    Qlast_nonmenu_event = intern ("last-nonmenu-event");
    staticpro (&Qlast_nonmenu_event);
***************
*** 4877,4882 ****
--- 5470,5481 ----
  The value takes effect when `start-process' is called.  */);
    Vprocess_connection_type = Qt;
  
+   DEFVAR_LISP ("network-server-log-function", &Vnetwork_server_log_function,
+              doc: /* Function called when accepting a network connecting.
+ Arguments are SERVER, PROCESS, and MESSAGE, where SERVER is the server 
process,
+ PROCESS is the new process for the connection, and MESSAGE is a string.  */);
+   Vnetwork_server_log_function = Qnil;
+ 
    defsubr (&Sprocessp);
    defsubr (&Sget_process);
    defsubr (&Sget_buffer_process);
***************
*** 4906,4911 ****
--- 5505,5511 ----
    defsubr (&Sopen_network_stream);
  #endif /* HAVE_SOCKETS */
    defsubr (&Saccept_process_output);
+   defsubr (&Sprocess_datagram_address);
    defsubr (&Sprocess_send_region);
    defsubr (&Sprocess_send_string);
    defsubr (&Sinterrupt_process);

-- 
Kim F. Storm <address@hidden> http://www.cua.dk




reply via email to

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