Haskell递归函数异常处理：如何在Web服务器中捕获用户中断并正确关闭套接字

Great question! The problem with your current code is that when you trigger a Ctrl+C (which throws a UserInterrupt exception), the forever loop in manageConnections gets interrupted immediately—without any chance to close the active conn socket or the listening socket. Let's fix this with proper exception handling to ensure graceful cleanup.

Step-by-Step Solution #

1. Replace forever with an Explicit Loop + Per-Connection Exception Handling #

Instead of relying on forever, we'll write a manual loop that wraps each connection's processing in an exception handler. This way, if a UserInterrupt hits while we're handling a connection, we first close that connection before propagating the exception.

2. Add Top-Level Exception Handling in main #

We'll catch the UserInterrupt at the main level to close the listening socket and print a clean shutdown message.

Modified Code #

Here's the updated version of your server with proper cleanup:

module Main where
import Control.Exception
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Char
import Network.Socket
import Network.Socket.ByteString (recv, sendAll)
import System.Mem (performGC)

msg :: String
msg = "HTTP/1.1 200 OK\n" ++ "Content-Type: text/html\n\n" ++ "<html><body><a href=#>download</a></body></html>\n"

manageConnections sock = loop
  where
    loop = do
      -- Accept a new connection
      (conn, addr) <- accept sock
      putStrLn $ "Connection from " ++ show addr

      -- Handle exceptions for this connection (including UserInterrupt)
      handle (handleInterrupt conn addr) $ do
        r <- recv conn 1024
        B.putStr r
        sendAll conn $ BC.pack msg  -- Use standard pack function instead of custom helper
        close conn  -- Clean up the connection when done normally

      -- Repeat the loop to accept new connections
      loop

    -- Handler for UserInterrupt and other connection errors
    handleInterrupt :: Socket -> SockAddr -> SomeException -> IO ()
    handleInterrupt conn addr e =
      case fromException e of
        Just UserInterrupt -> do
          putStrLn $ "\nInterrupt received: closing connection from " ++ show addr
          close conn
          throwIO e  -- Re-throw to trigger server-wide cleanup
        _ -> do
          putStrLn $ "Error handling connection from " ++ show addr ++ ": " ++ show e
          close conn

main :: IO ()
main = do
    putStrLn "Starting server on port 1337..."
    sock <- socket AF_INET Stream 0
    setSocketOption sock ReuseAddr 1
    bind sock (SockAddrInet 1337 $ tupleToHostAddress (127, 0, 0, 1))
    listen sock 4

    -- Catch UserInterrupt to clean up the listening socket
    catch (manageConnections sock) $ \(UserInterrupt) -> do
      putStrLn "\nShutting down server gracefully..."
      close sock
      putStrLn "Server closed successfully."

Key Improvements Explained #

• Removed custom packStr: We use Data.ByteString.Char8.pack directly—it's a standard, well-tested function that does the same job as your custom helper, simplifying the code.
• Targeted exception handling: The handleInterrupt function specifically checks for UserInterrupt, closes the active connection, then re-throws the exception so the main function can handle server-wide cleanup. It also catches other connection errors to ensure we never leave sockets open accidentally.
• Top-level socket cleanup: The catch in main ensures we close the listening socket when the user triggers an interrupt, preventing leftover socket resources from lingering.
• Clear feedback: We added descriptive print statements so you can track exactly what's happening during both connection handling and shutdown.

How It Works #

When you press Ctrl+C:

1. If the server is in the middle of handling a connection, handleInterrupt triggers, closes that specific connection, and re-throws the UserInterrupt.
2. The catch in main catches the re-thrown exception, closes the listening socket, and prints a shutdown confirmation.
3. The program exits cleanly, with no open sockets left behind.

内容的提问来源于stack exchange，提问作者Tony