mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 2

factor out common imports

Browse source 
no code changes
This commit is contained in:
Joey Hess 2011-10-03 22:24:57 -04:00
parent 003a604a6e
commit 8ef2095fa0
83 changed files with 264 additions and 619 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
Annex.hs
View file

@ -19,10 +19,10 @@ module Annex (
gitRepo
) where
import Control.Monad.State
import Control.Monad.IO.Control
import Control.Applicative hiding (empty)
import Control.Monad.State
import Common
import qualified Git
import Git.CatFile
import Git.Queue
@ -75,7 +75,7 @@ newState gitrepo = AnnexState
{ repo = gitrepo
, backends = []
, remotes = []
, repoqueue = empty
, repoqueue = Git.Queue.empty
, output = NormalOutput
, force = False
, fast = False

13
AnnexCommon.hs Normal file
View file

@ -0,0 +1,13 @@
module AnnexCommon (
module Common,
module Types,
module Annex,
module Locations,
module Messages,
) where
import Common
import Types
import Annex (gitRepo)
import Locations
import Messages

6
AnnexQueue.hs
View file

@ -11,13 +11,9 @@ module AnnexQueue (
flushWhenFull
) where
import Control.Monad.State (liftIO)
import Control.Monad (when, unless)
import AnnexCommon
import Annex
import Messages
import qualified Git.Queue
import Utility.SafeCommand
{- Adds a git command to the queue. -}
add :: String -> [CommandParam] -> [FilePath] -> Annex ()

12
Backend.hs
View file

@ -16,20 +16,14 @@ module Backend (
maybeLookupBackendName
) where
import Control.Monad.State (liftIO, when)
import Control.Applicative
import System.IO.Error (try)
import System.FilePath
import System.Posix.Files
import Data.Maybe
import Locations
import AnnexCommon
import qualified Git
import qualified Annex
import Types
import Types.Key
import qualified Types.Backend as B
import Messages
-- When adding a new backend, import it here and add it to the list.
import qualified Backend.WORM
@ -59,7 +53,7 @@ orderedList = do
Annex.changeState $ \state -> state { Annex.backends = l' }
return l'
getstandard = do
g <- Annex.gitRepo
g <- gitRepo
return $ parseBackendList $
Git.configGet g "annex.backends" ""
@ -108,7 +102,7 @@ type BackendFile = (Maybe (Backend Annex), FilePath)
-}
chooseBackends :: [FilePath] -> Annex [BackendFile]
chooseBackends fs = do
g <- Annex.gitRepo
g <- gitRepo
forced <- Annex.getState Annex.forcebackend
if isJust forced
then do

16
Backend/SHA.hs
View file

@ -7,23 +7,11 @@
module Backend.SHA (backends) where
import Control.Monad.State
import Data.String.Utils
import System.Cmd.Utils
import System.IO
import System.Directory
import Data.Maybe
import System.Posix.Files
import System.FilePath
import Messages
import AnnexCommon
import qualified Annex
import Locations
import Content
import Types
import Types.Backend
import Types.Key
import Utility.SafeCommand
import qualified Build.SysConfig as SysConfig
type SHASize = Int
@ -110,7 +98,7 @@ keyValueE size file = keyValue size file >>= maybe (return Nothing) addE
{- A key's checksum is checked during fsck. -}
checkKeyChecksum :: SHASize -> Key -> Annex Bool
checkKeyChecksum size key = do
g <- Annex.gitRepo
g <- gitRepo
fast <- Annex.getState Annex.fast
let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file

2
Backend/URL.hs
View file

@ -10,9 +10,9 @@ module Backend.URL (
fromUrl
) where
import AnnexCommon
import Types.Backend
import Types.Key
import Types
backends :: [Backend Annex]
backends = [backend]

6
Backend/WORM.hs
View file

@ -7,12 +7,8 @@
module Backend.WORM (backends) where
import Control.Monad.State
import System.FilePath
import System.Posix.Files
import AnnexCommon
import Types.Backend
import Types
import Types.Key
backends :: [Backend Annex]

50
Branch.hs
View file

@ -18,33 +18,17 @@ module Branch (
name
) where
import Control.Monad (unless, when, liftM, filterM)
import Control.Monad.State (liftIO)
import Control.Applicative ((<$>))
import System.FilePath
import System.Directory
import Data.String.Utils
import System.Cmd.Utils
import System.IO
import System.IO.Binary
import System.Posix.Process
import System.Posix.IO
import System.Posix.Files
import System.Exit
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad.IO.Control (liftIOOp)
import qualified Control.Exception.Base
import qualified Control.Exception
import AnnexCommon
import Types.BranchState
import qualified Git
import qualified Git.UnionMerge
import qualified Annex
import Utility
import Utility.Conditional
import Utility.SafeCommand
import Types
import Messages
import Locations
import CatFile
type GitRef = String
@ -79,7 +63,7 @@ withIndex :: Annex a -> Annex a
withIndex = withIndex' False
withIndex' :: Bool -> Annex a -> Annex a
withIndex' bootstrapping a = do
g <- Annex.gitRepo
g <- gitRepo
let f = index g
reset <- liftIO $ Git.useIndex f
@ -123,7 +107,7 @@ getCache file = getState >>= handle
{- Creates the branch, if it does not already exist. -}
create :: Annex ()
create = unlessM hasBranch $ do
g <- Annex.gitRepo
g <- gitRepo
e <- hasOrigin
if e
then liftIO $ Git.run g "branch" [Param name, Param originname]
@ -136,7 +120,7 @@ commit message = do
fs <- getJournalFiles
when (not $ null fs) $ lockJournal $ do
stageJournalFiles fs
g <- Annex.gitRepo
g <- gitRepo
withIndex $ liftIO $ Git.commit g message fullname [fullname]
{- Ensures that the branch is up-to-date; should be called before
@ -161,13 +145,13 @@ update = do
-}
unless (null fs) $ stageJournalFiles fs
mapM_ mergeref refs
g <- Annex.gitRepo
g <- gitRepo
liftIO $ Git.commit g "update" fullname (fullname:refs)
Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } }
invalidateCache
where
checkref ref = do
g <- Annex.gitRepo
g <- gitRepo
-- checking with log to see if there have been changes
-- is less expensive than always merging
diffs <- liftIO $ Git.pipeRead g [
@ -189,14 +173,14 @@ update = do
- advises users not to directly modify the
- branch.
-}
g <- Annex.gitRepo
g <- gitRepo
liftIO $ Git.UnionMerge.merge g [ref]
return $ Just ref
{- Checks if a git ref exists. -}
refExists :: GitRef -> Annex Bool
refExists ref = do
g <- Annex.gitRepo
g <- gitRepo
liftIO $ Git.runBool g "show-ref"
[Param "--verify", Param "-q", Param ref]
@ -216,7 +200,7 @@ hasSomeBranch = not . null <$> siblingBranches
- from remotes. -}
siblingBranches :: Annex [String]
siblingBranches = do
g <- Annex.gitRepo
g <- gitRepo
r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name]
return $ map (last . words . L.unpack) (L.lines r)
@ -253,7 +237,7 @@ get file = do
{- Lists all files on the branch. There may be duplicates in the list. -}
files :: Annex [FilePath]
files = withIndexUpdate $ do
g <- Annex.gitRepo
g <- gitRepo
bfiles <- liftIO $ Git.pipeNullSplit g
[Params "ls-tree --name-only -r -z", Param fullname]
jfiles <- getJournalledFiles
@ -265,7 +249,7 @@ files = withIndexUpdate $ do
- avoids git needing to rewrite the index after every change. -}
setJournalFile :: FilePath -> String -> Annex ()
setJournalFile file content = do
g <- Annex.gitRepo
g <- gitRepo
liftIO $ catch (write g) $ const $ do
createDirectoryIfMissing True $ gitAnnexJournalDir g
createDirectoryIfMissing True $ gitAnnexTmpDir g
@ -281,7 +265,7 @@ setJournalFile file content = do
{- Gets any journalled content for a file in the branch. -}
getJournalFile :: FilePath -> Annex (Maybe String)
getJournalFile file = do
g <- Annex.gitRepo
g <- gitRepo
liftIO $ catch (liftM Just . readFileStrict $ journalFile g file)
(const $ return Nothing)
@ -292,7 +276,7 @@ getJournalledFiles = map fileJournal <$> getJournalFiles
{- List of existing journal files. -}
getJournalFiles :: Annex [FilePath]
getJournalFiles = do
g <- Annex.gitRepo
g <- gitRepo
fs <- liftIO $ catch (getDirectoryContents $ gitAnnexJournalDir g)
(const $ return [])
return $ filter (`notElem` [".", ".."]) fs
@ -300,7 +284,7 @@ getJournalFiles = do
{- Stages the specified journalfiles. -}
stageJournalFiles :: [FilePath] -> Annex ()
stageJournalFiles fs = do
g <- Annex.gitRepo
g <- gitRepo
withIndex $ liftIO $ do
let dir = gitAnnexJournalDir g
let paths = map (dir </>) fs
@ -346,9 +330,9 @@ fileJournal = replace "//" "_" . replace "_" "/"
- contention with other git-annex processes. -}
lockJournal :: Annex a -> Annex a
lockJournal a = do
g <- Annex.gitRepo
g <- gitRepo
let file = gitAnnexJournalLock g
liftIOOp (Control.Exception.Base.bracket (lock file) unlock) run
liftIOOp (Control.Exception.bracket (lock file) unlock) run
where
lock file = do
l <- createFile file stdFileMode

6
CatFile.hs
View file

@ -9,17 +9,15 @@ module CatFile (
catFile
) where
import Control.Monad.State
import AnnexCommon
import qualified Git.CatFile
import Types
import qualified Annex
catFile :: String -> FilePath -> Annex String
catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle
where
startup = do
g <- Annex.gitRepo
g <- gitRepo
h <- liftIO $ Git.CatFile.catFileStart g
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
go h

5
CmdLine.hs
View file

@ -13,17 +13,14 @@ module CmdLine (
import System.IO.Error (try)
import System.Console.GetOpt
import Control.Monad.State (liftIO)
import Control.Monad (when)
import AnnexCommon
import qualified Annex
import qualified AnnexQueue
import qualified Git
import Content
import Types
import Command
import Options
import Messages
import Init
{- Runs the passed command line. -}

27
Command.hs
View file

@ -7,22 +7,11 @@
module Command where
import Control.Monad.State (liftIO)
import System.Directory
import System.Posix.Files
import Control.Monad (filterM, liftM)
import Control.Applicative
import Data.Maybe
import Types
import AnnexCommon
import qualified Backend
import Messages
import qualified Annex
import qualified Git
import qualified Git.LsFiles as LsFiles
import Utility
import Utility.Conditional
import Utility.Path
import Types.Key
import Trust
import LocationLog
@ -98,7 +87,7 @@ isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
notBareRepo :: Annex a -> Annex a
notBareRepo a = do
whenM (Git.repoIsLocalBare <$> Annex.gitRepo) $
whenM (Git.repoIsLocalBare <$> gitRepo) $
error "You cannot run this subcommand in a bare repository."
a
@ -106,11 +95,11 @@ notBareRepo a = do
user's parameters, and prepare actions operating on them. -}
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
withFilesInGit a params = do
repo <- Annex.gitRepo
repo <- gitRepo
runFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
withAttrFilesInGit attr a params = do
repo <- Annex.gitRepo
repo <- gitRepo
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
runFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files
withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek
@ -119,7 +108,7 @@ withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
go (file, v) = a file (readMaybe v)
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
withBackendFilesInGit a params = do
repo <- Annex.gitRepo
repo <- gitRepo
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
backendPairs a files
withFilesMissing :: (String -> CommandStart) -> CommandSeek
@ -128,7 +117,7 @@ withFilesMissing a params = runFiltered a $ liftIO $ filterM missing params
missing = liftM not . doesFileExist
withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
withFilesNotInGit a params = do
repo <- Annex.gitRepo
repo <- gitRepo
force <- Annex.getState Annex.force
newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params
backendPairs a newfiles
@ -138,7 +127,7 @@ withStrings :: (String -> CommandStart) -> CommandSeek
withStrings a params = return $ map a params
withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
withFilesToBeCommitted a params = do
repo <- Annex.gitRepo
repo <- gitRepo
runFiltered a $
liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek
@ -148,7 +137,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
withFilesUnlocked' typechanged a params = do
-- unlocked files have changed type from a symlink to a regular file
repo <- Annex.gitRepo
repo <- gitRepo
typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params
unlockedfiles <- liftIO $ filterM notSymlink $
map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles

13
Command/Add.hs
View file

@ -7,26 +7,17 @@
module Command.Add where
import Control.Monad.State (liftIO)
import Control.Monad (when)
import System.Posix.Files
import System.Directory
import Control.Exception.Control (handle)
import Control.Exception.Base (throwIO)
import Control.Exception.Extensible (IOException)
import AnnexCommon
import Command
import qualified Annex
import qualified AnnexQueue
import qualified Backend
import LocationLog
import Types
import Content
import Messages
import Utility.Conditional
import Utility.Touch
import Utility.SafeCommand
import Locations
import Backend
command :: [Command]
@ -72,7 +63,7 @@ undo file key e = do
-- fromAnnex could fail if the file ownership is weird
tryharder :: IOException -> Annex ()
tryharder _ = do
g <- Annex.gitRepo
g <- gitRepo
liftIO $ renameFile (gitAnnexLocation g key) file
cleanup :: FilePath -> Key -> Bool -> CommandCleanup

11
Command/AddUrl.hs
View file

@ -7,12 +7,9 @@
module Command.AddUrl where
import Control.Monad.State
import Network.URI
import Data.String.Utils
import Data.Maybe
import System.Directory
import AnnexCommon
import Command
import qualified Backend
import qualified Utility.Url as Url
@ -20,12 +17,8 @@ import qualified Remote.Web
import qualified Command.Add
import qualified Annex
import qualified Backend.URL
import Messages
import Content
import PresenceLog
import Locations
import Utility.Path
import Utility.Conditional
command :: [Command]
command = [repoCommand "addurl" (paramRepeating paramUrl) seek
@ -51,7 +44,7 @@ perform url file = do
download :: String -> FilePath -> CommandPerform
download url file = do
g <- Annex.gitRepo
g <- gitRepo
showAction $ "downloading " ++ url ++ " "
let dummykey = Backend.URL.fromUrl url
let tmp = gitAnnexTmpLocation g dummykey

6
Command/ConfigList.hs
View file

@ -7,9 +7,7 @@
module Command.ConfigList where
import Control.Monad.State (liftIO)
import Annex
import AnnexCommon
import Command
import UUID
@ -22,7 +20,7 @@ seek = [withNothing start]
start :: CommandStart
start = do
g <- Annex.gitRepo
g <- gitRepo
u <- getUUID g
liftIO $ putStrLn $ "annex.uuid=" ++ u
stop

2
Command/Describe.hs
View file

@ -7,10 +7,10 @@
module Command.Describe where
import AnnexCommon
import Command
import qualified Remote
import UUID
import Messages
command :: [Command]
command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek

8
Command/Drop.hs
View file

@ -7,14 +7,12 @@
module Command.Drop where
import AnnexCommon
import Command
import qualified Remote
import qualified Annex
import LocationLog
import Types
import Content
import Messages
import Utility.Conditional
import Trust
import Config
@ -71,9 +69,9 @@ dropKey key numcopiesM = do
| length have >= need = return True
| otherwise = do
let u = Remote.uuid r
let dup = u `elem` have
let duplicate = u `elem` have
haskey <- Remote.hasKey r key
case (dup, haskey) of
case (duplicate, haskey) of
(False, Right True) -> findcopies need (u:have) rs bad
(False, Left _) -> findcopies need have rs (r:bad)
_ -> findcopies need have rs bad

3
Command/DropKey.hs
View file

@ -7,12 +7,11 @@
module Command.DropKey where
import AnnexCommon
import Command
import qualified Annex
import LocationLog
import Types
import Content
import Messages
command :: [Command]
command = [repoCommand "dropkey" (paramRepeating paramKey) seek

12
Command/DropUnused.hs
View file

@ -7,22 +7,16 @@
module Command.DropUnused where
import Control.Monad.State (liftIO)
import qualified Data.Map as M
import System.Directory
import Data.Maybe
import AnnexCommon
import Command
import Types
import Messages
import Locations
import qualified Annex
import qualified Command.Drop
import qualified Command.Move
import qualified Remote
import qualified Git
import Types.Key
import Utility.Conditional
type UnusedMap = M.Map String Key
@ -67,14 +61,14 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
performOther filespec key = do
g <- Annex.gitRepo
g <- gitRepo
let f = filespec g key
liftIO $ whenM (doesFileExist f) $ removeFile f
next $ return True
readUnusedLog :: FilePath -> Annex UnusedMap
readUnusedLog prefix = do
g <- Annex.gitRepo
g <- gitRepo
let f = gitAnnexUnusedLog prefix g
e <- liftIO $ doesFileExist f
if e

4
Command/Find.hs
View file

@ -7,11 +7,9 @@
module Command.Find where
import Control.Monad.State
import AnnexCommon
import Command
import Content
import Utility.Conditional
import Limit
command :: [Command]

8
Command/Fix.hs
View file

@ -7,16 +7,10 @@
module Command.Fix where
import Control.Monad.State (liftIO)
import System.Posix.Files
import System.Directory
import AnnexCommon
import Command
import qualified AnnexQueue
import Utility.Path
import Utility.SafeCommand
import Content
import Messages
command :: [Command]
command = [repoCommand "fix" paramPaths seek

9
Command/FromKey.hs
View file

@ -7,18 +7,11 @@
module Command.FromKey where
import Control.Monad.State (liftIO)
import System.Posix.Files
import System.Directory
import Control.Monad (unless)
import AnnexCommon
import Command
import qualified AnnexQueue
import Utility.SafeCommand
import Content
import Messages
import Types.Key
import Utility.Path
command :: [Command]
command = [repoCommand "fromkey" paramPath seek

15
Command/Fsck.hs
View file

@ -7,25 +7,16 @@
module Command.Fsck where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Directory
import System.Posix.Files
import AnnexCommon
import Command
import qualified Annex
import qualified Remote
import qualified Types.Backend
import qualified Types.Key
import UUID
import Types
import Messages
import Content
import LocationLog
import Locations
import Trust
import Utility.DataUnits
import Utility.Path
import Utility.FileMode
import Config
@ -54,7 +45,7 @@ perform key file backend numcopies = do
in this repository only. -}
verifyLocationLog :: Key -> FilePath -> Annex Bool
verifyLocationLog key file = do
g <- Annex.gitRepo
g <- gitRepo
present <- inAnnex key
-- Since we're checking that a key's file is present, throw
@ -98,7 +89,7 @@ fsckKey backend key file numcopies = do
- the key's metadata, if available. -}
checkKeySize :: Key -> Annex Bool
checkKeySize key = do
g <- Annex.gitRepo
g <- gitRepo
let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file
case (present, Types.Key.keySize key) of

3
Command/Get.hs
View file

@ -7,12 +7,11 @@
module Command.Get where
import AnnexCommon
import Command
import qualified Annex
import qualified Remote
import Types
import Content
import Messages
import qualified Command.Move
command :: [Command]

5
Command/InAnnex.hs
View file

@ -7,12 +7,9 @@
module Command.InAnnex where
import Control.Monad.State (liftIO)
import System.Exit
import AnnexCommon
import Command
import Content
import Types
command :: [Command]
command = [repoCommand "inannex" (paramRepeating paramKey) seek

5
Command/Init.hs
View file

@ -7,10 +7,9 @@
module Command.Init where
import AnnexCommon
import Command
import qualified Annex
import UUID
import Messages
import Init
command :: [Command]
@ -30,7 +29,7 @@ start ws = do
perform :: String -> CommandPerform
perform description = do
initialize
g <- Annex.gitRepo
g <- gitRepo
u <- getUUID g
describeUUID u description
next $ return True

7
Command/InitRemote.hs
View file

@ -8,18 +8,13 @@
module Command.InitRemote where
import qualified Data.Map as M
import Control.Monad (when)
import Control.Monad.State (liftIO)
import Data.Maybe
import Data.String.Utils
import AnnexCommon
import Command
import qualified Remote
import qualified RemoteLog
import qualified Types.Remote as R
import Types
import UUID
import Messages
command :: [Command]
command = [repoCommand "initremote"

6
Command/Lock.hs
View file

@ -7,13 +7,9 @@
module Command.Lock where
import Control.Monad.State (liftIO)
import System.Directory
import AnnexCommon
import Command
import Messages
import qualified AnnexQueue
import Utility.SafeCommand
import Backend
command :: [Command]

11
Command/Map.hs
View file

@ -7,19 +7,12 @@
module Command.Map where
import Control.Monad.State (liftIO)
import Control.Exception.Extensible
import System.Cmd.Utils
import qualified Data.Map as M
import Data.List.Utils
import Data.Maybe
import AnnexCommon
import Command
import qualified Annex
import qualified Git
import Messages
import Types
import Utility.SafeCommand
import UUID
import Trust
import Utility.Ssh
@ -36,7 +29,7 @@ seek = [withNothing start]
start :: CommandStart
start = do
g <- Annex.gitRepo
g <- gitRepo
rs <- spider g
umap <- uuidMap

2
Command/Merge.hs
View file

@ -7,9 +7,9 @@
module Command.Merge where
import AnnexCommon
import Command
import qualified Branch
import Messages
command :: [Command]
command = [repoCommand "merge" paramNothing seek

15
Command/Migrate.hs
View file

@ -7,22 +7,11 @@
module Command.Migrate where
import Control.Monad.State (liftIO)
import Control.Applicative
import System.Posix.Files
import System.Directory
import System.FilePath
import Data.Maybe
import AnnexCommon
import Command
import qualified Annex
import qualified Backend
import qualified Types.Key
import Locations
import Types
import Content
import Messages
import Utility.Conditional
import qualified Command.Add
import Backend
@ -53,7 +42,7 @@ upgradableKey key = isNothing $ Types.Key.keySize key
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file oldkey newbackend = do
g <- Annex.gitRepo
g <- gitRepo
-- Store the old backend's cached key in the new backend
-- (the file can't be stored as usual, because it's already a symlink).

12
Command/Move.hs
View file

@ -7,18 +7,14 @@
module Command.Move where
import Control.Monad (when)
import AnnexCommon
import Command
import qualified Command.Drop
import qualified Annex
import LocationLog
import Types
import Content
import qualified Remote
import UUID
import Messages
import Utility.Conditional
command :: [Command]
command = [repoCommand "move" paramPaths seek
@ -60,7 +56,7 @@ showMoveAction False file = showStart "copy" file
remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
remoteHasKey remote key present = do
let remoteuuid = Remote.uuid remote
g <- Annex.gitRepo
g <- gitRepo
logChange g key remoteuuid status
where
status = if present then InfoPresent else InfoMissing
@ -76,7 +72,7 @@ remoteHasKey remote key present = do
-}
toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart
toStart dest move file = isAnnexed file $ \(key, _) -> do
g <- Annex.gitRepo
g <- gitRepo
u <- getUUID g
ishere <- inAnnex key
if not ishere || u == Remote.uuid dest
@ -126,7 +122,7 @@ toCleanup dest move key = do
-}
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart
fromStart src move file = isAnnexed file $ \(key, _) -> do
g <- Annex.gitRepo
g <- gitRepo
u <- getUUID g
remotes <- Remote.keyPossibilities key
if u == Remote.uuid src || not (any (== src) remotes)

6
Command/RecvKey.hs
View file

@ -7,15 +7,11 @@
module Command.RecvKey where
import Control.Monad.State (liftIO)
import System.Exit
import AnnexCommon
import Command
import CmdLine
import Content
import Utility.RsyncFile
import Utility.Conditional
import Types
command :: [Command]
command = [repoCommand "recvkey" paramKey seek

2
Command/Semitrust.hs
View file

@ -7,11 +7,11 @@
module Command.Semitrust where
import AnnexCommon
import Command
import qualified Remote
import UUID
import Trust
import Messages
command :: [Command]
command = [repoCommand "semitrust" (paramRepeating paramRemote) seek

11
Command/SendKey.hs
View file

@ -7,17 +7,10 @@
module Command.SendKey where
import Control.Monad.State (liftIO)
import System.Exit
import Locations
import qualified Annex
import AnnexCommon
import Command
import Content
import Utility.RsyncFile
import Utility.Conditional
import Messages
import Types
command :: [Command]
command = [repoCommand "sendkey" paramKey seek
@ -28,7 +21,7 @@ seek = [withKeys start]
start :: Key -> CommandStart
start key = do
g <- Annex.gitRepo
g <- gitRepo
let file = gitAnnexLocation g key
whenM (inAnnex key) $
liftIO $ rsyncServerSend file -- does not return

5
Command/SetKey.hs
View file

@ -7,13 +7,10 @@
module Command.SetKey where
import Control.Monad.State (liftIO)
import AnnexCommon
import Command
import Utility.SafeCommand
import LocationLog
import Content
import Messages
command :: [Command]
command = [repoCommand "setkey" paramPath seek

7
Command/Status.hs
View file

@ -8,25 +8,20 @@
module Command.Status where
import Control.Monad.State
import Control.Applicative
import Data.Maybe
import System.IO
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Set (Set)
import AnnexCommon
import qualified Types.Backend as B
import qualified Types.Remote as R
import qualified Remote
import qualified Command.Unused
import qualified Git
import Command
import Types
import Utility.DataUnits
import Content
import Types.Key
import Locations
import Backend
import UUID
import Remote

2
Command/Trust.hs
View file

@ -7,11 +7,11 @@
module Command.Trust where
import AnnexCommon
import Command
import qualified Remote
import Trust
import UUID
import Messages
command :: [Command]
command = [repoCommand "trust" (paramRepeating paramRemote) seek

15
Command/Unannex.hs
View file

@ -7,25 +7,16 @@
module Command.Unannex where
import Control.Monad.State (liftIO)
import Control.Monad (unless)
import System.Directory
import System.Posix.Files
import AnnexCommon
import Command
import qualified Command.Drop
import qualified Annex
import qualified AnnexQueue
import Utility.SafeCommand
import Utility.Path
import Utility.FileMode
import LocationLog
import Types
import Content
import qualified Git
import qualified Git.LsFiles as LsFiles
import Messages
import Locations
command :: [Command]
command = [repoCommand "unannex" paramPaths seek "undo accidential add command"]
@ -41,7 +32,7 @@ start file = isAnnexed file $ \(key, _) -> do
then do
force <- Annex.getState Annex.force
unless force $ do
g <- Annex.gitRepo
g <- gitRepo
staged <- liftIO $ LsFiles.staged g [Git.workTree g]
unless (null staged) $
error "This command cannot be run when there are already files staged for commit."
@ -60,7 +51,7 @@ perform file key = do
cleanup :: FilePath -> Key -> CommandCleanup
cleanup file key = do
g <- Annex.gitRepo
g <- gitRepo
liftIO $ removeFile file
liftIO $ Git.run g "rm" [Params "--quiet --", File file]

9
Command/Uninit.hs
View file

@ -7,19 +7,14 @@
module Command.Uninit where
import Control.Monad.State (liftIO)
import System.Directory
import System.Exit
import AnnexCommon
import Command
import Utility.SafeCommand
import qualified Git
import qualified Annex
import qualified Command.Unannex
import Init
import qualified Branch
import Content
import Locations
command :: [Command]
command = [repoCommand "uninit" paramPaths seek
@ -44,7 +39,7 @@ perform = next cleanup
cleanup :: CommandCleanup
cleanup = do
g <- Annex.gitRepo
g <- gitRepo
uninitialize
mapM_ removeAnnex =<< getKeysPresent
liftIO $ removeDirectoryRecursive (gitAnnexDir g)

14
Command/Unlock.hs
View file

@ -7,18 +7,10 @@
module Command.Unlock where
import Control.Monad.State (liftIO)
import System.Directory hiding (copyFile)
import AnnexCommon
import Command
import qualified Annex
import Types
import Messages
import Locations
import Content
import Utility.Conditional
import Utility.CopyFile
import Utility.Path
import Utility.FileMode
command :: [Command]
@ -43,12 +35,12 @@ perform dest key = do
checkDiskSpace key
g <- Annex.gitRepo
g <- gitRepo
let src = gitAnnexLocation g key
let tmpdest = gitAnnexTmpLocation g key
liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
showAction "copying"
ok <- liftIO $ copyFile src tmpdest
ok <- liftIO $ copyFileExternal src tmpdest
if ok
then do
liftIO $ do

2
Command/Untrust.hs
View file

@ -7,11 +7,11 @@
module Command.Untrust where
import AnnexCommon
import Command
import qualified Remote
import UUID
import Trust
import Messages
command :: [Command]
command = [repoCommand "untrust" (paramRepeating paramRemote) seek

28
Command/Unused.hs
View file

@ -9,23 +9,13 @@
module Command.Unused where
import Control.Monad (filterM, unless, forM_)
import Control.Monad.State (liftIO)
import qualified Data.Set as S
import Data.Maybe
import System.FilePath
import System.Directory
import Data.List
import qualified Data.ByteString.Lazy.Char8 as L
import AnnexCommon
import Command
import Types
import Content
import Messages
import Locations
import Utility
import Utility.FileMode
import Utility.SafeCommand
import LocationLog
import qualified Annex
import qualified Git
@ -92,7 +82,7 @@ checkRemoteUnused' r = do
writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex ()
writeUnusedFile prefix l = do
g <- Annex.gitRepo
g <- gitRepo
liftIO $ viaTmp writeFile (gitAnnexUnusedLog prefix g) $
unlines $ map (\(n, k) -> show n ++ " " ++ show k) l
@ -164,7 +154,7 @@ unusedKeys = do
excludeReferenced :: [Key] -> Annex [Key]
excludeReferenced [] = return [] -- optimisation
excludeReferenced l = do
g <- Annex.gitRepo
g <- gitRepo
c <- liftIO $ Git.pipeRead g [Param "show-ref"]
removewith (getKeysReferenced : map getKeysReferencedInGit (refs c))
(S.fromList l)
@ -200,7 +190,7 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller
{- List of keys referenced by symlinks in the git repo. -}
getKeysReferenced :: Annex [Key]
getKeysReferenced = do
g <- Annex.gitRepo
g <- gitRepo
files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
keypairs <- mapM Backend.lookupFile files
return $ map fst $ catMaybes keypairs
@ -209,7 +199,7 @@ getKeysReferenced = do
getKeysReferencedInGit :: String -> Annex [Key]
getKeysReferencedInGit ref = do
showAction $ "checking " ++ Git.refDescribe ref
g <- Annex.gitRepo
g <- gitRepo
findkeys [] =<< liftIO (LsTree.lsTree g ref)
where
findkeys c [] = return c
@ -232,17 +222,17 @@ staleKeysPrune dirspec present = do
contents <- staleKeys dirspec
let stale = contents `exclude` present
let dup = contents `exclude` stale
let dups = contents `exclude` stale
g <- Annex.gitRepo
g <- gitRepo
let dir = dirspec g
liftIO $ forM_ dup $ \t -> removeFile $ dir </> keyFile t
liftIO $ forM_ dups $ \t -> removeFile $ dir </> keyFile t
return stale
staleKeys :: (Git.Repo -> FilePath) -> Annex [Key]
staleKeys dirspec = do
g <- Annex.gitRepo
g <- gitRepo
let dir = dirspec g
exists <- liftIO $ doesDirectoryExist dir
if not exists

2
Command/Upgrade.hs
View file

@ -7,10 +7,10 @@
module Command.Upgrade where
import AnnexCommon
import Command
import Upgrade
import Version
import Messages
command :: [Command]
command = [standaloneCommand "upgrade" paramNothing seek

5
Command/Version.hs
View file

@ -7,10 +7,7 @@
module Command.Version where
import Control.Monad.State (liftIO)
import Data.String.Utils
import Data.Maybe
import AnnexCommon
import Command
import qualified Build.SysConfig as SysConfig
import Version

5
Command/Whereis.hs
View file

@ -7,13 +7,10 @@
module Command.Whereis where
import Control.Monad
import AnnexCommon
import LocationLog
import Command
import Messages
import Remote
import Types
import Trust
command :: [Command]

46
Common.hs Normal file
View file

@ -0,0 +1,46 @@
module Common (
module Control.Monad,
module Control.Applicative,
module Control.Monad.State,
module Control.Exception.Extensible,
module Data.Maybe,
module Data.List,
module Data.String.Utils,
module System.Path,
module System.FilePath,
module System.Directory,
module System.Cmd.Utils,
module System.IO,
module System.Posix.Files,
module System.Posix.IO,
module System.Posix.Process,
module System.Exit,
module Utility,
module Utility.Conditional,
module Utility.SafeCommand,
module Utility.Path,
) where
import Control.Monad hiding (join)
import Control.Applicative
import Control.Monad.State (liftIO)
import Control.Exception.Extensible (IOException)
import Data.Maybe
import Data.List
import Data.String.Utils
import System.Path
import System.FilePath
import System.Directory
import System.Cmd.Utils
import System.IO hiding (FilePath)
import System.Posix.Files
import System.Posix.IO
import System.Posix.Process hiding (executeFile)
import System.Exit
import Utility
import Utility.Conditional
import Utility.SafeCommand
import Utility.Path

15
Config.hs
View file

@ -7,23 +7,16 @@
module Config where
import Data.Maybe
import Control.Monad.State (liftIO)
import Control.Applicative
import System.Cmd.Utils
import AnnexCommon
import qualified Git
import qualified Annex
import Types
import Utility
import Utility.SafeCommand
type ConfigKey = String
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex ()
setConfig k value = do
g <- Annex.gitRepo
g <- gitRepo
liftIO $ Git.run g "config" [Param k, Param value]
-- re-read git config and update the repo's state
g' <- liftIO $ Git.configRead g
@ -33,7 +26,7 @@ setConfig k value = do
- Failing that, tries looking for a global config option. -}
getConfig :: Git.Repo -> ConfigKey -> String -> Annex String
getConfig r key def = do
g <- Annex.gitRepo
g <- gitRepo
let def' = Git.configGet g ("annex." ++ key) def
return $ Git.configGet g (remoteConfig r key) def'
@ -95,7 +88,7 @@ getNumCopies v =
where
use (Just n) = return n
use Nothing = do
g <- Annex.gitRepo
g <- gitRepo
return $ read $ Git.configGet g config "1"
config = "annex.numcopies"

34
Content.hs
View file

@ -21,26 +21,14 @@ module Content (
saveState
) where
import System.Directory
import Control.Monad.State (liftIO)
import System.Path
import Control.Monad
import System.Posix.Files
import System.FilePath
import Data.Maybe
import Types
import Locations
import AnnexCommon
import LocationLog
import UUID
import qualified Git
import qualified Annex
import qualified AnnexQueue
import qualified Branch
import Utility
import Utility.Conditional
import Utility.StatFS
import Utility.Path
import Utility.FileMode
import Types.Key
import Utility.DataUnits
@ -49,14 +37,14 @@ import Config
{- Checks if a given key is currently present in the gitAnnexLocation. -}
inAnnex :: Key -> Annex Bool
inAnnex key = do
g <- Annex.gitRepo
g <- gitRepo
when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
liftIO $ doesFileExist $ gitAnnexLocation g key
{- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath
calcGitLink file key = do
g <- Annex.gitRepo
g <- gitRepo
cwd <- liftIO getCurrentDirectory
let absfile = fromMaybe whoops $ absNormPath cwd file
return $ relPathDirToFile (parentDir absfile)
@ -68,7 +56,7 @@ calcGitLink file key = do
- repository. -}
logStatus :: Key -> LogStatus -> Annex ()
logStatus key status = do
g <- Annex.gitRepo
g <- gitRepo
u <- getUUID g
logChange g key u status
@ -77,7 +65,7 @@ logStatus key status = do
- the annex as a key's content. -}
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmp key action = do
g <- Annex.gitRepo
g <- gitRepo
let tmp = gitAnnexTmpLocation g key
-- Check that there is enough free disk space.
@ -96,7 +84,7 @@ getViaTmp key action = do
prepTmp :: Key -> Annex FilePath
prepTmp key = do
g <- Annex.gitRepo
g <- gitRepo
let tmp = gitAnnexTmpLocation g key
liftIO $ createDirectoryIfMissing True (parentDir tmp)
return tmp
@ -133,7 +121,7 @@ checkDiskSpace = checkDiskSpace' 0
checkDiskSpace' :: Integer -> Key -> Annex ()
checkDiskSpace' adjustment key = do
g <- Annex.gitRepo
g <- gitRepo
r <- getConfig g "diskreserve" ""
let reserve = fromMaybe megabyte $ readSize dataUnits r
stats <- liftIO $ getFileSystemStats (gitAnnexDir g)
@ -174,7 +162,7 @@ checkDiskSpace' adjustment key = do
-}
moveAnnex :: Key -> FilePath -> Annex ()
moveAnnex key src = do
g <- Annex.gitRepo
g <- gitRepo
let dest = gitAnnexLocation g key
let dir = parentDir dest
e <- liftIO $ doesFileExist dest
@ -189,7 +177,7 @@ moveAnnex key src = do
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
withObjectLoc key a = do
g <- Annex.gitRepo
g <- gitRepo
let file = gitAnnexLocation g key
let dir = parentDir file
a (dir, file)
@ -213,7 +201,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
- returns the file it was moved to. -}
moveBad :: Key -> Annex FilePath
moveBad key = do
g <- Annex.gitRepo
g <- gitRepo
let src = gitAnnexLocation g key
let dest = gitAnnexBadDir g </> takeFileName src
liftIO $ do
@ -227,7 +215,7 @@ moveBad key = do
{- List of keys whose content exists in .git/annex/objects/ -}
getKeysPresent :: Annex [Key]
getKeysPresent = do
g <- Annex.gitRepo
g <- gitRepo
getKeysPresent' $ gitAnnexObjectDir g
getKeysPresent' :: FilePath -> Annex [Key]
getKeysPresent' dir = do

15
Crypto.hs
View file

@ -30,26 +30,17 @@ import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map as M
import Data.ByteString.Lazy.UTF8 (fromString)
import Data.Digest.Pure.SHA
import System.Cmd.Utils
import Data.String.Utils
import Data.List
import Data.Maybe
import System.IO
import System.Posix.IO
import System.Posix.Types
import System.Posix.Process
import Control.Applicative
import Control.Concurrent
import Control.Exception (finally)
import System.Exit
import System.Environment
import Types
import AnnexCommon
import Types.Key
import Types.Remote
import Utility
import Utility.Base64
import Utility.SafeCommand
import Types.Crypto
{- The first half of a Cipher is used for HMAC; the remainder
@ -97,9 +88,9 @@ updateCipher :: RemoteConfig -> EncryptedCipher -> IO EncryptedCipher
updateCipher c encipher@(EncryptedCipher _ ks) = do
ks' <- configKeyIds c
cipher <- decryptCipher c encipher
encryptCipher cipher (combine ks ks')
encryptCipher cipher (merge ks ks')
where
combine (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
describeCipher :: EncryptedCipher -> String
describeCipher (EncryptedCipher _ (KeyIds ks)) =

16
Git.hs
View file

@ -64,34 +64,20 @@ module Git (
prop_idempotent_deencode
) where
import Control.Monad (unless, when, liftM2)
import Control.Applicative
import System.Directory
import System.FilePath
import System.Posix.Directory
import System.Posix.User
import System.Posix.Process
import System.Path
import System.Cmd.Utils
import IO (bracket_, try)
import Data.String.Utils
import System.IO
import qualified Data.Map as M hiding (map, split)
import Network.URI
import Data.Maybe
import Data.Char
import Data.Word (Word8)
import Codec.Binary.UTF8.String (encode)
import Text.Printf
import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
import System.Exit
import System.Posix.Env (setEnv, unsetEnv, getEnv)
import qualified Data.ByteString.Lazy.Char8 as L
import Utility
import Utility.Path
import Utility.Conditional
import Utility.SafeCommand
import Common
{- There are two types of repositories; those on local disk and those
- accessed via an URL. -}

6
GitAnnex.hs
View file

@ -8,14 +8,12 @@
module GitAnnex where
import System.Console.GetOpt
import Control.Monad.State (liftIO)
import AnnexCommon
import qualified Git
import CmdLine
import Command
import Options
import Utility
import Types
import Types.TrustLevel
import qualified Annex
import qualified Remote
@ -122,7 +120,7 @@ options = commonOptions ++
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v }
setgitconfig :: String -> Annex ()
setgitconfig v = do
g <- Annex.gitRepo
g <- gitRepo
g' <- liftIO $ Git.configStore g v
Annex.changeState $ \s -> s { Annex.repo = g' }

14
Init.hs
View file

@ -11,18 +11,10 @@ module Init (
uninitialize
) where
import Control.Monad.State (liftIO)
import Control.Monad (unless)
import System.Directory
import qualified Annex
import AnnexCommon
import qualified Git
import qualified Branch
import Version
import Messages
import Types
import Utility
import Utility.Conditional
import UUID
initialize :: Annex ()
@ -73,12 +65,12 @@ gitPreCommitHookUnWrite = unlessBare $ do
unlessBare :: Annex () -> Annex ()
unlessBare a = do
g <- Annex.gitRepo
g <- gitRepo
unless (Git.repoIsLocalBare g) a
preCommitHook :: Annex FilePath
preCommitHook = do
g <- Annex.gitRepo
g <- gitRepo
return $ Git.gitDir g ++ "/hooks/pre-commit"
preCommitScript :: String

6
Limit.hs
View file

@ -9,15 +9,13 @@ module Limit where
import Text.Regex.PCRE.Light.Char8
import System.Path.WildMatch
import Control.Applicative
import Data.Maybe
import Annex
import AnnexCommon
import qualified Annex
import qualified Utility.Matcher
import qualified Remote
import qualified Backend
import LocationLog
import Utility
import Content
type Limit = Utility.Matcher.Token (FilePath -> Annex Bool)

7
LocationLog.hs
View file

@ -21,15 +21,10 @@ module LocationLog (
logFileKey
) where
import System.FilePath
import Control.Applicative
import Data.Maybe
import AnnexCommon
import qualified Git
import qualified Branch
import UUID
import Types
import Locations
import PresenceLog
{- Log a change in the presence of a key's value in a repository. -}

4
Locations.hs
View file

@ -26,13 +26,11 @@ module Locations (
prop_idempotent_fileKey
) where
import System.FilePath
import Data.String.Utils
import Data.List
import Bits
import Word
import Data.Hash.MD5
import Common
import Types
import Types.Key
import qualified Git

4
Messages.hs
View file

@ -23,11 +23,9 @@ module Messages (
setupConsole
) where
import Control.Monad.State (liftIO)
import System.IO
import Data.String.Utils
import Text.JSON
import Common
import Types
import qualified Annex
import qualified Messages.JSON as JSON

3
Options.hs
View file

@ -9,10 +9,9 @@ module Options where
import System.Console.GetOpt
import System.Log.Logger
import Control.Monad.State (liftIO)
import AnnexCommon
import qualified Annex
import Types
import Command
import Limit

4
PresenceLog.hs
View file

@ -26,11 +26,9 @@ import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import qualified Data.Map as M
import Control.Monad.State (liftIO)
import Control.Applicative
import AnnexCommon
import qualified Branch
import Types
data LogLine = LogLine {
date :: POSIXTime,

16
Remote.hs
View file

@ -28,23 +28,17 @@ module Remote (
forceTrust
) where
import Control.Monad.State (filterM)
import Data.List
import qualified Data.Map as M
import Data.String.Utils
import Data.Maybe
import Control.Applicative
import Text.JSON
import Text.JSON.Generic
import Types
import AnnexCommon
import Types.Remote
import UUID
import qualified Annex
import Config
import Trust
import LocationLog
import Messages
import RemoteLog
import qualified Remote.Git
@ -110,7 +104,7 @@ byName' n = do
- and returns its UUID. Finds even remotes that are not configured in
- .git/config. -}
nameToUUID :: String -> Annex UUID
nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
nameToUUID "." = getUUID =<< gitRepo -- special case for current repo
nameToUUID n = do
res <- byName' n
case res of
@ -135,7 +129,7 @@ nameToUUID n = do
- of the UUIDs. -}
prettyPrintUUIDs :: String -> [UUID] -> Annex String
prettyPrintUUIDs desc uuids = do
here <- getUUID =<< Annex.gitRepo
here <- getUUID =<< gitRepo
m <- M.unionWith addname <$> uuidMap <*> remoteMap
maybeShowJSON [(desc, map (jsonify m here) uuids)]
return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") uuids
@ -184,7 +178,7 @@ keyPossibilitiesTrusted = keyPossibilities' True
keyPossibilities' :: Bool -> Key -> Annex ([Remote Annex], [UUID])
keyPossibilities' withtrusted key = do
g <- Annex.gitRepo
g <- gitRepo
u <- getUUID g
trusted <- if withtrusted then trustGet Trusted else return []
@ -204,7 +198,7 @@ keyPossibilities' withtrusted key = do
{- Displays known locations of a key. -}
showLocations :: Key -> [UUID] -> Annex ()
showLocations key exclude = do
g <- Annex.gitRepo
g <- gitRepo
u <- getUUID g
uuids <- keyLocations key
untrusteduuids <- trustGet UnTrusted

21
Remote/Bup.hs
View file

@ -8,30 +8,15 @@
module Remote.Bup (remote) where
import qualified Data.ByteString.Lazy.Char8 as L
import System.IO
import System.IO.Error
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Process
import System.Exit
import System.FilePath
import Data.Maybe
import Data.List.Utils
import System.Cmd.Utils
import Types
import AnnexCommon
import Types.Remote
import qualified Git
import qualified Annex
import UUID
import Locations
import Config
import Utility
import Utility.Conditional
import Utility.SafeCommand
import Messages
import Utility.Ssh
import Remote.Helper.Special
import Remote.Helper.Encryptable
@ -118,14 +103,14 @@ bupSplitParams r buprepo k src = do
store :: Git.Repo -> BupRepo -> Key -> Annex Bool
store r buprepo k = do
g <- Annex.gitRepo
g <- gitRepo
let src = gitAnnexLocation g k
params <- bupSplitParams r buprepo k (File src)
liftIO $ boolSystem "bup" params
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted r buprepo (cipher, enck) k = do
g <- Annex.gitRepo
g <- gitRepo
let src = gitAnnexLocation g k
params <- bupSplitParams r buprepo enck (Param "-")
liftIO $ catchBool $

23
Remote/Directory.hs
View file

@ -9,25 +9,14 @@ module Remote.Directory (remote) where
import qualified Data.ByteString.Lazy.Char8 as L
import System.IO.Error
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Directory hiding (copyFile)
import System.FilePath
import Data.Maybe
import Types
import AnnexCommon
import Utility.CopyFile
import Types.Remote
import qualified Git
import qualified Annex
import UUID
import Locations
import Utility.CopyFile
import Config
import Utility
import Utility.Conditional
import Utility.Path
import Utility.FileMode
import Remote.Helper.Special
import Remote.Helper.Encryptable
@ -82,14 +71,14 @@ dirKey d k = d </> hashDirMixed k </> f </> f
store :: FilePath -> Key -> Annex Bool
store d k = do
g <- Annex.gitRepo
g <- gitRepo
let src = gitAnnexLocation g k
let dest = dirKey d k
liftIO $ catchBool $ storeHelper dest $ copyFile src dest
liftIO $ catchBool $ storeHelper dest $ copyFileExternal src dest
storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted d (cipher, enck) k = do
g <- Annex.gitRepo
g <- gitRepo
let src = gitAnnexLocation g k
let dest = dirKey d enck
liftIO $ catchBool $ storeHelper dest $ encrypt src dest
@ -110,7 +99,7 @@ storeHelper dest a = do
return ok
retrieve :: FilePath -> Key -> FilePath -> Annex Bool
retrieve d k f = liftIO $ copyFile (dirKey d k) f
retrieve d k f = liftIO $ copyFileExternal (dirKey d k) f
retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted d (cipher, enck) f =

31
Remote/Git.hs
View file

@ -8,26 +8,17 @@
module Remote.Git (remote) where
import Control.Exception.Extensible
import Control.Monad.State (liftIO)
import qualified Data.Map as M
import System.Cmd.Utils
import System.Posix.Files
import System.IO
import Types
import Types.Remote
import qualified Git
import qualified Annex
import Locations
import UUID
import Utility
import qualified Content
import Messages
import AnnexCommon
import Utility.CopyFile
import Utility.RsyncFile
import Utility.Ssh
import Utility.SafeCommand
import Utility.Path
import Types.Remote
import qualified Git
import qualified Annex
import UUID
import qualified Content
import qualified Utility.Url as Url
import Config
import Init
@ -42,7 +33,7 @@ remote = RemoteType {
list :: Annex [Git.Repo]
list = do
g <- Annex.gitRepo
g <- gitRepo
return $ Git.remotes g
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
@ -109,7 +100,7 @@ tryGitConfigRead r
store a = do
r' <- a
g <- Annex.gitRepo
g <- gitRepo
let l = Git.remotes g
let g' = Git.remotesAdd g $ exchange l r'
Annex.changeState $ \s -> s { Annex.repo = g' }
@ -169,7 +160,7 @@ copyFromRemote r key file
copyToRemote :: Git.Repo -> Key -> Annex Bool
copyToRemote r key
| not $ Git.repoIsUrl r = do
g <- Annex.gitRepo
g <- gitRepo
let keysrc = gitAnnexLocation g key
-- run copy from perspective of remote
liftIO $ onLocal r $ do
@ -178,7 +169,7 @@ copyToRemote r key
Content.saveState
return ok
| Git.repoIsSsh r = do
g <- Annex.gitRepo
g <- gitRepo
let keysrc = gitAnnexLocation g key
rsyncHelper =<< rsyncParamsRemote r False key keysrc
| otherwise = error "copying to non-ssh repo not supported"
@ -200,7 +191,7 @@ rsyncOrCopyFile r src dest = do
ss <- liftIO $ getFileStatus $ parentDir src
ds <- liftIO $ getFileStatus $ parentDir dest
if deviceID ss == deviceID ds
then liftIO $ copyFile src dest
then liftIO $ copyFileExternal src dest
else do
params <- rsyncParams r
rsyncHelper $ params ++ [Param src, Param dest]

4
Remote/Helper/Encryptable.hs
View file

@ -8,13 +8,11 @@
module Remote.Helper.Encryptable where
import qualified Data.Map as M
import Control.Monad.State (liftIO)
import Types
import AnnexCommon
import Types.Remote
import Crypto
import qualified Annex
import Messages
import Config
{- Encryption setup for a remote. The user must specify whether to use

11
Remote/Helper/Special.hs
View file

@ -8,16 +8,11 @@
module Remote.Helper.Special where
import qualified Data.Map as M
import Data.Maybe
import Data.String.Utils
import Control.Monad.State (liftIO)
import Types
import AnnexCommon
import Types.Remote
import qualified Git
import qualified Annex
import UUID
import Utility.SafeCommand
{- Special remotes don't have a configured url, so Git.Repo does not
- automatically generate remotes for them. This looks for a different
@ -25,7 +20,7 @@ import Utility.SafeCommand
-}
findSpecialRemotes :: String -> Annex [Git.Repo]
findSpecialRemotes s = do
g <- Annex.gitRepo
g <- gitRepo
return $ map construct $ remotepairs g
where
remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r
@ -35,7 +30,7 @@ findSpecialRemotes s = do
{- Sets up configuration for a special remote in .git/config. -}
gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()
gitConfigSpecialRemote u c k v = do
g <- Annex.gitRepo
g <- gitRepo
liftIO $ do
Git.run g "config" [Param (configsetting $ "annex-"++k), Param v]
Git.run g "config" [Param (configsetting "annex-uuid"), Param u]

20
Remote/Hook.hs
View file

@ -8,31 +8,19 @@
module Remote.Hook (remote) where
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M
import Control.Monad.State (liftIO)
import System.FilePath
import System.Posix.Process hiding (executeFile)
import System.Posix.IO
import System.IO
import System.IO.Error (try)
import System.Exit
import Data.Maybe
import Types
import AnnexCommon
import Types.Remote
import qualified Git
import qualified Annex
import UUID
import Locations
import Config
import Content
import Utility
import Utility.SafeCommand
import Remote.Helper.Special
import Remote.Helper.Encryptable
import Crypto
import Messages
remote :: RemoteType Annex
remote = RemoteType {
@ -86,7 +74,7 @@ hookEnv k f = Just $ fileenv f ++ keyenv
lookupHook :: String -> String -> Annex (Maybe String)
lookupHook hooktype hook =do
g <- Annex.gitRepo
g <- gitRepo
command <- getConfig g hookname ""
if null command
then do
@ -111,12 +99,12 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
store :: String -> Key -> Annex Bool
store h k = do
g <- Annex.gitRepo
g <- gitRepo
runHook h "store" k (Just $ gitAnnexLocation g k) $ return True
storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
g <- Annex.gitRepo
g <- gitRepo
let f = gitAnnexLocation g k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
runHook h "store" enck (Just tmp) $ return True

22
Remote/Rsync.hs
View file

@ -8,32 +8,18 @@
module Remote.Rsync (remote) where
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M
import Control.Monad.State (liftIO)
import System.FilePath
import System.Directory
import System.Posix.Files
import System.Posix.Process
import Data.Maybe
import Types
import AnnexCommon
import Types.Remote
import qualified Git
import qualified Annex
import UUID
import Locations
import Config
import Content
import Utility
import Utility.Conditional
import Remote.Helper.Special
import Remote.Helper.Encryptable
import Crypto
import Messages
import Utility.RsyncFile
import Utility.SafeCommand
import Utility.Path
type RsyncUrl = String
@ -106,12 +92,12 @@ rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> shellEscape (keyFile k)
store :: RsyncOpts -> Key -> Annex Bool
store o k = do
g <- Annex.gitRepo
g <- gitRepo
rsyncSend o k (gitAnnexLocation g k)
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
g <- Annex.gitRepo
g <- gitRepo
let f = gitAnnexLocation g k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
rsyncSend o enck tmp
@ -166,7 +152,7 @@ partialParams = Params "--no-inplace --partial --partial-dir=.rsync-partial"
- up trees for rsync. -}
withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool
withRsyncScratchDir a = do
g <- Annex.gitRepo
g <- gitRepo
pid <- liftIO getProcessID
let tmp = gitAnnexTmpDir g </> "rsynctmp" </> show pid
nuke tmp

16
Remote/S3real.hs
View file

@ -7,31 +7,21 @@
module Remote.S3 (remote) where
import Control.Exception.Extensible (IOException)
import Network.AWS.AWSConnection
import Network.AWS.S3Object
import Network.AWS.S3Bucket hiding (size)
import Network.AWS.AWSResult
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map as M
import Data.Maybe
import Data.List
import Data.Char
import Data.String.Utils
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Environment
import System.Posix.Files
import System.Posix.Env (setEnv)
import Types
import AnnexCommon
import Types.Remote
import Types.Key
import qualified Git
import qualified Annex
import UUID
import Messages
import Locations
import Config
import Remote.Helper.Special
import Remote.Helper.Encryptable
@ -123,7 +113,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
store :: Remote Annex -> Key -> Annex Bool
store r k = s3Action r False $ \(conn, bucket) -> do
g <- Annex.gitRepo
g <- gitRepo
res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k
s3Bool res
@ -132,7 +122,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) ->
-- To get file size of the encrypted content, have to use a temp file.
-- (An alternative would be chunking to to a constant size.)
withTmp enck $ \tmp -> do
g <- Annex.gitRepo
g <- gitRepo
let f = gitAnnexLocation g k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
res <- liftIO $ storeHelper (conn, bucket) r enck tmp

12
Remote/Web.hs
View file

@ -10,21 +10,13 @@ module Remote.Web (
setUrl
) where
import Control.Monad.State (liftIO)
import Control.Exception
import System.FilePath
import Types
import AnnexCommon
import Types.Remote
import qualified Git
import qualified Annex
import Messages
import UUID
import Config
import PresenceLog
import LocationLog
import Locations
import Utility
import qualified Utility.Url as Url
type URLString = String
@ -80,7 +72,7 @@ getUrls key = do
{- Records a change in an url for a key. -}
setUrl :: Key -> URLString -> LogStatus -> Annex ()
setUrl key url status = do
g <- Annex.gitRepo
g <- gitRepo
addLog (urlLog key) =<< logNow status url
-- update location log to indicate that the web has the key, or not

5
RemoteLog.hs
View file

@ -15,14 +15,11 @@ module RemoteLog (
prop_idempotent_configEscape
) where
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Char
import Control.Applicative
import AnnexCommon
import qualified Branch
import Types
import Types.Remote
import UUID

4
Trust.hs
View file

@ -13,13 +13,11 @@ module Trust (
trustPartition
) where
import Control.Monad.State
import qualified Data.Map as M
import Data.List
import AnnexCommon
import Types.TrustLevel
import qualified Branch
import Types
import UUID
import qualified Annex

3
Types/Key.hs
View file

@ -15,9 +15,10 @@ module Types.Key (
prop_idempotent_key_read_show
) where
import Utility
import System.Posix.Types
import Common
{- A Key has a unique name, is associated with a key/value backend,
- and may contain other optional metadata. -}
data Key = Key {

12
UUID.hs
View file

@ -22,18 +22,12 @@ module UUID (
uuidLog
) where
import Control.Monad.State
import Control.Applicative
import System.Cmd.Utils
import System.IO
import qualified Data.Map as M
import Data.Maybe
import AnnexCommon
import qualified Git
import qualified Branch
import Types
import Types.UUID
import qualified Annex
import qualified Build.SysConfig as SysConfig
import Config
@ -60,7 +54,7 @@ genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h
-}
getUUID :: Git.Repo -> Annex UUID
getUUID r = do
g <- Annex.gitRepo
g <- gitRepo
let c = cached g
let u = getUncachedUUID r
@ -81,7 +75,7 @@ getUncachedUUID r = Git.configGet r configkey ""
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex ()
prepUUID = do
u <- getUUID =<< Annex.gitRepo
u <- getUUID =<< gitRepo
when ("" == u) $ do
uuid <- liftIO genUUID
setConfig configkey uuid

2
Upgrade.hs
View file

@ -7,7 +7,7 @@
module Upgrade where
import Types
import AnnexCommon
import Version
import qualified Upgrade.V0
import qualified Upgrade.V1

12
Upgrade/V0.hs
View file

@ -8,23 +8,15 @@
module Upgrade.V0 where
import System.IO.Error (try)
import System.Directory
import Control.Monad.State (liftIO)
import Control.Monad (filterM, forM_)
import System.Posix.Files
import System.FilePath
import AnnexCommon
import Content
import Types
import Locations
import qualified Annex
import Messages
import qualified Upgrade.V1
upgrade :: Annex Bool
upgrade = do
showAction "v0 to v1"
g <- Annex.gitRepo
g <- gitRepo
-- do the reorganisation of the key files
let olddir = gitAnnexDir g

26
Upgrade/V1.hs
View file

@ -8,33 +8,19 @@
module Upgrade.V1 where
import System.IO.Error (try)
import System.Directory
import Control.Monad.State (liftIO)
import Control.Monad (filterM, forM_, unless)
import Control.Applicative
import System.Posix.Files
import System.FilePath
import Data.String.Utils
import System.Posix.Types
import Data.Maybe
import Data.Char
import AnnexCommon
import Types.Key
import Content
import Types
import Locations
import PresenceLog
import qualified Annex
import qualified AnnexQueue
import qualified Git
import qualified Git.LsFiles as LsFiles
import Backend
import Messages
import Version
import Utility
import Utility.FileMode
import Utility.SafeCommand
import Utility.Path
import qualified Upgrade.V2
-- v2 adds hashing of filenames of content and location log files.
@ -64,7 +50,7 @@ upgrade :: Annex Bool
upgrade = do
showAction "v1 to v2"
g <- Annex.gitRepo
g <- gitRepo
if Git.repoIsLocalBare g
then do
moveContent
@ -96,7 +82,7 @@ moveContent = do
updateSymlinks :: Annex ()
updateSymlinks = do
showAction "updating symlinks"
g <- Annex.gitRepo
g <- gitRepo
files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
forM_ files fixlink
where
@ -117,7 +103,7 @@ moveLocationLogs = do
forM_ logkeys move
where
oldlocationlogs = do
g <- Annex.gitRepo
g <- gitRepo
let dir = Upgrade.V2.gitStateDir g
exists <- liftIO $ doesDirectoryExist dir
if exists
@ -126,7 +112,7 @@ moveLocationLogs = do
return $ mapMaybe oldlog2key contents
else return []
move (l, k) = do
g <- Annex.gitRepo
g <- gitRepo
let dest = logFile2 g k
let dir = Upgrade.V2.gitStateDir g
let f = dir </> l
@ -220,7 +206,7 @@ lookupFile1 file = do
getKeyFilesPresent1 :: Annex [FilePath]
getKeyFilesPresent1 = do
g <- Annex.gitRepo
g <- gitRepo
getKeyFilesPresent1' $ gitAnnexObjectDir g
getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
getKeyFilesPresent1' dir = do

20
Upgrade/V2.hs
View file

@ -7,21 +7,9 @@
module Upgrade.V2 where
import System.Directory
import System.FilePath
import Control.Monad.State (unless, when, liftIO)
import Data.List
import Data.Maybe
import Types.Key
import Types
import qualified Annex
import AnnexCommon
import qualified Git
import qualified Branch
import Messages
import Utility
import Utility.Conditional
import Utility.SafeCommand
import LocationLog
import Content
@ -48,7 +36,7 @@ olddir g
upgrade :: Annex Bool
upgrade = do
showAction "v2 to v3"
g <- Annex.gitRepo
g <- gitRepo
let bare = Git.repoIsLocalBare g
Branch.create
@ -85,7 +73,7 @@ locationLogs repo = liftIO $ do
inject :: FilePath -> FilePath -> Annex ()
inject source dest = do
g <- Annex.gitRepo
g <- gitRepo
new <- liftIO (readFile $ olddir g </> source)
Branch.change dest $ \prev ->
unlines $ nub $ lines prev ++ lines new
@ -114,7 +102,7 @@ push = do
Branch.update -- just in case
showAction "pushing new git-annex branch to origin"
showOutput
g <- Annex.gitRepo
g <- gitRepo
liftIO $ Git.run g "push" [Param "origin", Param Branch.name]
_ -> do
-- no origin exists, so just let the user

1
Utility.hs
View file

@ -11,7 +11,6 @@ module Utility (
readMaybe,
viaTmp,
withTempFile,
dirContains,
dirContents,
myHomeDir,
catchBool,

6
Utility/CopyFile.hs
View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.CopyFile (copyFile) where
module Utility.CopyFile (copyFileExternal) where
import System.Directory (doesFileExist, removeFile)
@ -15,8 +15,8 @@ import qualified Build.SysConfig as SysConfig
{- The cp command is used, because I hate reinventing the wheel,
- and because this allows easy access to features like cp --reflink. -}
copyFile :: FilePath -> FilePath -> IO Bool
copyFile src dest = do
copyFileExternal :: FilePath -> FilePath -> IO Bool
copyFileExternal src dest = do
whenM (doesFileExist dest) $
removeFile dest
boolSystem "cp" [params, File src, File dest]

5
Version.hs
View file

@ -7,8 +7,7 @@
module Version where
import Types
import qualified Annex
import AnnexCommon
import qualified Git
import Config
@ -28,7 +27,7 @@ versionField = "annex.version"
getVersion :: Annex (Maybe Version)
getVersion = do
g <- Annex.gitRepo
g <- gitRepo
let v = Git.configGet g versionField ""
if not $ null v
then return $ Just v

4
git-annex-shell.hs
View file

@ -6,13 +6,11 @@
-}
import System.Environment
import Data.List
import AnnexCommon
import qualified Git
import CmdLine
import Command
import Utility.Conditional
import Utility.SafeCommand
import Options
import qualified Command.ConfigList

2
git-annex.cabal
View file

@ -1,5 +1,5 @@
Name: git-annex
Version: 3.20110928
Version: 3.20110929
Cabal-Version: >= 1.6
License: GPL
Maintainer: Joey Hess <joey@kitenet.net>

4
git-union-merge.hs
View file

@ -6,10 +6,8 @@
-}
import System.Environment
import System.FilePath
import System.Directory
import Control.Monad (when)
import Common
import qualified Git.UnionMerge
import qualified Git

8
test.hs
View file

@ -9,23 +9,19 @@ import Test.HUnit
import Test.HUnit.Tools
import Test.QuickCheck
import System.Directory
import System.Posix.Directory (changeWorkingDirectory)
import System.Posix.Files
import IO (bracket_, bracket)
import Control.Monad (unless, when, filterM)
import Data.List
import System.IO.Error
import System.Posix.Env
import qualified Control.Exception.Extensible as E
import Control.Exception (throw)
import Data.Maybe
import qualified Data.Map as M
import System.Path (recurseDir)
import System.IO.HVFS (SystemFS(..))
import Utility.SafeCommand
import Common
import qualified Utility.SafeCommand
import qualified Annex
import qualified Backend
import qualified Git