diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs index 21b1719882..616ecd69e3 100644 --- a/Remote/HttpAlso.hs +++ b/Remote/HttpAlso.hs @@ -10,6 +10,7 @@ module Remote.HttpAlso (remote) where import Annex.Common import Types.Remote import Types.ProposedAccepted +import Types.Export import Remote.Helper.Messages import Remote.Helper.ExportImport import Remote.Helper.Special @@ -37,7 +38,7 @@ remote = RemoteType (FieldDesc "(required) url to the remote content") ] , setup = httpAlsoSetup - , exportSupported = exportUnsupported + , exportSupported = exportIsSupported , importSupported = importUnsupported } @@ -56,17 +57,24 @@ gen r u rc gc rs = do { uuid = u , cost = cst , name = Git.repoDescribe r - , storeKey = uploadKey + , storeKey = cannotModify , retrieveKeyFile = downloadKey url ll , retrieveKeyFileCheap = Nothing -- HttpManagerRestricted is used here, so this is -- secure. , retrievalSecurityPolicy = RetrievalAllKeysSecure - , removeKey = dropKey + , removeKey = cannotModify , lockContent = Nothing , checkPresent = checkKey url ll (this url ll c cst) , checkPresentCheap = False - , exportActions = exportUnsupported + , exportActions = ExportActions + { storeExport = cannotModify + , retrieveExport = retriveExportHttpAlso url + , removeExport = cannotModify + , checkPresentExport = checkPresentExportHttpAlso url + , removeExportDirectory = Nothing + , renameExport = cannotModify + } , importActions = importUnsupported , whereisKey = Nothing , remoteFsck = Nothing @@ -86,6 +94,9 @@ gen r u rc gc rs = do , remoteStateHandle = rs } +cannotModify :: a +cannotModify = giveup "httpalso special remote is read only" + httpAlsoSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) httpAlsoSetup _ Nothing _ _ _ = error "Must use --sameas when initializing a httpalso remote." @@ -99,23 +110,30 @@ httpAlsoSetup _ (Just u) _ c gc = do downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification downloadKey baseurl ll key _af dest p = do - unlessM (urlAction baseurl ll key go) $ + unlessM (keyUrlAction baseurl ll key (downloadKey' key dest p)) $ giveup "download failed" return UnVerified - where - go url = Url.withUrlOptions $ downloadUrl key p [url] dest -uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex () -uploadKey _ _ _ = giveup "upload to httpalso special remote not supported" +downloadKey' :: Key -> FilePath -> MeterUpdate -> URLString -> Annex Bool +downloadKey' key dest p url = + Url.withUrlOptions $ downloadUrl key p [url] dest -dropKey :: Key -> Annex () -dropKey _ = giveup "removal from httpalso special remote not supported" +retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex () +retriveExportHttpAlso baseurl key loc dest p = + unlessM (exportLocationUrlAction baseurl loc (downloadKey' key dest p)) $ + giveup "download failed" checkKey :: Maybe URLString -> LearnedLayout -> Remote -> Key -> Annex Bool checkKey baseurl ll r key = do showChecking r - urlAction baseurl ll key $ \url -> - Url.withUrlOptions $ Url.checkBoth url (fromKey keySize key) + keyUrlAction baseurl ll key (checkKey' key) + +checkKey' :: Key -> URLString -> Annex Bool +checkKey' key url = Url.withUrlOptions $ Url.checkBoth url (fromKey keySize key) + +checkPresentExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> Annex Bool +checkPresentExportHttpAlso baseurl key loc = + exportLocationUrlAction baseurl loc (checkKey' key) type LearnedLayout = TVar (Maybe [Key -> URLString]) @@ -125,8 +143,8 @@ newLearnedLayout = newTVarIO Nothing -- Learns which layout the special remote uses, so the once any -- action on an url succeeds, subsequent calls will continue to use that -- layout (or related layouts). -urlAction :: Maybe URLString -> LearnedLayout -> Key -> (URLString -> Annex Bool) -> Annex Bool -urlAction (Just baseurl) ll key a = liftIO (readTVarIO ll) >>= \case +keyUrlAction :: Maybe URLString -> LearnedLayout -> Key -> (URLString -> Annex Bool) -> Annex Bool +keyUrlAction (Just baseurl) ll key a = liftIO (readTVarIO ll) >>= \case Just learned -> go False [learned] Nothing -> go True (supportedLayouts baseurl) where @@ -144,9 +162,16 @@ urlAction (Just baseurl) ll key a = liftIO (readTVarIO ll) >>= \case return True , go' learn rest (layout:prevs) ) - +keyUrlAction Nothing _ _ _ = noBaseUrlError + +exportLocationUrlAction :: Maybe URLString -> ExportLocation -> (URLString -> Annex Bool) -> Annex Bool +exportLocationUrlAction (Just baseurl) loc a = + a (baseurl P. fromRawFilePath (fromExportLocation loc)) +exportLocationUrlAction Nothing _ _ = noBaseUrlError + -- cannot normally happen -urlAction Nothing _ _ _ = giveup "no url configured for httpalso special remote" +noBaseUrlError :: Annex a +noBaseUrlError = giveup "no url configured for httpalso special remote" -- Different ways that keys can be laid out in the special remote, -- with the more common first. diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index 6ee592b865..bc8af14107 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -29,7 +29,8 @@ type Template = String {- Runs an action like writeFile, writing to a temp file first and - then moving it into place. The temp file is stored in the same - - directory as the final file to avoid cross-device renames. -} + - directory as the final file to avoid cross-device renames. + -} viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m () viaTmp a file content = bracketIO setup cleanup use where diff --git a/doc/special_remotes/httpalso.mdwn b/doc/special_remotes/httpalso.mdwn index 6bdb3e0509..5935dec3fc 100644 --- a/doc/special_remotes/httpalso.mdwn +++ b/doc/special_remotes/httpalso.mdwn @@ -26,3 +26,8 @@ for a list of known working combinations. * `url` - The http or https url to where the content is stored by the other special remote. +* `exporttree` - If the other special remote has `exporttree=yes` set, + it also needs to be set when initializing the httpalso remote. + Setting this does not allow trees to be exported to the httpalso remote, + because it's read-only. But it does let exported files be downloaded + from it. diff --git a/doc/tips/multiple_remotes_accessing_the_same_data_store.mdwn b/doc/tips/multiple_remotes_accessing_the_same_data_store.mdwn index 4210c73386..d332e43700 100644 --- a/doc/tips/multiple_remotes_accessing_the_same_data_store.mdwn +++ b/doc/tips/multiple_remotes_accessing_the_same_data_store.mdwn @@ -58,4 +58,4 @@ If you find combinations that work, please edit this page to list them. * httpalso and directory * httpalso and rsync * httpalso and rclone (any layout except for frankencase) - +* httpalso and any special remote that uses exporttree=yes diff --git a/doc/todo/make_http_special_remote_support_exporttree_remotes.mdwn b/doc/todo/make_http_special_remote_support_exporttree_remotes.mdwn index 3f09ad0dce..8faa4858da 100644 --- a/doc/todo/make_http_special_remote_support_exporttree_remotes.mdwn +++ b/doc/todo/make_http_special_remote_support_exporttree_remotes.mdwn @@ -2,3 +2,5 @@ The http special remote doesn't currently support being used with a --sameas remote that uses exporttree=yes. It seems like this should be fairly easy to implement. --[[Joey]] + +> [[done]] --[[Joey]]