on master help sign in
command: Fix directory removal in case of symlink
commitc410884f481b8d4357b119b722d69407cf2ed298 authorElliot Cameron <eacameron@gmail.com> dateThu 19 Mar 2020, 11:51 (7 years ago) parenta574a7e
3 files changed+9−5
lib/command/src/Obelisk/Command/Thunk.hs+4−4 lib/command/src/Obelisk/Command/Utils.hs+3 lib/command/src/Obelisk/Command/VmBuilder.hs+2−1
lib/command/src/Obelisk/Command/Thunk.hs+4−4
@@ -5,9 +5,9 @@
55{-# LANGUAGE MultiWayIf #-}
66{-# LANGUAGE OverloadedStrings #-}
77{-# LANGUAGE PatternGuards #-}
8+{-# LANGUAGE QuasiQuotes #-}
89{-# LANGUAGE ScopedTypeVariables #-}
910{-# LANGUAGE TypeApplications #-}
10−{-# LANGUAGE QuasiQuotes #-}
1111module Obelisk.Command.Thunk where
1212
1313import Control.Applicative
@@ -368,7 +368,7 @@ overwriteThunk target thunk = do
368368 Right _ -> pure ()
369369
370370 --TODO: Is there a safer way to do this overwriting?
371− liftIO $ removeDirectoryRecursive target
371+ callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-r", target] -- target may be a symlink
372372 createThunk target thunk
373373
374374thunkPtrToSpec :: ThunkPtr -> ThunkSpec
@@ -751,7 +751,7 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with
751751 callProcessAndLogOutput (Notice, Error) $
752752 proc cp ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]
753753 callProcessAndLogOutput (Notice, Error) $
754− proc "rm" ["-r", thunkDir]
754+ proc rmPath ["-r", thunkDir]
755755 callProcessAndLogOutput (Notice, Error) $
756756 proc "mv" ["-T", tmpRepo, thunkDir]
757757
@@ -767,7 +767,7 @@ packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDire
767767 withSpinner' ("Packing thunk " <> T.pack thunkDir)
768768 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do
769769 thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) thunkDir (_thunkConfig_private thunkConfig)
770− liftIO $ removeDirectoryRecursive thunkDir
770+ callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-r", thunkDir] -- thunkDir may be a symlink
771771 createThunk thunkDir thunkPtr
772772 pure thunkPtr
773773
lib/command/src/Obelisk/Command/Utils.hs+3
@@ -32,6 +32,9 @@ import Obelisk.CliApp
3232cp :: FilePath
3333cp = $(staticWhich "cp")
3434
35+rmPath :: FilePath
36+rmPath = $(staticWhich "rm")
37+
3538ghcidExePath :: FilePath
3639ghcidExePath = $(staticWhich "ghcid")
3740
lib/command/src/Obelisk/Command/VmBuilder.hs+2−1
@@ -21,6 +21,7 @@ import qualified System.Info
2121
2222import Obelisk.App (MonadObelisk, getObeliskUserStateDir)
2323import Obelisk.CliApp
24+import Obelisk.Command.Utils (rmPath)
2425
2526-- | Generate the `--builders` argument string to enable the VM builder after ensuring it is available.
2627getNixBuildersArg :: MonadObelisk m => m String
@@ -95,7 +96,7 @@ setupNixDocker stateDir = withSpinner ("Creating Docker container named " <> con
9596
9697 -- Create new SSH keys for this container
9798 callProcessAndLogOutput (Debug, Error) $
98− proc "rm" ["-f", stateDir </> sshKeyFileName, stateDir </> sshKeyFileName <.> "pub"]
99+ proc rmPath ["-f", stateDir </> sshKeyFileName, stateDir </> sshKeyFileName <.> "pub"]
99100 callProcessAndLogOutput (Debug, Error) $
100101 proc "ssh-keygen" ["-t", "ed25519", "-f", stateDir </> sshKeyFileName, "-P", ""]
101102