[darcs-users] [patch415] Replace tmp- prefixes with meta- in packs (and 7 more)
Petr Rockai
me at mornfall.net
Fri Oct 15 15:36:34 UTC 2010
Alexey Levan <bugs at darcs.net> writes:
> Wed Oct 6 07:33:45 EEST 2010 Alexey Levan <exlevan at gmail.com>
> * Improve getting of packed repositories
>
> In this patch the big (~ 100 lines) where clause of copyPackedRepository was
> splitted into a bunch of top-level definitions. Some of them were renamed to
> be more meaningful without context.
>
> Also, I wrote a general unpackTar function, which accepts meta- files anywhere
> in tarball, calling provided meta-handler function. It accepts a (stopCond ::
> FilePath -> Bool) argument, and stops unpacking if stop condition is True.
> This is made to make lazy get more efficient, as the inventory files in the
> basic tarball actually don't needed for lazy repo.
>
> This patch may resolve issue1910 (I haven't seen error messages for a while
> after writing this patch). This needs additional checking, though.
Presumably, this could still happen with full (as opposed to lazy) get,
but only in the rare circumstance that the cache thread beats the tar
thread even though not everything is cached (at least the missing
inventory file must not be in the cache for the error to happen).
> Sat Oct 9 12:16:40 EEST 2010 Alexey Levan <exlevan at gmail.com>
> * Make gzipped inventories parse correctly in readInventoryPrivate
>
> A small fix to read all inventories during 'optimize --http'. Without this
> change, readInventoryPrivate doesn't uncompress inventory files and stops
> reading them after the first one.
>
>
> Sat Oct 9 12:54:53 EEST 2010 Alexey Levan <exlevan at gmail.com>
> * Moved inventories to patches tarball
>
> To make lazy getting of optimized repositories simpler, 'optimize --http'
> creates two tarballs: basic.tar.gz, with inventory and pristine files, and
> patches.tar.gz, which contains patches. The idea was that to get lazy
> repository, you only need to download the basic tarball. It appears that for
> lazy repository, inventory files not needed, except of hashed_inventory. In
> this patch, optimize --http was changed to pack inventories into patches
> tarball instead, and getting functions were modified accordingly. Also,
> unpackTar was simplified: it no longer accept stop condition, as there's no
> need to stop unpacking in the middle anymore.
>
>
> Sat Oct 9 14:10:21 EEST 2010 Alexey Levan <exlevan at gmail.com>
> * Use custom HTTP request for fetchFileLazyPS
>
> fetchFileLazyPS, now with real laziness. (At cost of some code duplication).
>
>
> Sat Oct 9 15:02:09 EEST 2010 Alexey Levan <exlevan at gmail.com>
> * Add flag for using repository packs
>
> Two new flags for 'darcs get', --packs and --no-packs [DEFAULT].
>
Improve getting of packed repositories
--------------------------------------
> hunk ./src/Darcs/Repository.hs 90
> import Control.Applicative ( (<$>) )
> import Control.Exception ( finally )
> import Control.Concurrent ( forkIO )
> -import Control.Concurrent.MVar ( newEmptyMVar, putMVar, takeMVar )
> +import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar )
> import Control.Monad ( unless, when )
> import System.Directory ( createDirectory, renameDirectory,
> createDirectoryIfMissing, renameFile,
> hunk ./src/Darcs/Repository.hs 304
> Repo _ _ _ (DarcsRepository _ toCache3) <-
> identifyRepositoryFor toRepo "."
> -- unpack inventory & pristine cache
> + let isLazy = any (`elem` opts) [Partial, Lazy, Ephemeral]
> cleanDir "pristine.hashed"
> hunk ./src/Darcs/Repository.hs 306
> - procBasic toCache3 . Tar.read $ decompress b
> + removeFile $ darcsdir </> "hashed_inventory"
> + unpackBasic isLazy toCache3 . Tar.read $ decompress b
> createPristineDirectoryTree toRepo "."
> -- pull new patches
> us <- readRepo toRepo
> hunk ./src/Darcs/Repository.hs 321
> applyToWorking toRepo opts pw
> return ()
> -- get old patches
> - (do
> + unless isLazy $ (do
> cleanDir "patches"
> hunk ./src/Darcs/Repository.hs 323
> - unless (any (`elem` opts) [Partial, Lazy, Ephemeral]) $ do
> - putInfo opts $ text "Copying patches, to get lazy repository hit ctrl-C..."
> - mv <- newEmptyMVar
> - _ <- forkIO . flip finally (putMVar mv ()) .
> - fetchFiles toCache3 HashedPatchesDir . mapFL hashedPatchFileName $
> - newset2FL us
> - procPatches toCache3 . Tar.read . decompress =<<
> - fetchFileLazyPS (fromPacksDir ++ "patches.tar.gz") Uncachable
> - takeMVar mv) `catchInterrupt` (putInfo opts $ text "Using lazy repository.")
> + putInfo opts $ text "Copying patches, to get lazy repository hit ctrl-C..."
> + unpackPatches toCache3 (mapFL hashedPatchFileName $ newset2FL us) .
> + Tar.read . decompress =<< fetchFileLazyPS (fromPacksDir ++
> + "patches.tar.gz") Uncachable
> + ) `catchInterrupt` (putInfo opts $ text "Using lazy repository.")
> where
> hunk ./src/Darcs/Repository.hs 329
> - procBasic = procHashedInv
> - procPatches ca = procFiles $ cacheDir ca
> - procHashedInv _ Tar.Done = fail
> - "Unexpected end of file; hashed_inventory expected"
> - procHashedInv ca (Tar.Next x xs) = withTarFile x $ \p c ->
> - if "hashed_inventory" == takeFileName p
> - then do
> - writeFile' Nothing p c
> - procTmp ca xs
> - else fail $ "Unexpected file: " ++ takeFileName p ++
> - "\nhashed_inventory expected"
> - procHashedInv _ (Tar.Fail e) = fail e
> - procTmp _ Tar.Done = return ()
> - procTmp ca xxs@(Tar.Next x xs) = withTarFile x $ \p c ->
> + cleanDir d = mapM_ (\x -> removeFile $ darcsdir </> d </> x) .
> + filter (\x -> head x /= '.') =<< getDirectoryContents (darcsdir </> d)
> +
> +withControlMVar :: (MVar () -> IO ()) -> IO ()
> +withControlMVar f = do
> + mv <- newMVar ()
> + f mv
> + takeMVar mv
> +
> +forkWithControlMVar :: MVar () -> IO () -> IO ()
> +forkWithControlMVar mv f = do
> + takeMVar mv
> + _ <- forkIO $ flip finally (putMVar mv ()) f
> + return ()
Could these two go into some more general place? And, more importantly,
get some haddocks? : - )
> +removeMetaFiles :: IO ()
> +removeMetaFiles = mapM_ (removeFile . (darcsdir </>)) .
> + filter ("meta-" `isPrefixOf`) =<< getDirectoryContents darcsdir
> +
> +unpackBasic :: Bool -> Cache -> Tar.Entries -> IO ()
> +unpackBasic isLazy c x = do
> + withControlMVar $ \mv -> unpackTar (\y -> isLazy && (darcsdir </>
> + "inventories") `isPrefixOf` y) c (basicMetaHandler isLazy c mv) x
> + removeMetaFiles
> +
> +unpackPatches :: Cache -> [String] -> Tar.Entries -> IO ()
> +unpackPatches c ps x = do
> + withControlMVar $ \mv -> do
> + forkWithControlMVar mv $ fetchFilesUsingCache c HashedPatchesDir ps
> + unpackTar (const False) c (return ()) x
> + removeMetaFiles
> +
> +unpackTar :: (FilePath -> Bool) -> Cache -> IO () -> Tar.Entries -> IO ()
> +unpackTar _ _ _ Tar.Done = return ()
> +unpackTar _ _ _ (Tar.Fail e)= fail e
> +unpackTar stopCond c mh (Tar.Next x xs) = case Tar.entryContent x of
> + Tar.NormalFile x' _ -> do
> + let p = Tar.entryPath x
> if "meta-" `isPrefixOf` takeFileName p
> then do
> hunk ./src/Darcs/Repository.hs 369
> - BL.writeFile p c
> - procTmp ca xs
> - else do
> - ex <- and <$> mapM doesFileExist
> - [ darcsdir </> "meta-filelist-pristine"
> - , darcsdir </> "meta-filelist-inventories"
> - ]
> + BL.writeFile p x'
> + mh
> + unpackTar stopCond c mh xs
> + else when (not $ stopCond p) $ do
> + ex <- doesFileExist p
> if ex
> hunk ./src/Darcs/Repository.hs 375
> - then do
> - mv <- newEmptyMVar
> - _ <- forkIO . flip finally (putMVar mv ()) $ do
> - fetchFiles ca HashedInventoriesDir . lines =<<
> - readFile (darcsdir </> "meta-filelist-inventories")
> - fetchFiles ca HashedPristineDir . lines =<<
> - readFile (darcsdir </> "meta-filelist-pristine")
> - procFiles (cacheDir ca) xxs
> - takeMVar mv
> - else procFiles (cacheDir ca) xxs
> - mapM_ removeFile . (map (darcsdir </>)) .
> - filter (("meta-" `isPrefixOf`) . takeFileName) =<<
> - getDirectoryContents darcsdir
> - procTmp _ (Tar.Fail e) = fail e
> - procFiles _ Tar.Done = return ()
> - procFiles ca (Tar.Next x xs) = withTarFile x $ \p c -> do
> - ex <- doesFileExist p
> - if ex
> - then debugMessage $ "Tar thread: STOP " ++ p
> - else do
> - writeFile' ca p $ compress c
> - debugMessage $ "Tar thread: GET " ++ p
> - procFiles ca xs
> - procFiles _ (Tar.Fail e) = fail e
> - withTarFile x f = case Tar.entryContent x of
> - Tar.NormalFile x' _ -> f (Tar.entryPath x) x'
> - _ -> fail "Unexpected non-file tar entry"
> + then debugMessage $ "Tar thread: STOP " ++ p
> + else do
> + if p == darcsdir </> "hashed_inventory"
> + then writeFile' Nothing p x'
> + else writeFile' (cacheDir c) p $ compress x'
> + debugMessage $ "Tar thread: GET " ++ p
> + unpackTar stopCond c mh xs
> + _ -> fail "Unexpected non-file tar entry"
> + where
> writeFile' Nothing z y = withTemp $ \x' -> do
> BL.writeFile x' y
> renameFile x' z
> hunk ./src/Darcs/Repository.hs 399
> createLink' z y = do
> createDirectoryIfMissing True $ takeDirectory y
> createLink z y `catchall` return ()
> - fetchFiles _ _ [] = return ()
> - fetchFiles c d (f:fs) = do
> - ex <- doesFileExist $ darcsdir </> hashedDir d </> f
> - if ex
> - then debugMessage $ "Cache thread: STOP " ++
> - (darcsdir </> hashedDir d </> f)
> - else do
> - debugMessage $ "Cache thread: GET " ++
> - (darcsdir </> hashedDir d </> f)
> - fetchFileUsingCache c d f
> - fetchFiles c d fs
> - hashedPatchFileName x = case extractHash x of
> - Left _ -> fail "unexpected unhashed patch"
> - Right h -> h
> - cacheDir (Ca cs) = let
> - cs' = catMaybes . flip map cs $ \x -> case x of
> - Cache Directory Writable x' -> Just x'
> - _ -> Nothing
> - in
> - if not (null cs') then Just (head cs') else Nothing
> - cleanDir d = mapM_ (\x -> removeFile $ darcsdir </> d </> x) .
> - filter (\x -> head x /= '.') =<< getDirectoryContents (darcsdir </> d)
> +
> +basicMetaHandler :: Bool -> Cache -> MVar () -> IO ()
> +basicMetaHandler isLazy ca mv = do
> + ex <- and <$> mapM doesFileExist
> + [ darcsdir </> "meta-filelist-pristine"
> + , darcsdir </> "meta-filelist-inventories"
> + ]
> + when ex . forkWithControlMVar mv $ do
> + unless isLazy $ fetchFilesUsingCache ca HashedInventoriesDir . lines =<<
> + readFile (darcsdir </> "meta-filelist-inventories")
> + fetchFilesUsingCache ca HashedPristineDir . lines =<<
> + readFile (darcsdir </> "meta-filelist-pristine")
> + return ()
> +
> +cacheDir :: Cache -> Maybe String
> +cacheDir (Ca cs) = safeHead . catMaybes .flip map cs $ \x -> case x of
> + Cache Directory Writable x' -> Just x'
> + _ -> Nothing
> +
> +safeHead :: [a] -> Maybe a
> +safeHead [] = Nothing
> +safeHead (x:_) = Just x
Another two candidates for lifting out of the module.
> +hashedPatchFileName :: PatchInfoAnd p C(a b) -> String
> +hashedPatchFileName x = case extractHash x of
> + Left _ -> fail "unexpected unhashed patch"
> + Right h -> h
And maybe another, although I'm not sure where it would go...
> hunk ./src/Darcs/Repository.hs 427
> + -- | fetchFilesUsingCache is similar to mapM fetchFileUsingCache, exepts
> + -- it stops execution if file it's going to fetch already exists.
> +fetchFilesUsingCache :: Cache -> HashedDir -> [FilePath] -> IO ()
> +fetchFilesUsingCache _ _ [] = return ()
> +fetchFilesUsingCache c d (f:fs) = do
> + ex <- doesFileExist $ darcsdir </> hashedDir d </> f
> + if ex
> + then debugMessage $ "Cache thread: STOP " ++
> + (darcsdir </> hashedDir d </> f)
> + else do
> + debugMessage $ "Cache thread: GET " ++
> + (darcsdir </> hashedDir d </> f)
> + fetchFileUsingCache c d f
> + fetchFilesUsingCache c d fs
OK.
Make gzipped inventories parse correctly in readInventoryPrivate
----------------------------------------------------------------
> hunk ./src/Darcs/Repository/HashedRepo.hs 74
> import Printer ( Doc, hcat, (<>), ($$), renderString, renderPS, text, invisiblePS )
> import Darcs.ColorPrinter () -- for instance Show Doc
> import Crypt.SHA256 ( sha256sum )
> -import Darcs.External ( copyFileOrUrl, cloneFile, fetchFilePS, Cachable( Uncachable ) )
> +import Darcs.External ( copyFileOrUrl, cloneFile, fetchFilePS, gzFetchFilePS,
> + Cachable( Uncachable ) )
> import Darcs.Lock ( writeBinFile, writeDocBinFile, writeAtomicFilePS, appendBinFile, appendDocBinFile )
> import Darcs.Utils ( withCurrentDirectory )
> import Progress ( beginTedious, endTedious, debugMessage, finishedOneIO )
> hunk ./src/Darcs/Repository/HashedRepo.hs 383
>
> readInventoryPrivate :: Cache -> String -> String -> IO (Maybe String, [(PatchInfo, String)])
> readInventoryPrivate _ d iname = do
> - i <- skipPristine `fmap` fetchFilePS (d </> iname) Uncachable
> + i <- skipPristine `fmap` gzFetchFilePS (d </> iname) Uncachable
> (rest,str) <- case BC.break ((==)'\n') i of
> (swt,pistr) | swt == BC.pack "Starting with inventory:" ->
> case BC.break ((==)'\n') $ B.tail pistr of
Ack.
Moved inventories to patches tarball
------------------------------------
> hunk ./src/Darcs/Commands/Optimize.lhs 385
> "Unsupported repository format:\n" ++
> " only hashed repositories can be optimized for HTTP"
> createDirectoryIfMissing False packsDir
> + -- pack patchesTar
> ps <- mapRL hashedPatchFileName . newset2RL <$> readRepo repo
> hunk ./src/Darcs/Commands/Optimize.lhs 387
> - BL.writeFile (patchesTar <.> "part") . compress . write =<<
> - mapM fileEntry' ps
> - renameFile (patchesTar <.> "part") patchesTar
> is <- map ((darcsdir </> "inventories") </>) <$> HashedRepo.listInventories
> writeFile (darcsdir </> "meta-filelist-inventories") . unlines $
> map takeFileName is
> hunk ./src/Darcs/Commands/Optimize.lhs 390
> + BL.writeFile (patchesTar <.> "part") . compress . write =<<
> + mapM fileEntry' ((darcsdir </> "meta-filelist-inventories") : ps ++
> + reverse is)
> + renameFile (patchesTar <.> "part") patchesTar
> + -- pack basicTar
> pr <- sortByMTime =<< dirContents "pristine.hashed"
> writeFile (darcsdir </> "meta-filelist-pristine") . unlines $
> map takeFileName pr
> hunk ./src/Darcs/Commands/Optimize.lhs 399
> BL.writeFile (basicTar <.> "part") . compress . write =<< mapM fileEntry' (
> - [ darcsdir </> "hashed_inventory"
> - , darcsdir </> "meta-filelist-pristine"
> - , darcsdir </> "meta-filelist-inventories"
> - ] ++ reverse pr ++ reverse is)
> + [ darcsdir </> "meta-filelist-pristine"
> + , darcsdir </> "hashed_inventory"
> + ] ++ reverse pr)
> renameFile (basicTar <.> "part") basicTar
> where
> packsDir = darcsdir </> "packs"
> hunk ./src/Darcs/Repository.hs 307
> let isLazy = any (`elem` opts) [Partial, Lazy, Ephemeral]
> cleanDir "pristine.hashed"
> removeFile $ darcsdir </> "hashed_inventory"
> - unpackBasic isLazy toCache3 . Tar.read $ decompress b
> + unpackBasic toCache3 . Tar.read $ decompress b
> createPristineDirectoryTree toRepo "."
> -- pull new patches
> us <- readRepo toRepo
> hunk ./src/Darcs/Repository.hs 348
> removeMetaFiles = mapM_ (removeFile . (darcsdir </>)) .
> filter ("meta-" `isPrefixOf`) =<< getDirectoryContents darcsdir
>
> -unpackBasic :: Bool -> Cache -> Tar.Entries -> IO ()
> -unpackBasic isLazy c x = do
> - withControlMVar $ \mv -> unpackTar (\y -> isLazy && (darcsdir </>
> - "inventories") `isPrefixOf` y) c (basicMetaHandler isLazy c mv) x
> +unpackBasic :: Cache -> Tar.Entries -> IO ()
> +unpackBasic c x = do
> + withControlMVar $ \mv -> unpackTar c (basicMetaHandler c mv) x
> removeMetaFiles
>
> unpackPatches :: Cache -> [String] -> Tar.Entries -> IO ()
> hunk ./src/Darcs/Repository.hs 355
> unpackPatches c ps x = do
> - withControlMVar $ \mv -> do
> - forkWithControlMVar mv $ fetchFilesUsingCache c HashedPatchesDir ps
> - unpackTar (const False) c (return ()) x
> + withControlMVar $ \mv -> unpackTar c (patchesMetaHandler c ps mv) x
> removeMetaFiles
>
> hunk ./src/Darcs/Repository.hs 358
> -unpackTar :: (FilePath -> Bool) -> Cache -> IO () -> Tar.Entries -> IO ()
> -unpackTar _ _ _ Tar.Done = return ()
> -unpackTar _ _ _ (Tar.Fail e)= fail e
> -unpackTar stopCond c mh (Tar.Next x xs) = case Tar.entryContent x of
> +unpackTar :: Cache -> IO () -> Tar.Entries -> IO ()
> +unpackTar _ _ Tar.Done = return ()
> +unpackTar _ _ (Tar.Fail e)= fail e
> +unpackTar c mh (Tar.Next x xs) = case Tar.entryContent x of
> Tar.NormalFile x' _ -> do
> let p = Tar.entryPath x
> if "meta-" `isPrefixOf` takeFileName p
> hunk ./src/Darcs/Repository.hs 368
> then do
> BL.writeFile p x'
> mh
> - unpackTar stopCond c mh xs
> - else when (not $ stopCond p) $ do
> + unpackTar c mh xs
> + else do
> ex <- doesFileExist p
> if ex
> then debugMessage $ "Tar thread: STOP " ++ p
> hunk ./src/Darcs/Repository.hs 378
> then writeFile' Nothing p x'
> else writeFile' (cacheDir c) p $ compress x'
> debugMessage $ "Tar thread: GET " ++ p
> - unpackTar stopCond c mh xs
> + unpackTar c mh xs
> _ -> fail "Unexpected non-file tar entry"
> where
> writeFile' Nothing z y = withTemp $ \x' -> do
> hunk ./src/Darcs/Repository.hs 397
> createDirectoryIfMissing True $ takeDirectory y
> createLink z y `catchall` return ()
>
> -basicMetaHandler :: Bool -> Cache -> MVar () -> IO ()
> -basicMetaHandler isLazy ca mv = do
> - ex <- and <$> mapM doesFileExist
> - [ darcsdir </> "meta-filelist-pristine"
> - , darcsdir </> "meta-filelist-inventories"
> - ]
> - when ex . forkWithControlMVar mv $ do
> - unless isLazy $ fetchFilesUsingCache ca HashedInventoriesDir . lines =<<
> - readFile (darcsdir </> "meta-filelist-inventories")
> +basicMetaHandler :: Cache -> MVar () -> IO ()
> +basicMetaHandler ca mv = do
> + ex <- doesFileExist $ darcsdir </> "meta-filelist-pristine"
> + when ex . forkWithControlMVar mv $
> fetchFilesUsingCache ca HashedPristineDir . lines =<<
> readFile (darcsdir </> "meta-filelist-pristine")
> return ()
> hunk ./src/Darcs/Repository.hs 404
> +
> +patchesMetaHandler :: Cache -> [String] -> MVar () -> IO ()
> +patchesMetaHandler ca ps mv = do
> + ex <- doesFileExist $ darcsdir </> "meta-filelist-inventories"
> + when ex $ do
> + forkWithControlMVar mv $ fetchFilesUsingCache ca HashedPristineDir .
> + lines =<< readFile (darcsdir </> "meta-filelist-inventories")
> + forkWithControlMVar mv $ fetchFilesUsingCache ca HashedPatchesDir ps
> + return ()
>
> cacheDir :: Cache -> Maybe String
> cacheDir (Ca cs) = safeHead . catMaybes .flip map cs $ \x -> case x of
Looks OK to me.
Use custom HTTP request for fetchFileLazyPS
-------------------------------------------
> hunk ./src/Darcs/External.hs 78
> simplePrinters,
> text, empty, packedString, vcat, renderString )
> import Darcs.Email ( formatHeader )
> +import Network.Browser ( browse, request, setErrHandler, setOutHandler
> + , setAllowRedirects )
> +import Network.HTTP ( RequestMethod(GET), rspCode, rspBody, rspReason
> + , mkRequest )
> +import Network.URI ( parseURI, uriScheme )
>
> sendmailPath :: IO String
> sendmailPath = do
> hunk ./src/Darcs/External.hs 154
> -- make sure to force consumption of file contents to avoid that. See
> -- "fetchFilePS" for details.
> fetchFileLazyPS :: String -> Cachable -> IO BL.ByteString
> -fetchFileLazyPS = copyAndReadFile BL.readFile
> +fetchFileLazyPS x c = case parseURI x of
> + Just x' | uriScheme x' == "http:" -> do
> + rsp <- fmap snd . browse $ do
> + setErrHandler . const $ return ()
> + setOutHandler . const $ return ()
> + setAllowRedirects True
> + request $ mkRequest GET x'
> + if rspCode rsp /= (2, 0, 0)
> + then fail $ "fetchFileLazyPS: " ++ rspReason rsp
> + else return $ rspBody rsp
> + _ -> copyAndReadFile BL.readFile x c
Looks OK. Hooray for real laziness here (should make get with --packs
behave a lot better).
Add flag for using repository packs
-----------------------------------
Would it be better to have --use-packs instead of just --packs? Sounds a
bit clearer to me, although I am not quite sure. Eric?
> hunk ./src/Darcs/Arguments.lhs 88
> networkOptions, noCache,
> allowUnrelatedRepos,
> checkOrRepair, justThisRepo, optimizePristine,
> - optimizeHTTP, getOutput, makeScriptsExecutable
> + optimizeHTTP, getOutput, makeScriptsExecutable,
> + usePacks
> ) where
> import System.Console.GetOpt
> import System.Directory ( doesDirectoryExist )
> hunk ./src/Darcs/Arguments.lhs 311
> getContent StoreInMemory = NoContent
> getContent ApplyOnDisk = NoContent
> getContent NoHTTPPipelining = NoContent
> +getContent Packs = NoContent
> +getContent NoPacks = NoContent
> getContent NoCache = NoContent
> getContent NullFlag = NoContent
> getContent (PrehookCmd s) = StringContent s
> hunk ./src/Darcs/Arguments.lhs 1718
> optimizeHTTP = DarcsSingleOption $
> DarcsNoArgOption [] ["http"] OptimizeHTTP
> "optimize repository for getting over network"
> +
> +usePacks :: DarcsOption
> +usePacks = DarcsMultipleChoiceOption
> + [ DarcsNoArgOption [] ["packs"] Packs "use repository packs"
> + , DarcsNoArgOption [] ["no-packs"] NoPacks
> + "don't use repository packs [DEFAULT]"
> + ]
> \end{code}
> \begin{options}
> --umask
> hunk ./src/Darcs/Commands/Get.lhs 38
> getContext, getInventoryChoices,
> partial, reponame,
> matchOneContext, setDefault, setScriptsExecutableOption,
> - networkOptions, makeScriptsExecutable )
> + networkOptions, makeScriptsExecutable, usePacks )
> import Darcs.Repository ( Repository, withRepository, ($-), withRepoLock, identifyRepositoryFor, readRepo,
> createPristineDirectoryTree,
> tentativelyRemovePatches, patchSetToRepository,
> hunk ./src/Darcs/Commands/Get.lhs 130
> commandPrereq = contextExists,
> commandGetArgPossibilities = return [],
> commandArgdefaults = nodefaults,
> - commandAdvancedOptions = networkOptions ++
> + commandAdvancedOptions = networkOptions ++ usePacks :
> commandAdvancedOptions initialize,
> commandBasicOptions = [reponame,
> partial,
> hunk ./src/Darcs/Flags.hs 104
> | UMask String
> | StoreInMemory | ApplyOnDisk
> | NoHTTPPipelining
> + | Packs | NoPacks
> | NoCache
> | AllowUnrelatedRepos
> | Check | Repair | JustThisRepo
> hunk ./src/Darcs/Repository.hs 128
> import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..), flipSeal, mapFlipped )
>
> import Darcs.Flags ( DarcsFlag( Quiet, Partial, Lazy, Ephemeral, Complete,
> - AllowUnrelatedRepos, NoUpdateWorking )
> + AllowUnrelatedRepos, NoUpdateWorking,
> + Packs, NoPacks )
> , compression, UseIndex(..), ScanKnown(..), remoteDarcs )
> import Darcs.Global ( darcsdir )
> import Darcs.URL ( isFile )
> hunk ./src/Darcs/Repository.hs 255
> debugMessage "Copying prefs"
> copyFileOrUrl (remoteDarcs opts) (fromDir ++ "/" ++ darcsdir ++ "/prefs/prefs")
> (darcsdir ++ "/prefs/prefs") (MaxAge 600) `catchall` return ()
> - if isFile fromDir
> + if isFile fromDir && Packs `elem` opts && NoPacks `notElem` opts
This *might* be a bit overshooting it. We nub the options, so that only
one of Packs or NoPacks might end up there, so only checking for Packs
should (in theory) work. I haven't checked though. This is probably
safe, if a bit bulky.
> then copyNotPackedRepository fromRepo
> else do
> b <- (Just <$> fetchFileLazyPS (fromDir ++ "/" ++ darcsdir ++
> hunk ./tests/get-http-packed.sh 27
> cd ..
>
> serve_http # sets baseurl
> -darcs get $baseurl/R S
> +darcs get --packs $baseurl/R S
> cd S
> rm _darcs/prefs/sources # avoid any further contact with the original repository
> darcs check
OK.
Yours,
Petr.
More information about the darcs-users
mailing list