From 900ca61d2d1c61cb5a100dbcd67c265c89bbc8b5 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Wed, 17 Nov 2004 19:07:40 +0000
Subject: [PATCH] [project @ 2004-11-17 19:07:38 by sof] Expose Win32 console
 event handling to the user.

Added RTS support for registering and delivering console events quite
a while ago (rts/win32/ConsoleHandler.c), but got bored with it before
completing the job. Here's the concluding commit; it does the following:

- new module, base/GHC/ConsoleHandler.hs which supports registering of
  console event handlers (the null module on plats other than mingw).
- special handling of aborted async read()s on 'standard input' in
  rts/win32/IOManager.c (together with GHC.Conc.asyncRead). See comments
  in that IOManager.c as to why this is needed.
  [ Any other code that performs blocking I/O on 'standard input' will
    need to be tweaked too to be console event handler/signal friendly.]
- for now, disable the delivery of 'close' events (see
  rts/win32/ConsoleHandler.c:generic_handler() for reasons why)

Feel free to hoik GHC/ConsoleHandler.hs around the lib hierarchy to wherever
is considered more fitting. Unifying functionality between System.Posix.Signals
and GHC.ConsoleHandler is one (obvious) thing to do.

-- Demonstrating GHC.ConsoleHandler use; win32 only
module Main(main) where

import GHC.ConsoleHandler
import System.IO  (hFlush, stdout)
import GHC.Conc   (threadDelay)

main :: IO ()
main = do
  installHandler (Catch (\ _ -> putStrLn "Caught console event; ignoring" >> hFlush stdout))
  loop
 where
  loop = do
    threadDelay 100000
    ls <- getLine
    putStrLn ls
    loop
--
---
 ghc/rts/win32/ConsoleHandler.c |   25 +++++++++++++++++++------
 ghc/rts/win32/IOManager.c      |   33 ++++++++++++++++++++++++++++++++-
 2 files changed, 51 insertions(+), 7 deletions(-)

diff --git a/ghc/rts/win32/ConsoleHandler.c b/ghc/rts/win32/ConsoleHandler.c
index 4220f29..a1d3bd9 100644
--- a/ghc/rts/win32/ConsoleHandler.c
+++ b/ghc/rts/win32/ConsoleHandler.c
@@ -50,9 +50,11 @@ static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
 {
     switch (dwCtrlType) {
     
+    case CTRL_CLOSE_EVENT:
+	/* see generic_handler() comment re: this event */
+	return FALSE;
     case CTRL_C_EVENT:
     case CTRL_BREAK_EVENT:
-    case CTRL_CLOSE_EVENT:
 
 	// If we're already trying to interrupt the RTS, terminate with
 	// extreme prejudice.  So the first ^C tries to exit the program
@@ -185,12 +187,23 @@ void handleSignalsInThisThread(void)
 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
 {
     /* Ultra-simple -- up the counter + signal a switch. */
-    if ( stg_pending_events < N_PENDING_EVENTS ) {
-	stg_pending_buf[stg_pending_events] = dwCtrlType;
-	stg_pending_events++;
+    switch(dwCtrlType) {
+    case CTRL_CLOSE_EVENT:
+	/* Don't support the delivery of this event; if we
+	 * indicate that we've handled it here and the Haskell handler
+	 * doesn't take proper action (e.g., terminate the OS process),
+	 * the user of the app will be unable to kill/close it. Not
+	 * good, so disable the delivery for now.
+	 */
+	return FALSE;
+    default:
+	if ( stg_pending_events < N_PENDING_EVENTS ) {
+	    stg_pending_buf[stg_pending_events] = dwCtrlType;
+	    stg_pending_events++;
+	}
+	context_switch = 1;
+	return TRUE;
     }
-    context_switch = 1;
-    return TRUE;
 }
 
 
diff --git a/ghc/rts/win32/IOManager.c b/ghc/rts/win32/IOManager.c
index c08c4e3..96e5794 100644
--- a/ghc/rts/win32/IOManager.c
+++ b/ghc/rts/win32/IOManager.c
@@ -42,7 +42,7 @@ IOWorkerProc(PVOID param)
     WorkQueue* pq = iom->workQueue;
     WorkItem*  work;
     int        len = 0, fd = 0;
-    DWORD      errCode;
+    DWORD      errCode = 0;
     void*      complData;
 
     hWaits[0] = (HANDLE)iom->hExitEvent;
@@ -96,9 +96,40 @@ IOWorkerProc(PVOID param)
 			    errCode = WSAGetLastError();
 			}
 		    } else {
+			DWORD dw;
+
+			/* Do the read(), with extra-special handling for Ctrl+C */
 			len = read(work->workData.ioData.fd,
 				   work->workData.ioData.buf,
 				   work->workData.ioData.len);
+			if ( len == 0 && work->workData.ioData.len != 0 ) {
+			    /* Given the following scenario:
+			     *     - a console handler has been registered that handles Ctrl+C
+			     *       events.
+			     *     - we've not tweaked the 'console mode' settings to turn on
+			     *       ENABLE_PROCESSED_INPUT.
+			     *     - we're blocked waiting on input from standard input.
+			     *     - the user hits Ctrl+C.
+			     *
+			     * The OS will invoke the console handler (in a separate OS thread),
+			     * and the above read() (i.e., under the hood, a ReadFile() op) returns
+			     * 0, with the error set to ERROR_OPERATION_ABORTED. We don't
+			     * want to percolate this non-EOF condition too far back up, but ignore
+			     * it. However, we do want to give the RTS an opportunity to deliver the
+			     * console event.
+			     * 
+			     * Hence, we set 'errorCode' to (-2), which we then look out for in
+			     * GHC.Conc.asyncRead.
+			     */
+			    dw = GetLastError();
+			    if ( dw == ERROR_OPERATION_ABORTED ) {
+				/* Only do the retry when dealing with the standard input handle. */
+				HANDLE h  = (HANDLE)GetStdHandle(STD_INPUT_HANDLE);
+				if ( _get_osfhandle(work->workData.ioData.fd) == (long)h ) {
+				    errCode = (DWORD)-2;
+				}
+			    }
+			}
 			if (len == -1) { errCode = errno; }
 		    }
 		    complData = work->workData.ioData.buf;
-- 
1.7.10.4