1{- git-annex log file names
2 -
3 - Copyright 2013-2021 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE OverloadedStrings #-}
9
10module Logs where
11
12import Annex.Common
13import Annex.DirHashes
14
15import qualified Data.ByteString as S
16import qualified System.FilePath.ByteString as P
17
18{- There are several varieties of log file formats. -}
19data LogVariety
20	= OldUUIDBasedLog
21	| NewUUIDBasedLog
22	| ChunkLog Key
23	| LocationLog Key
24	| UrlLog Key
25	| RemoteMetaDataLog
26	| OtherLog
27	deriving (Show)
28
29{- Converts a path from the git-annex branch into one of the varieties
30 - of logs used by git-annex, if it's a known path. -}
31getLogVariety :: GitConfig -> RawFilePath -> Maybe LogVariety
32getLogVariety config f
33	| f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog
34	| f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog
35	| isRemoteStateLog f = Just NewUUIDBasedLog
36	| isRemoteContentIdentifierLog f = Just NewUUIDBasedLog
37	| isRemoteMetaDataLog f = Just RemoteMetaDataLog
38	| isMetaDataLog f || f `elem` otherTopLevelLogs = Just OtherLog
39	| otherwise = (LocationLog <$> locationLogFileKey config f)
40		<|> (ChunkLog <$> extLogFileKey chunkLogExt f)
41		<|> (UrlLog  <$> urlLogFileKey f)
42
43{- Typical number of log files that may be read while processing a single
44 - key. This is used to size a cache.
45 -
46 - The location log is generally read, and the metadata log is read when
47 - matching a preferred content expression that matches on metadata,
48 - or when using metadata options.
49 -
50 - When using a remote, the url log, chunk log, remote state log, remote
51 - metadata log, and remote content identifier log might each be used,
52 - but probably at most 3 out of the 6. However, caching too much slows
53 - down all operations because the cache is a linear list, so the cache
54 - is not currently sized to include these.
55 -
56 - The result is that when seeking for files to operate on,
57 - the location log will stay in the cache if the metadata log is also
58 - read.
59 -}
60logFilesToCache :: Int
61logFilesToCache = 2
62
63{- All the log files that might contain information about a key. -}
64keyLogFiles :: GitConfig -> Key -> [RawFilePath]
65keyLogFiles config k =
66	[ locationLogFile config k
67	, urlLogFile config k
68	, remoteStateLogFile config k
69	, metaDataLogFile config k
70	, remoteMetaDataLogFile config k
71	, remoteContentIdentifierLogFile config k
72	, chunkLogFile config k
73	] ++ oldurlLogs config k
74
75{- All uuid-based logs stored in the top of the git-annex branch. -}
76topLevelUUIDBasedLogs :: [RawFilePath]
77topLevelUUIDBasedLogs = topLevelNewUUIDBasedLogs ++ topLevelOldUUIDBasedLogs
78
79{- All the old-format uuid-based logs stored in the top of the git-annex branch. -}
80topLevelOldUUIDBasedLogs :: [RawFilePath]
81topLevelOldUUIDBasedLogs =
82	[ uuidLog
83	, remoteLog
84	, trustLog
85	, groupLog
86	, preferredContentLog
87	, requiredContentLog
88	, scheduleLog
89	, activityLog
90	, differenceLog
91	, multicastLog
92	]
93
94{- All the new-format uuid-based logs stored in the top of the git-annex branch. -}
95topLevelNewUUIDBasedLogs :: [RawFilePath]
96topLevelNewUUIDBasedLogs =
97	[ exportLog
98	]
99
100{- Other top-level logs. -}
101otherTopLevelLogs :: [RawFilePath]
102otherTopLevelLogs =
103	[ numcopiesLog
104	, mincopiesLog
105	, configLog
106	, groupPreferredContentLog
107	]
108
109uuidLog :: RawFilePath
110uuidLog = "uuid.log"
111
112numcopiesLog :: RawFilePath
113numcopiesLog = "numcopies.log"
114
115mincopiesLog :: RawFilePath
116mincopiesLog = "mincopies.log"
117
118configLog :: RawFilePath
119configLog = "config.log"
120
121remoteLog :: RawFilePath
122remoteLog = "remote.log"
123
124trustLog :: RawFilePath
125trustLog = "trust.log"
126
127groupLog :: RawFilePath
128groupLog = "group.log"
129
130preferredContentLog :: RawFilePath
131preferredContentLog = "preferred-content.log"
132
133requiredContentLog :: RawFilePath
134requiredContentLog = "required-content.log"
135
136groupPreferredContentLog :: RawFilePath
137groupPreferredContentLog = "group-preferred-content.log"
138
139scheduleLog :: RawFilePath
140scheduleLog = "schedule.log"
141
142activityLog :: RawFilePath
143activityLog = "activity.log"
144
145differenceLog :: RawFilePath
146differenceLog = "difference.log"
147
148multicastLog :: RawFilePath
149multicastLog = "multicast.log"
150
151exportLog :: RawFilePath
152exportLog = "export.log"
153
154{- This is not a log file, it's where exported treeishes get grafted into
155 - the git-annex branch. -}
156exportTreeGraftPoint :: RawFilePath
157exportTreeGraftPoint = "export.tree"
158
159{- The pathname of the location log file for a given key. -}
160locationLogFile :: GitConfig -> Key -> RawFilePath
161locationLogFile config key =
162	branchHashDir config key P.</> keyFile key <> ".log"
163
164{- The filename of the url log for a given key. -}
165urlLogFile :: GitConfig -> Key -> RawFilePath
166urlLogFile config key =
167	branchHashDir config key P.</> keyFile key <> urlLogExt
168
169{- Old versions stored the urls elsewhere. -}
170oldurlLogs :: GitConfig -> Key -> [RawFilePath]
171oldurlLogs config key =
172	[ "remote/web" P.</> hdir P.</> serializeKey' key <> ".log"
173	, "remote/web" P.</> hdir P.</> keyFile key <> ".log"
174	]
175  where
176	hdir = branchHashDir config key
177
178urlLogExt :: S.ByteString
179urlLogExt = ".log.web"
180
181{- Does not work on oldurllogs. -}
182isUrlLog :: RawFilePath -> Bool
183isUrlLog file = urlLogExt `S.isSuffixOf` file
184
185{- The filename of the remote state log for a given key. -}
186remoteStateLogFile :: GitConfig -> Key -> RawFilePath
187remoteStateLogFile config key =
188	(branchHashDir config key P.</> keyFile key)
189		<> remoteStateLogExt
190
191remoteStateLogExt :: S.ByteString
192remoteStateLogExt = ".log.rmt"
193
194isRemoteStateLog :: RawFilePath -> Bool
195isRemoteStateLog path = remoteStateLogExt `S.isSuffixOf` path
196
197{- The filename of the chunk log for a given key. -}
198chunkLogFile :: GitConfig -> Key -> RawFilePath
199chunkLogFile config key =
200	(branchHashDir config key P.</> keyFile key)
201		<> chunkLogExt
202
203chunkLogExt :: S.ByteString
204chunkLogExt = ".log.cnk"
205
206{- The filename of the metadata log for a given key. -}
207metaDataLogFile :: GitConfig -> Key -> RawFilePath
208metaDataLogFile config key =
209	(branchHashDir config key P.</> keyFile key)
210		<> metaDataLogExt
211
212metaDataLogExt :: S.ByteString
213metaDataLogExt = ".log.met"
214
215isMetaDataLog :: RawFilePath -> Bool
216isMetaDataLog path = metaDataLogExt `S.isSuffixOf` path
217
218{- The filename of the remote metadata log for a given key. -}
219remoteMetaDataLogFile :: GitConfig -> Key -> RawFilePath
220remoteMetaDataLogFile config key =
221	(branchHashDir config key P.</> keyFile key)
222		<> remoteMetaDataLogExt
223
224remoteMetaDataLogExt :: S.ByteString
225remoteMetaDataLogExt = ".log.rmet"
226
227isRemoteMetaDataLog :: RawFilePath -> Bool
228isRemoteMetaDataLog path = remoteMetaDataLogExt `S.isSuffixOf` path
229
230{- The filename of the remote content identifier log for a given key. -}
231remoteContentIdentifierLogFile :: GitConfig -> Key -> RawFilePath
232remoteContentIdentifierLogFile config key =
233	(branchHashDir config key P.</> keyFile key)
234		<> remoteContentIdentifierExt
235
236remoteContentIdentifierExt :: S.ByteString
237remoteContentIdentifierExt = ".log.cid"
238
239isRemoteContentIdentifierLog :: RawFilePath -> Bool
240isRemoteContentIdentifierLog path = remoteContentIdentifierExt `S.isSuffixOf` path
241
242{- From an extension and a log filename, get the key that it's a log for. -}
243extLogFileKey :: S.ByteString -> RawFilePath -> Maybe Key
244extLogFileKey expectedext path
245	| ext == expectedext = fileKey base
246	| otherwise = Nothing
247  where
248	file = P.takeFileName path
249	(base, ext) = S.splitAt (S.length file - extlen) file
250	extlen = S.length expectedext
251
252{- Converts a url log file into a key.
253 - (Does not work on oldurlLogs.) -}
254urlLogFileKey :: RawFilePath -> Maybe Key
255urlLogFileKey = extLogFileKey urlLogExt
256
257{- Converts a pathname into a key if it's a location log. -}
258locationLogFileKey :: GitConfig -> RawFilePath -> Maybe Key
259locationLogFileKey config path
260	| length (splitDirectories (fromRawFilePath path)) /= locationLogFileDepth config = Nothing
261	| otherwise = extLogFileKey ".log" path
262
263{- Depth of location log files within the git-annex branch.
264 -
265 - Normally they are xx/yy/key.log so depth 3.
266 - The same extension is also used for other logs that
267 - are not location logs. -}
268locationLogFileDepth :: GitConfig -> Int
269locationLogFileDepth config = hashlevels + 1
270  where
271        HashLevels hashlevels = branchHashLevels config
272