Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}{-# OPTIONS_HADDOCK hide #-}------------------------------------------------------------------------------- |-- Module      :  System.Posix.Internals-- Copyright   :  (c) The University of Glasgow, 1992-2002-- License     :  see libraries/base/LICENSE---- Maintainer  :  cvs-ghc@haskell.org-- Stability   :  internal-- Portability :  non-portable (requires POSIX)---- POSIX support layer for the standard libraries.-- This library is built on *every* platform, including Win32.---- Non-posix compliant in order to support the following features:--      * S_ISSOCK (no sockets in POSIX)-------------------------------------------------------------------------------moduleSystem.Posix.Internalswhere#include "HsBaseConfig.h"importSystem.Posix.TypesimportForeignimportForeign.C-- import Data.BitsimportData.Maybe#if !defined(HTYPE_TCFLAG_T)importSystem.IO.Error#endifimportGHC.BaseimportGHC.NumimportGHC.RealimportGHC.IOimportGHC.IO.IOModeimportGHC.IO.ExceptionimportGHC.IO.Device#if !defined(mingw32_HOST_OS)import{-# SOURCE#-}GHC.IO.Encoding(getFileSystemEncoding)importqualifiedGHC.ForeignasGHC#endif-- ----------------------------------------------------------------------------- Debugging the base packageputs::String->IO()putss=withCAStringLen(s++"\n")$\(p,len)->do-- In reality should be withCString, but assume ASCII to avoid loop-- if this is called by GHC.Foreign_<-c_write1(castPtrp)(fromIntegrallen)return()-- ----------------------------------------------------------------------------- Typesdata{-# CTYPE"struct flock"#-}CFLockdata{-# CTYPE"struct group"#-}CGroupdata{-# CTYPE"struct lconv"#-}CLconvdata{-# CTYPE"struct passwd"#-}CPasswddata{-# CTYPE"struct sigaction"#-}CSigactiondata{-# CTYPE"sigset_t"#-}CSigsetdata{-# CTYPE"struct stat"#-}CStatdata{-# CTYPE"struct termios"#-}CTermiosdata{-# CTYPE"struct tm"#-}CTmdata{-# CTYPE"struct tms"#-}CTmsdata{-# CTYPE"struct utimbuf"#-}CUtimbufdata{-# CTYPE"struct utsname"#-}CUtsnametypeFD=CInt-- ----------------------------------------------------------------------------- stat()-related stufffdFileSize::FD->IOIntegerfdFileSizefd=allocaBytessizeof_stat$\p_stat->dothrowErrnoIfMinus1Retry_"fileSize"$c_fstatfdp_statc_mode<-st_modep_stat::IOCModeifnot(s_isregc_mode)thenreturn(-1)elsedoc_size<-st_sizep_statreturn(fromIntegralc_size)fileType::FilePath->IOIODeviceTypefileTypefile=allocaBytessizeof_stat$\p_stat->dowithFilePathfile$\p_file->dothrowErrnoIfMinus1Retry_"fileType"$c_statp_filep_statstatGetTypep_stat-- NOTE: On Win32 platforms, this will only work with file descriptors-- referring to file handles. i.e., it'll fail for socket FDs.fdStat::FD->IO(IODeviceType,CDev,CIno)fdStatfd=allocaBytessizeof_stat$\p_stat->dothrowErrnoIfMinus1Retry_"fdType"$c_fstatfdp_statty<-statGetTypep_statdev<-st_devp_statino<-st_inop_statreturn(ty,dev,ino)fdType::FD->IOIODeviceTypefdTypefd=do(ty,_,_)<-fdStatfd;returntystatGetType::PtrCStat->IOIODeviceTypestatGetTypep_stat=doc_mode<-st_modep_stat::IOCModecase()of_|s_isdirc_mode->returnDirectory|s_isfifoc_mode||s_issockc_mode||s_ischrc_mode->returnStream|s_isregc_mode->returnRegularFile-- Q: map char devices to RawDevice too?|s_isblkc_mode->returnRawDevice|otherwise->ioErrorioe_unknownfiletypeioe_unknownfiletype::IOExceptionioe_unknownfiletype=IOErrorNothingUnsupportedOperation"fdType""unknown file type"NothingNothingfdGetMode::FD->IOIOMode#if defined(mingw32_HOST_OS)fdGetMode_=do-- We don't have a way of finding out which flags are set on FDs-- on Windows, so make a handle that thinks that anything goes.letflags=o_RDWR#elsefdGetModefd=doflags<-throwErrnoIfMinus1Retry"fdGetMode"(c_fcntl_readfdconst_f_getfl)#endifletwH=(flags.&.o_WRONLY)/=0aH=(flags.&.o_APPEND)/=0rwH=(flags.&.o_RDWR)/=0mode|wH&&aH=AppendMode|wH=WriteMode|rwH=ReadWriteMode|otherwise=ReadModereturnmode#if defined(mingw32_HOST_OS)withFilePath::FilePath->(CWString->IOa)->IOawithFilePath=withCWStringnewFilePath::FilePath->IOCWStringnewFilePath=newCWStringpeekFilePath::CWString->IOFilePathpeekFilePath=peekCWString#elsewithFilePath::FilePath->(CString->IOa)->IOanewFilePath::FilePath->IOCStringpeekFilePath::CString->IOFilePathpeekFilePathLen::CStringLen->IOFilePathwithFilePathfpf=getFileSystemEncoding>>=\enc->GHC.withCStringencfpfnewFilePathfp=getFileSystemEncoding>>=\enc->GHC.newCStringencfppeekFilePathfp=getFileSystemEncoding>>=\enc->GHC.peekCStringencfppeekFilePathLenfp=getFileSystemEncoding>>=\enc->GHC.peekCStringLenencfp#endif-- ----------------------------------------------------------------------------- Terminal-related stuff#if defined(HTYPE_TCFLAG_T)setEcho::FD->Bool->IO()setEchofdon=dotcSetAttrfd$\p_tios->dolflag<-c_lflagp_tios::IOCTcflagletnew_lflag|on=lflag.|.fromIntegralconst_echo|otherwise=lflag.&.complement(fromIntegralconst_echo)poke_c_lflagp_tios(new_lflag::CTcflag)getEcho::FD->IOBoolgetEchofd=dotcSetAttrfd$\p_tios->dolflag<-c_lflagp_tios::IOCTcflagreturn((lflag.&.fromIntegralconst_echo)/=0)setCooked::FD->Bool->IO()setCookedfdcooked=tcSetAttrfd$\p_tios->do-- turn on/off ICANONlflag<-c_lflagp_tios::IOCTcflagletnew_lflag|cooked=lflag.|.(fromIntegralconst_icanon)|otherwise=lflag.&.complement(fromIntegralconst_icanon)poke_c_lflagp_tios(new_lflag::CTcflag)-- set VMIN & VTIME to 1/0 respectivelywhen(notcooked)$doc_cc<-ptr_c_ccp_tiosletvmin=(c_cc`plusPtr`(fromIntegralconst_vmin))::PtrWord8vtime=(c_cc`plusPtr`(fromIntegralconst_vtime))::PtrWord8pokevmin1pokevtime0tcSetAttr::FD->(PtrCTermios->IOa)->IOatcSetAttrfdfun=doallocaBytessizeof_termios$\p_tios->dothrowErrnoIfMinus1Retry_"tcSetAttr"(c_tcgetattrfdp_tios)-- Save a copy of termios, if this is a standard file descriptor.-- These terminal settings are restored in hs_exit().when(fd<=2)$dop<-get_saved_termiosfdwhen(p==nullPtr)$dosaved_tios<-mallocBytessizeof_termioscopyBytessaved_tiosp_tiossizeof_termiosset_saved_termiosfdsaved_tios-- tcsetattr() when invoked by a background process causes the process-- to be sent SIGTTOU regardless of whether the process has TOSTOP set-- in its terminal flags (try it...).  This function provides a-- wrapper which temporarily blocks SIGTTOU around the call, making it-- transparent.allocaBytessizeof_sigset_t$\p_sigset->doallocaBytessizeof_sigset_t$\p_old_sigset->dothrowErrnoIfMinus1_"sigemptyset"$c_sigemptysetp_sigsetthrowErrnoIfMinus1_"sigaddset"$c_sigaddsetp_sigsetconst_sigttouthrowErrnoIfMinus1_"sigprocmask"$c_sigprocmaskconst_sig_blockp_sigsetp_old_sigsetr<-funp_tios-- do the businessthrowErrnoIfMinus1Retry_"tcSetAttr"$c_tcsetattrfdconst_tcsanowp_tiosthrowErrnoIfMinus1_"sigprocmask"$c_sigprocmaskconst_sig_setmaskp_old_sigsetnullPtrreturnrforeignimportccallunsafe"HsBase.h __hscore_get_saved_termios"get_saved_termios::CInt->IO(PtrCTermios)foreignimportccallunsafe"HsBase.h __hscore_set_saved_termios"set_saved_termios::CInt->(PtrCTermios)->IO()#else-- 'raw' mode for Win32 means turn off 'line input' (=> buffering and-- character translation for the console.) The Win32 API for doing-- this is GetConsoleMode(), which also requires echoing to be disabled-- when turning off 'line input' processing. Notice that turning off-- 'line input' implies enter/return is reported as '\r' (and it won't-- report that character until another character is input..odd.) This-- latter feature doesn't sit too well with IO actions like IO.hGetLine..-- consider yourself warned.setCooked::FD->Bool->IO()setCookedfdcooked=dox<-set_console_bufferingfd(ifcookedthen1else0)if(x/=0)thenioError(ioe_unk_error"setCooked""failed to set buffering")elsereturn()ioe_unk_error::String->String->IOExceptionioe_unk_errorlocmsg=ioeSetErrorString(mkIOErrorOtherErrorlocNothingNothing)msg-- Note: echoing goes hand in hand with enabling 'line input' / raw-ness-- for Win32 consoles, hence setEcho ends up being the inverse of setCooked.setEcho::FD->Bool->IO()setEchofdon=dox<-set_console_echofd(ifonthen1else0)if(x/=0)thenioError(ioe_unk_error"setEcho""failed to set echoing")elsereturn()getEcho::FD->IOBoolgetEchofd=dor<-get_console_echofdif(r==(-1))thenioError(ioe_unk_error"getEcho""failed to get echoing")elsereturn(r==1)foreignimportccallunsafe"consUtils.h set_console_buffering__"set_console_buffering::CInt->CInt->IOCIntforeignimportccallunsafe"consUtils.h set_console_echo__"set_console_echo::CInt->CInt->IOCIntforeignimportccallunsafe"consUtils.h get_console_echo__"get_console_echo::CInt->IOCIntforeignimportccallunsafe"consUtils.h is_console__"is_console::CInt->IOCInt#endif-- ----------------------------------------------------------------------------- Turning on non-blocking for a file descriptorsetNonBlockingFD::FD->Bool->IO()#if !defined(mingw32_HOST_OS)setNonBlockingFDfdset=doflags<-throwErrnoIfMinus1Retry"setNonBlockingFD"(c_fcntl_readfdconst_f_getfl)letflags'|set=flags.|.o_NONBLOCK|otherwise=flags.&.complemento_NONBLOCKwhen(flags/=flags')$do-- An error when setting O_NONBLOCK isn't fatal: on some systems-- there are certain file handles on which this will fail (eg. /dev/null-- on FreeBSD) so we throw away the return code from fcntl_write._<-c_fcntl_writefdconst_f_setfl(fromIntegralflags')return()#else-- bogus defns for win32setNonBlockingFD__=return()#endif-- ------------------------------------------------------------------------------- Set close-on-exec for a file descriptor#if !defined(mingw32_HOST_OS)setCloseOnExec::FD->IO()setCloseOnExecfd=dothrowErrnoIfMinus1_"setCloseOnExec"$c_fcntl_writefdconst_f_setfdconst_fd_cloexec#endif-- ------------------------------------------------------------------------------- foreign imports#if !defined(mingw32_HOST_OS)typeCFilePath=CString#elsetypeCFilePath=CWString#endifforeignimportccallunsafe"HsBase.h __hscore_open"c_open::CFilePath->CInt->CMode->IOCIntforeignimportccallsafe"HsBase.h __hscore_open"c_safe_open::CFilePath->CInt->CMode->IOCIntforeignimportccallunsafe"HsBase.h __hscore_fstat"c_fstat::CInt->PtrCStat->IOCIntforeignimportccallunsafe"HsBase.h __hscore_lstat"lstat::CFilePath->PtrCStat->IOCInt{- Note: Win32 POSIX functionsFunctions that are not part of the POSIX standards wereat some point deprecated by Microsoft. This deprecationwas performed by renaming the functions according to theC++ ABI Section 17.6.4.3.2b. This was done to free up thenamespace of normal Windows programs since Windows isn'tPOSIX compliant anyway.These were working before since the RTS was re-exportingthese symbols under the undeprecated names. This is no longerbeing done. See #11223See https://msdn.microsoft.com/en-us/library/ms235384.aspxfor more.However since we can't hope to get people to support Windowspackages we should support the deprecated names. See #12497-}foreignimportcapiunsafe"unistd.h lseek"c_lseek::CInt->COff->CInt->IOCOffforeignimportccallunsafe"HsBase.h access"c_access::CString->CInt->IOCIntforeignimportccallunsafe"HsBase.h chmod"c_chmod::CString->CMode->IOCIntforeignimportccallunsafe"HsBase.h close"c_close::CInt->IOCIntforeignimportccallunsafe"HsBase.h creat"c_creat::CString->CMode->IOCIntforeignimportccallunsafe"HsBase.h dup"c_dup::CInt->IOCIntforeignimportccallunsafe"HsBase.h dup2"c_dup2::CInt->CInt->IOCIntforeignimportccallunsafe"HsBase.h isatty"c_isatty::CInt->IOCInt#if defined(mingw32_HOST_OS)-- See Note: Windows typesforeignimportcapiunsafe"HsBase.h _read"c_read::CInt->PtrWord8->CUInt->IOCInt-- See Note: Windows typesforeignimportcapisafe"HsBase.h _read"c_safe_read::CInt->PtrWord8->CUInt->IOCIntforeignimportccallunsafe"HsBase.h _umask"c_umask::CMode->IOCMode-- See Note: Windows typesforeignimportcapiunsafe"HsBase.h _write"c_write::CInt->PtrWord8->CUInt->IOCInt-- See Note: Windows typesforeignimportcapisafe"HsBase.h _write"c_safe_write::CInt->PtrWord8->CUInt->IOCIntforeignimportccallunsafe"HsBase.h _pipe"c_pipe::PtrCInt->IOCInt#else-- We use CAPI as on some OSs (eg. Linux) this is wrapped by a macro-- which redirects to the 64-bit-off_t versions when large file-- support is enabled.-- See Note: Windows typesforeignimportcapiunsafe"HsBase.h read"c_read::CInt->PtrWord8->CSize->IOCSsize-- See Note: Windows typesforeignimportcapisafe"HsBase.h read"c_safe_read::CInt->PtrWord8->CSize->IOCSsizeforeignimportccallunsafe"HsBase.h umask"c_umask::CMode->IOCMode-- See Note: Windows typesforeignimportcapiunsafe"HsBase.h write"c_write::CInt->PtrWord8->CSize->IOCSsize-- See Note: Windows typesforeignimportcapisafe"HsBase.h write"c_safe_write::CInt->PtrWord8->CSize->IOCSsizeforeignimportccallunsafe"HsBase.h pipe"c_pipe::PtrCInt->IOCInt#endifforeignimportccallunsafe"HsBase.h unlink"c_unlink::CString->IOCIntforeignimportcapiunsafe"HsBase.h utime"c_utime::CString->PtrCUtimbuf->IOCIntforeignimportccallunsafe"HsBase.h getpid"c_getpid::IOCPidforeignimportccallunsafe"HsBase.h __hscore_stat"c_stat::CFilePath->PtrCStat->IOCIntforeignimportccallunsafe"HsBase.h __hscore_ftruncate"c_ftruncate::CInt->COff->IOCInt#if !defined(mingw32_HOST_OS)foreignimportcapiunsafe"HsBase.h fcntl"c_fcntl_read::CInt->CInt->IOCIntforeignimportcapiunsafe"HsBase.h fcntl"c_fcntl_write::CInt->CInt->CLong->IOCIntforeignimportcapiunsafe"HsBase.h fcntl"c_fcntl_lock::CInt->CInt->PtrCFLock->IOCIntforeignimportccallunsafe"HsBase.h fork"c_fork::IOCPidforeignimportccallunsafe"HsBase.h link"c_link::CString->CString->IOCInt-- capi is required at least on Androidforeignimportcapiunsafe"HsBase.h mkfifo"c_mkfifo::CString->CMode->IOCIntforeignimportcapiunsafe"signal.h sigemptyset"c_sigemptyset::PtrCSigset->IOCIntforeignimportcapiunsafe"signal.h sigaddset"c_sigaddset::PtrCSigset->CInt->IOCIntforeignimportcapiunsafe"signal.h sigprocmask"c_sigprocmask::CInt->PtrCSigset->PtrCSigset->IOCInt-- capi is required at least on Androidforeignimportcapiunsafe"HsBase.h tcgetattr"c_tcgetattr::CInt->PtrCTermios->IOCInt-- capi is required at least on Androidforeignimportcapiunsafe"HsBase.h tcsetattr"c_tcsetattr::CInt->CInt->PtrCTermios->IOCIntforeignimportccallunsafe"HsBase.h waitpid"c_waitpid::CPid->PtrCInt->CInt->IOCPid#endif-- POSIX flags only:foreignimportccallunsafe"HsBase.h __hscore_o_rdonly"o_RDONLY::CIntforeignimportccallunsafe"HsBase.h __hscore_o_wronly"o_WRONLY::CIntforeignimportccallunsafe"HsBase.h __hscore_o_rdwr"o_RDWR::CIntforeignimportccallunsafe"HsBase.h __hscore_o_append"o_APPEND::CIntforeignimportccallunsafe"HsBase.h __hscore_o_creat"o_CREAT::CIntforeignimportccallunsafe"HsBase.h __hscore_o_excl"o_EXCL::CIntforeignimportccallunsafe"HsBase.h __hscore_o_trunc"o_TRUNC::CInt-- non-POSIX flags.foreignimportccallunsafe"HsBase.h __hscore_o_noctty"o_NOCTTY::CIntforeignimportccallunsafe"HsBase.h __hscore_o_nonblock"o_NONBLOCK::CIntforeignimportccallunsafe"HsBase.h __hscore_o_binary"o_BINARY::CIntforeignimportcapiunsafe"sys/stat.h S_ISREG"c_s_isreg::CMode->CIntforeignimportcapiunsafe"sys/stat.h S_ISCHR"c_s_ischr::CMode->CIntforeignimportcapiunsafe"sys/stat.h S_ISBLK"c_s_isblk::CMode->CIntforeignimportcapiunsafe"sys/stat.h S_ISDIR"c_s_isdir::CMode->CIntforeignimportcapiunsafe"sys/stat.h S_ISFIFO"c_s_isfifo::CMode->CInts_isreg::CMode->Bools_isregcm=c_s_isregcm/=0s_ischr::CMode->Bools_ischrcm=c_s_ischrcm/=0s_isblk::CMode->Bools_isblkcm=c_s_isblkcm/=0s_isdir::CMode->Bools_isdircm=c_s_isdircm/=0s_isfifo::CMode->Bools_isfifocm=c_s_isfifocm/=0foreignimportccallunsafe"HsBase.h __hscore_sizeof_stat"sizeof_stat::Intforeignimportccallunsafe"HsBase.h __hscore_st_mtime"st_mtime::PtrCStat->IOCTime#if defined(mingw32_HOST_OS)foreignimportccallunsafe"HsBase.h __hscore_st_size"st_size::PtrCStat->IOInt64#elseforeignimportccallunsafe"HsBase.h __hscore_st_size"st_size::PtrCStat->IOCOff#endifforeignimportccallunsafe"HsBase.h __hscore_st_mode"st_mode::PtrCStat->IOCModeforeignimportccallunsafe"HsBase.h __hscore_st_dev"st_dev::PtrCStat->IOCDevforeignimportccallunsafe"HsBase.h __hscore_st_ino"st_ino::PtrCStat->IOCInoforeignimportccallunsafe"HsBase.h __hscore_echo"const_echo::CIntforeignimportccallunsafe"HsBase.h __hscore_tcsanow"const_tcsanow::CIntforeignimportccallunsafe"HsBase.h __hscore_icanon"const_icanon::CIntforeignimportccallunsafe"HsBase.h __hscore_vmin"const_vmin::CIntforeignimportccallunsafe"HsBase.h __hscore_vtime"const_vtime::CIntforeignimportccallunsafe"HsBase.h __hscore_sigttou"const_sigttou::CIntforeignimportccallunsafe"HsBase.h __hscore_sig_block"const_sig_block::CIntforeignimportccallunsafe"HsBase.h __hscore_sig_setmask"const_sig_setmask::CIntforeignimportccallunsafe"HsBase.h __hscore_f_getfl"const_f_getfl::CIntforeignimportccallunsafe"HsBase.h __hscore_f_setfl"const_f_setfl::CIntforeignimportccallunsafe"HsBase.h __hscore_f_setfd"const_f_setfd::CIntforeignimportccallunsafe"HsBase.h __hscore_fd_cloexec"const_fd_cloexec::CLong#if defined(HTYPE_TCFLAG_T)foreignimportccallunsafe"HsBase.h __hscore_sizeof_termios"sizeof_termios::Intforeignimportccallunsafe"HsBase.h __hscore_sizeof_sigset_t"sizeof_sigset_t::Intforeignimportccallunsafe"HsBase.h __hscore_lflag"c_lflag::PtrCTermios->IOCTcflagforeignimportccallunsafe"HsBase.h __hscore_poke_lflag"poke_c_lflag::PtrCTermios->CTcflag->IO()foreignimportccallunsafe"HsBase.h __hscore_ptr_c_cc"ptr_c_cc::PtrCTermios->IO(PtrWord8)#endifs_issock::CMode->Bool#if !defined(mingw32_HOST_OS)s_issockcmode=c_s_issockcmode/=0foreignimportcapiunsafe"sys/stat.h S_ISSOCK"c_s_issock::CMode->CInt#elses_issock_=False#endifforeignimportccallunsafe"__hscore_bufsiz"dEFAULT_BUFFER_SIZE::Intforeignimportcapiunsafe"stdio.h value SEEK_CUR"sEEK_CUR::CIntforeignimportcapiunsafe"stdio.h value SEEK_SET"sEEK_SET::CIntforeignimportcapiunsafe"stdio.h value SEEK_END"sEEK_END::CInt{-Note: Windows typesWindows' _read and _write have types that differ from POSIX. They take anunsigned int for lengh and return a signed int where POSIX uses size_t andssize_t. Those are different on x86_64 and equivalent on x86. We import themwith the types in Microsoft's documentation which means that c_read,c_safe_read, c_write and c_safe_write have different Haskell types depending onthe OS.-}