From 20a33d9276d5781ca6993b857d8d097085983ede Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Thu, 28 Dec 2023 09:33:47 +0100 Subject: [PATCH] Add tar 0.6 support resolves https://github.com/snoyberg/keter/issues/286 this uses the upstream tar. it also has support for changing ownership of the files unpacked (which the keter implementation also seemed to manage). this also deletes the stack based ci in favor of a cabal based ci, it broke for some reason and I didn't want to play stack whackamole. use upstream unpack bump filepath forM more import forM trash result don't use a traverse but a fold update changelog add extra deps clear stack add cabal based action drop windows support clear stack based ci Add note on changing to cabal ci I just don't want to figure out why this broke. bump keter --- .github/workflows/cabal.yaml | 37 ++++++++++++++++++++++++ .github/workflows/stack.yaml | 44 ---------------------------- ChangeLog.md | 2 ++ keter.cabal | 6 ++-- src/Keter/TempTarball.hs | 56 ++++++------------------------------ 5 files changed, 51 insertions(+), 94 deletions(-) create mode 100644 .github/workflows/cabal.yaml delete mode 100644 .github/workflows/stack.yaml diff --git a/.github/workflows/cabal.yaml b/.github/workflows/cabal.yaml new file mode 100644 index 00000000..279d9d4c --- /dev/null +++ b/.github/workflows/cabal.yaml @@ -0,0 +1,37 @@ +on: [pull_request] +jobs: + build: + + runs-on: ${{ matrix.os }} + + strategy: + fail-fast: false + matrix: + ghc: # should mirror current stable releases: https://www.haskell.org/ghc/download.html + - '9.8' + - '9.6' + - '9.4' + - '9.2' + os: [ubuntu-latest, macOS-latest] + + steps: + - uses: actions/checkout@v3 + - uses: haskell/actions/setup@v2 # https://github.com/haskell/actions/tree/main/setup#haskellactionssetup + with: + ghc-version: ${{ matrix.ghc }} + + - name: Cabal cache + uses: actions/cache@v3 + env: + cache-name: cache-cabal + with: + path: ~/.cabal + key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }} + restore-keys: | + ${{ runner.os }}-build-${{ env.cache-name }}- + - name: Cabal update + run: cabal update + - name: Build using cabal + run: cabal build all + - name: Test + run: cabal test all diff --git a/.github/workflows/stack.yaml b/.github/workflows/stack.yaml deleted file mode 100644 index 548d0e13..00000000 --- a/.github/workflows/stack.yaml +++ /dev/null @@ -1,44 +0,0 @@ -name: Stack - -on: - pull_request: - push: - branches: - - master - -jobs: - build: - name: CI - runs-on: ${{ matrix.os }} - env: - STACK_ROOT: ${{ github.workspace }}/.stack - strategy: - fail-fast: false - matrix: - os: [ubuntu-latest, macos-latest, - # windows-latest # TODO add windows support - ] - resolver: [nightly, lts-19, lts-20] - - steps: - - name: Clone project - uses: actions/checkout@v2 - with: - submodules: 'true' - - - name: Cache dependencies - uses: actions/cache@v2 - with: - path: | - ~/.stack - ${{ github.workspace }}/.stack - key: ${{ runner.os }}-${{ matrix.resolver }}-haskell-${{ hashFiles('stack.yaml') }} - restore-keys: | - ${{ runner.os }}-${{ matrix.resolver }}-haskell- - - - name: Build and run tests - shell: bash - run: | - set -ex - curl -sSL https://get.haskellstack.org/ | sh -s - -f - stack test --fast --no-terminal --resolver=${{ matrix.resolver }} diff --git a/ChangeLog.md b/ChangeLog.md index 73647923..f76898e0 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -6,6 +6,8 @@ accidentally flipped. PR #282 * In case reading any one of `*-host-response-file` fails, keter now logs a warning, and falls back to builtin defaults. Before 2.1.3, this is a fatal error. +* Add support for tar 0.6, drop NIH tar unpack. ++ Change CI to be cabal based instead of stack. ## 2.1.2 diff --git a/keter.cabal b/keter.cabal index 119b49e2..624fddee 100644 --- a/keter.cabal +++ b/keter.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: keter -version: 2.1.2 +version: 2.1.3 synopsis: Web application deployment manager, focusing on Haskell web frameworks. It mitigates downtime. @@ -44,7 +44,7 @@ library containers >=0.6.4 && <0.7 || ^>=0.7, directory >=1.3.6 && <1.4, fast-logger >=3.0.0 && <4.0.0, - filepath >=1.4.2 && <1.5, + filepath >=1.4.2 && <1.6, fsnotify >=0.3.0 && <0.5, http-client >=0.7.11 && <0.8, http-conduit >=2.3.8 && <2.4, @@ -60,7 +60,7 @@ library random >=1.2.1 && <1.3, regex-tdfa >=1.3.1 && <1.4, stm >=2.5.0 && <2.6, - tar >=0.5.1 && <0.6, + tar >=0.5.1 && <0.7, template-haskell >=2.17.0 && <3.0, text >=1.2.5 && <3.0, time >=1.9.3 && <2.0, diff --git a/src/Keter/TempTarball.hs b/src/Keter/TempTarball.hs index 19da6675..c424b2a0 100644 --- a/src/Keter/TempTarball.hs +++ b/src/Keter/TempTarball.hs @@ -15,7 +15,7 @@ import qualified Codec.Archive.Tar.Check as Tar import qualified Codec.Archive.Tar.Entry as Tar import Codec.Compression.GZip (decompress) import Control.Exception (bracket, bracketOnError, throwIO) -import Control.Monad (unless, when) +import Control.Monad (unless, when, forM) import qualified Data.ByteString.Lazy as L import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import qualified Data.IORef as I @@ -67,51 +67,13 @@ unpackTempTar :: Maybe (UserID, GroupID) unpackTempTar muid tf bundle appname withDir = do lbs <- L.readFile bundle bracketOnError (getFolder muid tf appname) D.removeDirectoryRecursive $ \dir -> do - unpackTar muid dir $ Tar.read $ decompress lbs + D.createDirectoryIfMissing True dir + let entries = Tar.read $ decompress lbs + Tar.unpack dir entries + _ <- forM muid $ \perms -> + Tar.foldEntries (setEntryPermission perms) (pure ()) throwIO entries withDir dir -unpackTar :: Maybe (UserID, GroupID) - -> FilePath - -> Tar.Entries Tar.FormatError - -> IO () -unpackTar muid dir = - loop . Tar.checkSecurity - where - loop Tar.Done = return () - loop (Tar.Fail e) = either throwIO throwIO e - loop (Tar.Next e es) = go e >> loop es - - go e = do - let fp = dir Tar.entryPath e - case Tar.entryContent e of - Tar.NormalFile lbs _ -> do - case muid of - Nothing -> D.createDirectoryIfMissing True $ F.takeDirectory fp - Just (uid, gid) -> createTreeUID uid gid $ F.takeDirectory fp - let write fd bs = unsafeUseAsCStringLen bs $ \(ptr, len) -> do - _ <- fdWriteBuf fd (castPtr ptr) (fromIntegral len) - return () - bracket - (do - fd <- createFile fp $ Tar.entryPermissions e - setFdOption fd CloseOnExec True - case muid of - Nothing -> return () - Just (uid, gid) -> setFdOwnerAndGroup fd uid gid - return fd) - closeFd - (\fd -> mapM_ (write fd) (L.toChunks lbs)) - _ -> return () - --- | Create a directory tree, setting the uid and gid of all newly created --- folders. -createTreeUID :: UserID -> GroupID -> FilePath -> IO () -createTreeUID uid gid = - go - where - go fp = do - exists <- D.doesDirectoryExist fp - unless exists $ do - go $ F.takeDirectory fp - D.createDirectoryIfMissing False fp - setOwnerAndGroup fp uid gid +setEntryPermission :: (UserID, GroupID) -> Tar.Entry -> IO () -> IO () +setEntryPermission (uid, gid) entry io = + io >> setOwnerAndGroup (Tar.entryPath entry) uid gid