diff src/process-nt.c @ 563:183866b06e0b

[xemacs-hg @ 2001-05-24 07:50:48 by ben] Makefile.in.in, abbrev.c, alloc.c, buffer.c, bytecode.c, callint.c, callproc.c, casetab.c, chartab.c, cmdloop.c, cmds.c, console-msw.c, console-msw.h, console-stream.c, console-tty.c, console-x.c, console.c, data.c, database.c, debug.c, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, dired.c, doc.c, doprnt.c, dragdrop.c, editfns.c, eldap.c, eldap.h, elhash.c, emacs-widget-accessors.c, emacs.c, emodules.c, esd.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, extents.c, faces.c, file-coding.c, fileio.c, filelock.c, floatfns.c, fns.c, font-lock.c, frame-gtk.c, frame-x.c, frame.c, general-slots.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gpmevent.c, gui-gtk.c, gui-x.c, gui.c, gutter.c, hpplay.c, indent.c, input-method-xlib.c, insdel.c, intl.c, keymap.c, libsst.c, libsst.h, linuxplay.c, lisp.h, lread.c, lstream.c, lstream.h, macros.c, marker.c, md5.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, miscplay.c, miscplay.h, mule-ccl.c, mule-charset.c, mule-wnnfns.c, mule.c, nas.c, ntplay.c, ntproc.c, objects-gtk.c, objects-msw.c, objects-x.c, objects.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, ralloc.c, rangetab.c, redisplay.c, scrollbar.c, search.c, select-gtk.c, select-x.c, select.c, sgiplay.c, sheap.c, sound.c, specifier.c, sunplay.c, symbols.c, symeval.h, symsinit.h, syntax.c, sysdep.c, toolbar-msw.c, toolbar.c, tooltalk.c, ui-byhand.c, ui-gtk.c, undo.c, unexaix.c, unexapollo.c, unexconvex.c, unexec.c, widget.c, win32.c, window.c: -- defsymbol -> DEFSYMBOL. -- add an error type to all errors. -- eliminate the error functions in eval.c that let you just use Qerror as the type. -- redo the error API to be more consistent, sensibly named, and easier to use. -- redo the error hierarchy somewhat. create new errors: structure-formation-error, gui-error, invalid-constant, stack-overflow, out-of-memory, process-error, network-error, sound-error, printing-unreadable-object, base64-conversion- error; coding-system-error renamed to text-conversion error; some others. -- fix Mule problems in error strings in emodules.c, tooltalk.c. -- fix error handling in mswin open-network-stream. -- Mule-ize all sound files and clean up the headers. -- nativesound.h -> sound.h and used for all sound files. -- move some shared stuff into glyphs-shared.c: first attempt at eliminating some of the massive GTK code duplication. xemacs.mak: add glyphs-shared.c. xemacs-faq.texi: document how to debug X errors subr.el: fix doc string to reflect reality
author ben
date Thu, 24 May 2001 07:51:33 +0000
parents ed498ef2108b
children 373ced43e288
line wrap: on
line diff
--- a/src/process-nt.c	Thu May 24 06:30:21 2001 +0000
+++ b/src/process-nt.c	Thu May 24 07:51:33 2001 +0000
@@ -2,7 +2,7 @@
    Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
    Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
-   Copyright (C) 1995, 1996, 2000 Ben Wing.
+   Copyright (C) 1995, 1996, 2000, 2001 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -618,7 +618,7 @@
   if (signo != SIGKILL && signo != SIGTERM
       && signo != SIGQUIT && signo != SIGINT
       && signo != SIGHUP)
-    invalid_argument ("Signal number not supported", make_int (signo));
+    invalid_constant ("Signal number not supported", make_int (signo));
 }
   
 /*-----------------------------------------------------------------------*/
@@ -655,21 +655,20 @@
   WSAStartup (MAKEWORD (1,1), &wsa_data);
 }
 
-/*
- * Fork off a subprocess. P is a pointer to newly created subprocess
- * object. If this function signals, the caller is responsible for
- * deleting (and finalizing) the process object.
- *
- * The method must return PID of the new process, a (positive??? ####) number
- * which fits into Lisp_Int. No return value indicates an error, the method
- * must signal an error instead.
- */
+DOESNT_RETURN
+mswindows_report_process_error (const char *string, Lisp_Object data,
+				int errnum)
+{
+  report_file_type_error (Qprocess_error, mswindows_lisp_error (errnum),
+			  string, data);
+}
 
-static void
-signal_cannot_launch (Lisp_Object image_file, DWORD err)
+static DOESNT_RETURN
+mswindows_report_winsock_error (const char *string, Lisp_Object data,
+				int errnum)
 {
-  mswindows_set_errno (err);
-  report_file_error ("Error starting", image_file);
+  report_file_type_error (Qnetwork_error, mswindows_lisp_error (errnum),
+			  string, data);
 }
 
 static void
@@ -701,6 +700,16 @@
     return 1;
 }
 
+/*
+ * Fork off a subprocess. P is a pointer to newly created subprocess
+ * object. If this function signals, the caller is responsible for
+ * deleting (and finalizing) the process object.
+ *
+ * The method must return PID of the new process, a (positive??? ####) number
+ * which fits into Lisp_Int. No return value indicates an error, the method
+ * must signal an error instead.
+ */
+
 static int
 nt_create_process (Lisp_Process *p,
 		   Lisp_Object *argv, int nargv,
@@ -739,8 +748,11 @@
 	  image_type = xSHGetFileInfoA (progname, 0, NULL, 0, SHGFI_EXETYPE);
 	}
       if (image_type == 0)
-	signal_cannot_launch (program, (GetLastError () == ERROR_FILE_NOT_FOUND
-					? ERROR_BAD_FORMAT : GetLastError ()));
+	mswindows_report_process_error
+	  ("Error starting",
+	   program,
+	   GetLastError () == ERROR_FILE_NOT_FOUND
+	   ? ERROR_BAD_FORMAT : GetLastError ());
       windowed = HIWORD (image_type) != 0;
     }
   else /* NT 3.5; we have no idea so just guess. */
@@ -963,7 +975,9 @@
 	    CloseHandle (hmyshove);
 	    CloseHandle (hmyslurp);
 	  }
-	signal_cannot_launch (program, GetLastError ());
+	mswindows_report_process_error
+	  ("Error starting",
+	   program, GetLastError ());
       }
 
     /* The process started successfully */
@@ -1140,14 +1154,15 @@
 #define SOCK_TIMER_ID 666
 #define XM_SOCKREPLY (WM_USER + 666)
 
+/* Return 0 for success, or error code */
+
 static int
-get_internet_address (Lisp_Object host, struct sockaddr_in *address,
-		      Error_behavior errb)
+get_internet_address (Lisp_Object host, struct sockaddr_in *address)
 {
   char buf [MAXGETHOSTSTRUCT];
   HWND hwnd;
   HANDLE hasync;
-  int success = 0;
+  int errcode = 0;
 
   address->sin_family = AF_INET;
 
@@ -1157,7 +1172,7 @@
     if (inaddr != INADDR_NONE)
       {
 	address->sin_addr.s_addr = inaddr;
-	return 1;
+	return 0;
       }
   }
 
@@ -1170,7 +1185,10 @@
   hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, XSTRING_DATA (host),
 				  buf, sizeof (buf));
   if (hasync == NULL)
-    goto done;
+    {
+      errcode = WSAGetLastError ();
+      goto done;
+    }
 
   /* Set a timer to poll for quit every 250 ms */
   SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
@@ -1182,14 +1200,7 @@
       if (msg.message == XM_SOCKREPLY)
 	{
 	  /* Ok, got an answer */
-	  if (WSAGETASYNCERROR(msg.lParam) == NO_ERROR)
-	    success = 1;
-	  else
-	    {
-	      warn_when_safe(Qstream, Qwarning,
-			     "cannot get IP address for host \"%s\"",
-			     XSTRING_DATA (host));
-	    }
+	  errcode = WSAGETASYNCERROR (msg.lParam);
 	  goto done;
 	}
       else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
@@ -1208,13 +1219,13 @@
  done:
   KillTimer (hwnd, SOCK_TIMER_ID);
   DestroyWindow (hwnd);
-  if (success)
+  if (!errcode)
     {
       /* BUF starts with struct hostent */
       struct hostent* he = (struct hostent*) buf;
       address->sin_addr.s_addr = *(unsigned long*)he->h_addr_list[0];
     }
-  return success;
+  return errcode;
 }
 
 static Lisp_Object
@@ -1222,7 +1233,7 @@
 {
   struct sockaddr_in address;
 
-  if (!get_internet_address (host, &address, ERROR_ME_NOT))
+  if (get_internet_address (host, &address)) /* error */
     return host;
 
   if (address.sin_family == AF_INET)
@@ -1247,11 +1258,12 @@
   SOCKET s;
   int port;
   int retval;
+  int errnum;
 
   CHECK_STRING (host);
 
   if (!EQ (protocol, Qtcp))
-    invalid_argument ("Unsupported protocol", protocol);
+    invalid_constant ("Unsupported protocol", protocol);
 
   if (INTP (service))
     port = htons ((unsigned short) XINT (service));
@@ -1265,12 +1277,16 @@
       port = svc_info->s_port;
     }
 
-  get_internet_address (host, &address, ERROR_ME);
+  retval = get_internet_address (host, &address);
+  if (retval)
+    mswindows_report_winsock_error ("Getting IP address", host,
+				    retval);
   address.sin_port = port;
 
   s = socket (address.sin_family, SOCK_STREAM, 0);
   if (s < 0)
-    report_file_error ("error creating socket", list1 (name));
+    mswindows_report_winsock_error ("Creating socket", name,
+				    WSAGetLastError ());
 
   /* We don't want to be blocked on connect */
   {
@@ -1280,11 +1296,69 @@
   
   retval = connect (s, (struct sockaddr *) &address, sizeof (address));
   if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
-    goto connect_failed;
+    {
+      errnum = WSAGetLastError ();
+      goto connect_failed;
+    }
+
+#if 0 /* PUTA! I thought getsockopt() was failing, so I created the
+	 following based on the code in get_internet_address(), but
+	 it was my own fault down below.  Both versions should work. */
   /* Wait while connection is established */
+  {
+    HWND hwnd;
+
+  /* Create a window which will receive completion messages */
+    hwnd = CreateWindow ("STATIC", NULL, WS_OVERLAPPED, 0, 0, 1, 1,
+			 NULL, NULL, NULL, NULL);
+    assert (hwnd);
+
+    /* Post request */
+    if (WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, FD_CONNECT))
+      {
+	errnum = WSAGetLastError ();
+	goto done;
+      }
+
+    /* Set a timer to poll for quit every 250 ms */
+    SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
+
+    while (1)
+      {
+	MSG msg;
+	GetMessage (&msg, hwnd, 0, 0);
+	if (msg.message == XM_SOCKREPLY)
+	  {
+	    /* Ok, got an answer */
+	    errnum = WSAGETASYNCERROR (msg.lParam);
+	    goto done;
+	  }
+
+	else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
+	  {
+	    if (QUITP)
+	      {
+		WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0);
+		KillTimer (hwnd, SOCK_TIMER_ID);
+		DestroyWindow (hwnd);
+		REALLY_QUIT;
+	      }
+	  }
+	DispatchMessage (&msg);
+      }
+
+  done:
+    WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0);
+    KillTimer (hwnd, SOCK_TIMER_ID);
+    DestroyWindow (hwnd);
+    if (errnum)
+      goto connect_failed;
+  }
+
+#else
   while (1)
     {
-      fd_set fdset;
+      fd_set fdwriteset, fdexceptset;
       struct timeval tv;
       int nsel;
 
@@ -1298,21 +1372,44 @@
       tv.tv_sec = 0;
       tv.tv_usec = 250 * 1000;
 
-      FD_ZERO (&fdset);
-      FD_SET (s, &fdset);
-      nsel = select (0, NULL, &fdset, &fdset, &tv);
+      FD_ZERO (&fdwriteset);
+      FD_SET (s, &fdwriteset);
+      FD_ZERO (&fdexceptset);
+      FD_SET (s, &fdexceptset);
+      nsel = select (0, NULL, &fdwriteset, &fdexceptset, &tv);
+
+      if (nsel == SOCKET_ERROR)
+	{
+	  errnum = WSAGetLastError ();
+	  goto connect_failed;
+	}
 
       if (nsel > 0)
 	{
 	  /* Check: was connection successful or not? */
-	  tv.tv_usec = 0;
-	  nsel = select (0, NULL, NULL, &fdset, &tv);
-	  if (nsel > 0)
-	    goto connect_failed;
+	  if (FD_ISSET (s, &fdwriteset))
+	    break;
+	  else if (FD_ISSET (s, &fdexceptset))
+	    {
+	      int store_me_harder = sizeof (errnum);
+	      /* OK, we finally can get the REAL error code.  Any paths
+		 in this code that lead to a call of WSAGetLastError()
+		 indicate probable logic failure. */
+	      if (getsockopt (s, SOL_SOCKET, SO_ERROR, (char *) &errnum,
+			      &store_me_harder))
+		errnum = WSAGetLastError ();
+	      goto connect_failed;
+	    }
 	  else
-	    break;
+	    {
+	      signal_error (Qinternal_error,
+			    "Porra, esse caralho de um sistema de operacao",
+			    Qunbound);
+	      break;
+	    }
 	}
     }
+#endif
 
   /* We are connected at this point */
   *vinfd = (void*)s;
@@ -1321,23 +1418,13 @@
 		   0, FALSE, DUPLICATE_SAME_ACCESS);
   return;
 
- connect_failed:  
-  closesocket (s);
-  if (INTP (service))
-    {
-      warn_when_safe (Qstream, Qwarning,
-		      "failure to open network stream to host \"%s\" for service \"%d\"",
-		      XSTRING_DATA (host),
-		      (unsigned short) XINT (service));
-    }
-  else
-    {
-      warn_when_safe (Qstream, Qwarning,
-		      "failure to open network stream to host \"%s\" for service \"%s\"",
-		      XSTRING_DATA (host),
-		      XSTRING_DATA (service));
-    }
-  report_file_error ("connection failed", list2 (host, name));
+ connect_failed:
+  {
+    closesocket (s);
+    mswindows_report_winsock_error ("Connection failed",
+				    list3 (Qunbound, host, service),
+				    errnum);
+  }
 }
 
 #endif