add stub claimUrl
This commit is contained in:
parent
8093008ef4
commit
cb6e16947d
16 changed files with 28 additions and 13 deletions
|
@ -29,8 +29,7 @@ import qualified Annex.Branch
|
|||
import Annex.CatFile
|
||||
import qualified Git
|
||||
import qualified Git.LsFiles
|
||||
|
||||
type URLString = String
|
||||
import Utility.Url
|
||||
|
||||
-- Dummy uuid for the whole web. Do not alter.
|
||||
webUUID :: UUID
|
||||
|
|
|
@ -74,6 +74,7 @@ gen r u c gc = do
|
|||
, readonly = False
|
||||
, mkUnavailable = return Nothing
|
||||
, getInfo = return [("repo", buprepo)]
|
||||
, claimUrl = Nothing
|
||||
}
|
||||
return $ Just $ specialRemote' specialcfg c
|
||||
(simplyPrepare $ store this buprepo)
|
||||
|
|
|
@ -71,6 +71,7 @@ gen r u c gc = do
|
|||
, readonly = False
|
||||
, mkUnavailable = return Nothing
|
||||
, getInfo = return [("repo", ddarrepo)]
|
||||
, claimUrl = Nothing
|
||||
}
|
||||
ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc
|
||||
specialcfg = (specialRemoteCfg c)
|
||||
|
|
|
@ -68,7 +68,8 @@ gen r u c gc = do
|
|||
remotetype = remote,
|
||||
mkUnavailable = gen r u c $
|
||||
gc { remoteAnnexDirectory = Just "/dev/null" },
|
||||
getInfo = return [("directory", dir)]
|
||||
getInfo = return [("directory", dir)],
|
||||
claimUrl = Nothing
|
||||
}
|
||||
where
|
||||
dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
|
||||
|
|
|
@ -68,8 +68,9 @@ gen r u c gc = do
|
|||
availability = avail,
|
||||
remotetype = remote,
|
||||
mkUnavailable = gen r u c $
|
||||
gc { remoteAnnexExternalType = Just "!dne!" }
|
||||
, getInfo = return [("externaltype", externaltype)]
|
||||
gc { remoteAnnexExternalType = Just "!dne!" },
|
||||
getInfo = return [("externaltype", externaltype)],
|
||||
claimUrl = Nothing
|
||||
}
|
||||
where
|
||||
externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
|
||||
|
|
|
@ -122,6 +122,7 @@ gen' r u c gc = do
|
|||
, remotetype = remote
|
||||
, mkUnavailable = return Nothing
|
||||
, getInfo = return $ gitRepoInfo r
|
||||
, claimUrl = Nothing
|
||||
}
|
||||
return $ Just $ specialRemote' specialcfg c
|
||||
(simplyPrepare $ store this rsyncopts)
|
||||
|
|
|
@ -160,6 +160,7 @@ gen r u c gc
|
|||
, remotetype = remote
|
||||
, mkUnavailable = unavailable r u c gc
|
||||
, getInfo = return $ gitRepoInfo r
|
||||
, claimUrl = Nothing
|
||||
}
|
||||
|
||||
unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
|
||||
|
|
|
@ -68,7 +68,8 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
|
|||
remotetype = remote,
|
||||
mkUnavailable = return Nothing,
|
||||
getInfo = includeCredsInfo c (AWS.creds u) $
|
||||
[ ("glacier vault", getVault c) ]
|
||||
[ ("glacier vault", getVault c) ],
|
||||
claimUrl = Nothing
|
||||
}
|
||||
specialcfg = (specialRemoteCfg c)
|
||||
-- Disabled until jobList gets support for chunks.
|
||||
|
|
|
@ -61,7 +61,8 @@ gen r u c gc = do
|
|||
remotetype = remote,
|
||||
mkUnavailable = gen r u c $
|
||||
gc { remoteAnnexHookType = Just "!dne!" },
|
||||
getInfo = return [("hooktype", hooktype)]
|
||||
getInfo = return [("hooktype", hooktype)],
|
||||
claimUrl = Nothing
|
||||
}
|
||||
where
|
||||
hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
|
||||
|
|
|
@ -84,6 +84,7 @@ gen r u c gc = do
|
|||
, remotetype = remote
|
||||
, mkUnavailable = return Nothing
|
||||
, getInfo = return [("url", url)]
|
||||
, claimUrl = Nothing
|
||||
}
|
||||
where
|
||||
specialcfg = (specialRemoteCfg c)
|
||||
|
|
|
@ -92,7 +92,8 @@ gen r u c gc = do
|
|||
then Just ("internet archive item", iaItemUrl $ fromMaybe "unknown" $ getBucketName c)
|
||||
else Nothing
|
||||
, Just ("partsize", maybe "unlimited" (roughSize storageUnits False) (getPartSize c))
|
||||
]
|
||||
],
|
||||
claimUrl = Nothing
|
||||
}
|
||||
|
||||
s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||
|
|
|
@ -85,7 +85,8 @@ gen r u c gc = do
|
|||
availability = GloballyAvailable,
|
||||
remotetype = remote,
|
||||
mkUnavailable = return Nothing,
|
||||
getInfo = return []
|
||||
getInfo = return [],
|
||||
claimUrl = Nothing
|
||||
}
|
||||
|
||||
tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||
|
|
|
@ -63,7 +63,8 @@ gen r _ c gc =
|
|||
availability = GloballyAvailable,
|
||||
remotetype = remote,
|
||||
mkUnavailable = return Nothing,
|
||||
getInfo = return []
|
||||
getInfo = return [],
|
||||
claimUrl = Nothing -- implicitly claims all urls
|
||||
}
|
||||
|
||||
downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
|
||||
|
|
|
@ -73,7 +73,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
|
|||
remotetype = remote,
|
||||
mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc,
|
||||
getInfo = includeCredsInfo c (davCreds u) $
|
||||
[("url", fromMaybe "unknown" (M.lookup "url" c))]
|
||||
[("url", fromMaybe "unknown" (M.lookup "url" c))],
|
||||
claimUrl = Nothing
|
||||
}
|
||||
chunkconfig = getChunkConfig c
|
||||
|
||||
|
|
|
@ -29,6 +29,7 @@ import Config.Cost
|
|||
import Utility.Metered
|
||||
import Git.Types
|
||||
import Utility.SafeCommand
|
||||
import Utility.Url
|
||||
|
||||
type RemoteConfigKey = String
|
||||
type RemoteConfig = M.Map RemoteConfigKey String
|
||||
|
@ -100,7 +101,9 @@ data RemoteA a = Remote {
|
|||
-- available for use. All its actions should fail.
|
||||
mkUnavailable :: a (Maybe (RemoteA a)),
|
||||
-- Information about the remote, for git annex info to display.
|
||||
getInfo :: a [(String, String)]
|
||||
getInfo :: a [(String, String)],
|
||||
-- Some remotes can download from an url (or uri).
|
||||
claimUrl :: Maybe (URLString -> IO Bool)
|
||||
}
|
||||
|
||||
instance Show (RemoteA a) where
|
||||
|
|
|
@ -22,7 +22,7 @@ both available from CERN and from a torrent, for example.
|
|||
|
||||
Solution: Add a new method to remotes:
|
||||
|
||||
claimUri :: Maybe (Uri -> Bool)
|
||||
claimUrl :: Maybe (URLString -> IO Bool)
|
||||
|
||||
Remotes that implement this method (including special remotes) will
|
||||
be queried when such an uri is added, to see which claims it. Once the
|
||||
|
|
Loading…
Reference in a new issue