diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-05-12 13:23:22 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-05-12 13:23:22 -0400 |
commit | 4d49342612dd441cdc503b5294035fc05a9a5a77 (patch) | |
tree | 435a82d44b5a6aa3df411b36fb9fad2553cc670a /Command | |
parent | 44a48a19ffeb8085e7ae1f6bf58d5661adaf8a8d (diff) | |
parent | 5cd9e10cde3c06ecc6a97f5f60a9def22f959bd2 (diff) |
Merge branch 'master' into concurrentprogress
Conflicts:
Command/Fsck.hs
Messages.hs
Remote/Directory.hs
Remote/Git.hs
Remote/Helper/Special.hs
Types/Remote.hs
debian/changelog
git-annex.cabal
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 5 | ||||
-rw-r--r-- | Command/AddUrl.hs | 2 | ||||
-rw-r--r-- | Command/Assistant.hs | 40 | ||||
-rw-r--r-- | Command/ContentLocation.hs | 11 | ||||
-rw-r--r-- | Command/Copy.hs | 2 | ||||
-rw-r--r-- | Command/Drop.hs | 96 | ||||
-rw-r--r-- | Command/DropUnused.hs | 2 | ||||
-rw-r--r-- | Command/ExamineKey.hs | 9 | ||||
-rw-r--r-- | Command/Fsck.hs | 76 | ||||
-rw-r--r-- | Command/Get.hs | 2 | ||||
-rw-r--r-- | Command/GroupWanted.hs | 24 | ||||
-rw-r--r-- | Command/Import.hs | 60 | ||||
-rw-r--r-- | Command/ImportFeed.hs | 4 | ||||
-rw-r--r-- | Command/Info.hs | 2 | ||||
-rw-r--r-- | Command/Log.hs | 10 | ||||
-rw-r--r-- | Command/LookupKey.hs | 12 | ||||
-rw-r--r-- | Command/Mirror.hs | 2 | ||||
-rw-r--r-- | Command/NumCopies.hs | 2 | ||||
-rw-r--r-- | Command/Required.hs | 17 | ||||
-rw-r--r-- | Command/Wanted.hs | 56 | ||||
-rw-r--r-- | Command/WebApp.hs | 4 |
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 |