1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
{- management of the git-annex journal
-
- The journal is used to queue up changes before they are committed to the
- git-annex branch. Among other things, it ensures that if git-annex is
- interrupted, its recorded data is not lost.
-
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Annex.Journal where
import Common.Annex
import Annex.Exception
import qualified Git
import Annex.Perms
#ifdef mingw32_HOST_OS
import Utility.WinLock
#endif
{- Records content for a file in the branch to the journal.
-
- Using the journal, rather than immediatly staging content to the index
- avoids git needing to rewrite the index after every change.
-
- The file in the journal is updated atomically, which allows
- getJournalFileStale to always return a consistent journal file
- content, although possibly not the most current one.
-}
setJournalFile :: JournalLocked -> FilePath -> String -> Annex ()
setJournalFile _jl file content = do
tmp <- fromRepo gitAnnexTmpMiscDir
createAnnexDirectory =<< fromRepo gitAnnexJournalDir
createAnnexDirectory tmp
-- journal file is written atomically
jfile <- fromRepo $ journalFile file
let tmpfile = tmp </> takeFileName jfile
liftIO $ do
withFile tmpfile WriteMode $ \h -> do
fileEncoding h
#ifdef mingw32_HOST_OS
hSetNewlineMode h noNewlineTranslation
#endif
hPutStr h content
moveFile tmpfile jfile
{- Gets any journalled content for a file in the branch. -}
getJournalFile :: JournalLocked -> FilePath -> Annex (Maybe String)
getJournalFile _jl = getJournalFileStale
{- Without locking, this is not guaranteed to be the most recent
- version of the file in the journal, so should not be used as a basis for
- changes. -}
getJournalFileStale :: FilePath -> Annex (Maybe String)
getJournalFileStale file = inRepo $ \g -> catchMaybeIO $
readFileStrictAnyEncoding $ journalFile file g
{- List of files that have updated content in the journal. -}
getJournalledFiles :: JournalLocked -> Annex [FilePath]
getJournalledFiles jl = map fileJournal <$> getJournalFiles jl
getJournalledFilesStale :: Annex [FilePath]
getJournalledFilesStale = map fileJournal <$> getJournalFilesStale
{- List of existing journal files. -}
getJournalFiles :: JournalLocked -> Annex [FilePath]
getJournalFiles _jl = getJournalFilesStale
{- List of existing journal files, but without locking, may miss new ones
- just being added, or may have false positives if the journal is staged
- as it is run. -}
getJournalFilesStale :: Annex [FilePath]
getJournalFilesStale = do
g <- gitRepo
fs <- liftIO $ catchDefaultIO [] $
getDirectoryContents' $ gitAnnexJournalDir g
return $ filter (`notElem` [".", ".."]) fs
{- Checks if there are changes in the journal. -}
journalDirty :: Annex Bool
journalDirty = not . null <$> getJournalFilesStale
{- Produces a filename to use in the journal for a file on the branch.
-
- The journal typically won't have a lot of files in it, so the hashing
- used in the branch is not necessary, and all the files are put directly
- in the journal directory.
-}
journalFile :: FilePath -> Git.Repo -> FilePath
journalFile file repo = gitAnnexJournalDir repo </> concatMap mangle file
where
mangle c
| c == pathSeparator = "_"
| c == '_' = "__"
| otherwise = [c]
{- Converts a journal file (relative to the journal dir) back to the
- filename on the branch. -}
fileJournal :: FilePath -> FilePath
fileJournal = replace [pathSeparator, pathSeparator] "_" .
replace "_" [pathSeparator]
{- Sentinal value, only produced by lockJournal; required
- as a parameter by things that need to ensure the journal is
- locked. -}
data JournalLocked = ProduceJournalLocked
{- Runs an action that modifies the journal, using locking to avoid
- contention with other git-annex processes. -}
lockJournal :: (JournalLocked -> Annex a) -> Annex a
lockJournal a = do
lockfile <- fromRepo gitAnnexJournalLock
createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
bracketIO (lock lockfile mode) unlock (const $ a ProduceJournalLocked)
where
#ifndef mingw32_HOST_OS
lock lockfile mode = do
l <- noUmask mode $ createFile lockfile mode
waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
return l
unlock = closeFd
#else
lock lockfile _mode = waitToLock $ lockExclusive lockfile
unlock = dropLock
#endif
|
