diff --git a/Annex/Import.hs b/Annex/Import.hs index 0bc0c44c83..9c113002d5 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -658,14 +658,14 @@ makeImportMatcher r = load preferredContentKeylessTokens >>= \case - regardless. (Similar to how git add behaves on gitignored files.) - This avoids creating a remote tracking branch that, when merged, - would delete the files. + - + - Throws exception if unable to contact the remote. -} -getImportableContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> FileMatcher Annex -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize))) -getImportableContents r importtreeconfig ci matcher = - Remote.listImportableContents (Remote.importActions r) >>= \case - Nothing -> return Nothing - Just importable -> do - dbhandle <- Export.openDb (Remote.uuid r) - Just <$> filterunwanted dbhandle importable +getImportableContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> FileMatcher Annex -> Annex (ImportableContents (ContentIdentifier, ByteSize)) +getImportableContents r importtreeconfig ci matcher = do + importable <- Remote.listImportableContents (Remote.importActions r) + dbhandle <- Export.openDb (Remote.uuid r) + filterunwanted dbhandle importable where filterunwanted dbhandle ic = ImportableContents <$> filterM (wanted dbhandle) (importableContents ic) diff --git a/Command/Import.hs b/Command/Import.hs index 472d82d4e7..b09984c2c3 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -334,9 +334,9 @@ listContents remote importtreeconfig ci tvar = starting "list" ai si $ listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (ImportableContents (ContentIdentifier, Remote.ByteSize) -> Annex a) -> Annex a listContents' remote importtreeconfig ci a = makeImportMatcher remote >>= \case - Right matcher -> getImportableContents remote importtreeconfig ci matcher >>= \case - Just importable -> a importable - Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote + Right matcher -> tryNonAsync (getImportableContents remote importtreeconfig ci matcher) >>= \case + Right importable -> a importable + Left e -> giveup $ "Unable to list contents of " ++ Remote.name remote ++ ": " ++ show e Left err -> giveup $ unwords [ "Cannot import from" , Remote.name remote diff --git a/Remote/Adb.hs b/Remote/Adb.hs index 82459c8599..3543051030 100644 --- a/Remote/Adb.hs +++ b/Remote/Adb.hs @@ -286,9 +286,12 @@ renameExportM serial adir _k old new = do , File newloc ] -listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize))) -listImportableContentsM serial adir = - process <$> adbShell serial +listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (ImportableContents (ContentIdentifier, ByteSize)) +listImportableContentsM serial adir = adbfind >>= \case + Just ls -> return $ ImportableContents (mapMaybe mk ls) [] + Nothing -> giveup "adb find failed" + where + adbfind = adbShell serial [ Param "find" -- trailing slash is needed, or android's find command -- won't recurse into the directory @@ -298,9 +301,6 @@ listImportableContentsM serial adir = , Param "-c", Param statformat , Param "{}", Param "+" ] - where - process Nothing = Nothing - process (Just ls) = Just $ ImportableContents (mapMaybe mk ls) [] statformat = adbStatFormat ++ "\t%n" diff --git a/Remote/Borg.hs b/Remote/Borg.hs index 0e7dd50e6f..7cc4d5e0fa 100644 --- a/Remote/Borg.hs +++ b/Remote/Borg.hs @@ -132,7 +132,7 @@ borgLocal = notElem ':' -- 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? -listImportableContentsM :: UUID -> BorgRepo -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize))) +listImportableContentsM :: UUID -> BorgRepo -> Annex (ImportableContents (ContentIdentifier, ByteSize)) listImportableContentsM u borgrepo = prompt $ do imported <- getImported u ls <- withborglist borgrepo "{barchive}{NUL}" $ \as -> @@ -143,7 +143,7 @@ listImportableContentsM u borgrepo = prompt $ do let archive = borgrepo ++ "::" ++ decodeBS' archivename in withborglist archive "{size}{NUL}{path}{NUL}" $ liftIO . evaluate . force . parsefilelist archivename - return $ Just $ mkimportablecontents ls + return $ mkimportablecontents ls where withborglist what format a = do let p = (proc "borg" ["list", what, "--format", format]) diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 91ea86019a..ed2a9dce74 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -337,8 +337,8 @@ removeExportLocation topdir loc = mkExportLocation loc' in go (upFrom loc') =<< tryIO (removeDirectory p) -listImportableContentsM :: RawFilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize))) -listImportableContentsM dir = catchMaybeIO $ liftIO $ do +listImportableContentsM :: RawFilePath -> Annex (ImportableContents (ContentIdentifier, ByteSize)) +listImportableContentsM dir = liftIO $ do l <- dirContentsRecursive (fromRawFilePath dir) l' <- mapM (go . toRawFilePath) l return $ ImportableContents (catMaybes l') [] diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs index 573db92147..9e2840e2f5 100644 --- a/Remote/Helper/ExportImport.hs +++ b/Remote/Helper/ExportImport.hs @@ -54,7 +54,7 @@ instance HasImportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bo instance HasImportUnsupported (ImportActions Annex) where importUnsupported = ImportActions - { listImportableContents = return Nothing + { listImportableContents = nope , importKey = Nothing , retrieveExportWithContentIdentifier = nope , storeExportWithContentIdentifier = nope diff --git a/Remote/S3.hs b/Remote/S3.hs index 661e0ab7fa..ec9a16d1b4 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -550,13 +550,11 @@ renameExportS3 hv r rs info k src dest = Just <$> go srcobject = T.pack $ bucketExportLocation info src dstobject = T.pack $ bucketExportLocation info dest -listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize))) +listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> Annex (ImportableContents (ContentIdentifier, ByteSize)) listImportableContentsS3 hv r info = withS3Handle hv $ \case - Nothing -> do - warning $ needS3Creds (uuid r) - return Nothing - Just h -> catchMaybeIO $ liftIO $ runResourceT $ + Nothing -> giveup $ needS3Creds (uuid r) + Just h -> liftIO $ runResourceT $ extractFromResourceT =<< startlist h where startlist h diff --git a/Types/Remote.hs b/Types/Remote.hs index 9085b7311a..2404c52364 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -281,7 +281,9 @@ data ImportActions a = ImportActions -- -- May also find old versions of files that are still stored in the -- remote. - { listImportableContents :: a (Maybe (ImportableContents (ContentIdentifier, ByteSize))) + -- + -- Throws exception on failure to access the remote. + { listImportableContents :: a (ImportableContents (ContentIdentifier, ByteSize)) -- Generates a Key (of any type) for the file stored on the -- remote at the ImportLocation. Does not download the file -- from the remote.