summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs20
-rw-r--r--Command/AddUrl.hs21
-rw-r--r--Command/Drop.hs28
-rw-r--r--Command/DropKey.hs17
-rw-r--r--Command/DropUnused.hs4
-rw-r--r--Command/Fix.hs9
-rw-r--r--Command/Get.hs32
-rw-r--r--Command/Map.hs2
-rw-r--r--Command/Migrate.hs24
-rw-r--r--Command/Move.hs14
-rw-r--r--Command/Status.hs5
-rw-r--r--Command/Sync.hs70
-rw-r--r--Command/Unannex.hs41
-rw-r--r--Command/Unused.hs5
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-08-25 03:05:19 +0000