]> code.delx.au - gnu-emacs/blobdiff - src/process.c
Don't block in set-process-window-size
[gnu-emacs] / src / process.c
index 10c79ab14a3f4a67fdc34cecf32881e84dd195f8..9c09aeefa6be62c724eaee540d4cb275e7259a74 100644 (file)
@@ -284,6 +284,7 @@ static Lisp_Object chan_process[FD_SETSIZE];
 #ifdef HAVE_GETADDRINFO_A
 /* Pending DNS requests. */
 static Lisp_Object dns_processes;
+static void wait_for_socket_fds (Lisp_Object process, char *name);
 #endif
 
 /* Alist of elements (NAME . PROCESS).  */
@@ -1029,6 +1030,7 @@ The string argument is normally a multibyte string, except:
   struct Lisp_Process *p;
 
   CHECK_PROCESS (process);
+
   p = XPROCESS (process);
 
   /* Don't signal an error if the process's input file descriptor
@@ -1117,7 +1119,8 @@ DEFUN ("set-process-window-size", Fset_process_window_size,
   CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
   CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
 
-  if (XPROCESS (process)->infd < 0
+  if (NETCONN_P (process)
+      || XPROCESS (process)->infd < 0
       || (set_window_size (XPROCESS (process)->infd,
                           XINT (height), XINT (width))
          < 0))
@@ -1194,6 +1197,10 @@ list of keywords.  */)
   contact = XPROCESS (process)->childp;
 
 #ifdef DATAGRAM_SOCKETS
+
+  if (NETCONN_P (process))
+    wait_for_socket_fds (process, "process-contact");
+
   if (DATAGRAM_CONN_P (process)
       && (EQ (key, Qt) || EQ (key, QCremote)))
     contact = Fplist_put (contact, QCremote,
@@ -2372,7 +2379,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int
        {
          struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
          uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
-         len = sizeof (sin6->sin6_addr) + 1;
+         len = sizeof (sin6->sin6_addr) / 2 + 1;
          hostport = XINT (p->contents[--len]);
          sin6->sin6_port = htons (hostport);
          for (i = 0; i < len; i++)
@@ -2423,6 +2430,9 @@ DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_
 
   CHECK_PROCESS (process);
 
+  if (NETCONN_P (process))
+    wait_for_socket_fds (process, "process-datagram-address");
+
   if (!DATAGRAM_CONN_P (process))
     return Qnil;
 
@@ -2442,6 +2452,9 @@ Returns nil upon error setting address, ADDRESS otherwise.  */)
 
   CHECK_PROCESS (process);
 
+  if (NETCONN_P (process))
+    wait_for_socket_fds (process, "set-process-datagram-address");
+
   if (!DATAGRAM_CONN_P (process))
     return Qnil;
 
@@ -2610,6 +2623,8 @@ OPTION is not a supported option, return nil instead; otherwise return t.  */)
   if (!NETCONN1_P (p))
     error ("Process is not a network process");
 
+  wait_for_socket_fds (process, "set-network-process-option");
+
   s = p->infd;
   if (s < 0)
     error ("Process is not running");
@@ -2987,8 +3002,6 @@ void set_network_socket_coding_system (Lisp_Object proc)
     }
   pset_encode_coding_system (p, val);
 
-  setup_process_coding_systems (proc);
-
   pset_decoding_buf (p, empty_unibyte_string);
   p->decoding_carryover = 0;
   pset_encoding_buf (p, empty_unibyte_string);
@@ -3066,13 +3079,14 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
       {
        Lisp_Object params = contact, key, val;
 
-       while (!NILP (params)) {
-         key = XCAR (params);
-         params = XCDR (params);
-         val = XCAR (params);
-         params = XCDR (params);
-         optbits |= set_socket_option (s, key, val);
-       }
+       while (!NILP (params))
+         {
+           key = XCAR (params);
+           params = XCDR (params);
+           val = XCAR (params);
+           params = XCDR (params);
+           optbits |= set_socket_option (s, key, val);
+         }
       }
 
       if (p->is_server)
@@ -3303,7 +3317,7 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
   if (inch > max_process_desc)
     max_process_desc = inch;
 
-  set_network_socket_coding_system (proc);
+  setup_process_coding_systems (proc);
 
 #ifdef HAVE_GNUTLS
   /* Continue the asynchronous connection. */
@@ -3311,16 +3325,50 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
     {
       Lisp_Object boot, params = p->gnutls_boot_parameters;
 
-      p->gnutls_boot_parameters = Qnil;
       boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
-      if (NILP (boot) || STRINGP (boot)) {
-       deactivate_process (proc);
-       if (NILP (boot))
-         pset_status (p, list2 (Qfailed,
-                                build_string ("TLS negotiation failed")));
-       else
-         pset_status (p, list2 (Qfailed, boot));
-      }
+      p->gnutls_boot_parameters = Qnil;
+
+      if (NILP (boot) || STRINGP (boot) ||
+         p->gnutls_initstage != GNUTLS_STAGE_READY)
+       {
+         deactivate_process (proc);
+         if (NILP (boot))
+           pset_status (p, list2 (Qfailed,
+                                  build_string ("TLS negotiation failed")));
+         else
+           pset_status (p, list2 (Qfailed, boot));
+       }
+      else
+       {
+         Lisp_Object result = Qt;
+
+         if (!NILP (Ffboundp (Qnsm_verify_connection)))
+           result = call3 (Qnsm_verify_connection,
+                           proc,
+                           Fplist_get (contact, QChost),
+                           Fplist_get (contact, QCservice));
+
+         if (NILP (result))
+           {
+             pset_status (p, list2 (Qfailed,
+                                    build_string ("The Network Security Manager stopped the connections")));
+             deactivate_process (proc);
+           }
+         else
+           {
+             /* If we cleared the connection wait mask before we did
+                the TLS setup, then we have to say that the process
+                is finally "open" here. */
+             if (! FD_ISSET (p->outfd, &connect_wait_mask))
+               {
+                 pset_status (p, Qrun);
+                 /* Execute the sentinel here.  If we had relied on
+                    status_notify to do it later, it will read input
+                    from the process before calling the sentinel.  */
+                 exec_sentinel (proc, build_string ("open\n"));
+               }
+           }
+       }
     }
 #endif
 
@@ -3420,11 +3468,12 @@ system used for both reading and writing for this process.  If CODING
 is a cons (DECODING . ENCODING), DECODING is used for reading, and
 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
-a blocking connect (i.e. wait) for stream type connections.
+:nowait BOOL -- If NOWAIT 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 a blocking connect (i.e. wait) for stream type
+connections.
 
 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
 running when Emacs is exited.
@@ -3453,8 +3502,10 @@ and MESSAGE is a string.
 :plist PLIST -- Install PLIST as the new process's initial plist.
 
 :tls-parameters LIST -- is a list that should be supplied if you're
-opening a TLS connection.  The first element is the TLS type, and the
-remaining elements should be a keyword list accepted by gnutls-boot.
+opening a TLS connection.  The first element is the TLS type (either
+`gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
+be a keyword list accepted by gnutls-boot (as returned by
+`gnutls-boot-parameters').
 
 :server QLEN -- if QLEN is non-nil, create a server process for the
 specified FAMILY, SERVICE, and connection type (stream or datagram).
@@ -3842,6 +3893,8 @@ usage: (make-network-process &rest ARGS)  */)
   p->gnutls_boot_parameters = tem;
 #endif
 
+  set_network_socket_coding_system (proc);
+
   unbind_to (count, Qnil);
 
   /* :server BOOL */
@@ -4597,7 +4650,11 @@ check_for_dns (Lisp_Object proc)
 
   /* Sanity check. */
   if (! p->dns_requests)
-    return 1;
+    return Qnil;
+
+  /* This process should not already be connected (or killed). */
+  if (!EQ (p->status, Qconnect))
+    return Qnil;
 
   ret = gai_error (p->dns_requests[0]);
   if (ret == EAI_INPROGRESS)
@@ -4638,8 +4695,43 @@ check_for_dns (Lisp_Object proc)
 
   return ip_addresses;
 }
+
 #endif /* HAVE_GETADDRINFO_A */
 
+static void
+wait_for_socket_fds (Lisp_Object process, char *name)
+{
+  while (XPROCESS (process)->infd < 0 &&
+        EQ (XPROCESS (process)->status, Qconnect))
+    {
+      printf("Waiting for socket from %s...\n", name);
+      wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+    }
+}
+
+static void
+wait_while_connecting (Lisp_Object process)
+{
+  while (EQ (XPROCESS (process)->status, Qconnect))
+    {
+      printf("Waiting for connection...\n");
+      wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+    }
+}
+
+static void
+wait_for_tls_negotiation (Lisp_Object process)
+{
+#ifdef HAVE_GNUTLS
+  while (EQ (XPROCESS (process)->status, Qconnect) &&
+        !NILP (XPROCESS (process)->gnutls_boot_parameters))
+    {
+      printf("Waiting for TLS...\n");
+      wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+    }
+#endif
+}
+
 /* 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
@@ -5432,11 +5524,15 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
                }
              else
                {
-                 pset_status (p, Qrun);
-                 /* Execute the sentinel here.  If we had relied on
-                    status_notify to do it later, it will read input
-                    from the process before calling the sentinel.  */
-                 exec_sentinel (proc, build_string ("open\n"));
+                 if (NILP (p->gnutls_boot_parameters))
+                   {
+                     pset_status (p, Qrun);
+                     /* Execute the sentinel here.  If we had relied on
+                        status_notify to do it later, it will read input
+                        from the process before calling the sentinel.  */
+                     exec_sentinel (proc, build_string ("open\n"));
+                   }
+
                  if (0 <= p->infd && !EQ (p->filter, Qt)
                      && !EQ (p->command, Qt))
                    {
@@ -5893,6 +5989,11 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
   ssize_t rv;
   struct coding_system *coding;
 
+  if (NETCONN_P (proc)) {
+    wait_while_connecting (proc);
+    wait_for_tls_negotiation (proc);
+  }
+
   if (p->raw_status_new)
     update_status (p);
   if (! EQ (p->status, Qrun))
@@ -5900,13 +6001,6 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
   if (p->outfd < 0)
     error ("Output file descriptor of %s is closed", SDATA (p->name));
 
-#ifdef HAVE_GNUTLS
-  /* The TLS connection hasn't been set up yet, so we can't write
-     anything on the socket. */
-  if (p->gnutls_boot_parameters)
-    return;
-#endif
-
   coding = proc_encode_coding_system[p->outfd];
   Vlast_coding_system_used = CODING_ID_NAME (coding->id);
 
@@ -6131,6 +6225,9 @@ Output from processes can arrive in between bunches.  */)
   if (XINT (start) < GPT && XINT (end) > GPT)
     move_gap_both (XINT (start), start_byte);
 
+  if (NETCONN_P (proc))
+    wait_while_connecting (proc);
+
   send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
                end_byte - start_byte, Fcurrent_buffer ());
 
@@ -6150,6 +6247,7 @@ Output from processes can arrive in between bunches.  */)
   Lisp_Object proc;
   CHECK_STRING (string);
   proc = get_process (process);
+
   send_process (proc, SSDATA (string),
                SBYTES (string), string);
   return Qnil;
@@ -6564,10 +6662,15 @@ process has been transmitted to the serial port.  */)
   struct coding_system *coding = NULL;
   int outfd;
 
-  if (DATAGRAM_CONN_P (process))
+  proc = get_process (process);
+
+  if (NETCONN_P (proc))
+    wait_while_connecting (proc);
+
+  if (DATAGRAM_CONN_P (proc))
     return process;
 
-  proc = get_process (process);
+
   outfd = XPROCESS (proc)->outfd;
   if (outfd >= 0)
     coding = proc_encode_coding_system[outfd];
@@ -7018,7 +7121,12 @@ encode subprocess input.  */)
   register struct Lisp_Process *p;
 
   CHECK_PROCESS (process);
+
+  if (NETCONN_P (process))
+    wait_for_socket_fds (process, "set-process-coding-system");
+
   p = XPROCESS (process);
+
   if (p->infd < 0)
     error ("Input file descriptor of %s closed", SDATA (p->name));
   if (p->outfd < 0)
@@ -7055,6 +7163,10 @@ suppressed.  */)
   register struct Lisp_Process *p;
 
   CHECK_PROCESS (process);
+
+  if (NETCONN_P (process))
+    wait_for_socket_fds (process, "set-process-filter-multibyte");
+
   p = XPROCESS (process);
   if (NILP (flag))
     pset_decode_coding_system
@@ -7747,6 +7859,7 @@ syms_of_process (void)
   DEFSYM (QCnowait, ":nowait");
   DEFSYM (QCsentinel, ":sentinel");
   DEFSYM (QCtls_parameters, ":tls-parameters");
+  DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
   DEFSYM (QClog, ":log");
   DEFSYM (QCnoquery, ":noquery");
   DEFSYM (QCstop, ":stop");