add hashing to web log files
This commit is contained in:
parent
fb58d1a560
commit
79016c197c
4 changed files with 21 additions and 18 deletions
|
@ -17,7 +17,9 @@ module LocationLog (
|
||||||
readLog,
|
readLog,
|
||||||
writeLog,
|
writeLog,
|
||||||
keyLocations,
|
keyLocations,
|
||||||
loggedKeys
|
loggedKeys,
|
||||||
|
logFile,
|
||||||
|
logFileKey
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
@ -28,6 +30,7 @@ import qualified Git
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import UUID
|
import UUID
|
||||||
import Types
|
import Types
|
||||||
|
import Types.Key
|
||||||
import Locations
|
import Locations
|
||||||
import PresenceLog
|
import PresenceLog
|
||||||
|
|
||||||
|
@ -49,3 +52,15 @@ keyLocations key = currentLog $ logFile key
|
||||||
loggedKeys :: Annex [Key]
|
loggedKeys :: Annex [Key]
|
||||||
loggedKeys =
|
loggedKeys =
|
||||||
return . catMaybes . map (logFileKey . takeFileName) =<< Branch.files
|
return . catMaybes . map (logFileKey . takeFileName) =<< Branch.files
|
||||||
|
|
||||||
|
{- The filename of the log file for a given key. -}
|
||||||
|
logFile :: Key -> String
|
||||||
|
logFile key = hashDirLower key ++ keyFile key ++ ".log"
|
||||||
|
|
||||||
|
{- Converts a log filename into a key. -}
|
||||||
|
logFileKey :: FilePath -> Maybe Key
|
||||||
|
logFileKey file
|
||||||
|
| end == ".log" = readKey beginning
|
||||||
|
| otherwise = Nothing
|
||||||
|
where
|
||||||
|
(beginning, end) = splitAt (length file - 4) file
|
||||||
|
|
14
Locations.hs
14
Locations.hs
|
@ -19,8 +19,6 @@ module Locations (
|
||||||
gitAnnexUnusedLog,
|
gitAnnexUnusedLog,
|
||||||
gitAnnexJournalDir,
|
gitAnnexJournalDir,
|
||||||
isLinkToAnnex,
|
isLinkToAnnex,
|
||||||
logFile,
|
|
||||||
logFileKey,
|
|
||||||
hashDirMixed,
|
hashDirMixed,
|
||||||
hashDirLower,
|
hashDirLower,
|
||||||
|
|
||||||
|
@ -115,18 +113,6 @@ gitAnnexJournalDir r = addTrailingPathSeparator $ gitAnnexDir r </> "journal"
|
||||||
isLinkToAnnex :: FilePath -> Bool
|
isLinkToAnnex :: FilePath -> Bool
|
||||||
isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
|
isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
|
||||||
|
|
||||||
{- The filename of the log file for a given key. -}
|
|
||||||
logFile :: Key -> String
|
|
||||||
logFile key = hashDirLower key ++ keyFile key ++ ".log"
|
|
||||||
|
|
||||||
{- Converts a log filename into a key. -}
|
|
||||||
logFileKey :: FilePath -> Maybe Key
|
|
||||||
logFileKey file
|
|
||||||
| end == ".log" = readKey beginning
|
|
||||||
| otherwise = Nothing
|
|
||||||
where
|
|
||||||
(beginning, end) = splitAt (length file - 4) file
|
|
||||||
|
|
||||||
{- Converts a key into a filename fragment.
|
{- Converts a key into a filename fragment.
|
||||||
-
|
-
|
||||||
- Escape "/" in the key name, to keep a flat tree of files and avoid
|
- Escape "/" in the key name, to keep a flat tree of files and avoid
|
||||||
|
|
|
@ -29,6 +29,7 @@ import UUID
|
||||||
import Config
|
import Config
|
||||||
import PresenceLog
|
import PresenceLog
|
||||||
import LocationLog
|
import LocationLog
|
||||||
|
import Locations
|
||||||
|
|
||||||
remote :: RemoteType Annex
|
remote :: RemoteType Annex
|
||||||
remote = RemoteType {
|
remote = RemoteType {
|
||||||
|
@ -62,9 +63,10 @@ gen r _ _ =
|
||||||
config = Nothing
|
config = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
{- The urls for a key are stored in remote/web/key.log in the git-annex branch. -}
|
{- The urls for a key are stored in remote/web/hash/key.log
|
||||||
|
- in the git-annex branch. -}
|
||||||
urlLog :: Key -> FilePath
|
urlLog :: Key -> FilePath
|
||||||
urlLog key = "remote/web" </> show key ++ ".log"
|
urlLog key = "remote/web" </> hashDirLower key </> show key ++ ".log"
|
||||||
|
|
||||||
getUrls :: Key -> Annex [URLString]
|
getUrls :: Key -> Annex [URLString]
|
||||||
getUrls key = currentLog (urlLog key)
|
getUrls key = currentLog (urlLog key)
|
||||||
|
|
|
@ -20,7 +20,7 @@ import qualified Git
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Messages
|
import Messages
|
||||||
import Utility
|
import Utility
|
||||||
import Locations
|
import LocationLog
|
||||||
import Content
|
import Content
|
||||||
|
|
||||||
olddir :: Git.Repo -> FilePath
|
olddir :: Git.Repo -> FilePath
|
||||||
|
|
Loading…
Reference in a new issue