Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP           , NoImplicitPrelude           , BangPatterns  #-}{-# OPTIONS_GHC -Wno-identities #-}-- Whether there are identities depends on the platform{-# OPTIONS_HADDOCK hide #-}------------------------------------------------------------------------------- |-- Module      :  GHC.IO.FD-- Copyright   :  (c) The University of Glasgow, 1994-2008-- License     :  see libraries/base/LICENSE---- Maintainer  :  libraries@haskell.org-- Stability   :  internal-- Portability :  non-portable---- Raw read/write operations on file descriptors-------------------------------------------------------------------------------moduleGHC.IO.FD(FD(..),openFile,mkFD,release,setNonBlockingMode,readRawBufferPtr,readRawBufferPtrNoBlock,writeRawBufferPtr,stdin,stdout,stderr)whereimportGHC.BaseimportGHC.NumimportGHC.RealimportGHC.ShowimportGHC.EnumimportGHC.IOimportGHC.IO.IOModeimportGHC.IO.BufferimportGHC.IO.BufferedIOimportqualifiedGHC.IO.DeviceimportGHC.IO.Device(SeekMode(..),IODeviceType(..))importGHC.Conc.IOimportGHC.IO.Exception#if defined(mingw32_HOST_OS)importGHC.WindowsimportData.Bool#endifimportForeignimportForeign.CimportqualifiedSystem.Posix.InternalsimportSystem.Posix.Internalshiding(FD,setEcho,getEcho)importSystem.Posix.Types#if defined(mingw32_HOST_OS)# if defined(i386_HOST_ARCH)#  define WINDOWS_CCONV stdcall# elif defined(x86_64_HOST_ARCH)#  define WINDOWS_CCONV ccall# else#  error Unknown mingw32 arch# endif#endifc_DEBUG_DUMP::Boolc_DEBUG_DUMP=False-- ------------------------------------------------------------------------------- The file-descriptor IO devicedataFD=FD{fdFD::{-# UNPACK#-}!CInt,#if defined(mingw32_HOST_OS)-- On Windows, a socket file descriptor needs to be read and written-- using different functions (send/recv).fdIsSocket_::{-# UNPACK#-}!Int#else-- On Unix we need to know whether this FD has O_NONBLOCK set.-- If it has, then we can use more efficient routines to read/write to it.-- It is always safe for this to be off.fdIsNonBlocking::{-# UNPACK#-}!Int#endif }#if defined(mingw32_HOST_OS)fdIsSocket::FD->BoolfdIsSocketfd=fdIsSocket_fd/=0#endif-- | @since 4.1.0.0instanceShowFDwhereshowfd=show(fdFDfd)-- | @since 4.1.0.0instanceGHC.IO.Device.RawIOFDwhereread=fdReadreadNonBlocking=fdReadNonBlockingwrite=fdWritewriteNonBlocking=fdWriteNonBlocking-- | @since 4.1.0.0instanceGHC.IO.Device.IODeviceFDwhereready=readyclose=closeisTerminal=isTerminalisSeekable=isSeekableseek=seektell=tellgetSize=getSizesetSize=setSizesetEcho=setEchogetEcho=getEchosetRaw=setRawdevType=devTypedup=dupdup2=dup2-- We used to use System.Posix.Internals.dEFAULT_BUFFER_SIZE, which is-- taken from the value of BUFSIZ on the current platform.  This value-- varies too much though: it is 512 on Windows, 1024 on OS X and 8192-- on Linux.  So let's just use a decent size on every platform:dEFAULT_FD_BUFFER_SIZE::IntdEFAULT_FD_BUFFER_SIZE=8192-- | @since 4.1.0.0instanceBufferedIOFDwherenewBuffer_devstate=newByteBufferdEFAULT_FD_BUFFER_SIZEstatefillReadBufferfdbuf=readBuf'fdbuffillReadBuffer0fdbuf=readBufNonBlockingfdbufflushWriteBufferfdbuf=writeBuf'fdbufflushWriteBuffer0fdbuf=writeBufNonBlockingfdbufreadBuf'::FD->BufferWord8->IO(Int,BufferWord8)readBuf'fdbuf=dowhenc_DEBUG_DUMP$puts("readBuf fd="++showfd++" "++summaryBufferbuf++"\n")(r,buf')<-readBuffdbufwhenc_DEBUG_DUMP$puts("after: "++summaryBufferbuf'++"\n")return(r,buf')writeBuf'::FD->BufferWord8->IO(BufferWord8)writeBuf'fdbuf=dowhenc_DEBUG_DUMP$puts("writeBuf fd="++showfd++" "++summaryBufferbuf++"\n")writeBuffdbuf-- ------------------------------------------------------------------------------- opening files-- | Open a file and make an 'FD' for it.  Truncates the file to zero-- size when the `IOMode` is `WriteMode`.openFile::FilePath-- ^ file to open->IOMode-- ^ mode in which to open the file->Bool-- ^ open the file in non-blocking mode?->IO(FD,IODeviceType)openFilefilepathiomodenon_blocking=withFilePathfilepath$\f->letoflags1=caseiomodeofReadMode->read_flagsWriteMode->write_flagsReadWriteMode->rw_flagsAppendMode->append_flags#if defined(mingw32_HOST_OS)binary_flags=o_BINARY#elsebinary_flags=0#endifoflags2=oflags1.|.binary_flagsoflags|non_blocking=oflags2.|.nonblock_flags|otherwise=oflags2indo-- NB. always use a safe open(), because we don't know whether open()-- will be fast or not.  It can be slow on NFS and FUSE filesystems,-- for example.fd<-throwErrnoIfMinus1Retry"openFile"$c_safe_openfoflags0o666(fD,fd_type)<-mkFDfdiomodeNothing{-no stat-}False{-not a socket-}non_blocking`catchAny`\e->do_<-c_closefdthrowIOe-- we want to truncate() if this is an open in WriteMode, but only-- if the target is a RegularFile.  ftruncate() fails on special files-- like /dev/null.when(iomode==WriteMode&&fd_type==RegularFile)$setSizefD0return(fD,fd_type)std_flags,output_flags,read_flags,write_flags,rw_flags,append_flags,nonblock_flags::CIntstd_flags=o_NOCTTYoutput_flags=std_flags.|.o_CREATread_flags=std_flags.|.o_RDONLYwrite_flags=output_flags.|.o_WRONLYrw_flags=output_flags.|.o_RDWRappend_flags=write_flags.|.o_APPENDnonblock_flags=o_NONBLOCK-- | Make a 'FD' from an existing file descriptor.  Fails if the FD-- refers to a directory.  If the FD refers to a file, `mkFD` locks-- the file according to the Haskell 2010 single writer/multiple reader-- locking semantics (this is why we need the `IOMode` argument too).mkFD::CInt->IOMode->Maybe(IODeviceType,CDev,CIno)-- the results of fdStat if we already know them, or we want-- to prevent fdToHandle_stat from doing its own stat.-- These are used for:--   - we fail if the FD refers to a directory--   - if the FD refers to a file, we lock it using (cdev,cino)->Bool-- ^ is a socket (on Windows)->Bool-- ^ is in non-blocking mode on Unix->IO(FD,IODeviceType)mkFDfdiomodemb_statis_socketis_nonblock=dolet_=(is_socket,is_nonblock)-- warning suppression(fd_type,dev,ino)<-casemb_statofNothing->fdStatfdJuststat->returnstatletwrite=caseiomodeofReadMode->False_->Truecasefd_typeofDirectory->ioException(IOErrorNothingInappropriateType"openFile""is a directory"NothingNothing)-- regular files need to be lockedRegularFile->do-- On Windows we need an additional call to get a unique device id-- and inode, since fstat just returns 0 for both.(unique_dev,unique_ino)<-getUniqueFileInfofddevinor<-lockFilefdunique_devunique_ino(fromBoolwrite)when(r==-1)$ioException(IOErrorNothingResourceBusy"openFile""file is locked"NothingNothing)_other_type->return()#if defined(mingw32_HOST_OS)when(notis_socket)$setmodefdTrue>>return()#endifreturn(FD{fdFD=fd,#if !defined(mingw32_HOST_OS)fdIsNonBlocking=fromEnumis_nonblock#elsefdIsSocket_=fromEnumis_socket#endif              },            fd_type)getUniqueFileInfo :: CInt -> CDev -> CIno -> IO (Word64, Word64)#if !defined(mingw32_HOST_OS)getUniqueFileInfo_devino=return(fromIntegraldev,fromIntegralino)#elsegetUniqueFileInfofd__=dowith0$\devptr->dowith0$\inoptr->doc_getUniqueFileInfofddevptrinoptrliftM2(,)(peekdevptr)(peekinoptr)#endif#if defined(mingw32_HOST_OS)foreignimportccallunsafe"__hscore_setmode"setmode::CInt->Bool->IOCInt#endif-- ------------------------------------------------------------------------------- Standard file descriptorsstdFD::CInt->FDstdFDfd=FD{fdFD=fd,#if defined(mingw32_HOST_OS)fdIsSocket_=0#elsefdIsNonBlocking=0-- We don't set non-blocking mode on standard handles, because it may-- confuse other applications attached to the same TTY/pipe-- see Note [nonblock]#endif                }stdin, stdout, stderr :: FDstdin  = stdFD 0stdout = stdFD 1stderr = stdFD 2-- ------------------------------------------------------------------------------- Operations on file descriptorsclose :: FD -> IO ()close fd =  do let closer realFd =           throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $#if defined(mingw32_HOST_OS)iffdIsSocketfdthenc_closesocket(fromIntegralrealFd)else#endifc_close(fromIntegralrealFd)-- release the lock *first*, because otherwise if we're preempted-- after closing but before releasing, the FD may have been reused.-- (#7646)releasefdcloseFdWithcloser(fromIntegral(fdFDfd))release::FD->IO()releasefd=do_<-unlockFile(fdFDfd)return()#if defined(mingw32_HOST_OS)foreignimportWINDOWS_CCONVunsafe"HsBase.h closesocket"c_closesocket::CInt->IOCInt#endifisSeekable::FD->IOBoolisSeekablefd=dot<-devTypefdreturn(t==RegularFile||t==RawDevice)seek::FD->SeekMode->Integer->IO()seekfdmodeoff=dothrowErrnoIfMinus1Retry_"seek"$c_lseek(fdFDfd)(fromIntegraloff)seektypewhereseektype::CIntseektype=casemodeofAbsoluteSeek->sEEK_SETRelativeSeek->sEEK_CURSeekFromEnd->sEEK_ENDtell::FD->IOIntegertellfd=fromIntegral`fmap`(throwErrnoIfMinus1Retry"hGetPosn"$c_lseek(fdFDfd)0sEEK_CUR)getSize::FD->IOIntegergetSizefd=fdFileSize(fdFDfd)setSize::FD->Integer->IO()setSizefdsize=dothrowErrnoIf_(/=0)"GHC.IO.FD.setSize"$c_ftruncate(fdFDfd)(fromIntegralsize)devType::FD->IOIODeviceTypedevTypefd=do(ty,_,_)<-fdStat(fdFDfd);returntydup::FD->IOFDdupfd=donewfd<-throwErrnoIfMinus1"GHC.IO.FD.dup"$c_dup(fdFDfd)returnfd{fdFD=newfd}dup2::FD->FD->IOFDdup2fdfdto=do-- Windows' dup2 does not return the new descriptor, unlike UnixthrowErrnoIfMinus1_"GHC.IO.FD.dup2"$c_dup2(fdFDfd)(fdFDfdto)returnfd{fdFD=fdFDfdto}-- original FD, with the new fdFDsetNonBlockingMode::FD->Bool->IOFDsetNonBlockingModefdset=dosetNonBlockingFD(fdFDfd)set#if defined(mingw32_HOST_OS)returnfd#elsereturnfd{fdIsNonBlocking=fromEnumset}#endifready::FD->Bool->Int->IOBoolreadyfdwritemsecs=dor<-throwErrnoIfMinus1Retry"GHC.IO.FD.ready"$fdReady(fdFDfd)(fromIntegral$fromEnum$write)(fromIntegralmsecs)#if defined(mingw32_HOST_OS)(fromIntegral$fromEnum$fdIsSocketfd)#else0#endifreturn(toEnum(fromIntegralr))foreignimportccallsafe"fdReady"fdReady::CInt->CBool->Int64->CBool->IOCInt-- ----------------------------------------------------------------------------- Terminal-related stuffisTerminal::FD->IOBoolisTerminalfd=#if defined(mingw32_HOST_OS)iffdIsSocketfdthenreturnFalseelseis_console(fdFDfd)>>=return.toBool#elsec_isatty(fdFDfd)>>=return.toBool#endifsetEcho::FD->Bool->IO()setEchofdon=System.Posix.Internals.setEcho(fdFDfd)ongetEcho::FD->IOBoolgetEchofd=System.Posix.Internals.getEcho(fdFDfd)setRaw::FD->Bool->IO()setRawfdraw=System.Posix.Internals.setCooked(fdFDfd)(notraw)-- ------------------------------------------------------------------------------- Reading and WritingfdRead::FD->PtrWord8->Int->IOIntfdReadfdptrbytes=do{r<-readRawBufferPtr"GHC.IO.FD.fdRead"fdptr0(fromIntegralbytes);return(fromIntegralr)}fdReadNonBlocking::FD->PtrWord8->Int->IO(MaybeInt)fdReadNonBlockingfdptrbytes=dor<-readRawBufferPtrNoBlock"GHC.IO.FD.fdReadNonBlocking"fdptr0(fromIntegralbytes)casefromIntegralrof(-1)->return(Nothing)n->return(Justn)fdWrite::FD->PtrWord8->Int->IO()fdWritefdptrbytes=dores<-writeRawBufferPtr"GHC.IO.FD.fdWrite"fdptr0(fromIntegralbytes)letres'=fromIntegralresifres'<bytesthenfdWritefd(ptr`plusPtr`res')(bytes-res')elsereturn()-- XXX ToDo: this isn't non-blockingfdWriteNonBlocking::FD->PtrWord8->Int->IOIntfdWriteNonBlockingfdptrbytes=dores<-writeRawBufferPtrNoBlock"GHC.IO.FD.fdWriteNonBlocking"fdptr0(fromIntegralbytes)return(fromIntegralres)-- ------------------------------------------------------------------------------- FD operations-- Low level routines for reading/writing to (raw)buffers:#if !defined(mingw32_HOST_OS){-NOTE [nonblock]:Unix has broken semantics when it comes to non-blocking I/O: you canset the O_NONBLOCK flag on an FD, but it applies to the all other FDsattached to the same underlying file, pipe or TTY; there's no way tohave private non-blocking behaviour for an FD.  See bug #724.We fix this by only setting O_NONBLOCK on FDs that we create; FDs thatcome from external sources or are exposed externally are left inblocking mode.  This solution has some problems though.  We can'tcompletely simulate a non-blocking read without O_NONBLOCK: severalcases are wrong here.  The cases that are wrong:  * reading/writing to a blocking FD in non-threaded mode.    In threaded mode, we just make a safe call to read().    In non-threaded mode we call select() before attempting to read,    but that leaves a small race window where the data can be read    from the file descriptor before we issue our blocking read().  * readRawBufferNoBlock for a blocking FDNOTE [2363]:In the threaded RTS we could just make safe calls to read()/write()for file descriptors in blocking mode without worrying about blockingother threads, but the problem with this is that the thread will beuninterruptible while it is blocked in the foreign call.  See #2363.So now we always call fdReady() before reading, and if fdReadyindicates that there's no data, we call threadWaitRead.-}readRawBufferPtr::String->FD->PtrWord8->Int->CSize->IOIntreadRawBufferPtrloc!fd!buf!off!len|isNonBlockingfd=unsafe_read-- unsafe is ok, it can't block|otherwise=dor<-throwErrnoIfMinus1loc(unsafe_fdReady(fdFDfd)000)ifr/=0thenreadelsedothreadWaitRead(fromIntegral(fdFDfd));readwheredo_readcall=fromIntegral`fmap`throwErrnoIfMinus1RetryMayBlockloccall(threadWaitRead(fromIntegral(fdFDfd)))read=ifthreadedthensafe_readelseunsafe_readunsafe_read=do_read(c_read(fdFDfd)(buf`plusPtr`off)len)safe_read=do_read(c_safe_read(fdFDfd)(buf`plusPtr`off)len)-- return: -1 indicates EOF, >=0 is bytes readreadRawBufferPtrNoBlock::String->FD->PtrWord8->Int->CSize->IOIntreadRawBufferPtrNoBlockloc!fd!buf!off!len|isNonBlockingfd=unsafe_read-- unsafe is ok, it can't block|otherwise=dor<-unsafe_fdReady(fdFDfd)000ifr/=0thensafe_readelsereturn0-- XXX see note [nonblock]wheredo_readcall=dor<-throwErrnoIfMinus1RetryOnBlockloccall(return(-1))caserof(-1)->return00->return(-1)n->return(fromIntegraln)unsafe_read=do_read(c_read(fdFDfd)(buf`plusPtr`off)len)safe_read=do_read(c_safe_read(fdFDfd)(buf`plusPtr`off)len)writeRawBufferPtr::String->FD->PtrWord8->Int->CSize->IOCIntwriteRawBufferPtrloc!fd!buf!off!len|isNonBlockingfd=unsafe_write-- unsafe is ok, it can't block|otherwise=dor<-unsafe_fdReady(fdFDfd)100ifr/=0thenwriteelsedothreadWaitWrite(fromIntegral(fdFDfd));writewheredo_writecall=fromIntegral`fmap`throwErrnoIfMinus1RetryMayBlockloccall(threadWaitWrite(fromIntegral(fdFDfd)))write=ifthreadedthensafe_writeelseunsafe_writeunsafe_write=do_write(c_write(fdFDfd)(buf`plusPtr`off)len)safe_write=do_write(c_safe_write(fdFDfd)(buf`plusPtr`off)len)writeRawBufferPtrNoBlock::String->FD->PtrWord8->Int->CSize->IOCIntwriteRawBufferPtrNoBlockloc!fd!buf!off!len|isNonBlockingfd=unsafe_write-- unsafe is ok, it can't block|otherwise=dor<-unsafe_fdReady(fdFDfd)100ifr/=0thenwriteelsereturn0wheredo_writecall=dor<-throwErrnoIfMinus1RetryOnBlockloccall(return(-1))caserof(-1)->return0n->return(fromIntegraln)write=ifthreadedthensafe_writeelseunsafe_writeunsafe_write=do_write(c_write(fdFDfd)(buf`plusPtr`off)len)safe_write=do_write(c_safe_write(fdFDfd)(buf`plusPtr`off)len)isNonBlocking::FD->BoolisNonBlockingfd=fdIsNonBlockingfd/=0foreignimportccallunsafe"fdReady"unsafe_fdReady::CInt->CBool->Int64->CBool->IOCInt#else /* mingw32_HOST_OS.... */readRawBufferPtr::String->FD->PtrWord8->Int->CSize->IOCIntreadRawBufferPtrloc!fd!buf!off!len|threaded=blockingReadRawBufferPtrlocfdbufofflen|otherwise=asyncReadRawBufferPtrlocfdbufofflenwriteRawBufferPtr::String->FD->PtrWord8->Int->CSize->IOCIntwriteRawBufferPtrloc!fd!buf!off!len|threaded=blockingWriteRawBufferPtrlocfdbufofflen|otherwise=asyncWriteRawBufferPtrlocfdbufofflenreadRawBufferPtrNoBlock::String->FD->PtrWord8->Int->CSize->IOCIntreadRawBufferPtrNoBlock=readRawBufferPtrwriteRawBufferPtrNoBlock::String->FD->PtrWord8->Int->CSize->IOCIntwriteRawBufferPtrNoBlock=writeRawBufferPtr-- Async versions of the read/write primitives, for the non-threaded RTSasyncReadRawBufferPtr::String->FD->PtrWord8->Int->CSize->IOCIntasyncReadRawBufferPtrloc!fd!buf!off!len=do(l,rc)<-asyncRead(fromIntegral(fdFDfd))(fdIsSocket_fd)(fromIntegrallen)(buf`plusPtr`off)ifl==(-1)thenletsock_errno=c_maperrno_func(fromIntegralrc)non_sock_errno=Errno(fromIntegralrc)errno=boolnon_sock_errnosock_errno(fdIsSocketfd)inioError(errnoToIOErrorlocerrnoNothingNothing)elsereturn(fromIntegrall)asyncWriteRawBufferPtr::String->FD->PtrWord8->Int->CSize->IOCIntasyncWriteRawBufferPtrloc!fd!buf!off!len=do(l,rc)<-asyncWrite(fromIntegral(fdFDfd))(fdIsSocket_fd)(fromIntegrallen)(buf`plusPtr`off)ifl==(-1)thenletsock_errno=c_maperrno_func(fromIntegralrc)non_sock_errno=Errno(fromIntegralrc)errno=boolnon_sock_errnosock_errno(fdIsSocketfd)inioError(errnoToIOErrorlocerrnoNothingNothing)elsereturn(fromIntegrall)-- Blocking versions of the read/write primitives, for the threaded RTSblockingReadRawBufferPtr::String->FD->PtrWord8->Int->CSize->IOCIntblockingReadRawBufferPtrloc!fd!buf!off!len=throwErrnoIfMinus1Retryloc$doletstart_ptr=buf`plusPtr`offrecv_ret=c_safe_recv(fdFDfd)start_ptr(fromIntegrallen)0read_ret=c_safe_read(fdFDfd)start_ptr(fromIntegrallen)r<-boolread_retrecv_ret(fdIsSocketfd)when((fdIsSocketfd)&&(r==-1))c_maperrnoreturnr-- We trust read() to give us the correct errno but recv(), as a-- Winsock function, doesn't do the errno conversion so if the fd-- is for a socket, we do it from GetLastError() ourselves.blockingWriteRawBufferPtr::String->FD->PtrWord8->Int->CSize->IOCIntblockingWriteRawBufferPtrloc!fd!buf!off!len=throwErrnoIfMinus1Retryloc$doletstart_ptr=buf`plusPtr`offsend_ret=c_safe_send(fdFDfd)start_ptr(fromIntegrallen)0write_ret=c_safe_write(fdFDfd)start_ptr(fromIntegrallen)r<-boolwrite_retsend_ret(fdIsSocketfd)when(r==-1)c_maperrnoreturnr-- We don't trust write() to give us the correct errno, and-- instead do the errno conversion from GetLastError()-- ourselves. The main reason is that we treat ERROR_NO_DATA-- (pipe is closing) as EPIPE, whereas write() returns EINVAL-- for this case. We need to detect EPIPE correctly, because it-- shouldn't be reported as an error when it happens on stdout.-- As for send()'s case, Winsock functions don't do errno-- conversion in any case so we have to do it ourselves.-- That means we're doing the errno conversion no matter if the-- fd is from a socket or not.-- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.-- These calls may block, but that's ok.foreignimportWINDOWS_CCONVsafe"recv"c_safe_recv::CInt->PtrWord8->CInt->CInt{-flags-}->IOCIntforeignimportWINDOWS_CCONVsafe"send"c_safe_send::CInt->PtrWord8->CInt->CInt{-flags-}->IOCInt#endifforeignimportccallunsafe"rtsSupportsBoundThreads"threaded::Bool-- ------------------------------------------------------------------------------- utils#if !defined(mingw32_HOST_OS)throwErrnoIfMinus1RetryOnBlock::String->IOCSsize->IOCSsize->IOCSsizethrowErrnoIfMinus1RetryOnBlocklocfon_block=dores<-fif(res::CSsize)==-1thendoerr<-getErrnoiferr==eINTRthenthrowErrnoIfMinus1RetryOnBlocklocfon_blockelseiferr==eWOULDBLOCK||err==eAGAINthendoon_blockelsethrowErrnolocelsereturnres#endif-- ------------------------------------------------------------------------------- Locking/unlockingforeignimportccallunsafe"lockFile"lockFile::CInt->Word64->Word64->CInt->IOCIntforeignimportccallunsafe"unlockFile"unlockFile::CInt->IOCInt#if defined(mingw32_HOST_OS)foreignimportccallunsafe"get_unique_file_info"c_getUniqueFileInfo::CInt->PtrWord64->PtrWord64->IO()#endif