2011-03-30 18:56:31 +00:00
|
|
|
{- A "remote" that is just a filesystem directory.
|
2011-03-30 17:18:46 +00:00
|
|
|
-
|
2020-01-14 16:35:08 +00:00
|
|
|
- Copyright 2011-2020 Joey Hess <id@joeyh.name>
|
2011-03-30 17:18:46 +00:00
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2011-03-30 17:18:46 +00:00
|
|
|
-}
|
|
|
|
|
2013-05-11 20:03:00 +00:00
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
|
2014-08-04 13:35:57 +00:00
|
|
|
module Remote.Directory (
|
|
|
|
remote,
|
|
|
|
finalizeStoreGeneric,
|
|
|
|
removeDirGeneric,
|
|
|
|
) where
|
2011-03-30 17:18:46 +00:00
|
|
|
|
2012-06-20 17:13:40 +00:00
|
|
|
import qualified Data.ByteString.Lazy as L
|
2011-03-30 17:18:46 +00:00
|
|
|
import qualified Data.Map as M
|
2015-01-28 19:55:17 +00:00
|
|
|
import Data.Default
|
2011-03-30 17:18:46 +00:00
|
|
|
|
2016-01-20 20:36:33 +00:00
|
|
|
import Annex.Common
|
2011-06-02 01:56:04 +00:00
|
|
|
import Types.Remote
|
2017-09-15 20:34:45 +00:00
|
|
|
import Types.Export
|
2014-02-11 18:06:50 +00:00
|
|
|
import Types.Creds
|
2011-06-30 17:16:57 +00:00
|
|
|
import qualified Git
|
2013-03-13 20:16:01 +00:00
|
|
|
import Config.Cost
|
2011-03-30 18:32:08 +00:00
|
|
|
import Config
|
2020-01-14 16:35:08 +00:00
|
|
|
import Annex.SpecialRemote.Config
|
2011-09-23 22:13:24 +00:00
|
|
|
import Utility.FileMode
|
2011-08-17 00:49:54 +00:00
|
|
|
import Remote.Helper.Special
|
2019-02-20 19:55:01 +00:00
|
|
|
import Remote.Helper.ExportImport
|
2019-02-27 17:42:34 +00:00
|
|
|
import Types.Import
|
2014-07-27 00:19:24 +00:00
|
|
|
import qualified Remote.Directory.LegacyChunked as Legacy
|
2012-04-20 20:24:44 +00:00
|
|
|
import Annex.Content
|
2013-09-07 22:38:00 +00:00
|
|
|
import Annex.UUID
|
2013-03-28 21:03:04 +00:00
|
|
|
import Utility.Metered
|
2017-08-31 18:24:32 +00:00
|
|
|
import Utility.Tmp
|
2019-03-04 17:20:58 +00:00
|
|
|
import Utility.InodeCache
|
2020-01-10 18:10:20 +00:00
|
|
|
import Types.ProposedAccepted
|
2011-03-30 17:18:46 +00:00
|
|
|
|
2011-12-31 08:11:39 +00:00
|
|
|
remote :: RemoteType
|
2020-01-14 16:35:08 +00:00
|
|
|
remote = specialRemoteType $ RemoteType
|
2017-09-07 17:45:31 +00:00
|
|
|
{ typename = "directory"
|
|
|
|
, enumerate = const (findSpecialRemotes "directory")
|
|
|
|
, generate = gen
|
2020-01-14 16:35:08 +00:00
|
|
|
, configParser = [optionalStringParser directoryField]
|
2017-09-07 17:45:31 +00:00
|
|
|
, setup = directorySetup
|
|
|
|
, exportSupported = exportIsSupported
|
2019-03-04 20:02:56 +00:00
|
|
|
, importSupported = importIsSupported
|
2017-09-07 17:45:31 +00:00
|
|
|
}
|
2011-03-30 17:18:46 +00:00
|
|
|
|
2020-01-14 16:35:08 +00:00
|
|
|
directoryField :: RemoteConfigField
|
|
|
|
directoryField = Accepted "directory"
|
|
|
|
|
|
|
|
gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
|
add RemoteStateHandle
This solves the problem of sameas remotes trampling over per-remote
state. Used for:
* per-remote state, of course
* per-remote metadata, also of course
* per-remote content identifiers, because two remote implementations
could in theory generate the same content identifier for two different
peices of content
While chunk logs are per-remote data, they don't use this, because the
number and size of chunks stored is a common property across sameas
remotes.
External special remote had a complication, where it was theoretically
possible for a remote to send SETSTATE or GETSTATE during INITREMOTE or
EXPORTSUPPORTED. Since the uuid of the remote is typically generate in
Remote.setup, it would only be possible to pass a Maybe
RemoteStateHandle into it, and it would otherwise have to construct its
own. Rather than go that route, I decided to send an ERROR in this case.
It seems unlikely that any existing external special remote will be
affected. They would have to make up a git-annex key, and set state for
some reason during INITREMOTE. I can imagine such a hack, but it doesn't
seem worth complicating the code in such an ugly way to support it.
Unfortunately, both TestRemote and Annex.Import needed the Remote
to have a new field added that holds its RemoteStateHandle.
2019-10-14 16:33:27 +00:00
|
|
|
gen r u c gc rs = do
|
2013-01-01 17:52:47 +00:00
|
|
|
cst <- remoteCost gc cheapRemoteCost
|
2014-08-03 19:35:23 +00:00
|
|
|
let chunkconfig = getChunkConfig c
|
2017-09-07 17:45:31 +00:00
|
|
|
return $ Just $ specialRemote c
|
2014-07-27 00:19:24 +00:00
|
|
|
(prepareStore dir chunkconfig)
|
2017-09-15 17:15:47 +00:00
|
|
|
(retrieveKeyFileM dir chunkconfig)
|
|
|
|
(simplyPrepare $ removeKeyM dir)
|
|
|
|
(simplyPrepare $ checkPresentM dir chunkconfig)
|
2014-12-16 19:26:13 +00:00
|
|
|
Remote
|
|
|
|
{ uuid = u
|
|
|
|
, cost = cst
|
|
|
|
, name = Git.repoDescribe r
|
|
|
|
, storeKey = storeKeyDummy
|
|
|
|
, retrieveKeyFile = retreiveKeyFileDummy
|
2017-09-15 17:15:47 +00:00
|
|
|
, retrieveKeyFileCheap = retrieveKeyFileCheapM dir chunkconfig
|
2018-06-21 15:35:27 +00:00
|
|
|
, retrievalSecurityPolicy = RetrievalAllKeysSecure
|
2014-12-16 19:26:13 +00:00
|
|
|
, removeKey = removeKeyDummy
|
2015-10-08 19:01:38 +00:00
|
|
|
, lockContent = Nothing
|
2014-12-16 19:26:13 +00:00
|
|
|
, checkPresent = checkPresentDummy
|
|
|
|
, checkPresentCheap = True
|
2019-01-30 18:55:28 +00:00
|
|
|
, exportActions = ExportActions
|
2017-09-15 17:15:47 +00:00
|
|
|
{ storeExport = storeExportM dir
|
|
|
|
, retrieveExport = retrieveExportM dir
|
|
|
|
, removeExport = removeExportM dir
|
|
|
|
, checkPresentExport = checkPresentExportM dir
|
|
|
|
-- Not needed because removeExportLocation
|
|
|
|
-- auto-removes empty directories.
|
|
|
|
, removeExportDirectory = Nothing
|
|
|
|
, renameExport = renameExportM dir
|
2017-09-01 17:02:07 +00:00
|
|
|
}
|
2019-02-27 17:42:34 +00:00
|
|
|
, importActions = ImportActions
|
|
|
|
{ listImportableContents = listImportableContentsM dir
|
|
|
|
, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM dir
|
|
|
|
, storeExportWithContentIdentifier = storeExportWithContentIdentifierM dir
|
2019-03-05 18:20:14 +00:00
|
|
|
, removeExportWithContentIdentifier = removeExportWithContentIdentifierM dir
|
2019-05-28 15:12:53 +00:00
|
|
|
-- Not needed because removeExportWithContentIdentifier
|
|
|
|
-- auto-removes empty directories.
|
2019-03-05 18:20:14 +00:00
|
|
|
, removeExportDirectoryWhenEmpty = Nothing
|
2019-03-05 20:02:33 +00:00
|
|
|
, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM dir
|
2019-02-27 17:42:34 +00:00
|
|
|
}
|
2014-12-16 19:26:13 +00:00
|
|
|
, whereisKey = Nothing
|
|
|
|
, remoteFsck = Nothing
|
|
|
|
, repairRepo = Nothing
|
|
|
|
, config = c
|
2018-06-04 18:31:55 +00:00
|
|
|
, getRepo = return r
|
2014-12-16 19:26:13 +00:00
|
|
|
, gitconfig = gc
|
|
|
|
, localpath = Just dir
|
|
|
|
, readonly = False
|
2018-08-30 15:12:18 +00:00
|
|
|
, appendonly = False
|
2014-12-16 19:26:13 +00:00
|
|
|
, availability = LocallyAvailable
|
|
|
|
, remotetype = remote
|
add RemoteStateHandle
This solves the problem of sameas remotes trampling over per-remote
state. Used for:
* per-remote state, of course
* per-remote metadata, also of course
* per-remote content identifiers, because two remote implementations
could in theory generate the same content identifier for two different
peices of content
While chunk logs are per-remote data, they don't use this, because the
number and size of chunks stored is a common property across sameas
remotes.
External special remote had a complication, where it was theoretically
possible for a remote to send SETSTATE or GETSTATE during INITREMOTE or
EXPORTSUPPORTED. Since the uuid of the remote is typically generate in
Remote.setup, it would only be possible to pass a Maybe
RemoteStateHandle into it, and it would otherwise have to construct its
own. Rather than go that route, I decided to send an ERROR in this case.
It seems unlikely that any existing external special remote will be
affected. They would have to make up a git-annex key, and set state for
some reason during INITREMOTE. I can imagine such a hack, but it doesn't
seem worth complicating the code in such an ugly way to support it.
Unfortunately, both TestRemote and Annex.Import needed the Remote
to have a new field added that holds its RemoteStateHandle.
2019-10-14 16:33:27 +00:00
|
|
|
, mkUnavailable = gen r u c
|
|
|
|
(gc { remoteAnnexDirectory = Just "/dev/null" }) rs
|
2014-12-16 19:26:13 +00:00
|
|
|
, getInfo = return [("directory", dir)]
|
|
|
|
, claimUrl = Nothing
|
|
|
|
, checkUrl = Nothing
|
add RemoteStateHandle
This solves the problem of sameas remotes trampling over per-remote
state. Used for:
* per-remote state, of course
* per-remote metadata, also of course
* per-remote content identifiers, because two remote implementations
could in theory generate the same content identifier for two different
peices of content
While chunk logs are per-remote data, they don't use this, because the
number and size of chunks stored is a common property across sameas
remotes.
External special remote had a complication, where it was theoretically
possible for a remote to send SETSTATE or GETSTATE during INITREMOTE or
EXPORTSUPPORTED. Since the uuid of the remote is typically generate in
Remote.setup, it would only be possible to pass a Maybe
RemoteStateHandle into it, and it would otherwise have to construct its
own. Rather than go that route, I decided to send an ERROR in this case.
It seems unlikely that any existing external special remote will be
affected. They would have to make up a git-annex key, and set state for
some reason during INITREMOTE. I can imagine such a hack, but it doesn't
seem worth complicating the code in such an ugly way to support it.
Unfortunately, both TestRemote and Annex.Import needed the Remote
to have a new field added that holds its RemoteStateHandle.
2019-10-14 16:33:27 +00:00
|
|
|
, remoteStateHandle = rs
|
2014-12-16 19:26:13 +00:00
|
|
|
}
|
2013-01-01 17:52:47 +00:00
|
|
|
where
|
2016-11-16 01:29:54 +00:00
|
|
|
dir = fromMaybe (giveup "missing directory") $ remoteAnnexDirectory gc
|
2012-03-03 22:05:55 +00:00
|
|
|
|
2017-02-07 18:35:58 +00:00
|
|
|
directorySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
|
|
|
|
directorySetup _ mu _ c gc = do
|
2013-09-07 22:38:00 +00:00
|
|
|
u <- maybe (liftIO genUUID) return mu
|
2011-03-30 17:18:46 +00:00
|
|
|
-- verify configuration is sane
|
2020-01-10 18:10:20 +00:00
|
|
|
let dir = maybe (giveup "Specify directory=") fromProposedAccepted $
|
2020-01-14 16:35:08 +00:00
|
|
|
M.lookup directoryField c
|
2013-05-06 21:15:36 +00:00
|
|
|
absdir <- liftIO $ absPath dir
|
|
|
|
liftIO $ unlessM (doesDirectoryExist absdir) $
|
2016-11-16 01:29:54 +00:00
|
|
|
giveup $ "Directory does not exist: " ++ absdir
|
2016-05-23 21:27:15 +00:00
|
|
|
(c', _encsetup) <- encryptionSetup c gc
|
2011-03-30 17:18:46 +00:00
|
|
|
|
2011-03-30 18:32:08 +00:00
|
|
|
-- The directory is stored in git config, not in this remote's
|
|
|
|
-- persistant state, so it can vary between hosts.
|
2018-03-27 16:41:57 +00:00
|
|
|
gitConfigSpecialRemote u c' [("directory", absdir)]
|
2020-01-14 16:35:08 +00:00
|
|
|
return (M.delete directoryField c', u)
|
2011-03-30 17:18:46 +00:00
|
|
|
|
2014-07-27 00:19:24 +00:00
|
|
|
{- Locations to try to access a given Key in the directory.
|
|
|
|
- We try more than one since we used to write to different hash
|
|
|
|
- directories. -}
|
2011-11-22 22:20:55 +00:00
|
|
|
locations :: FilePath -> Key -> [FilePath]
|
2019-12-11 18:12:22 +00:00
|
|
|
locations d k = map (\f -> d </> fromRawFilePath f) (keyPaths k)
|
2011-03-30 17:18:46 +00:00
|
|
|
|
2014-07-27 00:19:24 +00:00
|
|
|
{- Returns the location off a Key in the directory. If the key is
|
|
|
|
- present, returns the location that is actually used, otherwise
|
|
|
|
- returns the first, default location. -}
|
|
|
|
getLocation :: FilePath -> Key -> IO FilePath
|
|
|
|
getLocation d k = do
|
|
|
|
let locs = locations d k
|
|
|
|
fromMaybe (Prelude.head locs) <$> firstM doesFileExist locs
|
|
|
|
|
2012-11-19 17:18:23 +00:00
|
|
|
{- Directory where the file(s) for a key are stored. -}
|
|
|
|
storeDir :: FilePath -> Key -> FilePath
|
2019-12-11 18:12:22 +00:00
|
|
|
storeDir d k = addTrailingPathSeparator $
|
2019-12-18 20:45:03 +00:00
|
|
|
d </> fromRawFilePath (hashDirLower def k) </> fromRawFilePath (keyFile k)
|
2012-11-19 17:18:23 +00:00
|
|
|
|
2014-07-27 00:19:24 +00:00
|
|
|
{- Check if there is enough free disk space in the remote's directory to
|
|
|
|
- store the key. Note that the unencrypted key size is checked. -}
|
2014-07-27 04:30:04 +00:00
|
|
|
prepareStore :: FilePath -> ChunkConfig -> Preparer Storer
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
prepareStore d chunkconfig = checkPrepare (checkDiskSpaceDirectory d)
|
2014-07-29 18:53:17 +00:00
|
|
|
(byteStorer $ store d chunkconfig)
|
2015-05-12 19:19:08 +00:00
|
|
|
where
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
|
|
|
|
checkDiskSpaceDirectory :: FilePath -> Key -> Annex Bool
|
|
|
|
checkDiskSpaceDirectory d k = do
|
|
|
|
annexdir <- fromRepo gitAnnexObjectDir
|
|
|
|
samefilesystem <- liftIO $ catchDefaultIO False $
|
|
|
|
(\a b -> deviceID a == deviceID b)
|
|
|
|
<$> getFileStatus d
|
|
|
|
<*> getFileStatus annexdir
|
|
|
|
checkDiskSpace (Just d) k 0 samefilesystem
|
2014-07-24 18:49:22 +00:00
|
|
|
|
2014-07-29 20:22:19 +00:00
|
|
|
store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
|
|
|
|
store d chunkconfig k b p = liftIO $ do
|
2014-07-27 03:01:44 +00:00
|
|
|
void $ tryIO $ createDirectoryIfMissing True tmpdir
|
2014-07-25 20:21:01 +00:00
|
|
|
case chunkconfig of
|
2014-08-04 13:35:57 +00:00
|
|
|
LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir
|
2014-07-27 03:26:10 +00:00
|
|
|
_ -> do
|
2019-12-18 20:45:03 +00:00
|
|
|
let tmpf = tmpdir </> kf
|
2014-07-27 00:19:24 +00:00
|
|
|
meteredWriteFile p tmpf b
|
2014-08-04 13:35:57 +00:00
|
|
|
finalizeStoreGeneric tmpdir destdir
|
2014-07-24 18:49:22 +00:00
|
|
|
return True
|
2014-07-25 20:21:01 +00:00
|
|
|
where
|
2019-12-18 20:45:03 +00:00
|
|
|
tmpdir = addTrailingPathSeparator $ d </> "tmp" </> kf
|
|
|
|
kf = fromRawFilePath (keyFile k)
|
2014-07-27 00:19:24 +00:00
|
|
|
destdir = storeDir d k
|
2014-08-04 13:35:57 +00:00
|
|
|
|
|
|
|
{- Passed a temp directory that contains the files that should be placed
|
|
|
|
- in the dest directory, moves it into place. Anything already existing
|
|
|
|
- in the dest directory will be deleted. File permissions will be locked
|
|
|
|
- down. -}
|
|
|
|
finalizeStoreGeneric :: FilePath -> FilePath -> IO ()
|
|
|
|
finalizeStoreGeneric tmp dest = do
|
|
|
|
void $ tryIO $ allowWrite dest -- may already exist
|
|
|
|
void $ tryIO $ removeDirectoryRecursive dest -- or not exist
|
2015-01-09 17:11:56 +00:00
|
|
|
createDirectoryIfMissing True (parentDir dest)
|
2014-08-04 13:35:57 +00:00
|
|
|
renameDirectory tmp dest
|
|
|
|
-- may fail on some filesystems
|
|
|
|
void $ tryIO $ do
|
|
|
|
mapM_ preventWrite =<< dirContents dest
|
|
|
|
preventWrite dest
|
2012-03-03 22:05:55 +00:00
|
|
|
|
2017-09-15 17:15:47 +00:00
|
|
|
retrieveKeyFileM :: FilePath -> ChunkConfig -> Preparer Retriever
|
|
|
|
retrieveKeyFileM d (LegacyChunks _) = Legacy.retrieve locations d
|
|
|
|
retrieveKeyFileM d _ = simplyPrepare $ byteRetriever $ \k sink ->
|
2014-08-03 05:12:24 +00:00
|
|
|
sink =<< liftIO (L.readFile =<< getLocation d k)
|
2011-04-17 01:41:14 +00:00
|
|
|
|
2017-09-15 17:15:47 +00:00
|
|
|
retrieveKeyFileCheapM :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Annex Bool
|
2014-07-27 00:19:24 +00:00
|
|
|
-- no cheap retrieval possible for chunks
|
2017-09-15 17:15:47 +00:00
|
|
|
retrieveKeyFileCheapM _ (UnpaddedChunks _) _ _ _ = return False
|
|
|
|
retrieveKeyFileCheapM _ (LegacyChunks _) _ _ _ = return False
|
2013-08-02 16:27:32 +00:00
|
|
|
#ifndef mingw32_HOST_OS
|
2017-09-15 17:15:47 +00:00
|
|
|
retrieveKeyFileCheapM d NoChunks k _af f = liftIO $ catchBoolIO $ do
|
2015-04-18 17:36:12 +00:00
|
|
|
file <- absPath =<< getLocation d k
|
|
|
|
ifM (doesFileExist file)
|
|
|
|
( do
|
|
|
|
createSymbolicLink file f
|
|
|
|
return True
|
|
|
|
, return False
|
|
|
|
)
|
2013-05-11 20:03:00 +00:00
|
|
|
#else
|
2017-09-15 17:15:47 +00:00
|
|
|
retrieveKeyFileCheapM _ _ _ _ _ = return False
|
2013-05-11 20:03:00 +00:00
|
|
|
#endif
|
2012-03-03 22:05:55 +00:00
|
|
|
|
2017-09-15 17:15:47 +00:00
|
|
|
removeKeyM :: FilePath -> Remover
|
|
|
|
removeKeyM d k = liftIO $ removeDirGeneric d (storeDir d k)
|
2014-08-04 13:00:57 +00:00
|
|
|
|
|
|
|
{- Removes the directory, which must be located under the topdir.
|
|
|
|
-
|
|
|
|
- Succeeds even on directories and contents that do not have write
|
|
|
|
- permission.
|
|
|
|
-
|
|
|
|
- If the directory does not exist, succeeds as long as the topdir does
|
|
|
|
- exist. If the topdir does not exist, fails, because in this case the
|
|
|
|
- remote is not currently accessible and probably still has the content
|
|
|
|
- we were supposed to remove from it.
|
|
|
|
-}
|
|
|
|
removeDirGeneric :: FilePath -> FilePath -> IO Bool
|
|
|
|
removeDirGeneric topdir dir = do
|
2013-02-14 18:10:36 +00:00
|
|
|
void $ tryIO $ allowWrite dir
|
2013-08-04 17:39:31 +00:00
|
|
|
#ifdef mingw32_HOST_OS
|
|
|
|
{- Windows needs the files inside the directory to be writable
|
|
|
|
- before it can delete them. -}
|
|
|
|
void $ tryIO $ mapM_ allowWrite =<< dirContents dir
|
|
|
|
#endif
|
2014-07-28 18:14:01 +00:00
|
|
|
ok <- catchBoolIO $ do
|
2013-02-14 18:10:36 +00:00
|
|
|
removeDirectoryRecursive dir
|
|
|
|
return True
|
2014-07-28 18:14:01 +00:00
|
|
|
if ok
|
|
|
|
then return ok
|
2014-08-04 13:00:57 +00:00
|
|
|
else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)
|
2011-03-30 17:18:46 +00:00
|
|
|
|
2017-09-15 17:15:47 +00:00
|
|
|
checkPresentM :: FilePath -> ChunkConfig -> CheckPresent
|
|
|
|
checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k
|
|
|
|
checkPresentM d _ k = checkPresentGeneric d (locations d k)
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
|
|
|
|
checkPresentGeneric :: FilePath -> [FilePath] -> Annex Bool
|
2019-03-05 20:02:33 +00:00
|
|
|
checkPresentGeneric d ps = checkPresentGeneric' d $
|
|
|
|
liftIO $ anyM doesFileExist ps
|
|
|
|
|
|
|
|
checkPresentGeneric' :: FilePath -> Annex Bool -> Annex Bool
|
|
|
|
checkPresentGeneric' d check = ifM check
|
|
|
|
( return True
|
|
|
|
, ifM (liftIO $ doesDirectoryExist d)
|
|
|
|
( return False
|
|
|
|
, giveup $ "directory " ++ d ++ " is not accessible"
|
2014-08-06 17:45:19 +00:00
|
|
|
)
|
2019-03-05 20:02:33 +00:00
|
|
|
)
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
|
2017-09-15 17:15:47 +00:00
|
|
|
storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
|
|
|
|
storeExportM d src _k loc p = liftIO $ catchBoolIO $ do
|
2017-08-29 18:58:38 +00:00
|
|
|
createDirectoryIfMissing True (takeDirectory dest)
|
2017-08-31 18:24:32 +00:00
|
|
|
-- Write via temp file so that checkPresentGeneric will not
|
|
|
|
-- see it until it's fully stored.
|
|
|
|
viaTmp (\tmp () -> withMeteredFile src p (L.writeFile tmp)) dest ()
|
2017-08-29 17:51:00 +00:00
|
|
|
return True
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
where
|
|
|
|
dest = exportPath d loc
|
|
|
|
|
2017-09-15 17:15:47 +00:00
|
|
|
retrieveExportM :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
|
|
|
|
retrieveExportM d _k loc dest p = liftIO $ catchBoolIO $ do
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
withMeteredFile src p (L.writeFile dest)
|
|
|
|
return True
|
|
|
|
where
|
|
|
|
src = exportPath d loc
|
|
|
|
|
2017-09-15 17:15:47 +00:00
|
|
|
removeExportM :: FilePath -> Key -> ExportLocation -> Annex Bool
|
|
|
|
removeExportM d _k loc = liftIO $ do
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
nukeFile src
|
2017-08-31 16:32:02 +00:00
|
|
|
removeExportLocation d loc
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
return True
|
|
|
|
where
|
|
|
|
src = exportPath d loc
|
|
|
|
|
2017-09-15 17:15:47 +00:00
|
|
|
checkPresentExportM :: FilePath -> Key -> ExportLocation -> Annex Bool
|
|
|
|
checkPresentExportM d _k loc =
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
checkPresentGeneric d [exportPath d loc]
|
|
|
|
|
2019-03-11 16:44:12 +00:00
|
|
|
renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
|
|
|
|
renameExportM d _k oldloc newloc = liftIO $ Just <$> go
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
where
|
2019-03-11 16:44:12 +00:00
|
|
|
go = catchBoolIO $ do
|
|
|
|
createDirectoryIfMissing True (takeDirectory dest)
|
|
|
|
renameFile src dest
|
|
|
|
removeExportLocation d oldloc
|
|
|
|
return True
|
|
|
|
|
add API for exporting
Implemented so far for the directory special remote.
Several remotes don't make sense to export to. Regular Git remotes,
obviously, do not. Bup remotes almost certianly do not, since bup would
need to be used to extract the export; same store for Ddar. Web and
Bittorrent are download-only. GCrypt is always encrypted so exporting to
it would be pointless. There's probably no point complicating the Hook
remotes with exporting at this point. External, S3, Glacier, WebDAV,
Rsync, and possibly Tahoe should be modified to support export.
Thought about trying to reuse the storeKey/retrieveKeyFile/removeKey
interface, rather than adding a new interface. But, it seemed better to
keep it separate, to avoid a complicated interface that sometimes
encrypts/chunks key/value storage and sometimes users non-key/value
storage. Any common parts can be factored out.
Note that storeExport is not atomic.
doc/design/exporting_trees_to_special_remotes.mdwn has some things in
the "resuming exports" section that bear on this decision. Basically,
I don't think, at this time, that an atomic storeExport would help with
resuming, because exports are not key/value storage, and we can't be
sure that a partially uploaded file is the same content we're currently
trying to export.
Also, note that ExportLocation will always use unix path separators.
This is important, because users may export from a mix of windows and
unix, and it avoids complicating the API with path conversions,
and ensures that in such a mix, they always use the same locations for
exports.
This commit was sponsored by Bruno BEAUFILS on Patreon.
2017-08-29 17:00:41 +00:00
|
|
|
src = exportPath d oldloc
|
|
|
|
dest = exportPath d newloc
|
2017-08-31 16:32:02 +00:00
|
|
|
|
|
|
|
exportPath :: FilePath -> ExportLocation -> FilePath
|
2019-11-26 19:27:22 +00:00
|
|
|
exportPath d loc = d </> fromRawFilePath (fromExportLocation loc)
|
2017-08-31 16:32:02 +00:00
|
|
|
|
2017-11-08 18:38:24 +00:00
|
|
|
{- Removes the ExportLocation's parent directory and its parents, so long as
|
2017-08-31 16:32:02 +00:00
|
|
|
- they're empty, up to but not including the topdir. -}
|
|
|
|
removeExportLocation :: FilePath -> ExportLocation -> IO ()
|
2017-11-08 18:38:24 +00:00
|
|
|
removeExportLocation topdir loc =
|
2019-11-26 19:27:22 +00:00
|
|
|
go (Just $ takeDirectory $ fromRawFilePath $ fromExportLocation loc) (Right ())
|
2017-08-31 16:32:02 +00:00
|
|
|
where
|
|
|
|
go _ (Left _e) = return ()
|
|
|
|
go Nothing _ = return ()
|
|
|
|
go (Just loc') _ = go (upFrom loc')
|
2019-11-26 19:27:22 +00:00
|
|
|
=<< tryIO (removeDirectory $ exportPath topdir (mkExportLocation (toRawFilePath loc')))
|
2019-02-27 17:42:34 +00:00
|
|
|
|
|
|
|
listImportableContentsM :: FilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
|
|
|
|
listImportableContentsM dir = catchMaybeIO $ liftIO $ do
|
|
|
|
l <- dirContentsRecursive dir
|
|
|
|
l' <- mapM go l
|
2019-03-04 17:20:58 +00:00
|
|
|
return $ ImportableContents (catMaybes l') []
|
2019-02-27 17:42:34 +00:00
|
|
|
where
|
|
|
|
go f = do
|
2019-03-04 17:20:58 +00:00
|
|
|
st <- getFileStatus f
|
|
|
|
mkContentIdentifier f st >>= \case
|
|
|
|
Nothing -> return Nothing
|
|
|
|
Just cid -> do
|
2019-11-26 19:27:22 +00:00
|
|
|
relf <- toRawFilePath <$> relPathDirToFile dir f
|
2019-03-04 17:20:58 +00:00
|
|
|
sz <- getFileSize' f st
|
|
|
|
return $ Just (mkImportLocation relf, (cid, sz))
|
|
|
|
|
|
|
|
-- Make a ContentIdentifier that contains an InodeCache.
|
|
|
|
--
|
|
|
|
-- The InodeCache is generated without checking a sentinal file.
|
|
|
|
-- So in a case when a remount etc causes all the inodes to change,
|
|
|
|
-- files may appear to be modified when they are not, which will only
|
|
|
|
-- result in extra work to re-import them.
|
|
|
|
--
|
|
|
|
-- If the file is not a regular file, this will return Nothing.
|
|
|
|
mkContentIdentifier :: FilePath -> FileStatus -> IO (Maybe ContentIdentifier)
|
|
|
|
mkContentIdentifier f st =
|
|
|
|
fmap (ContentIdentifier . encodeBS . showInodeCache)
|
|
|
|
<$> toInodeCache noTSDelta f st
|
2019-02-27 17:42:34 +00:00
|
|
|
|
|
|
|
retrieveExportWithContentIdentifierM :: FilePath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex (Maybe Key) -> MeterUpdate -> Annex (Maybe Key)
|
2019-03-04 17:20:58 +00:00
|
|
|
retrieveExportWithContentIdentifierM dir loc cid dest mkkey p =
|
|
|
|
catchDefaultIO Nothing $ precheck $ docopy postcheck
|
|
|
|
where
|
2019-03-05 18:20:14 +00:00
|
|
|
f = exportPath dir loc
|
2019-03-04 17:20:58 +00:00
|
|
|
|
|
|
|
docopy cont = do
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
|
|
-- Need a duplicate fd for the post check, since
|
|
|
|
-- hGetContentsMetered closes its handle.
|
|
|
|
fd <- liftIO $ openFd f ReadOnly Nothing defaultFileFlags
|
|
|
|
dupfd <- liftIO $ dup fd
|
|
|
|
h <- liftIO $ fdToHandle fd
|
|
|
|
#else
|
|
|
|
h <- liftIO $ openBinaryFile f ReadMode
|
|
|
|
#endif
|
|
|
|
liftIO $ hGetContentsMetered h p >>= L.writeFile dest
|
|
|
|
k <- mkkey
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
|
|
cont dupfd (return k)
|
|
|
|
#else
|
|
|
|
cont (return k)
|
|
|
|
#endif
|
|
|
|
|
|
|
|
-- Check before copy, to avoid expensive copy of wrong file
|
|
|
|
-- content.
|
|
|
|
precheck cont = comparecid cont
|
|
|
|
=<< liftIO . mkContentIdentifier f
|
|
|
|
=<< liftIO (getFileStatus f)
|
|
|
|
|
|
|
|
-- Check after copy, in case the file was changed while it was
|
|
|
|
-- being copied.
|
|
|
|
--
|
|
|
|
-- When possible (not on Windows), check the same handle
|
2019-04-09 21:52:41 +00:00
|
|
|
-- that the file was copied from. Avoids some race cases where
|
|
|
|
-- the file is modified while it's copied but then gets restored
|
|
|
|
-- to the original content afterwards.
|
2019-03-04 17:20:58 +00:00
|
|
|
--
|
|
|
|
-- This does not guard against every possible race, but neither
|
|
|
|
-- can InodeCaches detect every possible modification to a file.
|
|
|
|
-- It's probably as good or better than git's handling of similar
|
|
|
|
-- situations with files being modified while it's updating the
|
|
|
|
-- working tree for a merge.
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
|
|
postcheck fd cont = do
|
|
|
|
#else
|
|
|
|
postcheck cont = do
|
|
|
|
#endif
|
|
|
|
currcid <- liftIO $ mkContentIdentifier f
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
|
|
=<< getFdStatus fd
|
|
|
|
#else
|
|
|
|
=<< getFileStatus f
|
|
|
|
#endif
|
|
|
|
comparecid cont currcid
|
|
|
|
|
|
|
|
comparecid cont currcid
|
|
|
|
| currcid == Just cid = cont
|
|
|
|
| otherwise = return Nothing
|
2019-02-27 17:42:34 +00:00
|
|
|
|
2019-08-13 16:05:00 +00:00
|
|
|
storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)
|
2019-03-04 18:46:25 +00:00
|
|
|
storeExportWithContentIdentifierM dir src _k loc overwritablecids p =
|
2019-08-13 16:05:00 +00:00
|
|
|
catchIO go (return . Left . show)
|
|
|
|
where
|
|
|
|
go = do
|
2019-03-05 18:20:14 +00:00
|
|
|
liftIO $ createDirectoryIfMissing True destdir
|
2019-03-05 18:50:39 +00:00
|
|
|
withTmpFileIn destdir template $ \tmpf tmph -> do
|
|
|
|
liftIO $ withMeteredFile src p (L.hPut tmph)
|
|
|
|
liftIO $ hFlush tmph
|
2019-08-13 17:26:25 +00:00
|
|
|
liftIO $ hClose tmph
|
2019-03-05 18:50:39 +00:00
|
|
|
liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf >>= \case
|
2019-08-13 16:05:00 +00:00
|
|
|
Nothing ->
|
|
|
|
return $ Left "unable to generate content identifier"
|
2019-03-05 18:50:39 +00:00
|
|
|
Just newcid ->
|
2019-08-13 16:05:00 +00:00
|
|
|
checkExportContent dir loc (newcid:overwritablecids) (Left "unsafe to overwrite file") $ const $ do
|
2019-03-05 18:50:39 +00:00
|
|
|
liftIO $ rename tmpf dest
|
2019-08-13 16:05:00 +00:00
|
|
|
return (Right newcid)
|
2019-03-05 18:20:14 +00:00
|
|
|
dest = exportPath dir loc
|
2019-03-04 18:46:25 +00:00
|
|
|
(destdir, base) = splitFileName dest
|
|
|
|
template = relatedTemplate (base ++ ".tmp")
|
|
|
|
|
2019-03-05 18:20:14 +00:00
|
|
|
removeExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
|
|
|
|
removeExportWithContentIdentifierM dir k loc removeablecids =
|
2019-03-05 21:04:00 +00:00
|
|
|
checkExportContent dir loc removeablecids False $ \case
|
|
|
|
DoesNotExist -> return True
|
|
|
|
KnownContentIdentifier -> removeExportM dir k loc
|
2019-03-05 18:20:14 +00:00
|
|
|
|
2019-03-05 20:02:33 +00:00
|
|
|
checkPresentExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
|
|
|
|
checkPresentExportWithContentIdentifierM dir _k loc knowncids =
|
|
|
|
checkPresentGeneric' dir $
|
2019-03-05 21:04:00 +00:00
|
|
|
checkExportContent dir loc knowncids False $ \case
|
|
|
|
DoesNotExist -> return False
|
|
|
|
KnownContentIdentifier -> return True
|
|
|
|
|
|
|
|
data CheckResult = DoesNotExist | KnownContentIdentifier
|
2019-03-05 20:02:33 +00:00
|
|
|
|
2019-03-05 18:20:14 +00:00
|
|
|
-- Checks if the content at an ExportLocation is in the knowncids,
|
|
|
|
-- and only runs the callback that modifies it if it's safe to do so.
|
|
|
|
--
|
|
|
|
-- This should avoid races to the extent possible. However,
|
|
|
|
-- if something has the file open for write, it could write to the handle
|
|
|
|
-- after the callback has overwritten or deleted it, and its write would
|
|
|
|
-- be lost, and we don't need to detect that.
|
|
|
|
-- (In similar situations, git doesn't either!)
|
|
|
|
--
|
|
|
|
-- It follows that if something is written to the destination file
|
|
|
|
-- shortly before, it's acceptable to run the callback anyway, as that's
|
|
|
|
-- nearly indistinguishable from the above case.
|
|
|
|
--
|
|
|
|
-- So, it suffices to check if the destination file's current
|
|
|
|
-- content is known, and immediately run the callback.
|
2019-03-05 21:04:00 +00:00
|
|
|
checkExportContent :: FilePath -> ExportLocation -> [ContentIdentifier] -> a -> (CheckResult -> Annex a) -> Annex a
|
2019-03-05 18:20:14 +00:00
|
|
|
checkExportContent dir loc knowncids unsafe callback =
|
|
|
|
tryWhenExists (liftIO $ getFileStatus dest) >>= \case
|
|
|
|
Just destst
|
|
|
|
| not (isRegularFile destst) -> return unsafe
|
|
|
|
| otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier dest destst) >>= \case
|
2019-03-04 18:46:25 +00:00
|
|
|
Just destcid
|
2019-03-05 21:04:00 +00:00
|
|
|
| destcid `elem` knowncids -> callback KnownContentIdentifier
|
2019-03-04 18:46:25 +00:00
|
|
|
-- dest exists with other content
|
2019-03-05 18:20:14 +00:00
|
|
|
| otherwise -> return unsafe
|
|
|
|
-- should never happen
|
|
|
|
Nothing -> return unsafe
|
|
|
|
-- dest does not exist
|
2019-03-05 21:04:00 +00:00
|
|
|
Nothing -> callback DoesNotExist
|
2019-03-05 18:20:14 +00:00
|
|
|
where
|
|
|
|
dest = exportPath dir loc
|