Backports for 2.7.3 (#235)

* Add regression test for #218

#218

Error was:

uncaught exception: IOException of type InvalidArgument
semTrywait: invalid argument (Bad file descriptor)

* Fix 'semTrywait: invalid argument (Bad file descriptor)' wrt #218

* Add regression test for putEnv wrt #68

* Synchronize ByteString and String modules

And fix free-bug in 'putEnv'. Fixes #68

* Add cabal.project

* Fix the error handling of posix_fallocate other than FreeBSD

This commit introduces a CPP guard to take care of the difference
between OSes of the errors of posix_fallocate.

On Linux and NetBSD, posix_fallocate reports error by returning an error
number. errno is not set.
On the other hand, on FreeBSD, posix_fallocate returns -1 and sets
errno.

The existing code could handle FreeBSD-style errors only.

* Remove obsolete FreeBSD-style error handling

The FreeBSD-style error (return -1, set errno) is obsolete as of
FreeBSD 11.0; it now reports errors as same as the other OSes.

* Future-proof glibc version check

* Resource: Fix warning in case of no RLIM_SAVED_{CUR,MAX}

This previously failed to build with a warning on FreeBSD 11.2

* Bump to 2.7.3

* Add Eq and Show instance to BaudRate

Needed for test suite

* Add CI

* Tighten lower base bound to only allow GHC-8.2+

Co-authored-by: matil019 <[email protected]>
Co-authored-by: Viktor Dukhovni <[email protected]>
Co-authored-by: Ben Gamari <[email protected]>

Author: 4 people

.github/workflows/ci.yml

@@ -0,0 +1,124 @@
+name: ci
+on:
+  - push
+  - pull_request
+
+defaults:
+  run:
+    shell: bash
+
+jobs:
+  build:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: true
+      matrix:
+        os: [ubuntu-latest, macOS-latest]
+        ghc: ['9.2', '9.0', '8.10', '8.8', '8.6', '8.4', '8.2']
+    steps:
+    - uses: actions/checkout@v2
+    - uses: haskell/actions/setup@v1
+      id: setup-haskell-cabal
+      with:
+        ghc-version: ${{ matrix.ghc }}
+    - uses: actions/cache@v2
+      name: Cache cabal stuff
+      with:
+        path: |
+          ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+          dist-newstyle
+        key: ${{ runner.os }}-${{ matrix.ghc }}
+    - name: Build
+      run: |
+        cabal --version
+        cabal update
+        autoreconf --version
+        autoreconf -i
+        cabal sdist -z -o .
+        cabal get unix-*.tar.gz
+        cd unix-*/
+        cabal test all --test-show-details=direct
+    - name: Haddock
+      run: cabal haddock
+
+  centos7:
+    runs-on: ubuntu-latest
+    container:
+      image: centos:7
+    steps:
+    - name: Install
+      run: |
+        yum install -y gcc gmp gmp-devel make ncurses ncurses-compat-libs xz perl autoconf
+        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+    - uses: actions/checkout@v2
+    - name: Test
+      run: |
+        source ~/.ghcup/env
+        cabal --version
+        cabal update
+        autoreconf --version
+        autoreconf -i
+        cabal test all --test-show-details=direct
+
+  fedora34:
+    runs-on: ubuntu-latest
+    container:
+      image: fedora:34
+    steps:
+    - name: Install
+      run: |
+        dnf install -y gcc gmp gmp-devel make ncurses ncurses-compat-libs xz perl autoconf
+        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+    - uses: actions/checkout@v2
+    - name: Test
+      run: |
+        source ~/.ghcup/env
+        cabal --version
+        cabal update
+        autoreconf --version
+        autoreconf -i
+        cabal test all --test-show-details=direct
+
+  i386:
+    runs-on: ubuntu-latest
+    container:
+      image: i386/ubuntu:bionic
+    steps:
+    - name: Install
+      run: |
+        apt-get update -y
+        apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
+        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+    - uses: actions/checkout@v1
+    - name: Test
+      run: |
+        source ~/.ghcup/env
+        cabal --version
+        cabal update
+        autoreconf --version
+        autoreconf -i
+        cabal v2-test --constraint 'optparse-applicative -process' --constraint 'QuickCheck +old-random' --constraint 'tasty -unix' all
+
+  arm:
+    runs-on: ubuntu-latest
+    strategy:
+      fail-fast: false
+      matrix:
+        arch: ['armv7', 'aarch64']
+    steps:
+    - uses: actions/checkout@v2
+    - uses: uraimo/[email protected]
+      timeout-minutes: 120
+      with:
+        arch: ${{ matrix.arch }}
+        distro: ubuntu20.04
+        githubToken: ${{ github.token }}
+        install: |
+          apt-get update -y
+          apt-get install -y ghc cabal-install autoconf
+        run: |
+          cabal --version
+          cabal update
+          autoreconf --version
+          autoreconf -i
+          cabal v2-test --constraint 'optparse-applicative -process' --constraint 'QuickCheck +old-random' --constraint 'tasty -unix' all

System/Posix/Env/ByteString.hsc

@@ -1,8 +1,5 @@
 {-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE Trustworthy #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# OPTIONS_GHC -fno-warn-trustworthy-safe #-}
-#endif
 
 -----------------------------------------------------------------------------
 -- |
@@ -24,24 +21,28 @@ module System.Posix.Env.ByteString (
         , getEnvDefault
         , getEnvironmentPrim
         , getEnvironment
+        , setEnvironment
         , putEnv
         , setEnv
-       , unsetEnv
+        , unsetEnv
+        , clearEnv
 
        -- * Program arguments
        , getArgs
 ) where
 
 #include "HsUnix.h"
 
+import Control.Monad
 import Foreign
 import Foreign.C
-import Control.Monad    ( liftM )
 import Data.Maybe       ( fromMaybe )
 
+import System.Posix.Env ( clearEnv )
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import Data.ByteString (ByteString)
+import Data.ByteString.Internal (ByteString (PS), memcpy)
 
 -- |'getEnv' looks up a variable in the environment.
 
@@ -55,8 +56,8 @@ getEnv name = do
      else return Nothing
 
 -- |'getEnvDefault' is a wrapper around 'getEnv' where the
--- programmer can specify a fallback if the variable is not found
--- in the environment.
+-- programmer can specify a fallback as the second argument, which will be
+-- used if the variable is not found in the environment.
 
 getEnvDefault ::
   ByteString    {- ^ variable name                    -} ->
@@ -100,6 +101,18 @@ getEnvironment = do
       | BC.head y == '=' = (x,B.tail y)
       | otherwise       = error $ "getEnvironment: insane variable " ++ BC.unpack x
 
+-- |'setEnvironment' resets the entire environment to the given list of
+-- @(key,value)@ pairs.
+--
+-- @since 2.7.3
+setEnvironment ::
+  [(ByteString,ByteString)] {- ^ @[(key,value)]@ -} ->
+  IO ()
+setEnvironment env = do
+  clearEnv
+  forM_ env $ \(key,value) ->
+    setEnv key value True {-overwrite-}
+
 -- |The 'unsetEnv' function deletes all instances of the variable name
 -- from the environment.
 
@@ -120,15 +133,25 @@ foreign import capi unsafe "HsUnix.h unsetenv"
    c_unsetenv :: CString -> IO ()
 # endif
 #else
-unsetEnv name = putEnv (name ++ "=")
+unsetEnv name = putEnv (BC.snoc name '=')
 #endif
 
 -- |'putEnv' function takes an argument of the form @name=value@
 -- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
 
 putEnv :: ByteString {- ^ "key=value" -} -> IO ()
-putEnv keyvalue = B.useAsCString keyvalue $ \s ->
-  throwErrnoIfMinus1_ "putenv" (c_putenv s)
+putEnv (PS fp o l) = withForeignPtr fp $ \p -> do
+  -- https://pubs.opengroup.org/onlinepubs/009696899/functions/putenv.html
+  --
+  -- "the string pointed to by string shall become part of the environment,
+  -- so altering the string shall change the environment. The space used by
+  -- string is no longer used once a new string which defines name is passed to putenv()."
+  --
+  -- hence we must not free the buffer
+  buf <- mallocBytes (l+1)
+  memcpy buf (p `plusPtr` o) l
+  pokeByteOff buf l (0::Word8)
+  throwErrnoIfMinus1_ "putenv" (c_putenv (castPtr buf))
 
 foreign import ccall unsafe "putenv"
    c_putenv :: CString -> IO CInt

System/Posix/Fcntl.hsc

@@ -92,7 +92,10 @@ fileAdvise _ _ _ _ = return ()
 fileAllocate :: Fd -> FileOffset -> FileOffset -> IO ()
 #if HAVE_POSIX_FALLOCATE
 fileAllocate fd off len = do
-  throwErrnoIfMinus1_ "fileAllocate" (c_posix_fallocate (fromIntegral fd) (fromIntegral off) (fromIntegral len))
+  ret <- c_posix_fallocate (fromIntegral fd) (fromIntegral off) (fromIntegral len)
+  if ret == 0
+    then pure ()
+    else ioError (errnoToIOError "fileAllocate" (Errno ret) Nothing Nothing)
 
 foreign import capi safe "fcntl.h posix_fallocate"
   c_posix_fallocate :: CInt -> COff -> COff -> IO CInt

System/Posix/Resource.hsc

@@ -111,12 +111,18 @@ unpackRLimit other
 
 packRLimit :: ResourceLimit -> Bool -> CRLim
 packRLimit ResourceLimitInfinity _     = (#const RLIM_INFINITY)
-#ifdef RLIM_SAVED_CUR
+#if defined(RLIM_SAVED_CUR)
 packRLimit ResourceLimitUnknown  True  = (#const RLIM_SAVED_CUR)
 #endif
-#ifdef RLIM_SAVED_MAX
+#if defined(RLIM_SAVED_MAX)
 packRLimit ResourceLimitUnknown  False = (#const RLIM_SAVED_MAX)
 #endif
+#if ! defined(RLIM_SAVED_MAX) && !defined(RLIM_SAVED_CUR)
+packRLimit ResourceLimitUnknown  _     =
+    error
+      $ "System.Posix.Resource.packRLimit: " ++
+        "ResourceLimitUnknown but RLIM_SAVED_MAX/RLIM_SAVED_CUR not defined by platform"
+#endif
 packRLimit (ResourceLimit other) _     = fromIntegral other
 
 

System/Posix/Semaphore.hsc

@@ -3,6 +3,7 @@
 #else
 {-# LANGUAGE Trustworthy #-}
 #endif
+{-# LANGUAGE CApiFFI #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.Posix.Semaphore
@@ -114,18 +115,18 @@ semGetValue_ sem ptr = do throwErrnoIfMinus1Retry_ "semGetValue" $
                           cint <- peek ptr
                           return $ fromEnum cint
 
-foreign import ccall safe "sem_open"
+foreign import capi safe "semaphore.h sem_open"
         sem_open :: CString -> CInt -> CMode -> CUInt -> IO (Ptr ())
-foreign import ccall safe "sem_close"
+foreign import capi safe "semaphore.h sem_close"
         sem_close :: Ptr () -> IO CInt
-foreign import ccall safe "sem_unlink"
+foreign import capi safe "semaphore.h sem_unlink"
         sem_unlink :: CString -> IO CInt
 
-foreign import ccall safe "sem_wait"
+foreign import capi safe "semaphore.h sem_wait"
         sem_wait :: Ptr () -> IO CInt
-foreign import ccall safe "sem_trywait"
+foreign import capi safe "semaphore.h sem_trywait"
         sem_trywait :: Ptr () -> IO CInt
-foreign import ccall safe "sem_post"
+foreign import capi safe "semaphore.h sem_post"
         sem_post :: Ptr () -> IO CInt
-foreign import ccall safe "sem_getvalue"
+foreign import capi safe "semaphore.h sem_getvalue"
         sem_getvalue :: Ptr () -> Ptr CInt -> IO Int

System/Posix/Terminal/Common.hsc

@@ -335,6 +335,7 @@ data BaudRate
   | B38400
   | B57600
   | B115200
+  deriving (Eq, Show)
 
 inputSpeed :: TerminalAttributes -> BaudRate
 inputSpeed termios = unsafePerformIO $ do

cabal.project

@@ -0,0 +1,6 @@
+packages: .
+
+tests: True
+
+constraints:
+  tasty -unix, optparse-applicative -process

cbits/HsUnix.c

@@ -47,7 +47,7 @@ int __hsunix_push_module(int fd, const char *module)
  * re-entrant.
  */
 
-#if defined (__GLIBC__) && (__GLIBC__ >= 2) && (__GLIBC_MINOR__ >= 23)
+#if defined (__GLIBC__) && ((__GLIBC__ > 2) || (__GLIBC__ == 2) && (__GLIBC_MINOR__ >= 23))
 #define USE_READDIR_R 0
 #else
 #define USE_READDIR_R 1

changelog.md

@@ -1,5 +1,23 @@
 # Changelog for [`unix` package](http://hackage.haskell.org/package/unix)
 
+## 2.7.2.3  *Unreleased*
+
+  * Resource: Fix warning in case of no RLIM_SAVED_{CUR,MAX}
+
+  * Future-proof glibc version check
+
+  * Fix the error handling of posix_fallocate in non-FreeBSD
+
+  * Synchronize ByteString and String modules and fix grave bug in 'putEnv'
+
+  * Fix 'semTrywait: invalid argument (Bad file descriptor)' wrt #218
+
+  * Improve error messages
+
+  * Improve tests
+
+  * Don't show repo as modified after configure
+
 ## 2.7.2.2  *May 2017*
 
   * Bundled with GHC 8.2.1

tests/fdReadBuf001.hs renamed to tests/FdReadBuf001.hs

@@ -1,24 +1,25 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
+module Main where
+
 import System.Posix
 import Control.Monad
-import Foreign
+import Foreign hiding (void)
 import Control.Concurrent
 import Data.Char
 import System.Exit
 
-size  = 10000
-block = 512
-
+main :: IO ()
 main = do
+  let size  = 10000
+      block = 512
   (rd,wr) <- createPipe
   let bytes = take size (map (fromIntegral.ord) (cycle ['a'..'z']))
-  allocaBytes size $ \p -> do
-    pokeArray p bytes
-    forkIO $ do r <- fdWriteBuf wr p (fromIntegral size)
-                when (fromIntegral r /= size) $ error "fdWriteBuf failed"
+  void $ forkIO $ allocaBytes size $ \p -> do
+        pokeArray p bytes
+        r <- fdWriteBuf wr p (fromIntegral size)
+        when (fromIntegral r /= size) $ error "fdWriteBuf failed"
   allocaBytes block $ \p -> do
     let loop text = do
-           r <- fdReadBuf rd p block
+           r <- fdReadBuf rd p (fromIntegral block)
            let (chunk,rest) = splitAt (fromIntegral r) text
            chars <- peekArray (fromIntegral r) p
            when (chars /= chunk) $ error $ "mismatch: expected="++show chunk++", found="++show chars