testremote: Support testing readonly remotes with the --test-readonly option

This commit was sponsored by Ilya Shlyakhter on Patreon.

CHANGELOG

@@ -29,6 +29,7 @@ git-annex (7.20181212) UNRELEASED; urgency=medium
     allowing for future expansion.
   * addunused, merge, assistant: Avoid creating work tree files in
     subdirectories in an edge case where the key contains "/".
+  * testremote: Support testing readonly remotes with the --test-readonly option.
 
  -- Joey Hess <id@joeyh.name>  Tue, 18 Dec 2018 12:24:52 -0400
 

Command/TestRemote.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -14,7 +14,9 @@ import qualified Types.Remote as Remote
 import qualified Types.Backend as Backend
 import Types.KeySource
 import Annex.Content
+import Annex.WorkTree
 import Backend
+import Logs.Location
 import qualified Backend.Hash
 import Utility.Tmp
 import Utility.Metered
@@ -42,6 +44,7 @@ cmd = command "testremote" SectionTesting
 data TestRemoteOptions = TestRemoteOptions
 	{ testRemote :: RemoteName
 	, sizeOption :: ByteSize
+	, testReadonlyFile :: [FilePath]
 	}
 
 optParser :: CmdParamsDesc -> Parser TestRemoteOptions
@@ -52,22 +55,43 @@ optParser desc = TestRemoteOptions
 		<> value (1024 * 1024)
 		<> help "base key size (default 1MiB)"
 		)
+	<*> many testreadonly
+  where
+	testreadonly = option str
+		( long "test-readonly" <> metavar paramFile
+		<> help "readonly test object"
+		)
 
 seek :: TestRemoteOptions -> CommandSeek
-seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o) 
+seek = commandAction . start 
 
-start :: Int -> RemoteName -> CommandStart
+start :: TestRemoteOptions -> CommandStart
-start basesz name = do
+start o = do
-	showStart' "testremote" (Just name)
+	showStart' "testremote" (Just (testRemote o))
 	fast <- Annex.getState Annex.fast
-	r <- either giveup disableExportTree =<< Remote.byName' name
+	r <- either giveup disableExportTree =<< Remote.byName' (testRemote o)
-	rs <- catMaybes <$> mapM (adjustChunkSize r) (chunkSizes basesz fast)
+	ks <- case testReadonlyFile o of
-	rs' <- concat <$> mapM encryptionVariants rs
+		[] -> if Remote.readonly r
-	unavailrs  <- catMaybes <$> mapM Remote.mkUnavailable [r]
+			then giveup "This remote is readonly, so you need to use the --test-readonly option."
-	exportr <- exportTreeVariant r
+			else do
 				showAction "generating test keys"
-	ks <- mapM randKey (keySizes basesz fast)
+				mapM randKey (keySizes basesz fast)
-	next $ perform rs' unavailrs exportr ks
+		fs -> mapM (getReadonlyKey r) fs
+	let r' = if null (testReadonlyFile o)
+		then r
+		else r { Remote.readonly = True }
+	rs <- if Remote.readonly r'
+		then return [r']
+		else do
+			rs <- catMaybes <$> mapM (adjustChunkSize r') (chunkSizes basesz fast)
+			concat <$> mapM encryptionVariants rs
+	unavailrs  <- catMaybes <$> mapM Remote.mkUnavailable [r']
+	exportr <- if Remote.readonly r'
+		then return Nothing
+		else exportTreeVariant r'
+	next $ perform rs unavailrs exportr ks
+  where
+	basesz = fromInteger $ sizeOption o
 
 perform :: [Remote] -> [Remote] -> Maybe Remote -> [Key] -> CommandPerform
 perform rs unavailrs exportr ks = do
@@ -132,18 +156,18 @@ adjustRemoteConfig r adjustconfig = do
 		(Remote.gitconfig r)
 
 test :: Annex.AnnexState -> Remote -> Key -> [TestTree]
-test st r k =
+test st r k = catMaybes
-	[ check "removeKey when not present" remove
+	[ whenwritable $ check "removeKey when not present" remove
-	, present False
+	, whenwritable $ present False
-	, check "storeKey" store
+	, whenwritable $ check "storeKey" store
-	, present True
+	, whenwritable $ present True
-	, check "storeKey when already present" store
+	, whenwritable $ check "storeKey when already present" store
-	, present True
+	, whenwritable $ present True
-	, check "retrieveKeyFile" $ do
+	, Just $ check "retrieveKeyFile" $ do
 		lockContentForRemoval k removeAnnex
 		get
-	, check "fsck downloaded object" fsck
+	, Just $ check "fsck downloaded object" fsck
-	, check "retrieveKeyFile resume from 33%" $ do
+	, Just $ check "retrieveKeyFile resume from 33%" $ do
 		loc <- Annex.calcRepo (gitAnnexLocation k)
 		tmp <- prepTmp k
 		partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do
@@ -152,24 +176,25 @@ test st r k =
 		liftIO $ L.writeFile tmp partial
 		lockContentForRemoval k removeAnnex
 		get
-	, check "fsck downloaded object" fsck
+	, Just $ check "fsck downloaded object" fsck
-	, check "retrieveKeyFile resume from 0" $ do
+	, Just $ check "retrieveKeyFile resume from 0" $ do
 		tmp <- prepTmp k
 		liftIO $ writeFile tmp ""
 		lockContentForRemoval k removeAnnex
 		get
-	, check "fsck downloaded object" fsck
+	, Just $ check "fsck downloaded object" fsck
-	, check "retrieveKeyFile resume from end" $ do
+	, Just $ check "retrieveKeyFile resume from end" $ do
 		loc <- Annex.calcRepo (gitAnnexLocation k)
 		tmp <- prepTmp k
 		void $ liftIO $ copyFileExternal CopyAllMetaData loc tmp
 		lockContentForRemoval k removeAnnex
 		get
-	, check "fsck downloaded object" fsck
+	, Just $ check "fsck downloaded object" fsck
-	, check "removeKey when present" remove
+	, whenwritable $ check "removeKey when present" remove
-	, present False
+	, whenwritable $ present False
 	]
   where
+	whenwritable a = if Remote.readonly r then Nothing else Just a
 	check desc a = testCase desc $
 		Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"
 	present b = check ("present " ++ show b) $
@@ -252,7 +277,9 @@ testUnavailable st r k =
 		checkval v  @? ("(got: " ++ show v ++ ")")
 
 cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup
-cleanup rs ks ok = do
+cleanup rs ks ok
+	| all Remote.readonly rs = return ok
+	| otherwise = do
 		forM_ rs $ \r -> forM_ ks (Remote.removeKey r)
 		forM_ ks $ \k -> lockContentForRemoval k removeAnnex
 		return ok
@@ -297,3 +324,13 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
 		<$> Backend.getKey Backend.Hash.testKeyBackend ks
 	_ <- moveAnnex k f
 	return k
+
+getReadonlyKey :: Remote -> FilePath -> Annex Key
+getReadonlyKey r f = lookupFile f >>= \case
+	Nothing -> giveup $ f ++ " is not an annexed file"
+	Just k -> do
+		unlessM (inAnnex k) $
+			giveup $ f ++ " does not have its content locally present, cannot test it"
+		unlessM ((Remote.uuid r `elem`) <$> loggedLocations k) $
+			giveup $ f ++ " is not stored in the remote being tested, cannot test it"
+		return k

doc/git-annex-testremote.mdwn

@@ -8,8 +8,8 @@ git annex testremote `remote`
 
 # DESCRIPTION
 
-This tests a remote by generating some random objects and sending them to
+This tests a remote by sending objects to it, downloading objects from it,
-the remote, then redownloading them, removing them from the remote, etc.
+etc.
 
 It's safe to run in an existing repository (the repository contents are
 not altered), although it may perform expensive data transfers.
@@ -20,7 +20,8 @@ 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.
+and exporttree disabled and enabled. If the remote is readonly, testing
+is limited to checking various properties of downloading from it.
 
 # OPTIONS
 
@@ -28,9 +29,19 @@ and exporttree disabled and enabled.
 
   Perform a smaller set of tests.
 
+* `--test-readonly=file`
+
+  Normally, random objects are generated for the test and are sent to the
+  remote. When a readonly remote is being tested, that cannot be done,
+  and so you need to specify some annexed files to use in the testing,
+  using this option. Their content needs to be present in the readonly remote
+  being tested, and in the local repository.
+
+  This option can be repeated.
+
 * `--size=NUnits`
 
-  Tune the base size of the generated objects. The default is 1MiB.
+  Tune the base size of generated objects. The default is 1MiB.
 
 # SEE ALSO
 

doc/todo/testremote_for_read-only_remotes.mdwn

@@ -1 +1,3 @@
 It's not uncommon to create external special remotes for which, like for the built-in web remote, only download operations are defined.  It would be good if git-annex-testremote had the option of testing such remotes, using as test data the keys and URLs already registered as present in the remote.  This could also be used to test addurl-related functionality for fully implemented remotes; currently this part of a remote's implementation isn't tested.
+
+> Good idea, [[done]] using the --test-readonly option. --[[Joey]]