summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs5
-rw-r--r--Command/AddUrl.hs2
-rw-r--r--Command/Assistant.hs40
-rw-r--r--Command/ContentLocation.hs11
-rw-r--r--Command/Copy.hs2
-rw-r--r--Command/Drop.hs96
-rw-r--r--Command/DropUnused.hs2
-rw-r--r--Command/ExamineKey.hs9
-rw-r--r--Command/Fsck.hs76
-rw-r--r--Command/Get.hs2
-rw-r--r--Command/GroupWanted.hs24
-rw-r--r--Command/Import.hs60
-rw-r--r--Command/ImportFeed.hs4
-rw-r--r--Command/Info.hs2
-rw-r--r--Command/Log.hs10
-rw-r--r--Command/LookupKey.hs12
-rw-r--r--Command/Mirror.hs2
-rw-r--r--Command/NumCopies.hs2
-rw-r--r--Command/Required.hs17
-rw-r--r--Command/Wanted.hs56
-rw-r--r--Command/WebApp.hs4
21 files changed, 261 insertions, 177 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index c461c4d56..d53ba91ad 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -116,7 +116,10 @@ start file = ifAnnexed file addpresent add
- Lockdown can fail if a file gets deleted, and Nothing will be returned.
-}
lockDown :: FilePath -> Annex (Maybe KeySource)
-lockDown = either (\e -> showErr e >> return Nothing) (return . Just) <=< lockDown'
+lockDown = either
+ (\e -> warning (show e) >> return Nothing)
+ (return . Just)
+ <=< lockDown'
lockDown' :: FilePath -> Annex (Either IOException KeySource)
lockDown' file = ifM crippledFileSystem
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 5defc52d9..6474f2614 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -178,7 +178,7 @@ startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring
pathmax <- liftIO $ fileNameLengthLimit "."
let file = flip fromMaybe optfile $
truncateFilePath pathmax $ sanitizeFilePath $
- Quvi.pageTitle page ++ "." ++ Quvi.linkSuffix link
+ Quvi.pageTitle page ++ "." ++ fromMaybe "m" (Quvi.linkSuffix link)
showStart "addurl" file
next $ performQuvi relaxed urlstring (Quvi.linkUrl link) file
#else
diff --git a/Command/Assistant.hs b/Command/Assistant.hs
index 590a2e437..97bc08c7b 100644
--- a/Command/Assistant.hs
+++ b/Command/Assistant.hs
@@ -20,7 +20,7 @@ import Assistant.Install
import System.Environment
cmd :: [Command]
-cmd = [noRepo checkAutoStart $ dontCheck repoExists $ withOptions options $
+cmd = [noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $
notBareRepo $ command "assistant" paramNothing seek SectionCommon
"automatically sync changes"]
@@ -30,11 +30,15 @@ options =
, Command.Watch.stopOption
, autoStartOption
, startDelayOption
+ , autoStopOption
]
autoStartOption :: Option
autoStartOption = flagOption [] "autostart" "start in known repositories"
+autoStopOption :: Option
+autoStopOption = flagOption [] "autostop" "stop in known repositories"
+
startDelayOption :: Option
startDelayOption = fieldOption [] "startdelay" paramNumber "delay before running startup scan"
@@ -43,25 +47,31 @@ seek ps = do
stopdaemon <- getOptionFlag Command.Watch.stopOption
foreground <- getOptionFlag Command.Watch.foregroundOption
autostart <- getOptionFlag autoStartOption
+ autostop <- getOptionFlag autoStopOption
startdelay <- getOptionField startDelayOption (pure . maybe Nothing parseDuration)
- withNothing (start foreground stopdaemon autostart startdelay) ps
+ withNothing (start foreground stopdaemon autostart autostop startdelay) ps
-start :: Bool -> Bool -> Bool -> Maybe Duration -> CommandStart
-start foreground stopdaemon autostart startdelay
+start :: Bool -> Bool -> Bool -> Bool -> Maybe Duration -> CommandStart
+start foreground stopdaemon autostart autostop startdelay
| autostart = do
liftIO $ autoStart startdelay
stop
+ | autostop = do
+ liftIO autoStop
+ stop
| otherwise = do
liftIO ensureInstalled
ensureInitialized
Command.Watch.start True foreground stopdaemon startdelay
-{- Run outside a git repository. Check to see if any parameter is
- - --autostart and enter autostart mode. -}
-checkAutoStart :: CmdParams -> IO ()
-checkAutoStart _ = ifM (elem "--autostart" <$> getArgs)
+{- Run outside a git repository; support autostart and autostop mode. -}
+checkNoRepoOpts :: CmdParams -> IO ()
+checkNoRepoOpts _ = ifM (elem "--autostart" <$> getArgs)
( autoStart Nothing
- , error "Not in a git repository."
+ , ifM (elem "--autostop" <$> getArgs)
+ ( autoStop
+ , error "Not in a git repository."
+ )
)
autoStart :: Maybe Duration -> IO ()
@@ -89,3 +99,15 @@ autoStart startdelay = do
[ Param "assistant"
, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) startdelay)
]
+
+autoStop :: IO ()
+autoStop = do
+ dirs <- liftIO readAutoStartFile
+ program <- programPath
+ forM_ dirs $ \d -> do
+ putStrLn $ "git-annex autostop in " ++ d
+ setCurrentDirectory d
+ ifM (boolSystem program [Param "assistant", Param "--stop"])
+ ( putStrLn "ok"
+ , putStrLn "failed"
+ )
diff --git a/Command/ContentLocation.hs b/Command/ContentLocation.hs
index 3f4775f57..10879f5b1 100644
--- a/Command/ContentLocation.hs
+++ b/Command/ContentLocation.hs
@@ -9,19 +9,20 @@ module Command.ContentLocation where
import Common.Annex
import Command
+import CmdLine.Batch
import Annex.Content
cmd :: [Command]
-cmd = [noCommit $ noMessages $
+cmd = [withOptions [batchOption] $ noCommit $ noMessages $
command "contentlocation" (paramRepeating paramKey) seek
SectionPlumbing "looks up content for a key"]
seek :: CommandSeek
-seek = withKeys start
+seek = batchable withKeys start
-start :: Key -> CommandStart
-start k = do
- liftIO . maybe exitFailure putStrLn
+start :: Batchable Key
+start batchmode k = do
+ maybe (batchBadInput batchmode) (liftIO . putStrLn)
=<< inAnnex' (pure True) Nothing check k
stop
where
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 1b9b2aac8..5cfdabb4e 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -12,7 +12,7 @@ import Command
import qualified Command.Move
import qualified Remote
import Annex.Wanted
-import Config.NumCopies
+import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions copyOptions $ command "copy" paramPaths seek
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 63b9ccb7f..698dd7bad 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -15,7 +15,7 @@ import Annex.UUID
import Logs.Location
import Logs.Trust
import Logs.PreferredContent
-import Config.NumCopies
+import Annex.NumCopies
import Annex.Content
import Annex.Wanted
import Annex.Notification
@@ -27,7 +27,7 @@ cmd = [withOptions (dropOptions) $ command "drop" paramPaths seek
SectionCommon "indicate content of files not currently wanted"]
dropOptions :: [Option]
-dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption]
+dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions
dropFromOption :: Option
dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
@@ -36,23 +36,32 @@ seek :: CommandSeek
seek ps = do
from <- getOptionField dropFromOption Remote.byNameWithUUID
auto <- getOptionFlag autoOption
- withFilesInGit (whenAnnexed $ start auto from) ps
+ withKeyOptions auto
+ (startKeys auto from)
+ (withFilesInGit $ whenAnnexed $ start auto from)
+ ps
start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
-start auto from file key = checkDropAuto auto from file key $ \numcopies ->
+start auto from file key = start' auto from key (Just file)
+
+start' :: Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
+start' auto from key afile = checkDropAuto auto from afile key $ \numcopies ->
stopUnless want $
case from of
- Nothing -> startLocal (Just file) numcopies key Nothing
+ Nothing -> startLocal afile numcopies key Nothing
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
- then startLocal (Just file) numcopies key Nothing
- else startRemote (Just file) numcopies key remote
+ then startLocal afile numcopies key Nothing
+ else startRemote afile numcopies key remote
where
want
- | auto = wantDrop False (Remote.uuid <$> from) (Just key) (Just file)
+ | auto = wantDrop False (Remote.uuid <$> from) (Just key) afile
| otherwise = return True
+startKeys :: Bool -> Maybe Remote -> Key -> CommandStart
+startKeys auto from key = start' auto from key Nothing
+
startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
showStart' "drop" key afile
@@ -72,7 +81,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ \content
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
let trusteduuids' = case knownpresentremote of
Nothing -> trusteduuids
- Just r -> nub (Remote.uuid r:trusteduuids)
+ Just r -> Remote.uuid r:trusteduuids
untrusteduuids <- trustGet UnTrusted
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
u <- getUUID
@@ -91,17 +100,9 @@ performRemote key afile numcopies remote = do
-- Filter the remote it's being dropped from out of the lists of
-- places assumed to have the key, and places to check.
-- When the local repo has the key, that's one additional copy,
- -- as long asthe local repo is not untrusted.
- (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
- present <- inAnnex key
- u <- getUUID
- trusteduuids' <- if present
- then ifM ((<= SemiTrusted) <$> lookupTrust u)
- ( pure (u:trusteduuids)
- , pure trusteduuids
- )
- else pure trusteduuids
- let have = filter (/= uuid) trusteduuids'
+ -- as long as the local repo is not untrusted.
+ (remotes, trusteduuids) <- knownCopies key
+ let have = filter (/= uuid) trusteduuids
untrusteduuids <- trustGet UnTrusted
let tocheck = filter (/= remote) $
Remote.remotesWithoutUUID remotes (have++untrusteduuids)
@@ -131,45 +132,20 @@ cleanupRemote key remote ok = do
- --force overrides and always allows dropping.
-}
canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
-canDrop dropfrom key afile numcopies have check skip = ifM (Annex.getState Annex.force)
- ( return True
- , checkRequiredContent dropfrom key afile
- <&&>
- findCopies key numcopies skip have check
- )
-
-findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
-findCopies key need skip = helper [] []
- where
- helper bad missing have []
- | NumCopies (length have) >= need = return True
- | otherwise = notEnoughCopies key need have (skip++missing) bad
- helper bad missing have (r:rs)
- | NumCopies (length have) >= need = return True
- | otherwise = do
- let u = Remote.uuid r
- let duplicate = u `elem` have
- haskey <- Remote.hasKey r key
- case (duplicate, haskey) of
- (False, Right True) -> helper bad missing (u:have) rs
- (False, Left _) -> helper (r:bad) missing have rs
- (False, Right False) -> helper bad (u:missing) have rs
- _ -> helper bad missing have rs
-
-notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
-notEnoughCopies key need have skip bad = do
- unsafe
- showLongNote $
- "Could only verify the existence of " ++
- show (length have) ++ " out of " ++ show (fromNumCopies need) ++
- " necessary copies"
- Remote.showTriedRemotes bad
- Remote.showLocations True key (have++skip)
- "Rather than dropping this file, try using: git annex move"
- hint
- return False
+canDrop dropfrom key afile numcopies have check skip =
+ ifM (Annex.getState Annex.force)
+ ( return True
+ , ifM (checkRequiredContent dropfrom key afile
+ <&&> verifyEnoughCopies nolocmsg key numcopies skip have check
+ )
+ ( return True
+ , do
+ hint
+ return False
+ )
+ )
where
- unsafe = showNote "unsafe"
+ nolocmsg = "Rather than dropping this file, try using: git annex move"
hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"
checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool
@@ -187,8 +163,8 @@ requiredContent = do
{- In auto mode, only runs the action if there are enough
- copies on other semitrusted repositories. -}
-checkDropAuto :: Bool -> Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart
-checkDropAuto auto mremote file key a = go =<< getFileNumCopies file
+checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
+checkDropAuto auto mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
where
go numcopies
| auto = do
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 36ff49720..d441a4bd2 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -14,7 +14,7 @@ import qualified Command.Drop
import qualified Remote
import qualified Git
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
-import Config.NumCopies
+import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions [Command.Drop.dropFromOption] $
diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs
index 00d4d3a95..05db9817a 100644
--- a/Command/ExamineKey.hs
+++ b/Command/ExamineKey.hs
@@ -9,21 +9,22 @@ module Command.ExamineKey where
import Common.Annex
import Command
+import CmdLine.Batch
import qualified Utility.Format
import Command.Find (formatOption, getFormat, showFormatted, keyVars)
import Types.Key
cmd :: [Command]
-cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $
+cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $
command "examinekey" (paramRepeating paramKey) seek
SectionPlumbing "prints information from a key"]
seek :: CommandSeek
seek ps = do
format <- getFormat
- withKeys (start format) ps
+ batchable withKeys (start format) ps
-start :: Maybe Utility.Format.Format -> Key -> CommandStart
-start format key = do
+start :: Maybe Utility.Format.Format -> Batchable Key
+start format _ key = do
showFormatted format (key2file key) (keyVars key)
stop
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 54f20f5e8..8414b5b26 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -24,21 +24,21 @@ import Annex.Link
import Logs.Location
import Logs.Trust
import Logs.Activity
-import Config.NumCopies
+import Logs.TimeStamp
+import Annex.NumCopies
import Annex.UUID
import Utility.DataUnits
import Config
import Types.Key
import Types.CleanupActions
import Utility.HumanTime
+import Utility.CopyFile
import Git.FilePath
import Utility.PID
import qualified Database.Fsck as FsckDb
import Data.Time.Clock.POSIX
-import Data.Time
import System.Posix.Types (EpochTime)
-import System.Locale
cmd :: [Command]
cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek
@@ -75,7 +75,7 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start from i)
ps
withFsckDb i FsckDb.closeDb
- recordActivity Fsck u
+ void $ tryIO $ recordActivity Fsck u
start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
start from inc file key = do
@@ -111,14 +111,15 @@ performRemote key file backend numcopies remote =
dispatch (Left err) = do
showNote err
return False
- dispatch (Right True) = withtmp $ \tmpfile ->
- ifM (getfile tmpfile)
- ( go True (Just tmpfile)
- , do
+ dispatch (Right True) = withtmp $ \tmpfile -> do
+ r <- getfile tmpfile
+ case r of
+ Nothing -> go True Nothing
+ Just True -> go True (Just tmpfile)
+ Just False -> do
warning "failed to download file from remote"
void $ go True Nothing
return False
- )
dispatch (Right False) = go False Nothing
go present localcopy = check
[ verifyLocationLogRemote key file remote present
@@ -134,14 +135,17 @@ performRemote key file backend numcopies remote =
let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
cleanup
cleanup `after` a tmp
- getfile tmp =
- ifM (Remote.retrieveKeyFileCheap remote key (Just file) tmp)
- ( return True
+ getfile tmp = ifM (checkDiskSpace (Just tmp) key 0)
+ ( ifM (Remote.retrieveKeyFileCheap remote key (Just file) tmp)
+ ( return (Just True)
, ifM (Annex.getState Annex.fast)
- ( return False
- , Remote.retrieveKeyFile remote key (Just file) tmp dummymeter
+ ( return Nothing
+ , Just <$>
+ Remote.retrieveKeyFile remote key Nothing tmp dummymeter
)
)
+ , return (Just False)
+ )
dummymeter _ = noop
startKey :: Incremental -> Key -> NumCopies -> CommandStart
@@ -273,7 +277,7 @@ checkKeySize key = ifM isDirect
checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool
checkKeySizeRemote _ _ Nothing = return True
checkKeySizeRemote key remote (Just file) =
- checkKeySizeOr (badContentRemote remote) key file
+ checkKeySizeOr (badContentRemote remote file) key file
checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> Annex Bool
checkKeySizeOr bad key file = case Types.Key.keySize key of
@@ -318,7 +322,7 @@ checkBackend backend key mfile = go =<< isDirect
checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
checkBackendRemote backend key remote = maybe (return True) go
where
- go = checkBackendOr (badContentRemote remote) backend key
+ go file = checkBackendOr (badContentRemote remote file) backend key file
checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool
checkBackendOr bad backend key file =
@@ -380,13 +384,36 @@ badContentDirect file key = do
logStatus key InfoMissing
return "left in place for you to examine"
-badContentRemote :: Remote -> Key -> Annex String
-badContentRemote remote key = do
- ok <- Remote.removeKey remote key
- when ok $
+{- Bad content is dropped from the remote. We have downloaded a copy
+ - from the remote to a temp file already (in some cases, it's just a
+ - symlink to a file in the remote). To avoid any further data loss,
+ - that temp file is moved to the bad content directory unless
+ - the local annex has a copy of the content. -}
+badContentRemote :: Remote -> FilePath -> Key -> Annex String
+badContentRemote remote localcopy key = do
+ bad <- fromRepo gitAnnexBadDir
+ let destbad = bad </> key2file key
+ movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
+ ( return False
+ , do
+ createAnnexDirectory (parentDir destbad)
+ liftIO $ catchDefaultIO False $
+ ifM (isSymbolicLink <$> getSymbolicLinkStatus localcopy)
+ ( copyFileExternal CopyTimeStamps localcopy destbad
+ , do
+ moveFile localcopy destbad
+ return True
+ )
+ )
+
+ dropped <- Remote.removeKey remote key
+ when dropped $
Remote.logStatus remote key InfoMissing
- return $ (if ok then "dropped from " else "failed to drop from ")
- ++ Remote.name remote
+ return $ case (movedbad, dropped) of
+ (True, True) -> "moved from " ++ Remote.name remote ++
+ " to " ++ destbad
+ (False, True) -> "dropped from " ++ Remote.name remote
+ (_, False) -> "failed to drop from" ++ Remote.name remote
runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart
runFsck inc file key a = ifM (needFsck inc key)
@@ -448,14 +475,11 @@ getStartTime u = do
liftIO $ catchDefaultIO Nothing $ do
timestamp <- modificationTime <$> getFileStatus f
let fromstatus = Just (realToFrac timestamp)
- fromfile <- readishTime <$> readFile f
+ fromfile <- parsePOSIXTime <$> readFile f
return $ if matchingtimestamp fromfile fromstatus
then Just timestamp
else Nothing
where
- readishTime :: String -> Maybe POSIXTime
- readishTime s = utcTimeToPOSIXSeconds <$>
- parseTime defaultTimeLocale "%s%Qs" s
matchingtimestamp fromfile fromstatus =
#ifndef mingw32_HOST_OS
fromfile == fromstatus
diff --git a/Command/Get.hs b/Command/Get.hs
index 111c69e32..380a68097 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -12,7 +12,7 @@ import Command
import qualified Remote
import Annex.Content
import Annex.Transfer
-import Config.NumCopies
+import Annex.NumCopies
import Annex.Wanted
import qualified Command.Move
diff --git a/Command/GroupWanted.hs b/Command/GroupWanted.hs
index 859a39c1b..5cdf785d7 100644
--- a/Command/GroupWanted.hs
+++ b/Command/GroupWanted.hs
@@ -8,13 +8,9 @@
module Command.GroupWanted where
import Common.Annex
-import qualified Annex
import Command
import Logs.PreferredContent
-import Types.Messages
-import Types.Group
-
-import qualified Data.Map as M
+import Command.Wanted (performGet, performSet)
cmd :: [Command]
cmd = [command "groupwanted" (paramPair paramGroup (paramOptional paramExpression)) seek
@@ -24,22 +20,8 @@ seek :: CommandSeek
seek = withWords start
start :: [String] -> CommandStart
-start (g:[]) = next $ performGet g
+start (g:[]) = next $ performGet groupPreferredContentMapRaw g
start (g:expr:[]) = do
showStart "groupwanted" g
- next $ performSet g expr
+ next $ performSet groupPreferredContentSet expr g
start _ = error "Specify a group."
-
-performGet :: Group -> CommandPerform
-performGet g = do
- Annex.setOutput QuietOutput
- m <- groupPreferredContentMapRaw
- liftIO $ putStrLn $ fromMaybe "" $ M.lookup g m
- next $ return True
-
-performSet :: Group -> String -> CommandPerform
-performSet g expr = case checkPreferredContentExpression expr of
- Just e -> error $ "Parse error: " ++ e
- Nothing -> do
- groupPreferredContentSet g expr
- next $ return True
diff --git a/Command/Import.hs b/Command/Import.hs
index 17cb49db1..fffa301ec 100644
--- a/Command/Import.hs
+++ b/Command/Import.hs
@@ -9,6 +9,7 @@ module Command.Import where
import Common.Annex
import Command
+import qualified Git
import qualified Annex
import qualified Command.Add
import Utility.CopyFile
@@ -16,6 +17,10 @@ import Backend
import Remote
import Types.KeySource
import Types.Key
+import Annex.CheckIgnore
+import Annex.NumCopies
+import Types.TrustLevel
+import Logs.Trust
cmd :: [Command]
cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek
@@ -58,6 +63,10 @@ getDuplicateMode = go . catMaybes <$> mapM getflag [minBound..maxBound]
seek :: CommandSeek
seek ps = do
mode <- getDuplicateMode
+ repopath <- liftIO . absPath =<< fromRepo Git.repoPath
+ inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath ps
+ unless (null inrepops) $ do
+ error $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
withPathContents (start mode) ps
start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart
@@ -75,23 +84,41 @@ start mode (srcfile, destfile) =
where
deletedup k = do
showNote $ "duplicate of " ++ key2file k
- liftIO $ removeFile srcfile
- next $ return True
+ ifM (verifiedExisting k destfile)
+ ( do
+ liftIO $ removeFile srcfile
+ next $ return True
+ , do
+ warning "Could not verify that the content is still present in the annex; not removing from the import location."
+ stop
+ )
importfile = do
- handleexisting =<< liftIO (catchMaybeIO $ getSymbolicLinkStatus destfile)
+ ignored <- not <$> Annex.getState Annex.force <&&> checkIgnored destfile
+ if ignored
+ then do
+ warning $ "not importing " ++ destfile ++ " which is .gitignored (use --force to override)"
+ stop
+ else do
+ existing <- liftIO (catchMaybeIO $ getSymbolicLinkStatus destfile)
+ case existing of
+ Nothing -> importfilechecked
+ (Just s)
+ | isDirectory s -> notoverwriting "(is a directory)"
+ | otherwise -> ifM (Annex.getState Annex.force)
+ ( do
+ liftIO $ nukeFile destfile
+ importfilechecked
+ , notoverwriting "(use --force to override, or a duplication option such as --deduplicate to clean up)"
+ )
+ importfilechecked = do
liftIO $ createDirectoryIfMissing True (parentDir destfile)
liftIO $ if mode == Duplicate || mode == SkipDuplicates
then void $ copyFileExternal CopyAllMetaData srcfile destfile
else moveFile srcfile destfile
Command.Add.perform destfile
- handleexisting Nothing = noop
- handleexisting (Just s)
- | isDirectory s = notoverwriting "(is a directory)"
- | otherwise = ifM (Annex.getState Annex.force)
- ( liftIO $ nukeFile destfile
- , notoverwriting "(use --force to override, or a duplication option such as --deduplicate to clean up)"
- )
- notoverwriting why = error $ "not overwriting existing " ++ destfile ++ " " ++ why
+ notoverwriting why = do
+ warning $ "not overwriting existing " ++ destfile ++ " " ++ why
+ stop
checkdup dupa notdupa = do
backend <- chooseBackend destfile
let ks = KeySource srcfile srcfile Nothing
@@ -107,3 +134,14 @@ start mode (srcfile, destfile) =
CleanDuplicates -> checkdup (Just deletedup) Nothing
SkipDuplicates -> checkdup Nothing (Just importfile)
_ -> return (Just importfile)
+
+verifiedExisting :: Key -> FilePath -> Annex Bool
+verifiedExisting key destfile = do
+ -- Look up the numcopies setting for the file that it would be
+ -- imported to, if it were imported.
+ need <- getFileNumCopies destfile
+
+ (remotes, trusteduuids) <- knownCopies key
+ untrusteduuids <- trustGet UnTrusted
+ let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
+ verifyEnoughCopies [] key need trusteduuids [] tocheck
diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index 2a278dea1..6d3a1765b 100644
--- a/Command/ImportFeed.hs
+++ b/Command/ImportFeed.hs
@@ -16,7 +16,9 @@ import qualified Data.Set as S
import qualified Data.Map as M
import Data.Time.Clock
import Data.Time.Format
+#if ! MIN_VERSION_time(1,5,0)
import System.Locale
+#endif
import Common.Annex
import qualified Annex
@@ -196,7 +198,7 @@ performDownload opts cache todownload = case location todownload of
Just link -> do
let videourl = Quvi.linkUrl link
checkknown videourl $
- rundownload videourl ("." ++ Quvi.linkSuffix link) $ \f ->
+ rundownload videourl ("." ++ fromMaybe "m" (Quvi.linkSuffix link)) $ \f ->
maybeToList <$> addUrlFileQuvi (relaxedOpt opts) quviurl videourl f
#else
return False
diff --git a/Command/Info.hs b/Command/Info.hs
index b7cb3232f..1c2dd2fb2 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -30,7 +30,7 @@ import Types.Key
import Logs.UUID
import Logs.Trust
import Logs.Location
-import Config.NumCopies
+import Annex.NumCopies
import Remote
import Config
import Utility.Percentage
diff --git a/Command/Log.hs b/Command/Log.hs
index 4bc7bb89a..671c9d674 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -5,15 +5,19 @@
- Licensed under the GNU GPL version 3 or higher.
-}
+{-# LANGUAGE CPP #-}
+
module Command.Log where
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
import Data.Time.Clock.POSIX
import Data.Time
+#if ! MIN_VERSION_time(1,5,0)
import System.Locale
-import Data.Char
+#endif
import Common.Annex
import Command
@@ -172,7 +176,11 @@ parseRaw l = go $ words l
parseTimeStamp :: String -> POSIXTime
parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (error "bad timestamp") .
+#if MIN_VERSION_time(1,5,0)
+ parseTimeM True defaultTimeLocale "%s"
+#else
parseTime defaultTimeLocale "%s"
+#endif
showTimeStamp :: TimeZone -> POSIXTime -> String
showTimeStamp zone = show . utcToLocalTime zone . posixSecondsToUTCTime
diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs
index 0485232ae..6e7f07049 100644
--- a/Command/LookupKey.hs
+++ b/Command/LookupKey.hs
@@ -9,18 +9,20 @@ module Command.LookupKey where
import Common.Annex
import Command
+import CmdLine.Batch
import Annex.CatFile
import Types.Key
cmd :: [Command]
-cmd = [notBareRepo $ noCommit $ noMessages $
+cmd = [withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $
command "lookupkey" (paramRepeating paramFile) seek
SectionPlumbing "looks up key used for file"]
seek :: CommandSeek
-seek = withStrings start
+seek = batchable withStrings start
-start :: String -> CommandStart
-start file = do
- liftIO . maybe exitFailure (putStrLn . key2file) =<< catKeyFile file
+start :: Batchable String
+start batchmode file = do
+ maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file)
+ =<< catKeyFile file
stop
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index 6c3895be1..535dc64b6 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -14,7 +14,7 @@ import qualified Command.Drop
import qualified Command.Get
import qualified Remote
import Annex.Content
-import Config.NumCopies
+import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek
diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs
index 6c69b2166..1e710f561 100644
--- a/Command/NumCopies.hs
+++ b/Command/NumCopies.hs
@@ -10,7 +10,7 @@ module Command.NumCopies where
import Common.Annex
import qualified Annex
import Command
-import Config.NumCopies
+import Annex.NumCopies
import Types.Messages
cmd :: [Command]
diff --git a/Command/Required.hs b/Command/Required.hs
new file mode 100644
index 000000000..3d9c59279
--- /dev/null
+++ b/Command/Required.hs
@@ -0,0 +1,17 @@
+{- git-annex command
+ -
+ - Copyright 2015 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Required where
+
+import Command
+import Logs.PreferredContent
+import qualified Command.Wanted
+
+cmd :: [Command]
+cmd = Command.Wanted.cmd' "required" "get or set required content expression"
+ requiredContentMapRaw
+ requiredContentSet
diff --git a/Command/Wanted.hs b/Command/Wanted.hs
index 6b87e51d8..07f5ee7c3 100644
--- a/Command/Wanted.hs
+++ b/Command/Wanted.hs
@@ -1,6 +1,6 @@
{- git-annex command
-
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -13,39 +13,47 @@ import Command
import qualified Remote
import Logs.PreferredContent
import Types.Messages
+import Types.StandardGroups
import qualified Data.Map as M
cmd :: [Command]
-cmd = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek
- SectionSetup "get or set preferred content expression"]
-
-seek :: CommandSeek
-seek = withWords start
-
-start :: [String] -> CommandStart
-start = parse
+cmd = cmd' "wanted" "get or set preferred content expression"
+ preferredContentMapRaw
+ preferredContentSet
+
+cmd'
+ :: String
+ -> String
+ -> Annex (M.Map UUID PreferredContentExpression)
+ -> (UUID -> PreferredContentExpression -> Annex ())
+ -> [Command]
+cmd' name desc getter setter = [command name pdesc seek SectionSetup desc]
where
- parse (name:[]) = go name performGet
- parse (name:expr:[]) = go name $ \uuid -> do
- showStart "wanted" name
- performSet expr uuid
- parse _ = error "Specify a repository."
-
- go name a = do
- u <- Remote.nameToUUID name
+ pdesc = paramPair paramRemote (paramOptional paramExpression)
+
+ seek = withWords start
+
+ start (rname:[]) = go rname (performGet getter)
+ start (rname:expr:[]) = go rname $ \uuid -> do
+ showStart name rname
+ performSet setter expr uuid
+ start _ = error "Specify a repository."
+
+ go rname a = do
+ u <- Remote.nameToUUID rname
next $ a u
-performGet :: UUID -> CommandPerform
-performGet uuid = do
+performGet :: Ord a => Annex (M.Map a PreferredContentExpression) -> a -> CommandPerform
+performGet getter a = do
Annex.setOutput QuietOutput
- m <- preferredContentMapRaw
- liftIO $ putStrLn $ fromMaybe "" $ M.lookup uuid m
+ m <- getter
+ liftIO $ putStrLn $ fromMaybe "" $ M.lookup a m
next $ return True
-performSet :: String -> UUID -> CommandPerform
-performSet expr uuid = case checkPreferredContentExpression expr of
+performSet :: Ord a => (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform
+performSet setter expr a = case checkPreferredContentExpression expr of
Just e -> error $ "Parse error: " ++ e
Nothing -> do
- preferredContentSet uuid expr
+ setter a expr
next $ return True
diff --git a/Command/WebApp.hs b/Command/WebApp.hs
index 46ba556a3..e872d4be0 100644
--- a/Command/WebApp.hs
+++ b/Command/WebApp.hs
@@ -143,10 +143,10 @@ firstRun :: Maybe HostName -> IO ()
firstRun listenhost = do
checkEnvironmentIO
{- Without a repository, we cannot have an Annex monad, so cannot
- - get a ThreadState. Using undefined is only safe because the
+ - get a ThreadState. This is only safe because the
- webapp checks its noAnnex field before accessing the
- threadstate. -}
- let st = undefined
+ let st = error "annex state not available"
{- Get a DaemonStatus without running in the Annex monad. -}
dstatus <- atomically . newTMVar =<< newDaemonStatus
d <- newAssistantData st dstatus