check for EINTR in openFd
authorSimon Marlow <marlowsd@gmail.com>
Wed, 27 Jan 2010 11:46:00 +0000 (11:46 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Wed, 27 Jan 2010 11:46:00 +0000 (11:46 +0000)
System/Posix/Error.hs
System/Posix/IO.hsc

index 1f05b03..cd4b91e 100644 (file)
@@ -16,10 +16,34 @@ module System.Posix.Error (
        throwErrnoPath,
        throwErrnoPathIf, 
        throwErrnoPathIf_,
+        throwErrnoPathIfRetry,
        throwErrnoPathIfNull,
+       throwErrnoPathIfNullRetry,
        throwErrnoPathIfMinus1,
-       throwErrnoPathIfMinus1_
+       throwErrnoPathIfMinus1_,
+        throwErrnoPathIfMinus1Retry
   ) where
 
-import Foreign.C.Error
+import Foreign
+import Foreign.C
+
+throwErrnoPathIfMinus1Retry :: Num a => String -> FilePath -> IO a -> IO a
+throwErrnoPathIfMinus1Retry loc path f =
+  throwErrnoPathIfRetry (== -1) loc path f
+
+throwErrnoPathIfNullRetry :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoPathIfNullRetry loc path f =
+  throwErrnoPathIfRetry (== nullPtr) loc path f
+
+throwErrnoPathIfRetry :: (a -> Bool) -> String -> FilePath -> IO a -> IO a
+throwErrnoPathIfRetry pr loc path f =
+  do
+    res <- f
+    if pr res
+      then do
+        err <- getErrno
+        if err == eINTR
+          then throwErrnoPathIfRetry pr loc path f
+          else throwErrnoPath loc path
+      else return res
 
index df2ed45..839ec4f 100644 (file)
@@ -179,7 +179,7 @@ openFd :: FilePath
 openFd name how maybe_mode (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
                                nonBlockFlag truncateFlag) = do
    withCString name $ \s -> do
-    fd <- throwErrnoPathIfMinus1 "openFd" name (c_open s all_flags mode_w)
+    fd <- throwErrnoPathIfMinus1Retry "openFd" name (c_open s all_flags mode_w)
     return (Fd fd)
   where
     all_flags  = creat .|. flags .|. open_mode