summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--libraries/base/GHC/Handle.hs26
-rw-r--r--libraries/base/System/Posix/Internals.hs14
-rw-r--r--libraries/base/base.cabal1
-rw-r--r--libraries/base/cbits/lockFile.c112
-rw-r--r--libraries/base/include/HsBase.h3
-rw-r--r--libraries/base/include/lockFile.h14
6 files changed, 30 insertions, 140 deletions
diff --git a/libraries/base/GHC/Handle.hs b/libraries/base/GHC/Handle.hs
index 37d78e6427..fa57fce88d 100644
--- a/libraries/base/GHC/Handle.hs
+++ b/libraries/base/GHC/Handle.hs
@@ -62,6 +62,7 @@ import Foreign
import Foreign.C
import System.IO.Error
import System.Posix.Internals
+import System.Posix.Types
import GHC.Real
@@ -875,9 +876,9 @@ openFile' filepath mode binary =
fd <- throwErrnoIfMinus1Retry "openFile"
(c_open f (fromIntegral oflags) 0o666)
- fd_type <- fdType fd
+ stat@(fd_type,_,_) <- fdStat fd
- h <- fdToHandle' fd (Just fd_type) False filepath mode binary
+ h <- fdToHandle' fd (Just stat) False filepath mode binary
`catchException` \e -> do c_close fd; throw e
-- NB. don't forget to close the FD if fdToHandle' fails, otherwise
-- this FD leaks.
@@ -907,8 +908,15 @@ append_flags = write_flags .|. o_APPEND
-- ---------------------------------------------------------------------------
-- fdToHandle'
-fdToHandle' :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> IO Handle
-fdToHandle' fd mb_fd_type is_socket filepath mode binary = do
+fdToHandle' :: FD
+ -> Maybe (FDType, CDev, CIno)
+ -> Bool
+ -> FilePath
+ -> IOMode
+ -> Bool
+ -> IO Handle
+
+fdToHandle' fd mb_stat is_socket filepath mode binary = do
-- turn on non-blocking mode
setNonBlockingFD fd
@@ -929,10 +937,10 @@ fdToHandle' fd mb_fd_type is_socket filepath mode binary = do
-- open() won't tell us if it was a directory if we only opened for
-- reading, so check again.
- fd_type <-
- case mb_fd_type of
+ (fd_type,dev,ino) <-
+ case mb_stat of
Just x -> return x
- Nothing -> fdType fd
+ Nothing -> fdStat fd
case fd_type of
Directory ->
@@ -942,7 +950,7 @@ fdToHandle' fd mb_fd_type is_socket filepath mode binary = do
-- regular files need to be locked
RegularFile -> do
#ifndef mingw32_HOST_OS
- r <- lockFile fd (fromBool write) 1{-exclusive-}
+ r <- lockFile fd dev ino (fromBool write)
when (r == -1) $
ioException (IOError Nothing ResourceBusy "openFile"
"file is locked" Nothing)
@@ -969,7 +977,7 @@ fdToHandle fd = do
#ifndef mingw32_HOST_OS
foreign import ccall unsafe "lockFile"
- lockFile :: CInt -> CInt -> CInt -> IO CInt
+ lockFile :: CInt -> CDev -> CIno -> CInt -> IO CInt
foreign import ccall unsafe "unlockFile"
unlockFile :: CInt -> IO CInt
diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs
index 11ee6ee18d..6173140ce8 100644
--- a/libraries/base/System/Posix/Internals.hs
+++ b/libraries/base/System/Posix/Internals.hs
@@ -98,12 +98,18 @@ fileType file =
-- NOTE: On Win32 platforms, this will only work with file descriptors
-- referring to file handles. i.e., it'll fail for socket FDs.
-fdType :: FD -> IO FDType
-fdType fd =
+fdStat :: FD -> IO (FDType, CDev, CIno)
+fdStat fd =
allocaBytes sizeof_stat $ \ p_stat -> do
throwErrnoIfMinus1Retry "fdType" $
c_fstat fd p_stat
- statGetType p_stat
+ ty <- statGetType p_stat
+ dev <- st_dev p_stat
+ ino <- st_ino p_stat
+ return (ty,dev,ino)
+
+fdType :: FD -> IO FDType
+fdType fd = do (ty,_,_) <- fdStat fd; return ty
statGetType p_stat = do
c_mode <- st_mode p_stat :: IO CMode
@@ -476,6 +482,8 @@ foreign import ccall unsafe "HsBase.h __hscore_sizeof_stat" sizeof_stat :: Int
foreign import ccall unsafe "HsBase.h __hscore_st_mtime" st_mtime :: Ptr CStat -> IO CTime
foreign import ccall unsafe "HsBase.h __hscore_st_size" st_size :: Ptr CStat -> IO COff
foreign import ccall unsafe "HsBase.h __hscore_st_mode" st_mode :: Ptr CStat -> IO CMode
+foreign import ccall unsafe "HsBase.h __hscore_st_dev" st_dev :: Ptr CStat -> IO CDev
+foreign import ccall unsafe "HsBase.h __hscore_st_ino" st_ino :: Ptr CStat -> IO CIno
foreign import ccall unsafe "HsBase.h __hscore_echo" const_echo :: CInt
foreign import ccall unsafe "HsBase.h __hscore_tcsanow" const_tcsanow :: CInt
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index cf14de2cd9..74ca3ba8ab 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -159,7 +159,6 @@ Library {
cbits/consUtils.c
cbits/dirUtils.c
cbits/inputReady.c
- cbits/lockFile.c
cbits/longlong.c
cbits/selectUtils.c
include-dirs: include
diff --git a/libraries/base/cbits/lockFile.c b/libraries/base/cbits/lockFile.c
deleted file mode 100644
index 721246b126..0000000000
--- a/libraries/base/cbits/lockFile.c
+++ /dev/null
@@ -1,112 +0,0 @@
-/*
- * (c) The GRASP/AQUA Project, Glasgow University, 1994-2004
- *
- * $Id: lockFile.c,v 1.5 2005/01/28 13:36:32 simonmar Exp $
- *
- * stdin/stout/stderr Runtime Support
- */
-
-#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))
-
-#include "HsBase.h"
-#include "Rts.h"
-#include "RtsUtils.h"
-
-typedef struct {
- dev_t device;
- ino_t inode;
- int fd;
-} Lock;
-
-static Lock readLock[FD_SETSIZE];
-static Lock writeLock[FD_SETSIZE];
-
-static int readLocks = 0;
-static int writeLocks = 0;
-
-int
-lockFile(int fd, int for_writing, int exclusive)
-{
- struct stat sb;
- int i;
-
- if (fd > FD_SETSIZE) {
- barf("lockFile: fd out of range");
- }
-
- while (fstat(fd, &sb) < 0) {
- if (errno != EINTR)
- return -1;
- }
-
- if (for_writing) {
- /* opening a file for writing, check to see whether
- we don't have any read locks on it already.. */
- for (i = 0; i < readLocks; i++) {
- if (readLock[i].inode == sb.st_ino && readLock[i].device == sb.st_dev)
- return -1;
- }
- /* If we're determined that there is only a single
- writer to the file, check to see whether the file
- hasn't already been opened for writing..
- */
- if (exclusive) {
- for (i = 0; i < writeLocks; i++) {
- if (writeLock[i].inode == sb.st_ino && writeLock[i].device == sb.st_dev) {
- return -1;
- }
- }
- }
- /* OK, everything is cool lock-wise, record it and leave. */
- i = writeLocks++;
- writeLock[i].device = sb.st_dev;
- writeLock[i].inode = sb.st_ino;
- writeLock[i].fd = fd;
- return 0;
- } else {
- /* For reading, it's simpler - just check to see
- that there's no-one writing to the underlying file. */
- for (i = 0; i < writeLocks; i++) {
- if (writeLock[i].inode == sb.st_ino && writeLock[i].device == sb.st_dev)
- return -1;
- }
- /* Fit in new entry, reusing an existing table entry, if possible. */
- for (i = 0; i < readLocks; i++) {
- if (readLock[i].inode == sb.st_ino && readLock[i].device == sb.st_dev) {
- return 0;
- }
- }
- i = readLocks++;
- readLock[i].device = sb.st_dev;
- readLock[i].inode = sb.st_ino;
- readLock[i].fd = fd;
- return 0;
- }
-
-}
-
-int
-unlockFile(int fd)
-{
- int i;
-
- for (i = 0; i < readLocks; i++)
- if (readLock[i].fd == fd) {
- while (++i < readLocks)
- readLock[i - 1] = readLock[i];
- readLocks--;
- return 0;
- }
-
- for (i = 0; i < writeLocks; i++)
- if (writeLock[i].fd == fd) {
- while (++i < writeLocks)
- writeLock[i - 1] = writeLock[i];
- writeLocks--;
- return 0;
- }
- /* Signal that we did not find an entry */
- return 1;
-}
-
-#endif
diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h
index dfe68402af..e067c259eb 100644
--- a/libraries/base/include/HsBase.h
+++ b/libraries/base/include/HsBase.h
@@ -125,7 +125,6 @@
#if HAVE_VFORK_H
#include <vfork.h>
#endif
-#include "lockFile.h"
#include "dirUtils.h"
#include "WCsubst.h"
@@ -502,6 +501,8 @@ INLINE time_t __hscore_st_mtime ( struct stat* st ) { return st->st_mtime; }
INLINE off_t __hscore_st_size ( struct stat* st ) { return st->st_size; }
#if !defined(_MSC_VER)
INLINE mode_t __hscore_st_mode ( struct stat* st ) { return st->st_mode; }
+INLINE mode_t __hscore_st_dev ( struct stat* st ) { return st->st_dev; }
+INLINE mode_t __hscore_st_ino ( struct stat* st ) { return st->st_ino; }
#endif
#if HAVE_TERMIOS_H
diff --git a/libraries/base/include/lockFile.h b/libraries/base/include/lockFile.h
deleted file mode 100644
index b6deaf41be..0000000000
--- a/libraries/base/include/lockFile.h
+++ /dev/null
@@ -1,14 +0,0 @@
-/*
- * (c) The University of Glasgow 2001
- *
- * $Id: lockFile.h,v 1.3 2005/01/28 13:36:34 simonmar Exp $
- *
- * lockFile header
- */
-
-#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))
-
-int lockFile(int fd, int for_writing, int exclusive);
-int unlockFile(int fd);
-
-#endif
View Lorry Controller Status