summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs4
-rw-r--r--Command/AddUrl.hs4
-rw-r--r--Command/Drop.hs60
-rw-r--r--Command/DropUnused.hs5
-rw-r--r--Command/FromKey.hs3
-rw-r--r--Command/Fsck.hs77
-rw-r--r--Command/Get.hs49
-rw-r--r--Command/Migrate.hs17
-rw-r--r--Command/Status.hs6
-rw-r--r--Command/Unannex.hs13
-rw-r--r--Command/Unlock.hs3
11 files changed, 196 insertions, 45 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index 6a1ffb5da..2831e1b35 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -42,8 +42,8 @@ start pair@(file, _) = notAnnexed file $ do
perform :: BackendFile -> CommandPerform
perform (file, backend) = do
- stored <- Backend.storeFileKey file backend
- case stored of
+ k <- Backend.genKey file backend
+ case k of
Nothing -> stop
Just (key, _) -> do
moveAnnex key file
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index ebf0810ba..e80fe9621 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -51,8 +51,8 @@ perform url file = do
if ok
then do
[(_, backend)] <- Backend.chooseBackends [file]
- stored <- Backend.storeFileKey tmp backend
- case stored of
+ k <- Backend.genKey tmp backend
+ case k of
Nothing -> stop
Just (key, _) -> do
moveAnnex key tmp
diff --git a/Command/Drop.hs b/Command/Drop.hs
index bd4740741..14f098349 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -8,12 +8,15 @@
module Command.Drop where
import Command
-import qualified Backend
+import qualified Remote
+import qualified Annex
import LocationLog
import Types
import Content
import Messages
import Utility
+import Trust
+import Config
command :: [Command]
command = [repoCommand "drop" paramPath seek
@@ -25,19 +28,19 @@ seek = [withAttrFilesInGit "annex.numcopies" start]
{- Indicates a file's content is not wanted anymore, and should be removed
- if it's safe to do so. -}
start :: CommandStartAttrFile
-start (file, attr) = isAnnexed file $ \(key, backend) -> do
- inbackend <- Backend.hasKey key
- if inbackend
+start (file, attr) = isAnnexed file $ \(key, _) -> do
+ present <- inAnnex key
+ if present
then do
showStart "drop" file
- next $ perform key backend numcopies
+ next $ perform key numcopies
else stop
where
numcopies = readMaybe attr :: Maybe Int
-perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform
-perform key backend numcopies = do
- success <- Backend.removeKey backend key numcopies
+perform :: Key -> Maybe Int -> CommandPerform
+perform key numcopies = do
+ success <- dropKey key numcopies
if success
then next $ cleanup key
else stop
@@ -47,3 +50,44 @@ cleanup key = do
whenM (inAnnex key) $ removeAnnex key
logStatus key InfoMissing
return True
+
+{- Checks remotes to verify that enough copies of a key exist to allow
+ - for a key to be safely removed (with no data loss), and fails with an
+ - error if not. -}
+dropKey :: Key -> Maybe Int -> Annex Bool
+dropKey key numcopiesM = do
+ force <- Annex.getState Annex.force
+ if force || numcopiesM == Just 0
+ then return True
+ else do
+ (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
+ untrusteduuids <- trustGet UnTrusted
+ let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
+ numcopies <- getNumCopies numcopiesM
+ findcopies numcopies trusteduuids tocheck []
+ where
+ findcopies need have [] bad
+ | length have >= need = return True
+ | otherwise = notEnoughCopies need have bad
+ findcopies need have (r:rs) bad
+ | length have >= need = return True
+ | otherwise = do
+ let u = Remote.uuid r
+ let dup = u `elem` have
+ haskey <- Remote.hasKey r key
+ case (dup, haskey) of
+ (False, Right True) -> findcopies need (u:have) rs bad
+ (False, Left _) -> findcopies need have rs (r:bad)
+ _ -> findcopies need have rs bad
+ notEnoughCopies need have bad = do
+ unsafe
+ showLongNote $
+ "Could only verify the existence of " ++
+ show (length have) ++ " out of " ++ show need ++
+ " necessary copies"
+ Remote.showTriedRemotes bad
+ Remote.showLocations key have
+ hint
+ return False
+ unsafe = showNote "unsafe"
+ hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)"
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 2125abdc3..55007c1f7 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -21,7 +21,6 @@ import qualified Command.Drop
import qualified Command.Move
import qualified Remote
import qualified Git
-import Backend
import Types.Key
import Utility
@@ -64,9 +63,7 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
r <- Remote.byName name
showNote $ "from " ++ Remote.name r ++ "..."
next $ Command.Move.fromCleanup r True key
- droplocal = do
- backend <- keyBackend key
- Command.Drop.perform key backend (Just 0) -- force drop
+ droplocal = Command.Drop.perform key (Just 0) -- force drop
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
performOther filespec key = do
diff --git a/Command/FromKey.hs b/Command/FromKey.hs
index 34816d657..fb9ab0775 100644
--- a/Command/FromKey.hs
+++ b/Command/FromKey.hs
@@ -15,7 +15,6 @@ import Control.Monad (unless)
import Command
import qualified AnnexQueue
import Utility
-import qualified Backend
import Content
import Messages
import Types.Key
@@ -30,7 +29,7 @@ seek = [withFilesMissing start]
start :: CommandStartString
start file = notBareRepo $ do
key <- cmdlineKey
- inbackend <- Backend.hasKey key
+ inbackend <- inAnnex key
unless inbackend $ error $
"key ("++keyName key++") is not present in backend"
showStart "fromkey" file
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 988cfd28d..446d25a44 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -9,10 +9,15 @@ module Command.Fsck where
import Control.Monad (when)
import Control.Monad.State (liftIO)
+import System.Directory
+import Data.List
+import System.Posix.Files
import Command
-import qualified Backend
import qualified Annex
+import qualified Remote
+import qualified Types.Backend
+import qualified Types.Key
import UUID
import Types
import Messages
@@ -20,6 +25,9 @@ import Utility
import Content
import LocationLog
import Locations
+import Trust
+import DataUnits
+import Config
command :: [Command]
command = [repoCommand "fsck" (paramOptional $ paramRepeating paramPath) seek
@@ -40,7 +48,7 @@ perform key file backend numcopies = do
-- the location log is checked first, so that if it has bad data
-- that gets corrected
locationlogok <- verifyLocationLog key file
- backendok <- Backend.fsckKey backend key (Just file) numcopies
+ backendok <- fsckKey backend key (Just file) numcopies
if locationlogok && backendok
then next $ return True
else stop
@@ -80,3 +88,68 @@ verifyLocationLog key file = do
fix g u s = do
showNote "fixing location log"
logChange g key u s
+
+{- Checks a key for problems. -}
+fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
+fsckKey backend key file numcopies = do
+ size_ok <- checkKeySize key
+ copies_ok <- checkKeyNumCopies key file numcopies
+ backend_ok <-(Types.Backend.fsckKey backend) key
+ return $ size_ok && copies_ok && backend_ok
+
+{- The size of the data for a key is checked against the size encoded in
+ - the key's metadata, if available. -}
+checkKeySize :: Key -> Annex Bool
+checkKeySize key = do
+ g <- Annex.gitRepo
+ let file = gitAnnexLocation g key
+ present <- liftIO $ doesFileExist file
+ case (present, Types.Key.keySize key) of
+ (_, Nothing) -> return True
+ (False, _) -> return True
+ (True, Just size) -> do
+ stat <- liftIO $ getFileStatus file
+ let size' = fromIntegral (fileSize stat)
+ if size == size'
+ then return True
+ else do
+ dest <- moveBad key
+ warning $ "Bad file size (" ++
+ compareSizes storageUnits True size size' ++
+ "); moved to " ++ dest
+ return False
+
+
+checkKeyNumCopies :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool
+checkKeyNumCopies key file numcopies = do
+ needed <- getNumCopies numcopies
+ locations <- keyLocations key
+ untrusted <- trustGet UnTrusted
+ let untrustedlocations = intersect untrusted locations
+ let safelocations = filter (`notElem` untrusted) locations
+ let present = length safelocations
+ if present < needed
+ then do
+ ppuuids <- Remote.prettyPrintUUIDs untrustedlocations
+ warning $ missingNote (filename file key) present needed ppuuids
+ return False
+ else return True
+ where
+ filename Nothing k = show k
+ filename (Just f) _ = f
+
+missingNote :: String -> Int -> Int -> String -> String
+missingNote file 0 _ [] =
+ "** No known copies exist of " ++ file
+missingNote file 0 _ untrusted =
+ "Only these untrusted locations may have copies of " ++ file ++
+ "\n" ++ untrusted ++
+ "Back it up to trusted locations with git-annex copy."
+missingNote file present needed [] =
+ "Only " ++ show present ++ " of " ++ show needed ++
+ " trustworthy copies exist of " ++ file ++
+ "\nBack it up with git-annex copy."
+missingNote file present needed untrusted =
+ missingNote file present needed [] ++
+ "\nThe following untrusted locations may also have copies: " ++
+ "\n" ++ untrusted
diff --git a/Command/Get.hs b/Command/Get.hs
index 50dc009fe..cc780cb6a 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -8,7 +8,6 @@
module Command.Get where
import Command
-import qualified Backend
import qualified Annex
import qualified Remote
import Types
@@ -24,7 +23,7 @@ seek :: [CommandSeek]
seek = [withFilesInGit start]
start :: CommandStartString
-start file = isAnnexed file $ \(key, backend) -> do
+start file = isAnnexed file $ \(key, _) -> do
inannex <- inAnnex key
if inannex
then stop
@@ -32,14 +31,52 @@ start file = isAnnexed file $ \(key, backend) -> do
showStart "get" file
from <- Annex.getState Annex.fromremote
case from of
- Nothing -> next $ perform key backend
+ Nothing -> next $ perform key
Just name -> do
src <- Remote.byName name
next $ Command.Move.fromPerform src False key
-perform :: Key -> Backend Annex -> CommandPerform
-perform key backend = do
- ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
+perform :: Key -> CommandPerform
+perform key = do
+ ok <- getViaTmp key (getKeyFile key)
if ok
then next $ return True -- no cleanup needed
else stop
+
+{- Try to find a copy of the file in one of the remotes,
+ - and copy it to here. -}
+getKeyFile :: Key -> FilePath -> Annex Bool
+getKeyFile key file = do
+ remotes <- Remote.keyPossibilities key
+ if null remotes
+ then do
+ showNote "not available"
+ Remote.showLocations key []
+ return False
+ else trycopy remotes remotes
+ where
+ trycopy full [] = do
+ Remote.showTriedRemotes full
+ Remote.showLocations key []
+ return False
+ trycopy full (r:rs) = do
+ probablythere <- probablyPresent r
+ if probablythere
+ then docopy r (trycopy full rs)
+ else trycopy full rs
+ -- This check is to avoid an ugly message if a remote is a
+ -- drive that is not mounted.
+ probablyPresent r =
+ if Remote.hasKeyCheap r
+ then do
+ res <- Remote.hasKey r key
+ case res of
+ Right b -> return b
+ Left _ -> return False
+ else return True
+ docopy r continue = do
+ showNote $ "from " ++ Remote.name r ++ "..."
+ copied <- Remote.retrieveKeyFile r key file
+ if copied
+ then return True
+ else continue
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index 09ff6df7d..495bf9fb6 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -15,6 +15,7 @@ import System.FilePath
import Command
import qualified Annex
import qualified Backend
+import qualified Types.Key
import Locations
import Types
import Content
@@ -32,18 +33,20 @@ start :: CommandStartBackendFile
start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
exists <- inAnnex key
newbackend <- choosebackend b
- upgradable <- Backend.upgradableKey oldbackend key
- if (newbackend /= oldbackend || upgradable) && exists
+ if (newbackend /= oldbackend || upgradableKey key) && exists
then do
showStart "migrate" file
next $ perform file key newbackend
else stop
where
- choosebackend Nothing = do
- backends <- Backend.list
- return $ head backends
+ choosebackend Nothing = return . head =<< Backend.orderedList
choosebackend (Just backend) = return backend
+{- Checks if a key is upgradable to a newer representation. -}
+{- Ideally, all keys have file size metadata. Old keys may not. -}
+upgradableKey :: Key -> Bool
+upgradableKey key = Types.Key.keySize key == Nothing
+
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file oldkey newbackend = do
g <- Annex.gitRepo
@@ -55,9 +58,9 @@ perform file oldkey newbackend = do
let src = gitAnnexLocation g oldkey
let tmpfile = gitAnnexTmpDir g </> takeFileName file
liftIO $ createLink src tmpfile
- stored <- Backend.storeFileKey tmpfile $ Just newbackend
+ k <- Backend.genKey tmpfile $ Just newbackend
liftIO $ cleantmp tmpfile
- case stored of
+ case k of
Nothing -> stop
Just (newkey, _) -> do
ok <- getViaTmpUnchecked newkey $ \t -> do
diff --git a/Command/Status.hs b/Command/Status.hs
index 53589030b..2448f65a4 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -25,6 +25,7 @@ import DataUnits
import Content
import Types.Key
import Locations
+import Backend
-- a named computation that produces a statistic
type Stat = StatState (Maybe (String, StatState String))
@@ -95,9 +96,8 @@ showStat s = calc =<< s
calc Nothing = return ()
supported_backends :: Stat
-supported_backends = stat "supported backends" $
- lift (Annex.getState Annex.supportedBackends) >>=
- return . unwords . (map B.name)
+supported_backends = stat "supported backends" $
+ return $ unwords $ map B.name Backend.list
supported_remote_types :: Stat
supported_remote_types = stat "supported remote types" $
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index f0c1b27c6..f22503ee0 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -13,10 +13,10 @@ import System.Directory
import System.Posix.Files
import Command
+import qualified Command.Drop
import qualified Annex
import qualified AnnexQueue
import Utility
-import qualified Backend
import LocationLog
import Types
import Content
@@ -33,7 +33,7 @@ seek = [withFilesInGit start]
{- The unannex subcommand undoes an add. -}
start :: CommandStartString
-start file = isAnnexed file $ \(key, backend) -> do
+start file = isAnnexed file $ \(key, _) -> do
ishere <- inAnnex key
if ishere
then do
@@ -46,13 +46,12 @@ start file = isAnnexed file $ \(key, backend) -> do
Annex.changeState $ \s -> s { Annex.force = True }
showStart "unannex" file
- next $ perform file key backend
+ next $ perform file key
else stop
-perform :: FilePath -> Key -> Backend Annex -> CommandPerform
-perform file key backend = do
- -- force backend to always remove
- ok <- Backend.removeKey backend key (Just 0)
+perform :: FilePath -> Key -> CommandPerform
+perform file key = do
+ ok <- Command.Drop.dropKey key (Just 0) -- always remove
if ok
then next $ cleanup file key
else stop
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index ca8b62502..8a897c365 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -12,7 +12,6 @@ import System.Directory hiding (copyFile)
import Command
import qualified Annex
-import qualified Backend
import Types
import Messages
import Locations
@@ -38,7 +37,7 @@ start file = isAnnexed file $ \(key, _) -> do
perform :: FilePath -> Key -> CommandPerform
perform dest key = do
- unlessM (Backend.hasKey key) $ error "content not present"
+ unlessM (inAnnex key) $ error "content not present"
checkDiskSpace key
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-04 04:43:27 +0000