git.iko.soy/obelisk
on master help sign in
command: Fix directory removal in case of symlink
c410884Elliot Cameron
lib/command/src/Obelisk/Command/Thunk.hs+4−4
compare with master
unifiedsplit
@@ -5,9 +5,9 @@
5{-# LANGUAGE MultiWayIf #-}
5{-# LANGUAGE MultiWayIf #-}
6{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE PatternGuards #-}
7{-# LANGUAGE PatternGuards #-}
8+{-# LANGUAGE QuasiQuotes #-}
8{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE TypeApplications #-}
10{-# LANGUAGE TypeApplications #-}
10−{-# LANGUAGE QuasiQuotes #-}
11module Obelisk.Command.Thunk where
11module Obelisk.Command.Thunk where
12
12
13import Control.Applicative
13import Control.Applicative
@@ -368,7 +368,7 @@ overwriteThunk target thunk = do
368 Right _ -> pure ()
368 Right _ -> pure ()
369
369
370 --TODO: Is there a safer way to do this overwriting?
370 --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
372 createThunk target thunk
372 createThunk target thunk
373
373
374thunkPtrToSpec :: ThunkPtr -> ThunkSpec
374thunkPtrToSpec :: ThunkPtr -> ThunkSpec
@@ -751,7 +751,7 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with
751 callProcessAndLogOutput (Notice, Error) $
751 callProcessAndLogOutput (Notice, Error) $
752 proc cp ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]
752 proc cp ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]
753 callProcessAndLogOutput (Notice, Error) $
753 callProcessAndLogOutput (Notice, Error) $
754− proc "rm" ["-r", thunkDir]
754+ proc rmPath ["-r", thunkDir]
755 callProcessAndLogOutput (Notice, Error) $
755 callProcessAndLogOutput (Notice, Error) $
756 proc "mv" ["-T", tmpRepo, thunkDir]
756 proc "mv" ["-T", tmpRepo, thunkDir]
757
757
@@ -767,7 +767,7 @@ packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDire
767 withSpinner' ("Packing thunk " <> T.pack thunkDir)
767 withSpinner' ("Packing thunk " <> T.pack thunkDir)
768 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do
768 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do
769 thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) thunkDir (_thunkConfig_private thunkConfig)
769 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
771 createThunk thunkDir thunkPtr
771 createThunk thunkDir thunkPtr
772 pure thunkPtr
772 pure thunkPtr
773
773
lib/command/src/Obelisk/Command/Utils.hs+3
@@ -32,6 +32,9 @@ import Obelisk.CliApp
32cp :: FilePath
32cp :: FilePath
33cp = $(staticWhich "cp")
33cp = $(staticWhich "cp")
34
34
35+rmPath :: FilePath
36+rmPath = $(staticWhich "rm")
37+
35ghcidExePath :: FilePath
38ghcidExePath :: FilePath
36ghcidExePath = $(staticWhich "ghcid")
39ghcidExePath = $(staticWhich "ghcid")
37
40
lib/command/src/Obelisk/Command/VmBuilder.hs+2−1
@@ -21,6 +21,7 @@ import qualified System.Info
21
21
22import Obelisk.App (MonadObelisk, getObeliskUserStateDir)
22import Obelisk.App (MonadObelisk, getObeliskUserStateDir)
23import Obelisk.CliApp
23import Obelisk.CliApp
24+import Obelisk.Command.Utils (rmPath)
24
25
25-- | Generate the `--builders` argument string to enable the VM builder after ensuring it is available.
26-- | Generate the `--builders` argument string to enable the VM builder after ensuring it is available.
26getNixBuildersArg :: MonadObelisk m => m String
27getNixBuildersArg :: MonadObelisk m => m String
@@ -95,7 +96,7 @@ setupNixDocker stateDir = withSpinner ("Creating Docker container named " <> con
95
96
96 -- Create new SSH keys for this container
97 -- Create new SSH keys for this container
97 callProcessAndLogOutput (Debug, Error) $
98 callProcessAndLogOutput (Debug, Error) $
98− proc "rm" ["-f", stateDir </> sshKeyFileName, stateDir </> sshKeyFileName <.> "pub"]
99+ proc rmPath ["-f", stateDir </> sshKeyFileName, stateDir </> sshKeyFileName <.> "pub"]
99 callProcessAndLogOutput (Debug, Error) $
100 callProcessAndLogOutput (Debug, Error) $
100 proc "ssh-keygen" ["-t", "ed25519", "-f", stateDir </> sshKeyFileName, "-P", ""]
101 proc "ssh-keygen" ["-t", "ed25519", "-f", stateDir </> sshKeyFileName, "-P", ""]
101
102