diff options
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 20 | ||||
-rw-r--r-- | Command/AddUrl.hs | 21 | ||||
-rw-r--r-- | Command/Drop.hs | 28 | ||||
-rw-r--r-- | Command/DropKey.hs | 17 | ||||
-rw-r--r-- | Command/DropUnused.hs | 4 | ||||
-rw-r--r-- | Command/Fix.hs | 9 | ||||
-rw-r--r-- | Command/Get.hs | 32 | ||||
-rw-r--r-- | Command/Map.hs | 2 | ||||
-rw-r--r-- | Command/Migrate.hs | 24 | ||||
-rw-r--r-- | Command/Move.hs | 14 | ||||
-rw-r--r-- | Command/Status.hs | 5 | ||||
-rw-r--r-- | Command/Sync.hs | 70 | ||||
-rw-r--r-- | Command/Unannex.hs | 41 | ||||
-rw-r--r-- | Command/Unused.hs | 5 |
14 files changed, 158 insertions, 134 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index 9fdbdcaa6..9410601b8 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -29,13 +29,21 @@ seek = [withFilesNotInGit start, withFilesUnlocked start] - moving it into the annex directory and setting up the symlink pointing - to its content. -} start :: BackendFile -> CommandStart -start p@(_, file) = notBareRepo $ notAnnexed file $ do - s <- liftIO $ getSymbolicLinkStatus file - if isSymbolicLink s || not (isRegularFile s) - then stop - else do +start p@(_, file) = notBareRepo $ ifAnnexed file fixup add + where + add = do + s <- liftIO $ getSymbolicLinkStatus file + if isSymbolicLink s || not (isRegularFile s) + then stop + else do + showStart "add" file + next $ perform p + fixup (key, _) = do + -- fixup from an interrupted add; the symlink + -- is present but not yet added to git showStart "add" file - next $ perform p + liftIO $ removeFile file + next $ next $ cleanup file key =<< inAnnex key perform :: BackendFile -> CommandPerform perform (backend, file) = Backend.genKey file backend >>= go diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 945848e9f..75ca74031 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -45,18 +45,15 @@ download url file = do let dummykey = Backend.URL.fromUrl url tmp <- fromRepo $ gitAnnexTmpLocation dummykey liftIO $ createDirectoryIfMissing True (parentDir tmp) - ok <- liftIO $ Url.download url tmp - if ok - then do - [(backend, _)] <- Backend.chooseBackends [file] - k <- Backend.genKey tmp backend - case k of - Nothing -> stop - Just (key, _) -> do - moveAnnex key tmp - setUrlPresent key url - next $ Command.Add.cleanup file key True - else stop + stopUnless (liftIO $ Url.download url tmp) $ do + [(backend, _)] <- Backend.chooseBackends [file] + k <- Backend.genKey tmp backend + case k of + Nothing -> stop + Just (key, _) -> do + moveAnnex key tmp + setUrlPresent key url + next $ Command.Add.cleanup file key True nodownload :: String -> FilePath -> CommandPerform nodownload url file = do diff --git a/Command/Drop.hs b/Command/Drop.hs index ee3583869..0a4c9dfd6 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -37,13 +37,9 @@ start numcopies file (key, _) = autoCopies key (>) numcopies $ do else startRemote file numcopies key remote startLocal :: FilePath -> Maybe Int -> Key -> CommandStart -startLocal file numcopies key = do - present <- inAnnex key - if present - then do - showStart "drop" file - next $ performLocal key numcopies - else stop +startLocal file numcopies key = stopUnless (inAnnex key) $ do + showStart "drop" file + next $ performLocal key numcopies startRemote :: FilePath -> Maybe Int -> Key -> Remote.Remote Annex -> CommandStart startRemote file numcopies key remote = do @@ -55,12 +51,9 @@ performLocal key numcopies = lockContent key $ do (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key untrusteduuids <- trustGet UnTrusted let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids) - success <- canDropKey key numcopies trusteduuids tocheck [] - if success - then do - whenM (inAnnex key) $ removeAnnex key - next $ cleanupLocal key - else stop + stopUnless (canDropKey key numcopies trusteduuids tocheck []) $ do + whenM (inAnnex key) $ removeAnnex key + next $ cleanupLocal key performRemote :: Key -> Maybe Int -> Remote.Remote Annex -> CommandPerform performRemote key numcopies remote = lockContent key $ do @@ -75,12 +68,9 @@ performRemote key numcopies remote = lockContent key $ do untrusteduuids <- trustGet UnTrusted let tocheck = filter (/= remote) $ Remote.remotesWithoutUUID remotes (have++untrusteduuids) - success <- canDropKey key numcopies have tocheck [uuid] - if success - then do - ok <- Remote.removeKey remote key - next $ cleanupRemote key remote ok - else stop + stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do + ok <- Remote.removeKey remote key + next $ cleanupRemote key remote ok where uuid = Remote.uuid remote diff --git a/Command/DropKey.hs b/Command/DropKey.hs index b63d481bf..aaaa22466 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -21,18 +21,11 @@ seek :: [CommandSeek] seek = [withKeys start] start :: Key -> CommandStart -start key = do - present <- inAnnex key - if not present - then stop - else do - checkforced - showStart "dropkey" (show key) - next $ perform key - where - checkforced = - unlessM (Annex.getState Annex.force) $ - error "dropkey can cause data loss; use --force if you're sure you want to do this" +start key = stopUnless (inAnnex key) $ do + unlessM (Annex.getState Annex.force) $ + error "dropkey can cause data loss; use --force if you're sure you want to do this" + showStart "dropkey" (show key) + next $ perform key perform :: Key -> CommandPerform perform key = lockContent key $ do diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 3df9ab6c2..244f378d9 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -73,6 +73,6 @@ readUnusedLog prefix = do then M.fromList . map parse . lines <$> liftIO (readFile f) else return M.empty where - parse line = (num, fromJust $ readKey $ tail rest) + parse line = (num, fromJust $ readKey rest) where - (num, rest) = break (== ' ') line + (num, rest) = separate (== ' ') line diff --git a/Command/Fix.hs b/Command/Fix.hs index 27c4b167e..f264106c3 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -23,12 +23,9 @@ seek = [withFilesInGit $ whenAnnexed start] start :: FilePath -> (Key, Backend Annex) -> CommandStart start file (key, _) = do link <- calcGitLink file key - l <- liftIO $ readSymbolicLink file - if link == l - then stop - else do - showStart "fix" file - next $ perform file link + stopUnless ((/=) link <$> liftIO (readSymbolicLink file)) $ do + showStart "fix" file + next $ perform file link perform :: FilePath -> FilePath -> CommandPerform perform file link = do diff --git a/Command/Get.hs b/Command/Get.hs index 093cd2cc5..b7023e2de 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -22,32 +22,24 @@ seek :: [CommandSeek] seek = [withNumCopies $ \n -> whenAnnexed $ start n] start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart -start numcopies file (key, _) = do - inannex <- inAnnex key - if inannex - then stop - else autoCopies key (<) numcopies $ do - from <- Annex.getState Annex.fromremote - case from of - Nothing -> go $ perform key - Just name -> do - -- get --from = copy --from - src <- Remote.byName name - ok <- Command.Move.fromOk src key - if ok - then go $ Command.Move.fromPerform src False key - else stop +start numcopies file (key, _) = stopUnless (not <$> inAnnex key) $ + autoCopies key (<) numcopies $ do + from <- Annex.getState Annex.fromremote + case from of + Nothing -> go $ perform key + Just name -> do + -- get --from = copy --from + src <- Remote.byName name + stopUnless (Command.Move.fromOk src key) $ + go $ Command.Move.fromPerform src False key where go a = do showStart "get" file next a perform :: Key -> CommandPerform -perform key = do - ok <- getViaTmp key (getKeyFile key) - if ok - then next $ return True -- no cleanup needed - else stop +perform key = stopUnless (getViaTmp key $ getKeyFile key) $ do + next $ return True -- no cleanup needed {- Try to find a copy of the file in one of the remotes, - and copy it to here. -} diff --git a/Command/Map.hs b/Command/Map.hs index 6b1e8d5bb..57b48d503 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -203,7 +203,7 @@ tryScan r "git config --list" dir = Git.workTree r cddir - | take 2 dir == "/~" = + | "/~" `isPrefixOf` dir = let (userhome, reldir) = span (/= '/') (drop 1 dir) in "cd " ++ userhome ++ " && cd " ++ shellEscape (drop 1 reldir) | otherwise = "cd " ++ shellEscape dir diff --git a/Command/Migrate.hs b/Command/Migrate.hs index c85d7c2ac..30288fc16 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -58,22 +58,18 @@ perform file oldkey newbackend = do cleantmp tmpfile case k of Nothing -> stop - Just (newkey, _) -> do - ok <- link src newkey - if ok - then do - -- Update symlink to use the new key. - liftIO $ removeFile file + Just (newkey, _) -> stopUnless (link src newkey) $ do + -- Update symlink to use the new key. + liftIO $ removeFile file - -- If the old key had some - -- associated urls, record them for - -- the new key as well. - urls <- getUrls oldkey - unless (null urls) $ - mapM_ (setUrlPresent newkey) urls + -- If the old key had some + -- associated urls, record them for + -- the new key as well. + urls <- getUrls oldkey + unless (null urls) $ + mapM_ (setUrlPresent newkey) urls - next $ Command.Add.cleanup file newkey True - else stop + next $ Command.Add.cleanup file newkey True where cleantmp t = liftIO $ whenM (doesFileExist t) $ removeFile t link src newkey = getViaTmpUnchecked newkey $ \t -> do diff --git a/Command/Move.hs b/Command/Move.hs index fd1ed9019..85fdff739 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -108,17 +108,11 @@ toPerform dest move key = moveLock move key $ do fromStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart fromStart src move file key | move = go - | otherwise = do - ishere <- inAnnex key - if ishere then stop else go + | otherwise = stopUnless (not <$> inAnnex key) go where - go = do - ok <- fromOk src key - if ok - then do - showMoveAction move file - next $ fromPerform src move key - else stop + go = stopUnless (fromOk src key) $ do + showMoveAction move file + next $ fromPerform src move key fromOk :: Remote.Remote Annex -> Key -> Annex Bool fromOk src key = do u <- getUUID diff --git a/Command/Status.hs b/Command/Status.hs index 0fefda1f6..09da41987 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -191,9 +191,8 @@ staleSize label dirspec = do keys <- lift (Command.Unused.staleKeys dirspec) if null keys then nostat - else do - stat label $ json (++ aside "clean up with git-annex unused") $ - return $ keySizeSum $ S.fromList keys + else stat label $ json (++ aside "clean up with git-annex unused") $ + return $ keySizeSum $ S.fromList keys aside :: String -> String aside s = " (" ++ s ++ ")" diff --git a/Command/Sync.hs b/Command/Sync.hs new file mode 100644 index 000000000..7dc5f4d24 --- /dev/null +++ b/Command/Sync.hs @@ -0,0 +1,70 @@ +{- git-annex command + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Sync where + +import Common.Annex +import Command +import qualified Annex.Branch +import qualified Git + +import qualified Data.ByteString.Lazy.Char8 as L + +def :: [Command] +def = [command "sync" paramPaths seek "synchronize local repository with remote"] + +-- syncing involves several operations, any of which can independantly fail +seek :: [CommandSeek] +seek = map withNothing [commit, pull, push] + +commit :: CommandStart +commit = do + showStart "commit" "" + next $ next $ do + showOutput + -- Commit will fail when the tree is clean, so ignore failure. + _ <- inRepo $ Git.runBool "commit" [Param "-a", Param "-m", Param "sync"] + return True + +pull :: CommandStart +pull = do + remote <- defaultRemote + showStart "pull" remote + next $ next $ do + showOutput + checkRemote remote + inRepo $ Git.runBool "pull" [Param remote] + +push :: CommandStart +push = do + remote <- defaultRemote + showStart "push" remote + next $ next $ do + Annex.Branch.update + showOutput + inRepo $ Git.runBool "push" [Param remote, matchingbranches] + where + -- git push may be configured to not push matching + -- branches; this should ensure it always does. + matchingbranches = Param ":" + +-- the remote defaults to origin when not configured +defaultRemote :: Annex String +defaultRemote = do + branch <- currentBranch + fromRepo $ Git.configGet ("branch." ++ branch ++ ".remote") "origin" + +currentBranch :: Annex String +currentBranch = last . split "/" . L.unpack . head . L.lines <$> + inRepo (Git.pipeRead [Param "symbolic-ref", Param "HEAD"]) + +checkRemote :: String -> Annex () +checkRemote remote = do + remoteurl <- fromRepo $ + Git.configGet ("remote." ++ remote ++ ".url") "" + when (null remoteurl) $ do + error $ "No url is configured for the remote: " ++ remote diff --git a/Command/Unannex.hs b/Command/Unannex.hs index e97b6d05d..bed857b06 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -10,7 +10,6 @@ module Command.Unannex where import Common.Annex import Command import qualified Annex -import qualified Annex.Queue import Utility.FileMode import Logs.Location import Annex.Content @@ -23,23 +22,10 @@ def = [command "unannex" paramPaths seek "undo accidential add command"] seek :: [CommandSeek] seek = [withFilesInGit $ whenAnnexed start] -{- The unannex subcommand undoes an add. -} start :: FilePath -> (Key, Backend Annex) -> CommandStart -start file (key, _) = do - ishere <- inAnnex key - if ishere - then do - force <- Annex.getState Annex.force - unless force $ do - top <- fromRepo Git.workTree - staged <- inRepo $ LsFiles.staged [top] - unless (null staged) $ - error "This command cannot be run when there are already files staged for commit." - Annex.changeState $ \s -> s { Annex.force = True } - - showStart "unannex" file - next $ perform file key - else stop +start file (key, _) = stopUnless (inAnnex key) $ do + showStart "unannex" file + next $ perform file key perform :: FilePath -> Key -> CommandPerform perform file key = next $ cleanup file key @@ -47,9 +33,17 @@ perform file key = next $ cleanup file key cleanup :: FilePath -> Key -> CommandCleanup cleanup file key = do liftIO $ removeFile file - inRepo $ Git.run "rm" [Params "--quiet --", File file] - -- git rm deletes empty directories; put them back - liftIO $ createDirectoryIfMissing True (parentDir file) + -- git rm deletes empty directory without --cached + inRepo $ Git.run "rm" [Params "--cached --quiet --", File file] + + -- If the file was already committed, it is now staged for removal. + -- Commit that removal now, to avoid later confusing the + -- pre-commit hook if this file is later added back to + -- git as a normal, non-annexed file. + whenM (not . null <$> inRepo (LsFiles.staged [file])) $ do + inRepo $ Git.run "commit" [ + Param "-m", Param "content removed from git annex", + Param "--", File file] fast <- Annex.getState Annex.fast if fast @@ -62,10 +56,5 @@ cleanup file key = do else do fromAnnex key file logStatus key InfoMissing - - -- Commit staged changes at end to avoid confusing the - -- pre-commit hook if this file is later added back to - -- git as a normal, non-annexed file. - Annex.Queue.add "commit" [Param "-m", Param "content removed from git annex"] [] - + return True diff --git a/Command/Unused.hs b/Command/Unused.hs index 7f9edfef2..be0107752 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -152,13 +152,12 @@ excludeReferenced l = do (S.fromList l) where -- Skip the git-annex branches, and get all other unique refs. - refs = map Git.Ref . - map last . + refs = map (Git.Ref . last) . nubBy cmpheads . filter ourbranches . map words . lines . L.unpack cmpheads a b = head a == head b - ourbranchend = '/' : show (Annex.Branch.name) + ourbranchend = '/' : show Annex.Branch.name ourbranches ws = not $ ourbranchend `isSuffixOf` last ws removewith [] s = return $ S.toList s removewith (a:as) s |