emacs: src/process.c comparison

comparison src/process.c @ 52516:0ca23eb697b9

(Fset_process_sentinel): Add sentinel to childp plist for network process. (socket_options): Add `:' prefix to option names. Add optbit field. (set_socket_option): Remove no_error arg and special handling of s < 0. Return 1<<optbit for known option, 0 for unknown. Do not interpret 0 as false for boolean option (only nil). Pass failed option and value to report_file_error. (Fset_network_process_options): Replaced by Fset_network_process_option. (Fset_network_process_option): New function to set just one option. (Fmake_network_process): Allow :coding arg to be a cons. Allow :server arg to be an integer specifying backlog size. Remove :options arg, and allow options to be specified directly as :KEY, VALUE pairs. Parse these options before binding socket. As before, :reuseaddr t is default for a server process, but this can now be disabled by specifying :reuseaddr nil. (Fnetwork_interface_info): Rename from Fget_network_interface_info. (init_process): Availability of network options is now checked with simpler syntax (featurep 'make-network-process :OPTION); use loop to setup features. (syms_of_process): Fix defsubr's for the replaced functions.

author	Kim F. Storm <storm@cua.dk>
date	Tue, 16 Sep 2003 23:05:24 +0000
parents	256a27a47af1
children	fd2be6cea0e7

comparison

equal deleted inserted replaced

-:14b2402877fc
+:0ca23eb697b9
 The sentinel is called as a function when the process changes state.
 It gets two arguments: the process, and a string describing the change.  */)
 (process, sentinel)
 register Lisp_Object process, sentinel;
 {
+struct Lisp_Process *p;
 CHECK_PROCESS (process);
-XPROCESS (process)->sentinel = sentinel;
+p = XPROCESS (process);
+p->sentinel = sentinel;
+if (NETCONN1_P (p))
+p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
 return sentinel;
 }
 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
 1, 1, 0,
 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;
+enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit;
 } socket_options[] =
 {
 #ifdef SO_BINDTODEVICE
-{ "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
+{ ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR, OPIX_MISC },
 #endif
 #ifdef SO_BROADCAST
-{ "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
+{ ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
 #endif
 #ifdef SO_DONTROUTE
-{ "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
+{ ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
 #endif
 #ifdef SO_KEEPALIVE
-{ "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
+{ ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
 #endif
 #ifdef SO_LINGER
-{ "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
+{ ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
 #endif
 #ifdef SO_OOBINLINE
-{ "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
+{ ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
 #endif
 #ifdef SO_PRIORITY
-{ "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
+{ ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
 #endif
 #ifdef SO_REUSEADDR
-{ "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
+{ ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
 #endif
-{ 0, 0, 0, 0, SOPT_UNKNOWN }
+{ 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
 };
-/* Process list of socket options OPTS on socket S.
+/* Set option OPT to value VAL on socket S.
-Only check if options are supported is S < 0.
-If NO_ERROR is non-zero, continue silently if an option
+Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
-cannot be set.
+Signals an error if setting a known option fails.
+*/
-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)
+set_socket_option (s, opt, val)
 int s;
-Lisp_Object opts;
+Lisp_Object opt, val;
-int no_error;
+{
-{
+char *name;
-if (!CONSP (opts))
+struct socket_options *sopt;
-opts = Fcons (opts, Qnil);
+int ret = 0;
-while (CONSP (opts))
+CHECK_SYMBOL (opt);
-{
-Lisp_Object opt;
+name = (char *) SDATA (SYMBOL_NAME (opt));
-Lisp_Object val;
+for (sopt = socket_options; sopt->name; sopt++)
-char *name, *arg;
+if (strcmp (name, sopt->name) == 0)
-struct socket_options *sopt;
+break;
-int ret = 0;
+switch (sopt->opttype)
-opt = XCAR (opts);
+{
-opts = XCDR (opts);
+case SOPT_BOOL:
+{
-name = 0;
+	int optval;
-val = Qt;
+	optval = NILP (val) ? 0 : 1;
-if (CONSP (opt))
+	ret = setsockopt (s, sopt->optlevel, sopt->optnum,
-	{
+			  &optval, sizeof (optval));
-	  val = XCDR (opt);
+	break;
-	  opt = XCAR (opt);
-	}
-if (STRINGP (opt))
-	name = (char *) SDATA (opt);
-else if (SYMBOLP (opt))
-	name = (char *) SDATA (SYMBOL_NAME (opt));
-else {
-	error ("Mal-formed option list");
-	return 0;
 }
-if (strncmp (name, "no", 2) == 0)
+case SOPT_INT:
-	{
+{
-	  val = Qnil;
+	int optval;
-	  name += 2;
+	if (INTEGERP (val))
-	}
+	  optval = XINT (val);
+	else
-arg = 0;
+	  error ("Bad option value for %s", name);
-for (sopt = socket_options; sopt->name; sopt++)
+	ret = setsockopt (s, sopt->optlevel, sopt->optnum,
-	if (strncmp (name, sopt->name, sopt->nlen) == 0)
+			  &optval, sizeof (optval));
-	  {
+	break;
-	    if (name[sopt->nlen] == 0)
+}
-	      break;
-	    if (name[sopt->nlen] == '=')
+case SOPT_STR:
-	      {
+{
-		arg = name + sopt->nlen + 1;
+	char *arg;
-		break;
-	      }
+	if (NILP (val))
-	  }
+	  arg = "";
+	else if (STRINGP (val))
-switch (sopt->opttype)
+	  arg = (char *) SDATA (val);
-	{
+	else if (XSYMBOL (val))
-	case SOPT_BOOL:
+	  arg = (char *) SDATA (SYMBOL_NAME (val));
-	  {
+	else
-	    int optval;
+	  error ("Bad option value for %s", name);
-	    if (s < 0)
+	ret = setsockopt (s, sopt->optlevel, sopt->optnum,
-	      return 1;
+			  arg, strlen (arg));
-	    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 *) SDATA (val);
-		else if (XSYMBOL (val))
-		  arg = (char *) SDATA (SYMBOL_NAME (val));
-		else
-		  error ("Invalid argument to %s option", name);
-	      }
-	    ret = setsockopt (s, sopt->optlevel, sopt->optnum,
-			      arg, strlen (arg));
-	  }
 #ifdef SO_LINGER
-	case SOPT_LINGER:
+case SOPT_LINGER:
-	  {
+{
-	    struct linger linger;
+	struct linger linger;
-	    linger.l_onoff = 1;
+	linger.l_onoff = 1;
-	    linger.l_linger = 0;
+	linger.l_linger = 0;
+	if (INTEGERP (val))
-	    if (s < 0)
+	  linger.l_linger = XINT (val);
-	      return 1;
+	else
+	  linger.l_onoff = NILP (val) ? 0 : 1;
-	    if (arg)
+	ret = setsockopt (s, sopt->optlevel, sopt->optnum,
-	      {
+			  &linger, sizeof (linger));
-		if (*arg == 'n' || *arg == 't' || *arg == 'y')
+	break;
-		  linger.l_onoff = (*arg == 'n') ? 0 : 1;
+}
-		else
+#endif
-		  linger.l_linger = atoi(arg);
-	      }
+default:
-	    else if (INTEGERP (val))
+return 0;
-	      linger.l_linger = XINT (val);
+}
-	    else
-	      linger.l_onoff = NILP (val) ? 0 : 1;
+if (ret < 0)
-	    ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+report_file_error ("Cannot set network option",
-			      &linger, sizeof (linger));
+		       Fcons (opt, Fcons (val, Qnil)));
-	    break;
+return (1 << sopt->optbit);
-	  }
+}
-#endif
-	default:
-	  if (s < 0)
+DEFUN ("set-network-process-option",
-	    return 0;
+Fset_network_process_option, Sset_network_process_option,
-	  if (no_error)
+3, 4, 0,
-	    continue;
+doc: /* For network process PROCESS set option OPTION to value VALUE.
-	  error ("Unsupported option: %s", name);
+See `make-network-process' for a list of options and values.
-	}
+If optional fourth arg NO-ERROR is non-nil, don't signal an error if
-if (ret < 0 && ! no_error)
+OPTION is not a supported option, return nil instead; otherwise return t.  */)
-	  report_file_error ("Cannot set network option: %s", opt);
+(process, option, value, no_error)
-}
+Lisp_Object process, option, value;
-return 1;
+Lisp_Object no_error;
-}
+{
+int s, i;
-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)
-{
+s = XINT (XPROCESS (process)->infd);
-opts = Flist (nargs, args);
+if (s < 0)
-set_socket_options (XINT (XPROCESS (process)->infd), opts, 0);
+error ("Process is not running");
-}
-return process;
+if (set_socket_option (s, option, value))
-}
+return Qt;
+if (NILP (no_error))
+error ("Unknown or unsupported option");
+return Qnil;
+}
 /* A version of request_sigio suitable for a record_unwind_protect.  */
 Lisp_Object
 unwind_request_sigio (dummy)
 where F is the family number and AV is a vector containing the socket
 address data with one element per address data byte.  Do not rely on
 this format in portable code, as it may depend on implementation
 defined constants, data sizes, and data structure alignment.
-:coding CODING -- CODING is coding system for this process.
+:coding CODING -- If CODING is a symbol, it specifies the coding
+system used for both reading and writing for this process.  If CODING
-:options OPTIONS -- Set the specified options for the network process.
+is a cons (DECODING . ENCODING), DECODING is used for reading, and
-See `set-network-process-options' for details.
+ENCODING is used for writing.
 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
 return without waiting for the connection to complete; instead, the
 sentinel function will be called with second arg matching "open" (if
 successful) or "failed" when the connect completes.  Default is to use
 is the server process, CLIENT is the new process for the connection,
 and MESSAGE is a string.
 :plist PLIST -- Install PLIST as the new process' initial plist.
-:server BOOL -- if BOOL is non-nil, create a server process for the
+:server QLEN -- if QLEN is non-nil, create a server process for the
 specified FAMILY, SERVICE, and connection type (stream or datagram).
-Default is a client process.
+If QLEN is an integer, it is used as the max. length of the server's
+pending connection queue (also known as the backlog); the default
-A server process will listen for and accept connections from
+queue length is 5.  Default is to create a client process.
-clients.  When a client connection is accepted, a new network process
-is created for the connection with the following parameters:
+The following network options can be specified for this connection:
+:bindtodevice NAME -- bind to interface NAME.
+: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 local address
+(this is allowed by default for a server process).
+Consult the relevant system programmer's manual pages for more
+information on using these options.
+A 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
 Lisp_Object QCaddress;  /* one of QClocal or QCremote */
 Lisp_Object tem;
 Lisp_Object name, buffer, host, service, address;
 Lisp_Object filter, sentinel;
 int is_non_blocking_client = 0;
-int is_server = 0;
+int is_server = 0, backlog = 5;
 int socktype;
 int family = -1;
 if (nargs == 0)
 return Qnil;
 	 not available, since a blocked Emacs is not useful.  */
 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
 error ("Network servers not supported");
 #else
 is_server = 1;
+if (INTEGERP (tem))
+	backlog = XINT (tem);
 #endif
 }
 /* Make QCaddress an alias for :local (server) or :remote (client).  */
 QCaddress = is_server ? QClocal : QCremote;
 count1 = SPECPDL_INDEX ();
 s = -1;
 for (lres = res; lres; lres = lres->ai_next)
 {
+int optn, optbits;
 s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
 if (s < 0)
 	{
 	  xerrno = errno;
 	  continue;
 #endif
 /* Make us close S if quit.  */
 record_unwind_protect (close_file_unwind, make_number (s));
+/* Parse network options in the arg list.
+	 We simply ignore anything which isn't a known option (including other keywords).
+An error is signalled if setting a known option fails.  */
+for (optn = optbits = 0; optn < nargs-1; optn += 2)
+	optbits |= set_socket_option (s, args[optn], args[optn+1]);
 if (is_server)
 	{
 	  /* Configure as a server socket.  */
+	  /* SO_REUSEADDR = 1 is default for server sockets; must specify
+	     explicit :reuseaddr key to override this.  */
 #ifdef HAVE_LOCAL_SOCKETS
 	  if (family != AF_LOCAL)
 #endif
-	    {
+	    if (!(optbits & (1 << OPIX_REUSEADDR)))
-	      int optval = 1;
+	      {
-	      if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
+		int optval = 1;
-		report_file_error ("Cannot set reuse option on server socket.", Qnil);
+		if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
-	    }
+		  report_file_error ("Cannot set reuse option on server socket.", Qnil);
+	      }
 	  if (bind (s, lres->ai_addr, lres->ai_addrlen))
 	    report_file_error ("Cannot bind server socket", Qnil);
 #ifdef HAVE_GETSOCKNAME
 		  contact = Fplist_put (contact, QCservice, service);
 		}
 	    }
 #endif
-	  if (socktype == SOCK_STREAM && listen (s, 5))
+	  if (socktype == SOCK_STREAM && listen (s, backlog))
 	    report_file_error ("Cannot listen on server socket", Qnil);
 	  break;
 	}
 	report_file_error ("make server process failed", contact);
 else
 	report_file_error ("make client process failed", contact);
 }
-tem = Fplist_get (contact, QCoptions);
-if (!NILP (tem))
-set_socket_options (s, tem, 1);
 #endif /* not TERM */
 inch = s;
 outch = s;
 /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
 Lisp_Object coding_systems = Qt;
 Lisp_Object args[5], val;
 if (!NILP (tem))
-val = XCAR (XCDR (tem));
+{
+	val = XCAR (XCDR (tem));
+	if (CONSP (val))
+	  val = XCAR (val);
+}
 else 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
 	  val = Qnil;
 }
 p->decode_coding_system = val;
 if (!NILP (tem))
-val = XCAR (XCDR (tem));
+{
+	val = XCAR (XCDR (tem));
+	if (CONSP (val))
+	  val = XCDR (val);
+}
 else if (!NILP (Vcoding_system_for_write))
 val = Vcoding_system_for_write;
 else if (NILP (current_buffer->enable_multibyte_characters))
 val = Qnil;
 else
 { IFF_DYNAMIC,	"dynamic" },
 #endif
 { 0, 0 }
 };
-DEFUN ("get-network-interface-info", Fget_network_interface_info, Sget_network_interface_info, 1, 1, 0,
+DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
 doc: /* Return information about network interface named IFNAME.
 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
 FLAGS is the current flags of the interface.  */)
 #endif
 #ifdef HAVE_SOCKETS
 {
 Lisp_Object subfeatures = Qnil;
+struct socket_options *sopt;
 #define ADD_SUBFEATURE(key, val) \
 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
 #ifdef NON_BLOCKING_CONNECT
 ADD_SUBFEATURE (QCnowait, Qt);
 ADD_SUBFEATURE (QCservice, Qt);
 #endif
 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
 ADD_SUBFEATURE (QCserver, Qt);
 #endif
-#ifdef SO_BINDTODEVICE
-ADD_SUBFEATURE (QCoptions, intern ("bindtodevice"));
+for (sopt = socket_options; sopt->name; sopt++)
-#endif
+subfeatures = Fcons (intern (sopt->name), subfeatures);
-#ifdef SO_BROADCAST
-ADD_SUBFEATURE (QCoptions, intern ("broadcast"));
-#endif
-#ifdef SO_DONTROUTE
-ADD_SUBFEATURE (QCoptions, intern ("dontroute"));
-#endif
-#ifdef SO_KEEPALIVE
-ADD_SUBFEATURE (QCoptions, intern ("keepalive"));
-#endif
-#ifdef SO_LINGER
-ADD_SUBFEATURE (QCoptions, intern ("linger"));
-#endif
-#ifdef SO_OOBINLINE
-ADD_SUBFEATURE (QCoptions, intern ("oobinline"));
-#endif
-#ifdef SO_PRIORITY
-ADD_SUBFEATURE (QCoptions, intern ("priority"));
-#endif
-#ifdef SO_REUSEADDR
-ADD_SUBFEATURE (QCoptions, intern ("reuseaddr"));
-#endif
 Fprovide (intern ("make-network-process"), subfeatures);
 }
 #endif /* HAVE_SOCKETS */
 }
 defsubr (&Sset_process_plist);
 defsubr (&Slist_processes);
 defsubr (&Sprocess_list);
 defsubr (&Sstart_process);
 #ifdef HAVE_SOCKETS
-defsubr (&Sset_network_process_options);
+defsubr (&Sset_network_process_option);
 defsubr (&Smake_network_process);
 defsubr (&Sformat_network_address);
 #ifdef SIOCGIFCONF
 defsubr (&Snetwork_interface_list);
 #endif
 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
-defsubr (&Sget_network_interface_info);
+defsubr (&Snetwork_interface_info);
 #endif
 #endif /* HAVE_SOCKETS */
 #ifdef DATAGRAM_SOCKETS
 defsubr (&Sprocess_datagram_address);
 defsubr (&Sset_process_datagram_address);

Mercurial > emacs

comparison src/process.c @ 52516:0ca23eb697b9