check for EINTR in openFd

2 files changed, 27 insertions, 3 deletions

diff --git a/System/Posix/Error.hs b/System/Posix/Error.hs
index 1f05b03..cd4b91e 100644
--- a/System/Posix/Error.hs
+++ b/System/Posix/Error.hs
@@ -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
 
diff --git a/System/Posix/IO.hsc b/System/Posix/IO.hsc
index df2ed45..839ec4f 100644
--- a/System/Posix/IO.hsc
+++ b/System/Posix/IO.hsc
@@ -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