31a38f8468
Since old ones had a buggy git bundle command. In particular, git 2.30.2 has a git bundle that supports --stdin, but does not read from it, and so fails to create a bundle. While not using --stdin would perhaps work, it limits the number of revs that get included in the bundle to the command line length limit. But the real kicker is that at the same time --stdin got fixed, a bug also got fixed that made git bundle skip including refs when they had the same sha as other refs it included. Which would lead to data loss. So best to avoid that buggy thing.
74 lines
2.1 KiB
Haskell
74 lines
2.1 KiB
Haskell
{- git bundles
|
|
-
|
|
- Copyright 2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Git.Bundle where
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Command
|
|
import qualified Git.Version
|
|
|
|
import Data.Char (ord)
|
|
import qualified Data.ByteString.Char8 as S8
|
|
|
|
-- Older versions of git had a git bundle command that sometimes omitted
|
|
-- refs, and that did not properly support --stdin.
|
|
versionSupported :: IO Bool
|
|
versionSupported = not <$> Git.Version.older "2.31"
|
|
|
|
listHeads :: FilePath -> Repo -> IO [(Sha, Ref)]
|
|
listHeads bundle repo = map gen . S8.lines <$>
|
|
pipeReadStrict [Param "bundle", Param "list-heads", File bundle] repo
|
|
where
|
|
gen l = let (s, r) = separate' (== fromIntegral (ord ' ')) l
|
|
in (Ref s, Ref r)
|
|
|
|
unbundle :: FilePath -> Repo -> IO ()
|
|
unbundle bundle = runQuiet [Param "bundle", Param "unbundle", File bundle]
|
|
|
|
-- Specifies what to include in the bundle.
|
|
data BundleSpec = BundleSpec
|
|
{ preRequisiteRef :: Maybe Ref
|
|
-- ^ Do not include this Ref, or any objects reachable from it
|
|
-- in the bundle. This should be an ancestor of the includeRef.
|
|
, includeRef :: Ref
|
|
-- ^ Include this Ref and objects reachable from it in the bundle,
|
|
-- unless filtered out by the preRequisiteRef of this BundleSpec
|
|
-- or any other one that is included in the bundle.
|
|
}
|
|
deriving (Show)
|
|
|
|
-- Include the ref and all objects reachable from it in the bundle.
|
|
-- (Unless another BundleSpec is included that has a preRequisiteRef
|
|
-- that filters out the ref or other objects.)
|
|
fullBundleSpec :: Ref -> BundleSpec
|
|
fullBundleSpec r = BundleSpec
|
|
{ preRequisiteRef = Nothing
|
|
, includeRef = r
|
|
}
|
|
|
|
create :: FilePath -> [BundleSpec] -> Repo -> IO ()
|
|
create bundle revs repo = pipeWrite
|
|
[ Param "bundle"
|
|
, Param "create"
|
|
, Param "--quiet"
|
|
, File bundle
|
|
, Param "--stdin"
|
|
] repo writer
|
|
where
|
|
writer h = do
|
|
forM_ revs $ \bs ->
|
|
case preRequisiteRef bs of
|
|
Nothing -> S8.hPutStrLn h $
|
|
fromRef' (includeRef bs)
|
|
Just pr -> S8.hPutStrLn h $
|
|
fromRef' pr
|
|
<> ".." <>
|
|
fromRef' (includeRef bs)
|
|
hClose h
|