git-annex 6.20171026 → 6.20171109

raw patch · 16 files changed

+127/−41 lines, 16 files

Files

• Annex/Export.hs +1/−1
• Assistant/Install.hs +0/−4
• CHANGELOG +16/−0
• Command/Lock.hs +1/−1
• Command/TestRemote.hs +73/−6
• Command/Unlock.hs +1/−1
• Git/Ref.hs +7/−2
• Logs/UUID.hs +0/−10
• Remote/Directory.hs +3/−2
• Remote/Web.hs +2/−2
• doc/git-annex-lock.mdwn +5/−0
• doc/git-annex-test.mdwn +2/−0
• doc/git-annex-testremote.mdwn +9/−3
• doc/git-annex-unlock.mdwn +5/−0
• git-annex.cabal +1/−1
• stack.yaml +1/−8

@@ -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

@@ -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

@@ -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 <id@joeyh.name>  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

@@ -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)

@@ -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 =

@@ -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

@@ -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.  -

@@ -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

@@ -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 ()

@@ -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

@@ -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)

@@ -29,6 +29,8 @@  [[git-annex]](1) +[[git-annex-testremote]](1)+ # AUTHOR  Joey Hess <id@joeyh.name>

@@ -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 

@@ -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)

@@ -1,5 +1,5 @@ Name: git-annex-Version: 6.20171026+Version: 6.20171109 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>

@@ -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