diff --git a/Annex/Export.hs b/Annex/Export.hs --- a/Annex/Export.hs +++ b/Annex/Export.hs @@ -31,7 +31,7 @@ where mk (Just k) = AnnexKey k mk Nothing = GitKey $ Key - { keyName = show sha + { keyName = Git.fromRef sha , keyVariety = SHA1Key (HasExt False) , keySize = Nothing , keyMtime = Nothing diff --git a/Assistant/Install.hs b/Assistant/Install.hs --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -22,9 +22,6 @@ import Utility.OSX #else import Utility.FreeDesktop -#ifdef linux_HOST_OS -import Utility.UserInfo -#endif import Assistant.Install.Menu #endif @@ -106,7 +103,6 @@ genNautilusScript nautilusScriptdir -- KDE - home <- myHomeDir userdata <- userDataDir let kdeServiceMenusdir = userdata "kservices5" "ServiceMenus" createDirectoryIfMissing True kdeServiceMenusdir diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,19 @@ +git-annex (6.20171109) unstable; urgency=medium + + * Fix export of subdir of a branch. + * Fix exporting of non-annexed files to external special remotes. + * unlock, lock: Support --json. + * When there are multiple urls for a file, still treat it as being present + in the web when some urls don't work, as long as at least one url does + work. + * Makefile improvement for sudo make install. + Thanks, Eric Siegerman + * Makefile improvement for BUILDER=stack, use stack to run ghc. + * testremote: Test exporttree. + * Fix directory special remote's cleanup of empty export directories. + + -- Joey Hess Thu, 09 Nov 2017 12:21:49 -0400 + git-annex (6.20171026) unstable; urgency=medium * Windows: Fix reversion that caused the path used to link diff --git a/Command/Lock.hs b/Command/Lock.hs --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -23,7 +23,7 @@ import Git.FilePath cmd :: Command -cmd = notDirect $ withGlobalOptions annexedMatchingOptions $ +cmd = notDirect $ withGlobalOptions (jsonOption : annexedMatchingOptions) $ command "lock" SectionCommon "undo unlock command" paramPaths (withParams seek) diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -21,6 +21,8 @@ import Utility.DataUnits import Utility.CopyFile import Types.Messages +import Types.Export +import Remote.Helper.Export import Remote.Helper.Chunked import Git.Types @@ -57,21 +59,24 @@ start :: Int -> RemoteName -> CommandStart start basesz name = do showStart "testremote" name - r <- either giveup id <$> Remote.byName' name - showAction "generating test keys" fast <- Annex.getState Annex.fast - ks <- mapM randKey (keySizes basesz fast) + r <- either giveup disableExportTree =<< Remote.byName' name rs <- catMaybes <$> mapM (adjustChunkSize r) (chunkSizes basesz fast) rs' <- concat <$> mapM encryptionVariants rs unavailrs <- catMaybes <$> mapM Remote.mkUnavailable [r] - next $ perform rs' unavailrs ks + exportr <- exportTreeVariant r + showAction "generating test keys" + ks <- mapM randKey (keySizes basesz fast) + next $ perform rs' unavailrs exportr ks -perform :: [Remote] -> [Remote] -> [Key] -> CommandPerform -perform rs unavailrs ks = do +perform :: [Remote] -> [Remote] -> Maybe Remote -> [Key] -> CommandPerform +perform rs unavailrs exportr ks = do + ea <- maybe exportUnsupported Remote.exportActions exportr st <- Annex.getState id let tests = testGroup "Remote Tests" $ concat [ [ testGroup "unavailable remote" (testUnavailable st r (Prelude.head ks)) | r <- unavailrs ] , [ testGroup (desc r k) (test st r k) | k <- ks, r <- rs ] + , [ testGroup (descexport k1 k2) (testExportTree st exportr ea k1 k2) | k1 <- take 2 ks, k2 <- take 2 (reverse ks) ] ] ok <- case tryIngredients [consoleTestReporter] mempty tests of Nothing -> error "No tests found!?" @@ -83,6 +88,11 @@ , [ show (getChunkConfig (Remote.config r')) ] , ["encryption", fromMaybe "none" (M.lookup "encryption" (Remote.config r'))] ] + descexport k1 k2 = intercalate "; " $ map unwords + [ [ "exporttree=yes" ] + , [ "key1 size", show (keySize k1) ] + , [ "key2 size", show (keySize k2) ] + ] adjustChunkSize :: Remote -> Int -> Annex (Maybe Remote) adjustChunkSize r chunksize = adjustRemoteConfig r @@ -98,6 +108,19 @@ M.insert "highRandomQuality" "false" return $ catMaybes [noenc, sharedenc] +-- Variant of a remote with exporttree disabled. +disableExportTree :: Remote -> Annex Remote +disableExportTree r = maybe (error "failed disabling exportreee") return + =<< adjustRemoteConfig r (M.delete "exporttree") + +-- Variant of a remote with exporttree enabled. +exportTreeVariant :: Remote -> Annex (Maybe Remote) +exportTreeVariant r = ifM (Remote.isExportSupported r) + ( adjustRemoteConfig r $ + M.insert "encryption" "none" . M.insert "exporttree" "yes" + , return Nothing + ) + -- Regenerate a remote with a modified config. adjustRemoteConfig :: Remote -> (Remote.RemoteConfig -> Remote.RemoteConfig) -> Annex (Maybe Remote) adjustRemoteConfig r adjustconfig = Remote.generate (Remote.remotetype r) @@ -159,6 +182,50 @@ dest nullMeterUpdate store = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate remove = Remote.removeKey r k + +testExportTree :: Annex.AnnexState -> Maybe Remote -> Remote.ExportActions Annex -> Key -> Key -> [TestTree] +testExportTree _ Nothing _ _ _ = [] +testExportTree st (Just _) ea k1 k2 = + [ check "check present export when not present" $ + not <$> checkpresentexport k1 + , check "remove export when not present" (removeexport k1) + , check "store export" (storeexport k1) + , check "check present export after store" $ + checkpresentexport k1 + , check "store export when already present" (storeexport k1) + , check "retrieve export" (retrieveexport k1) + , check "store new content to export" (storeexport k2) + , check "check present export after store of new content" $ + checkpresentexport k2 + , check "retrieve export new content" (retrieveexport k2) + , check "remove export" (removeexport k2) + , check "check present export after remove" $ + not <$> checkpresentexport k2 + , check "retrieve export fails after removal" $ + not <$> retrieveexport k2 + , check "remove export directory" removeexportdirectory + , check "remove export directory that is already removed" removeexportdirectory + -- renames are not tested because remotes do not need to support them + ] + where + testexportdirectory = "testremote-export" + testexportlocation = mkExportLocation (testexportdirectory "location") + check desc a = testCase desc $ + Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed" + storeexport k = do + loc <- Annex.calcRepo (gitAnnexLocation k) + Remote.storeExport ea loc k testexportlocation nullMeterUpdate + retrieveexport k = withTmpFile "exported" $ \tmp h -> do + liftIO $ hClose h + ifM (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) + ( verifyKeyContent AlwaysVerify UnVerified k tmp + , return False + ) + checkpresentexport k = Remote.checkPresentExport ea k testexportlocation + removeexport k = Remote.removeExport ea k testexportlocation + removeexportdirectory = case Remote.removeExportDirectory ea of + Nothing -> return True + Just a -> a (mkExportDirectory testexportdirectory) testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree] testUnavailable st r k = diff --git a/Command/Unlock.hs b/Command/Unlock.hs --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -26,7 +26,7 @@ editcmd = mkcmd "edit" "same as unlock" mkcmd :: String -> String -> Command -mkcmd n d = notDirect $ withGlobalOptions annexedMatchingOptions $ +mkcmd n d = notDirect $ withGlobalOptions (jsonOption : annexedMatchingOptions) $ command n SectionCommon d paramPaths (withParams seek) seek :: CmdParams -> CommandSeek diff --git a/Git/Ref.hs b/Git/Ref.hs --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -136,8 +136,13 @@ {- Gets the sha of the tree a ref uses. -} tree :: Ref -> Repo -> IO (Maybe Sha) -tree ref = extractSha <$$> pipeReadStrict - [ Param "rev-parse", Param (fromRef ref ++ ":") ] +tree (Ref ref) = extractSha <$$> pipeReadStrict + [ Param "rev-parse", Param ref' ] + where + ref' = if ":" `isInfixOf` ref + then ref + -- de-reference commit objects to the tree + else ref ++ ":" {- Checks if a String is a legal git ref name. - diff --git a/Logs/UUID.hs b/Logs/UUID.hs --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -16,7 +16,6 @@ module Logs.UUID ( uuidLog, describeUUID, - recordUUID, uuidMap, uuidMapLoad ) where @@ -67,15 +66,6 @@ newertime (LogEntry Unknown _) = VectorClock minimumPOSIXTimeSlice minimumPOSIXTimeSlice = 0.000001 isuuid s = length s == 36 && length (splitc '-' s) == 5 - -{- Records the uuid in the log, if it's not already there. -} -recordUUID :: UUID -> Annex () -recordUUID u = go . M.lookup u =<< uuidMap - where - go (Just "") = set - go Nothing = set - go _ = noop - set = describeUUID u "" {- The map is cached for speed. -} uuidMap :: Annex UUIDMap diff --git a/Remote/Directory.hs b/Remote/Directory.hs --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -276,10 +276,11 @@ exportPath :: FilePath -> ExportLocation -> FilePath exportPath d loc = d fromExportLocation loc -{- Removes the ExportLocation directory and its parents, so long as +{- Removes the ExportLocation's parent directory and its parents, so long as - they're empty, up to but not including the topdir. -} removeExportLocation :: FilePath -> ExportLocation -> IO () -removeExportLocation topdir loc = go (Just $ fromExportLocation loc) (Right ()) +removeExportLocation topdir loc = + go (Just $ takeDirectory $ fromExportLocation loc) (Right ()) where go _ (Left _e) = return () go Nothing _ = return () diff --git a/Remote/Web.hs b/Remote/Web.hs --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -119,8 +119,8 @@ firsthit (u:rest) _ a = do r <- a u case r of - Right _ -> return r - Left _ -> firsthit rest r a + Right True -> return r + _ -> firsthit rest r a getWebUrls :: Key -> Annex [URLString] getWebUrls key = filter supported <$> getUrls key diff --git a/doc/git-annex-lock.mdwn b/doc/git-annex-lock.mdwn --- a/doc/git-annex-lock.mdwn +++ b/doc/git-annex-lock.mdwn @@ -18,6 +18,11 @@ The [[git-annex-matching-options]](1) can be used to specify files to lock. +* `--json` + + Enable JSON output. This is intended to be parsed by programs that use + git-annex. Each line of output is a JSON object. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-test.mdwn b/doc/git-annex-test.mdwn --- a/doc/git-annex-test.mdwn +++ b/doc/git-annex-test.mdwn @@ -29,6 +29,8 @@ [[git-annex]](1) +[[git-annex-testremote]](1) + # AUTHOR Joey Hess diff --git a/doc/git-annex-testremote.mdwn b/doc/git-annex-testremote.mdwn --- a/doc/git-annex-testremote.mdwn +++ b/doc/git-annex-testremote.mdwn @@ -14,10 +14,14 @@ It's safe to run in an existing repository (the repository contents are not altered), although it may perform expensive data transfers. -Testing a single remote will use the remote's configuration, -automatically varying the chunk sizes, and with simple shared encryption -enabled and disabled. +It's best to make a new remote for testing purposes. While the test +tries to clean up after itself, if the remote being tested had a bug, +the cleanup might fail, leaving test data in the remote. +Testing will use the remote's configuration, automatically varying +the chunk sizes, and with simple shared encryption disabled and enabled, +and exporttree disabled and enabled. + # OPTIONS * `--fast` @@ -31,6 +35,8 @@ # SEE ALSO [[git-annex]](1) + +[[git-annex-test]](1) # AUTHOR diff --git a/doc/git-annex-unlock.mdwn b/doc/git-annex-unlock.mdwn --- a/doc/git-annex-unlock.mdwn +++ b/doc/git-annex-unlock.mdwn @@ -37,6 +37,11 @@ The [[git-annex-matching-options]](1) can be used to specify files to unlock. +* `--json` + + Enable JSON output. This is intended to be parsed by programs that use + git-annex. Each line of output is a JSON object. + # SEE ALSO [[git-annex]](1) diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 6.20171026 +Version: 6.20171109 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -21,14 +21,7 @@ - bloomfilter-2.0.1.0 - torrent-10000.1.1 - yesod-default-1.2.0 +- optparse-applicative-0.14.0.0 explicit-setup-deps: git-annex: true resolver: lts-9.9 -nix: - packages: - - ncurses - - icu - - libcxx - - gcc - - zlib - - rsync