+/* Convert an internal struct sockaddr to a lisp object (vector or string).
+ The address family of sa is not included in the result. */
+
+static Lisp_Object
+conv_sockaddr_to_lisp (sa, len)
+ struct sockaddr *sa;
+ int len;
+{
+ Lisp_Object address;
+ int i;
+ unsigned char *cp;
+ register struct Lisp_Vector *p;
+
+ switch (sa->sa_family)
+ {
+ case AF_INET:
+ {
+ struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+ len = sizeof (sin->sin_addr) + 1;
+ address = Fmake_vector (make_number (len), Qnil);
+ p = XVECTOR (address);
+ p->contents[--len] = make_number (ntohs (sin->sin_port));
+ cp = (unsigned char *)&sin->sin_addr;
+ break;
+ }
+#ifdef HAVE_LOCAL_SOCKETS
+ case AF_LOCAL:
+ {
+ struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
+ for (i = 0; i < sizeof (sockun->sun_path); i++)
+ if (sockun->sun_path[i] == 0)
+ break;
+ return make_unibyte_string (sockun->sun_path, i);
+ }
+#endif
+ default:
+ len -= sizeof (sa->sa_family);
+ address = Fcons (make_number (sa->sa_family),
+ Fmake_vector (make_number (len), Qnil));
+ p = XVECTOR (XCDR (address));
+ cp = (unsigned char *) sa + sizeof (sa->sa_family);
+ break;
+ }
+
+ i = 0;
+ while (i < len)
+ p->contents[i++] = make_number (*cp++);
+
+ return address;
+}
+
+
+/* Get family and required size for sockaddr structure to hold ADDRESS. */
+
+static int
+get_lisp_to_sockaddr_size (address, familyp)
+ Lisp_Object address;
+ int *familyp;
+{
+ register struct Lisp_Vector *p;
+
+ if (VECTORP (address))
+ {
+ p = XVECTOR (address);
+ if (p->size == 5)
+ {
+ *familyp = AF_INET;
+ return sizeof (struct sockaddr_in);
+ }
+ }
+#ifdef HAVE_LOCAL_SOCKETS
+ else if (STRINGP (address))
+ {
+ *familyp = AF_LOCAL;
+ return sizeof (struct sockaddr_un);
+ }
+#endif
+ else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
+ {
+ struct sockaddr *sa;
+ *familyp = XINT (XCAR (address));
+ p = XVECTOR (XCDR (address));
+ return p->size + sizeof (sa->sa_family);
+ }
+ return 0;
+}
+
+/* Convert an address object (vector or string) to an internal sockaddr.
+ Format of address has already been validated by size_lisp_to_sockaddr. */
+
+static void
+conv_lisp_to_sockaddr (family, address, sa, len)
+ int family;
+ Lisp_Object address;
+ struct sockaddr *sa;
+ int len;
+{
+ register struct Lisp_Vector *p;
+ register unsigned char *cp;
+ register int i;
+
+ bzero (sa, len);
+ sa->sa_family = family;
+
+ if (VECTORP (address))
+ {
+ p = XVECTOR (address);
+ if (family == AF_INET)
+ {
+ struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+ len = sizeof (sin->sin_addr) + 1;
+ i = XINT (p->contents[--len]);
+ sin->sin_port = htons (i);
+ cp = (unsigned char *)&sin->sin_addr;
+ }
+ }
+ else if (STRINGP (address))
+ {
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family == AF_LOCAL)
+ {
+ struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
+ cp = XSTRING (address)->data;
+ for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
+ sockun->sun_path[i] = *cp++;
+ }
+#endif
+ return;
+ }
+ else
+ {
+ p = XVECTOR (XCDR (address));
+ cp = (unsigned char *)sa + sizeof (sa->sa_family);
+ }
+
+ for (i = 0; i < len; i++)
+ if (INTEGERP (p->contents[i]))
+ *cp++ = XFASTINT (p->contents[i]) & 0xff;
+}
+
+#ifdef DATAGRAM_SOCKETS
+DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
+ 1, 1, 0,
+ doc: /* Get the current datagram address associated with PROCESS. */)
+ (process)
+ Lisp_Object process;
+{
+ int channel;
+
+ CHECK_PROCESS (process);
+
+ if (!DATAGRAM_CONN_P (process))
+ return Qnil;
+
+ channel = XINT (XPROCESS (process)->infd);
+ return conv_sockaddr_to_lisp (datagram_address[channel].sa,
+ datagram_address[channel].len);
+}
+
+DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
+ 2, 2, 0,
+ doc: /* Set the datagram address for PROCESS to ADDRESS.
+Returns nil upon error setting address, ADDRESS otherwise. */)
+ (process, address)
+ Lisp_Object process, address;
+{
+ int channel;
+ int family, len;
+
+ CHECK_PROCESS (process);
+
+ if (!DATAGRAM_CONN_P (process))
+ return Qnil;
+
+ channel = XINT (XPROCESS (process)->infd);
+
+ len = get_lisp_to_sockaddr_size (address, &family);
+ if (datagram_address[channel].len != len)
+ return Qnil;
+ conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
+ return address;
+}
+#endif
+\f
+
+static struct socket_options {
+ /* The name of this option. Should be lowercase version of option
+ name without SO_ prefix. */
+ char *name;
+ /* Length of name. */
+ int nlen;
+ /* Option level SOL_... */
+ int optlevel;
+ /* Option number SO_... */
+ int optnum;
+ enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_STR, SOPT_LINGER } opttype;
+} socket_options[] =
+ {
+#ifdef SO_BINDTODEVICE
+ { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
+#endif
+#ifdef SO_BROADCAST
+ { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
+#endif
+#ifdef SO_DONTROUTE
+ { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
+#endif
+#ifdef SO_KEEPALIVE
+ { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
+#endif
+#ifdef SO_LINGER
+ { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
+#endif
+#ifdef SO_OOBINLINE
+ { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
+#endif
+#ifdef SO_PRIORITY
+ { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
+#endif
+#ifdef SO_REUSEADDR
+ { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
+#endif
+ { 0, 0, 0, 0, SOPT_UNKNOWN }
+ };
+
+/* Process list of socket options OPTS on socket S.
+ Only check if options are supported is S < 0.
+ If NO_ERROR is non-zero, continue silently if an option
+ cannot be set.
+
+ Each element specifies one option. An element is either a string
+ "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
+ or a symbol. */
+
+static int
+set_socket_options (s, opts, no_error)
+ int s;
+ Lisp_Object opts;
+ int no_error;
+{
+ if (!CONSP (opts))
+ opts = Fcons (opts, Qnil);
+
+ while (CONSP (opts))
+ {
+ Lisp_Object opt;
+ Lisp_Object val;
+ char *name, *arg;
+ struct socket_options *sopt;
+ int ret = 0;
+
+ opt = XCAR (opts);
+ opts = XCDR (opts);
+
+ name = 0;
+ val = Qt;
+ if (CONSP (opt))
+ {
+ val = XCDR (opt);
+ opt = XCAR (opt);
+ }
+ if (STRINGP (opt))
+ name = (char *) XSTRING (opt)->data;
+ else if (SYMBOLP (opt))
+ name = (char *) XSYMBOL (opt)->name->data;
+ else {
+ error ("Mal-formed option list");
+ return 0;
+ }
+
+ if (strncmp (name, "no", 2) == 0)
+ {
+ val = Qnil;
+ name += 2;
+ }
+
+ arg = 0;
+ for (sopt = socket_options; sopt->name; sopt++)
+ if (strncmp (name, sopt->name, sopt->nlen) == 0)
+ {
+ if (name[sopt->nlen] == 0)
+ break;
+ if (name[sopt->nlen] == '=')
+ {
+ arg = name + sopt->nlen + 1;
+ break;
+ }
+ }
+
+ switch (sopt->opttype)
+ {
+ case SOPT_BOOL:
+ {
+ int optval;
+ if (s < 0)
+ return 1;
+ if (arg)
+ optval = (*arg == '0' || *arg == 'n') ? 0 : 1;
+ else if (INTEGERP (val))
+ optval = XINT (val) == 0 ? 0 : 1;
+ else
+ optval = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
+
+ case SOPT_INT:
+ {
+ int optval;
+ if (arg)
+ optval = atoi(arg);
+ else if (INTEGERP (val))
+ optval = XINT (val);
+ else
+ error ("Bad option argument for %s", name);
+ if (s < 0)
+ return 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
+
+ case SOPT_STR:
+ {
+ if (!arg)
+ {
+ if (NILP (val))
+ arg = "";
+ else if (STRINGP (val))
+ arg = (char *) XSTRING (val)->data;
+ else if (XSYMBOL (val))
+ arg = (char *) XSYMBOL (val)->name->data;
+ else
+ error ("Invalid argument to %s option", name);
+ }
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ arg, strlen (arg));
+ }
+
+#ifdef SO_LINGER
+ case SOPT_LINGER:
+ {
+ struct linger linger;
+
+ linger.l_onoff = 1;
+ linger.l_linger = 0;
+
+ if (s < 0)
+ return 1;
+
+ if (arg)
+ {
+ if (*arg == 'n' || *arg == 't' || *arg == 'y')
+ linger.l_onoff = (*arg == 'n') ? 0 : 1;
+ else
+ linger.l_linger = atoi(arg);
+ }
+ else if (INTEGERP (val))
+ linger.l_linger = XINT (val);
+ else
+ linger.l_onoff = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &linger, sizeof (linger));
+ break;
+ }
+#endif
+ default:
+ if (s < 0)
+ return 0;
+ if (no_error)
+ continue;
+ error ("Unsupported option: %s", name);
+ }
+ if (ret < 0 && ! no_error)
+ report_file_error ("Cannot set network option: %s", opt);
+ }
+ return 1;
+}
+
+DEFUN ("set-network-process-options",
+ Fset_network_process_options, Sset_network_process_options,
+ 1, MANY, 0,
+ doc: /* Set one or more options for network process PROCESS.
+Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
+A boolean value is false if it either zero or nil, true otherwise.
+
+The following options are known. Consult the relevant system manual
+pages for more information.
+
+bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
+broadcast=BOOL -- Allow send and receive of datagram broadcasts.
+dontroute=BOOL -- Only send to directly connected hosts.
+keepalive=BOOL -- Send keep-alive messages on network stream.
+linger=BOOL or TIMEOUT -- Send queued messages before closing.
+oobinline=BOOL -- Place out-of-band data in receive data stream.
+priority=INT -- Set protocol defined priority for sent packets.
+reuseaddr=BOOL -- Allow reusing a recently used address.
+
+usage: (set-network-process-options PROCESS &rest OPTIONS) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object process;
+ Lisp_Object opts;
+
+ process = args[0];
+ CHECK_PROCESS (process);
+ if (nargs > 1 && XINT (XPROCESS (process)->infd) >= 0)
+ {
+ opts = Flist (nargs, args);
+ set_socket_options (XINT (XPROCESS (process)->infd), opts, 0);
+ }
+ return process;
+}
+\f
+/* A version of request_sigio suitable for a record_unwind_protect. */
+
+Lisp_Object
+unwind_request_sigio (dummy)
+ Lisp_Object dummy;
+{
+ if (interrupt_input)
+ request_sigio ();
+ return Qnil;
+}
+
+/* Create a network stream/datagram client/server process. Treated
+ exactly like a normal process when reading and writing. Primary