git-annex (8.20200815) UNRELEASED; urgency=medium
- * Added http special remote, which is useful for accessing other remotes
- that publish content stored in them via http/https.
+ * Added httpalso special remote, which is useful for accessing
+ content stored on other remotes that is published by http.
* The external special remote protocol got an ASYNC extension.
This can be used by an external special remote to let a single process
perform concurrent actions, rather than multiple processes being
+++ /dev/null
-{- Http remote (readonly).
- -
- - Copyright 2020 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU AGPL version 3 or higher.
- -}
-
-module Remote.Http (remote) where
-
-import Annex.Common
-import Types.Remote
-import Types.ProposedAccepted
-import Remote.Helper.Messages
-import Remote.Helper.ExportImport
-import Remote.Helper.Special
-import qualified Git
-import Annex.Content
-import Config.Cost
-import Config
-import Logs.Web
-import Creds
-import Utility.Metered
-import qualified Annex.Url as Url
-import Annex.SpecialRemote.Config
-
-import qualified Data.Map as M
-import System.FilePath.Posix as P
-import Control.Concurrent.STM
-
-remote :: RemoteType
-remote = RemoteType
- { typename = "http"
- , enumerate = const (findSpecialRemotes "http")
- , generate = gen
- , configParser = mkRemoteConfigParser
- [ optionalStringParser urlField
- (FieldDesc "(required) url to the remote content")
- ]
- , setup = httpSetup
- , exportSupported = exportUnsupported
- , importSupported = importUnsupported
- }
-
-urlField :: RemoteConfigField
-urlField = Accepted "url"
-
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
-gen r u rc gc rs = do
- c <- parsedRemoteConfig remote rc
- cst <- remoteCost gc expensiveRemoteCost
- let url = getRemoteConfigValue urlField c
- ll <- liftIO newLearnedLayout
- return $ Just $ this url ll c cst
- where
- this url ll c cst = Remote
- { uuid = u
- , cost = cst
- , name = Git.repoDescribe r
- , storeKey = uploadKey
- , retrieveKeyFile = downloadKey url ll
- , retrieveKeyFileCheap = Nothing
- -- HttpManagerRestricted is used here, so this is
- -- secure.
- , retrievalSecurityPolicy = RetrievalAllKeysSecure
- , removeKey = dropKey
- , lockContent = Nothing
- , checkPresent = checkKey url ll (this url ll c cst)
- , checkPresentCheap = False
- , exportActions = exportUnsupported
- , importActions = importUnsupported
- , whereisKey = Nothing
- , remoteFsck = Nothing
- , repairRepo = Nothing
- , config = c
- , gitconfig = gc
- , localpath = Nothing
- , getRepo = return r
- , readonly = True
- , appendonly = False
- , availability = GloballyAvailable
- , remotetype = remote
- , mkUnavailable = return Nothing
- , getInfo = return []
- , claimUrl = Nothing
- , checkUrl = Nothing
- , remoteStateHandle = rs
- }
-
-httpSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-httpSetup _ Nothing _ _ _ =
- error "Must use --sameas when initializing a http remote."
-httpSetup _ (Just u) _ c gc = do
- _url <- maybe (giveup "Specify url=")
- (return . fromProposedAccepted)
- (M.lookup urlField c)
- (c', _encsetup) <- encryptionSetup c gc
- gitConfigSpecialRemote u c' [("http", "true")]
- return (c', u)
-
-downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
-downloadKey baseurl ll key _af dest p = do
- unlessM (urlAction baseurl ll key go) $
- giveup "download failed"
- return UnVerified
- where
- go url = Url.withUrlOptions $ downloadUrl key p [url] dest
-
-uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex ()
-uploadKey _ _ _ = giveup "upload to http special remote not supported"
-
-dropKey :: Key -> Annex ()
-dropKey _ = giveup "removal from http special remote not supported"
-
-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)
-
-type LearnedLayout = TVar (Maybe [Key -> URLString])
-
-newLearnedLayout :: IO LearnedLayout
-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
- Just learned -> go False [learned]
- Nothing -> go True (supportedLayouts baseurl)
- where
- go _learn [] = return False
- go learn (layouts:rest) = go' learn layouts [] <||> go learn rest
-
- go' _ [] _ = return False
- go' learn (layout:rest) prevs =
- ifM (a (layout key))
- ( do
- when learn $ do
- let learned = layout:prevs++rest
- liftIO $ atomically $
- writeTVar ll (Just learned)
- return True
- , go' learn rest (layout:prevs)
- )
-
--- cannot normally happen
-urlAction Nothing _ _ _ = giveup "no url configured for http special remote"
-
--- Different ways that keys can be laid out in the special remote,
--- with the more common first.
---
--- This is a nested list, because a single remote may use more than one
--- layout. In particular, old versions of git-annex used hashDirMixed
--- for some special remotes, before switching to hashDirLower for new data.
--- So, when learning the layout, both need to be tried.
-supportedLayouts :: URLString -> [[Key -> URLString]]
-supportedLayouts baseurl =
- -- Layout used for bare git-annex repos, and for many
- -- special remotes like directory.
- [ [ \k -> mkurl k (hashDirLower (HashLevels 2)) P.</> kf k
- -- Layout used for non-bare git-annex repos, and for some old
- -- special remotes.
- , \k -> mkurl k (hashDirMixed (HashLevels 2)) P.</> kf k
- ]
- -- Special remotes that do not need hash directories.
- , [ \k -> baseurl P.</> kf k ]
- -- Layouts without a key directory, used by some special remotes.
- , [ \k -> mkurl k (hashDirLower def)
- , \k -> mkurl k (hashDirMixed def)
- ]
- -- Layouts with only 1 level of hash directory,
- -- rather than the default 2.
- , [ \k -> mkurl k (hashDirLower (HashLevels 1))
- , \k -> mkurl k (hashDirMixed (HashLevels 1))
- ]
- ]
- where
- mkurl k hasher = baseurl P.</> fromRawFilePath (hasher k) P.</> kf k
- kf k = fromRawFilePath (keyFile k)
--- /dev/null
+{- HttpAlso remote (readonly).
+ -
+ - Copyright 2020 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Remote.HttpAlso (remote) where
+
+import Annex.Common
+import Types.Remote
+import Types.ProposedAccepted
+import Remote.Helper.Messages
+import Remote.Helper.ExportImport
+import Remote.Helper.Special
+import qualified Git
+import Annex.Content
+import Config.Cost
+import Config
+import Logs.Web
+import Creds
+import Utility.Metered
+import qualified Annex.Url as Url
+import Annex.SpecialRemote.Config
+
+import qualified Data.Map as M
+import System.FilePath.Posix as P
+import Control.Concurrent.STM
+
+remote :: RemoteType
+remote = RemoteType
+ { typename = "httpalso"
+ , enumerate = const (findSpecialRemotes "httpalso")
+ , generate = gen
+ , configParser = mkRemoteConfigParser
+ [ optionalStringParser urlField
+ (FieldDesc "(required) url to the remote content")
+ ]
+ , setup = httpAlsoSetup
+ , exportSupported = exportUnsupported
+ , importSupported = importUnsupported
+ }
+
+urlField :: RemoteConfigField
+urlField = Accepted "url"
+
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+gen r u rc gc rs = do
+ c <- parsedRemoteConfig remote rc
+ cst <- remoteCost gc expensiveRemoteCost
+ let url = getRemoteConfigValue urlField c
+ ll <- liftIO newLearnedLayout
+ return $ Just $ this url ll c cst
+ where
+ this url ll c cst = Remote
+ { uuid = u
+ , cost = cst
+ , name = Git.repoDescribe r
+ , storeKey = uploadKey
+ , retrieveKeyFile = downloadKey url ll
+ , retrieveKeyFileCheap = Nothing
+ -- HttpManagerRestricted is used here, so this is
+ -- secure.
+ , retrievalSecurityPolicy = RetrievalAllKeysSecure
+ , removeKey = dropKey
+ , lockContent = Nothing
+ , checkPresent = checkKey url ll (this url ll c cst)
+ , checkPresentCheap = False
+ , exportActions = exportUnsupported
+ , importActions = importUnsupported
+ , whereisKey = Nothing
+ , remoteFsck = Nothing
+ , repairRepo = Nothing
+ , config = c
+ , gitconfig = gc
+ , localpath = Nothing
+ , getRepo = return r
+ , readonly = True
+ , appendonly = False
+ , availability = GloballyAvailable
+ , remotetype = remote
+ , mkUnavailable = return Nothing
+ , getInfo = return []
+ , claimUrl = Nothing
+ , checkUrl = Nothing
+ , remoteStateHandle = rs
+ }
+
+httpAlsoSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+httpAlsoSetup _ Nothing _ _ _ =
+ error "Must use --sameas when initializing a httpalso remote."
+httpAlsoSetup _ (Just u) _ c gc = do
+ _url <- maybe (giveup "Specify url=")
+ (return . fromProposedAccepted)
+ (M.lookup urlField c)
+ (c', _encsetup) <- encryptionSetup c gc
+ gitConfigSpecialRemote u c' [("httpalso", "true")]
+ return (c', u)
+
+downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
+downloadKey baseurl ll key _af dest p = do
+ unlessM (urlAction baseurl ll key go) $
+ 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"
+
+dropKey :: Key -> Annex ()
+dropKey _ = giveup "removal from httpalso special remote not supported"
+
+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)
+
+type LearnedLayout = TVar (Maybe [Key -> URLString])
+
+newLearnedLayout :: IO LearnedLayout
+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
+ Just learned -> go False [learned]
+ Nothing -> go True (supportedLayouts baseurl)
+ where
+ go _learn [] = return False
+ go learn (layouts:rest) = go' learn layouts [] <||> go learn rest
+
+ go' _ [] _ = return False
+ go' learn (layout:rest) prevs =
+ ifM (a (layout key))
+ ( do
+ when learn $ do
+ let learned = layout:prevs++rest
+ liftIO $ atomically $
+ writeTVar ll (Just learned)
+ return True
+ , go' learn rest (layout:prevs)
+ )
+
+-- cannot normally happen
+urlAction Nothing _ _ _ = 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.
+--
+-- This is a nested list, because a single remote may use more than one
+-- layout. In particular, old versions of git-annex used hashDirMixed
+-- for some special remotes, before switching to hashDirLower for new data.
+-- So, when learning the layout, both need to be tried.
+supportedLayouts :: URLString -> [[Key -> URLString]]
+supportedLayouts baseurl =
+ -- Layout used for bare git-annex repos, and for many
+ -- special remotes like directory.
+ [ [ \k -> mkurl k (hashDirLower (HashLevels 2)) P.</> kf k
+ -- Layout used for non-bare git-annex repos, and for some old
+ -- special remotes.
+ , \k -> mkurl k (hashDirMixed (HashLevels 2)) P.</> kf k
+ ]
+ -- Special remotes that do not need hash directories.
+ , [ \k -> baseurl P.</> kf k ]
+ -- Layouts without a key directory, used by some special remotes.
+ , [ \k -> mkurl k (hashDirLower def)
+ , \k -> mkurl k (hashDirMixed def)
+ ]
+ -- Layouts with only 1 level of hash directory,
+ -- rather than the default 2.
+ , [ \k -> mkurl k (hashDirLower (HashLevels 1))
+ , \k -> mkurl k (hashDirMixed (HashLevels 1))
+ ]
+ ]
+ where
+ mkurl k hasher = baseurl P.</> fromRawFilePath (hasher k) P.</> kf k
+ kf k = fromRawFilePath (keyFile k)
import qualified Remote.Glacier
import qualified Remote.Ddar
import qualified Remote.GitLFS
-import qualified Remote.Http
+import qualified Remote.HttpAlso
import qualified Remote.Hook
import qualified Remote.External
, Remote.Glacier.remote
, Remote.Ddar.remote
, Remote.GitLFS.remote
- , Remote.Http.remote
+ , Remote.HttpAlso.remote
, Remote.Hook.remote
, Remote.External.remote
]
It is set to "true" if this is a git-lfs remote.
-* `remote.<name>.annex-http`
+* `remote.<name>.annex-httpalso`
- Used to identify http special remotes.
+ Used to identify httpalso special remotes.
Normally this is automatically set up by `git annex initremote`.
* `remote.<name>.annex-externaltype`
* [[S3]] (Amazon S3, and other compatible services)
* [[tahoe]]
* [[tor]]
-* [[web]] and [[http]]
+* [[web]]
* [[webdav]]
* [[git]]
+* [[httpalso]]
* [[xmpp]]
The above special remotes are built into git-annex, and can be used
+++ /dev/null
-This special remote allows downloading annexed objects from other remotes
-that expose their content by http. Not to be confused with the [[web]]
-special remote, this one is only useful in combination with some other
-special remote.
-
-Suppose, for example, that you have a [[directory]] special remote. And the
-directory happens to be published by a web server. (Or it could be a
-[[rsync]] special remote, or many other kinds.) To let git-annex know that
-the content of this special remote can also be accessed over http, set up
-a http special remote.
-
- git annex initremote --sameas=foo foo-http type=http url=http://example.com/foo
-
-The --sameas parameter tells git-annex what other special remote this http
-remote is accessing. (See [[tips/multiple_remotes_accessing_the_same_data_store]].)
-Since the http remote is read-only, it can only be used to download content
-that is stored in that other remote.
-
-This special remote is compatible with many, but not all, other special
-remotes. If the special remote does something unusual with the name
-a file is stored under, or with how the data is stored, it might not work.
-See [[tips/multiple_remotes_accessing_the_same_data_store]]
-for a list of known working combinations.
-
-## configuration
-
-* `url` - The http or https url to where the content is stored by the
- other special remote.
--- /dev/null
+This special remote allows downloading annexed objects from other remotes
+that also publish their content by http. Not to be confused with the [[web]]
+special remote, this one is only useful in combination with some other
+special remote.
+
+Suppose, for example, that you have a [[directory]] special remote. And the
+directory happens to be published by a web server. (Or it could be a
+[[rsync]] special remote, or many other kinds.) To let git-annex know that
+the content of this special remote can also be accessed over http, set up
+a httpalso special remote.
+
+ git annex initremote --sameas=foo foo-http type=httpalso url=http://example.com/foo
+
+The --sameas parameter tells git-annex what other special remote this httpalso
+remote is accessing. (See [[tips/multiple_remotes_accessing_the_same_data_store]].)
+Since the httpalso remote is read-only, it can only be used to download
+content that is stored in that other remote.
+
+This special remote is compatible with many, but not all, other special
+remotes. If the special remote does something unusual with the name
+a file is stored under, or with how the data is stored, it might not work.
+See [[tips/multiple_remotes_accessing_the_same_data_store]]
+for a list of known working combinations.
+
+## configuration
+
+* `url` - The http or https url to where the content is stored by the
+ other special remote.
This special remote uses urls on the web as the source for content.
There are several other ways http can be used to download annexed objects,
including a git remote accessible by http, S3 with a `publicurl` configured,
-and the [[http]] special remote.
+and the [[httpalso]] special remote.
## known working combinations
* directory and rsync
-* http and directory
-* http and rsync
-* http and rclone (any layout except for frankencase)
+* httpalso and directory
+* httpalso and rsync
+* httpalso and rclone (any layout except for frankencase)
Call it "http" maybe. (There may be some confusion between this and the web
special remote by users looking for such a thing.) --[[Joey]]
-> http special remote implemented, [[done]] --[[Joey]]
+> httpalso special remote implemented, [[done]] --[[Joey]]
Remote.Helper.ReadOnly
Remote.Helper.Special
Remote.Helper.Ssh
- Remote.Http
+ Remote.HttpAlso
Remote.Hook
Remote.List
Remote.List.Util
projects / git-annex.git / commitdiff