implemented checkPresentExportWithContentIdentifier

Remote/Borg.hs

@@ -128,6 +128,9 @@ borgSetup _ mu _ c _gc = do
 borgLocal :: BorgRepo -> Bool
 borgLocal = notElem ':'
 
+borgArchive :: BorgRepo -> BorgArchiveName -> String
+borgArchive r n = r ++ "::" ++ decodeBS' n
+
 -- XXX the tree generated by using this does not seem to get grafted into
 -- the git-annex branch, so would be subject to being lost to GC.
 -- Is this a general problem affecting importtree too?
@@ -139,7 +142,7 @@ listImportableContentsM u borgrepo = prompt $ do
 			case M.lookup archivename imported of
 				Just getfast -> return $ Left getfast
 				Nothing -> Right <$>
-					let archive = borgrepo ++ "::" ++ decodeBS' archivename
+					let archive = borgArchive borgrepo archivename
 					in withborglist archive "{size}{NUL}{path}{NUL}" $
 						liftIO . evaluate . force . parsefilelist archivename
 	if all isLeft ls
@@ -249,5 +252,49 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)
 retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
 retrieveExportWithContentIdentifierM borgrepo loc cid dest k p = error "TODO"
 
+-- Check if the file is still there in the borg archive.
+-- Does not check that the content is unchanged; we assume that 
+-- the content of files in borg archives does not change, which is normally
+-- the case. But archives may be deleted, and files may be deleted.
 checkPresentExportWithContentIdentifierM :: BorgRepo -> Key -> ImportLocation -> [ContentIdentifier] -> Annex Bool
-checkPresentExportWithContentIdentifierM borgrepo k loc cids = error "TODO"
+checkPresentExportWithContentIdentifierM borgrepo k loc cids = liftIO $ do
+	let p = proc "borg"
+		[ "list"
+		, "--format"
+		, "1"
+		, borgArchive borgrepo archivename
+		, fromRawFilePath archivefile
+		]
+	-- borg list exits nonzero with an error message if an archive
+	-- no longer exists. But, the user can delete archives at any
+	-- time they want. So, hide errors, and if it exists nonzero,
+	-- check if the borg repository still exists, and only throw an
+	-- exception if not.
+	(Nothing, Just h, Nothing, pid) <- withNullHandle $ \nullh ->
+		createProcess $ p
+			{ std_out = CreatePipe
+			, std_err = UseHandle nullh
+			}
+	ok <- (== "1") <$> hGetContentsStrict h
+	hClose h
+	ifM (checkSuccessProcess pid)
+		( return ok
+		, checkrepoexists
+		)
+  where
+	(archivename, archivefile) = extractImportLocation loc
+	
+	checkrepoexists = do
+		let p = proc "borg"
+			[ "list"
+			, "--format"
+			, "1"
+			, borgrepo
+			]
+		(Nothing, Nothing, Nothing, pid) <- withNullHandle $ \nullh ->
+			createProcess $ p
+				{ std_out = UseHandle nullh }
+		ifM (checkSuccessProcess pid)
+			( return False -- repo exists, content not in it
+			, giveup $ "Unable to access borg repository " ++ borgrepo
+			)