summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Backend/File.hs2
-rw-r--r--Backend/SHA1.hs2
-rw-r--r--Backend/WORM.hs2
-rw-r--r--CmdLine.hs56
-rw-r--r--Command/Add.hs2
-rw-r--r--Command/Drop.hs2
-rw-r--r--Command/DropKey.hs2
-rw-r--r--Command/Find.hs2
-rw-r--r--Command/Fix.hs2
-rw-r--r--Command/FromKey.hs2
-rw-r--r--Command/Get.hs2
-rw-r--r--Command/InAnnex.hs2
-rw-r--r--Command/Migrate.hs2
-rw-r--r--Command/Move.hs2
-rw-r--r--Command/RecvKey.hs3
-rw-r--r--Command/SendKey.hs2
-rw-r--r--Command/SetKey.hs2
-rw-r--r--Command/Unannex.hs2
-rw-r--r--Command/Unlock.hs2
-rw-r--r--Command/Unused.hs13
-rw-r--r--Content.hs (renamed from Core.hs)75
-rw-r--r--Remotes.hs6
-rw-r--r--Upgrade.hs2
-rw-r--r--test.hs4
24 files changed, 104 insertions, 89 deletions
diff --git a/Backend/File.hs b/Backend/File.hs
index 073a7c226..27b2a6901 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -22,7 +22,7 @@ import LocationLog
import Locations
import qualified Remotes
import qualified GitRepo as Git
-import Core
+import Content
import qualified Annex
import UUID
import Messages
diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs
index 68f7f683b..2f3e2cf53 100644
--- a/Backend/SHA1.hs
+++ b/Backend/SHA1.hs
@@ -18,7 +18,7 @@ import TypeInternals
import Messages
import qualified Annex
import Locations
-import Core
+import Content
backend :: Backend
backend = Backend.File.backend {
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index e9d8c4285..0c9301238 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -18,7 +18,7 @@ import qualified Backend.File
import TypeInternals
import Locations
import qualified Annex
-import Core
+import Content
import Messages
backend :: Backend
diff --git a/CmdLine.hs b/CmdLine.hs
index fbcfb6405..6772282c5 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -1,4 +1,4 @@
-{- git-annex command line parsing
+{- git-annex command line parsing and dispatch
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
@@ -7,22 +7,27 @@
module CmdLine (
dispatch,
- parseCmd,
usage,
+ shutdown
) where
+import System.IO.Error (try)
import System.Console.GetOpt
-import Control.Monad (when)
import Control.Monad.State (liftIO)
+import Control.Monad (when, unless)
+import System.Directory
import qualified Annex
import qualified GitRepo as Git
+import qualified GitQueue
import Types
import Command
import BackendList
-import Core
import Upgrade
import Options
+import Messages
+import UUID
+import Locations
{- Runs the passed command line. -}
dispatch :: Git.Repo -> [String] -> [Command] -> [Option] -> String -> IO ()
@@ -68,3 +73,46 @@ usage header cmds options =
indent l = " " ++ l
pad n s = replicate (n - length s) ' '
longest f = foldl max 0 $ map (length . f) cmds
+
+{- Runs a list of Annex actions. Catches IO errors and continues
+ - (but explicitly thrown errors terminate the whole command).
+ - Runs shutdown and propigates an overall error status at the end.
+ -}
+tryRun :: AnnexState -> [Annex Bool] -> IO ()
+tryRun state actions = tryRun' state 0 actions
+tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO ()
+tryRun' state errnum (a:as) = do
+ result <- try $ Annex.run state a
+ case result of
+ Left err -> do
+ Annex.eval state $ showErr err
+ tryRun' state (errnum + 1) as
+ Right (True,state') -> tryRun' state' errnum as
+ Right (False,state') -> tryRun' state' (errnum + 1) as
+tryRun' state errnum [] = do
+ _ <- try $ Annex.run state $ shutdown errnum
+ when (errnum > 0) $ error $ show errnum ++ " failed"
+
+{- Actions to perform each time ran. -}
+startup :: Annex Bool
+startup = do
+ prepUUID
+ return True
+
+{- Cleanup actions. -}
+shutdown :: Integer -> Annex ()
+shutdown errnum = do
+ q <- Annex.queueGet
+ unless (q == GitQueue.empty) $ do
+ showSideAction "Recording state in git..."
+ Annex.queueRun
+
+ -- If nothing failed, clean up any files left in the temp directory,
+ -- but leave the directory itself. If something failed, temp files
+ -- are left behind to allow resuming on re-run.
+ when (errnum == 0) $ do
+ g <- Annex.gitRepo
+ let tmp = annexTmpLocation g
+ exists <- liftIO $ doesDirectoryExist tmp
+ when exists $ liftIO $ removeDirectoryRecursive tmp
+ liftIO $ createDirectoryIfMissing True tmp
diff --git a/Command/Add.hs b/Command/Add.hs
index c74b726e3..4b49297fc 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -15,7 +15,7 @@ import qualified Annex
import qualified Backend
import LocationLog
import Types
-import Core
+import Content
import Messages
command :: [Command]
diff --git a/Command/Drop.hs b/Command/Drop.hs
index a425c6138..065e1743a 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -13,7 +13,7 @@ import Command
import qualified Backend
import LocationLog
import Types
-import Core
+import Content
import Messages
import Utility
diff --git a/Command/DropKey.hs b/Command/DropKey.hs
index 29056139d..6ba5c117c 100644
--- a/Command/DropKey.hs
+++ b/Command/DropKey.hs
@@ -12,7 +12,7 @@ import qualified Annex
import qualified Backend
import LocationLog
import Types
-import Core
+import Content
import Messages
command :: [Command]
diff --git a/Command/Find.hs b/Command/Find.hs
index 6d94ea3f4..3ed15c153 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -11,7 +11,7 @@ import Control.Monad (when)
import Control.Monad.State (liftIO)
import Command
-import Core
+import Content
command :: [Command]
command = [Command "find" (paramOptional $ paramRepeating paramPath) seek
diff --git a/Command/Fix.hs b/Command/Fix.hs
index 8b08a26f6..d67eca164 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -14,7 +14,7 @@ import System.Directory
import Command
import qualified Annex
import Utility
-import Core
+import Content
import Messages
command :: [Command]
diff --git a/Command/FromKey.hs b/Command/FromKey.hs
index 0a13b8c73..9c4a3cfdc 100644
--- a/Command/FromKey.hs
+++ b/Command/FromKey.hs
@@ -17,7 +17,7 @@ import qualified Annex
import Utility
import qualified Backend
import Types
-import Core
+import Content
import Messages
command :: [Command]
diff --git a/Command/Get.hs b/Command/Get.hs
index e3668649e..e0af6c407 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -10,7 +10,7 @@ module Command.Get where
import Command
import qualified Backend
import Types
-import Core
+import Content
import Messages
command :: [Command]
diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs
index d49539513..68ac9a2c6 100644
--- a/Command/InAnnex.hs
+++ b/Command/InAnnex.hs
@@ -12,7 +12,7 @@ import System.Exit
import Command
import Types
-import Core
+import Content
import qualified Backend
command :: [Command]
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index 59ad36a2b..5bc54ceab 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -16,7 +16,7 @@ import qualified Annex
import qualified Backend
import Locations
import Types
-import Core
+import Content
import Messages
import qualified Command.Add
diff --git a/Command/Move.hs b/Command/Move.hs
index 3e7fde370..2920c0661 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -14,7 +14,7 @@ import qualified Command.Drop
import qualified Annex
import LocationLog
import Types
-import Core
+import Content
import qualified GitRepo as Git
import qualified Remotes
import UUID
diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index 840b32861..0abea07f2 100644
--- a/Command/RecvKey.hs
+++ b/Command/RecvKey.hs
@@ -13,7 +13,8 @@ import System.Exit
import Command
import Types
-import Core
+import CmdLine
+import Content
import qualified Backend
import RsyncFile
diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index 0ddc0d23b..aaa0b4836 100644
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -15,7 +15,7 @@ import Locations
import qualified Annex
import Command
import Types
-import Core
+import Content
import qualified Backend
import RsyncFile
diff --git a/Command/SetKey.hs b/Command/SetKey.hs
index 5048d052f..412504b2e 100644
--- a/Command/SetKey.hs
+++ b/Command/SetKey.hs
@@ -16,7 +16,7 @@ import Utility
import qualified Backend
import LocationLog
import Types
-import Core
+import Content
import Messages
command :: [Command]
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index 2c60a23bb..cdd577ba8 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -16,7 +16,7 @@ import Utility
import qualified Backend
import LocationLog
import Types
-import Core
+import Content
import qualified GitRepo as Git
import Messages
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index 4bd6e8599..645fac8a2 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -17,7 +17,7 @@ import qualified Backend
import Types
import Messages
import Locations
-import Core
+import Content
import CopyFile
command :: [Command]
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 62bc5d023..9fdf4cda6 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -9,13 +9,16 @@ module Command.Unused where
import Control.Monad.State (liftIO)
import qualified Data.Map as M
+import Data.Maybe
import Command
import Types
-import Core
+import Content
import Messages
import Locations
import qualified Annex
+import qualified GitRepo as Git
+import qualified Backend
command :: [Command]
command = [Command "unused" paramNothing seek "look for unused file content"]
@@ -80,3 +83,11 @@ unusedKeys = do
existsMap :: Ord k => [k] -> M.Map k Int
existsMap l = M.fromList $ map (\k -> (k, 1)) l
+
+{- List of keys referenced by symlinks in the git repo. -}
+getKeysReferenced :: Annex [Key]
+getKeysReferenced = do
+ g <- Annex.gitRepo
+ files <- liftIO $ Git.inRepo g [Git.workTree g]
+ keypairs <- mapM Backend.lookupFile files
+ return $ map fst $ catMaybes keypairs
diff --git a/Core.hs b/Content.hs
index d59120d67..0cbd6905c 100644
--- a/Core.hs
+++ b/Content.hs
@@ -1,19 +1,30 @@
-{- git-annex core functions
+{- git-annex file content managing
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
-module Core where
+module Content (
+ inAnnex,
+ calcGitLink,
+ logStatus,
+ getViaTmp,
+ preventWrite,
+ allowWrite,
+ moveAnnex,
+ removeAnnex,
+ fromAnnex,
+ moveBad,
+ getKeysPresent
+) where
import System.IO.Error (try)
import System.Directory
import Control.Monad.State (liftIO)
import System.Path
-import Control.Monad (when, unless, filterM)
+import Control.Monad (when, filterM)
import System.Posix.Files
-import Data.Maybe
import System.FilePath
import Types
@@ -21,56 +32,8 @@ import Locations
import LocationLog
import UUID
import qualified GitRepo as Git
-import qualified GitQueue
import qualified Annex
-import qualified Backend
import Utility
-import Messages
-
-{- Runs a list of Annex actions. Catches IO errors and continues
- - (but explicitly thrown errors terminate the whole command).
- - Runs shutdown and propigates an overall error status at the end.
- -}
-tryRun :: AnnexState -> [Annex Bool] -> IO ()
-tryRun state actions = tryRun' state 0 actions
-tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO ()
-tryRun' state errnum (a:as) = do
- result <- try $ Annex.run state a
- case result of
- Left err -> do
- Annex.eval state $ showErr err
- tryRun' state (errnum + 1) as
- Right (True,state') -> tryRun' state' errnum as
- Right (False,state') -> tryRun' state' (errnum + 1) as
-tryRun' state errnum [] = do
- _ <- try $ Annex.run state $ shutdown errnum
- when (errnum > 0) $ error $ show errnum ++ " failed"
-
-{- Actions to perform each time ran. -}
-startup :: Annex Bool
-startup = do
- prepUUID
- return True
-
-{- When git-annex is done, it runs this. -}
-shutdown :: Integer -> Annex Bool
-shutdown errnum = do
- q <- Annex.queueGet
- unless (q == GitQueue.empty) $ do
- showSideAction "Recording state in git..."
- Annex.queueRun
-
- -- If nothing failed, clean up any files left in the temp directory,
- -- but leave the directory itself. If something failed, temp files
- -- are left behind to allow resuming on re-run.
- when (errnum == 0) $ do
- g <- Annex.gitRepo
- let tmp = annexTmpLocation g
- exists <- liftIO $ doesDirectoryExist tmp
- when exists $ liftIO $ removeDirectoryRecursive tmp
- liftIO $ createDirectoryIfMissing True tmp
-
- return True
{- Checks if a given key is currently present in the annexLocation. -}
inAnnex :: Key -> Annex Bool
@@ -200,11 +163,3 @@ getKeysPresent' dir = do
case result of
Right s -> return $ isRegularFile s
Left _ -> return False
-
-{- List of keys referenced by symlinks in the git repo. -}
-getKeysReferenced :: Annex [Key]
-getKeysReferenced = do
- g <- Annex.gitRepo
- files <- liftIO $ Git.inRepo g [Git.workTree g]
- keypairs <- mapM Backend.lookupFile files
- return $ map fst $ catMaybes keypairs
diff --git a/Remotes.hs b/Remotes.hs
index a7a1db415..9004b33d0 100644
--- a/Remotes.hs
+++ b/Remotes.hs
@@ -34,7 +34,7 @@ import LocationLog
import Locations
import UUID
import Utility
-import qualified Core
+import qualified Content
import Messages
import CopyFile
import RsyncFile
@@ -159,7 +159,7 @@ inAnnex r key = if Git.repoIsUrl r
-- run a local check inexpensively,
-- by making an Annex monad using the remote
a <- Annex.new r []
- Annex.eval a (Core.inAnnex key)
+ Annex.eval a (Content.inAnnex key)
checkremote = do
showNote ("checking " ++ Git.repoDescribe r ++ "...")
inannex <- onRemote r (boolSystem, False) "inannex"
@@ -253,7 +253,7 @@ copyToRemote r key
liftIO $ do
a <- Annex.new r []
Annex.eval a $ do
- ok <- Core.getViaTmp key $
+ ok <- Content.getViaTmp key $
\f -> liftIO $ copyFile keysrc f
Annex.queueRun
return ok
diff --git a/Upgrade.hs b/Upgrade.hs
index 2e1708439..596d525db 100644
--- a/Upgrade.hs
+++ b/Upgrade.hs
@@ -14,7 +14,7 @@ import Control.Monad (filterM)
import System.Posix.Files
import System.FilePath
-import Core
+import Content
import Types
import Locations
import qualified GitRepo as Git
diff --git a/test.hs b/test.hs
index 2504bc797..b8b264f0c 100644
--- a/test.hs
+++ b/test.hs
@@ -32,7 +32,7 @@ import qualified GitAnnex
import qualified LocationLog
import qualified UUID
import qualified Remotes
-import qualified Core
+import qualified Content
import qualified Backend.SHA1
import qualified Backend.WORM
import qualified Command.DropUnused
@@ -318,7 +318,7 @@ test_fsck = "git-annex fsck" ~: intmpclonerepo $ do
where
corrupt f = do
git_annex "get" ["-q", f] @? "get of file failed"
- Core.allowWrite f
+ Content.allowWrite f
writeFile f (changedcontent f)
r <- git_annex "fsck" ["-q"]
not r @? "fsck failed to fail with corrupted file content"
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-17 02:26:46 +0000