Skip to content

Commit

Permalink
Disable setting file permissions on Windows
Browse files Browse the repository at this point in the history
It is currently broken; See the discussion of dhall-lang#2452
  • Loading branch information
mmhat committed Sep 30, 2022
1 parent e7847a7 commit cf9b4fe
Show file tree
Hide file tree
Showing 3 changed files with 34 additions and 3 deletions.
2 changes: 1 addition & 1 deletion dhall/src/Dhall/DirectoryTree.hs
Original file line number Diff line number Diff line change
Expand Up @@ -311,7 +311,7 @@ applyMetadata entry fp = do

let mode' = maybe mode (updateModeWith mode) (entryMode entry)
unless (mode' == mode) $
Posix.setFileMode fp $ modeToFileMode mode'
setFileModeOnUnix fp $ modeToFileMode mode'

-- | Calculate the new `Mode` from the current mode and the changes specified by
-- the user.
Expand Down
15 changes: 14 additions & 1 deletion dhall/src/Dhall/DirectoryTree/Types.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
Expand All @@ -21,6 +20,8 @@ module Dhall.DirectoryTree.Types
, Group(..)
, Mode(..)
, Access(..)

, setFileModeOnUnix
) where

import Data.Functor.Identity (Identity (..))
Expand All @@ -45,9 +46,11 @@ import qualified Dhall.Marshal.Decode as Decode

#ifdef mingw32_HOST_OS
import Data.Word (Word32)
import System.IO (hPutStrLn, stderr)

import qualified Unsafe.Coerce
#else
import qualified System.PosixCompat.Files as Posix
import qualified System.PosixCompat.Types as Posix
#endif

Expand Down Expand Up @@ -179,3 +182,13 @@ accessDecoder :: FromDhall (f Bool) => InputNormalizer -> Decoder (Access f)
accessDecoder = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions
{ fieldModifier = Text.toLower . Text.drop (Text.length "access")
}



-- | Set file permissions if we are not on Windows as it is currently not supported.
setFileModeOnUnix :: FilePath -> Posix.FileMode -> IO ()
#ifdef mingw32_HOST_OS
setFileModeOnUnix fp _ = hPutStrLn stderr $ "Warning: Feature is not supported on your platform; Failed to set permissions for " <> fp
#else
setFileModeOnUnix fp mode = Posix.setFileMode fp mode
#endif
20 changes: 19 additions & 1 deletion dhall/tests/Dhall/Test/DirectoryTree.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}

Expand All @@ -9,6 +10,7 @@ import Data.Either.Validation
import Dhall.DirectoryTree (Entry(..), Group(..), User(..))
import Lens.Family (set)
import System.FilePath ((</>))
import System.PosixCompat.Types (FileMode)
import Test.Tasty
import Test.Tasty.HUnit

Expand All @@ -26,7 +28,9 @@ tests = testGroup "to-directory-tree"
[ fixpointedType
, fixpointedEmpty
, fixpointedSimple
#ifndef mingw32_HOST_OS
, fixpointedPermissions
#endif
, fixpointedUserGroup
]
]
Expand Down Expand Up @@ -58,6 +62,11 @@ fixpointedSimple = testCase "simple" $ do
, Directory $ outDir </> "directory"
]

{-
This test is disabled on Windows for now as it fails:
expected: 448
but got: 438
-}
fixpointedPermissions :: TestTree
fixpointedPermissions = testCase "permissions" $ do
let outDir = "./tests/to-directory-tree/fixpoint-permissions.out"
Expand All @@ -69,7 +78,16 @@ fixpointedPermissions = testCase "permissions" $ do
]
s <- Files.getFileStatus $ outDir </> "file"
let mode = Files.fileMode s `Files.intersectFileModes` Files.accessModes
mode @?= Files.ownerModes
prettyMode mode @?= prettyMode Files.ownerModes
where
prettyMode :: FileMode -> String
prettyMode m =
[ 'r' | isBitSet Files.ownerExecuteMode m ] <>
[ 'w' | isBitSet Files.ownerExecuteMode m ] <>
[ 'x' | isBitSet Files.ownerExecuteMode m ]

isBitSet :: FileMode -> FileMode -> Bool
isBitSet mask m = mask `Files.intersectFileModes` m == Files.nullFileMode

fixpointedUserGroup :: TestTree
fixpointedUserGroup = testCase "user and group" $ do
Expand Down

0 comments on commit cf9b4fe

Please sign in to comment.