40ecf58d4b
This does not change the overall license of the git-annex program, which was already AGPL due to a number of sources files being AGPL already. Legally speaking, I'm adding a new license under which these files are now available; I already released their current contents under the GPL license. Now they're dual licensed GPL and AGPL. However, I intend for all my future changes to these files to only be released under the AGPL license, and I won't be tracking the dual licensing status, so I'm simply changing the license statement to say it's AGPL. (In some cases, others wrote parts of the code of a file and released it under the GPL; but in all cases I have contributed a significant portion of the code in each file and it's that code that is getting the AGPL license; the GPL license of other contributors allows combining with AGPL code.)
57 lines
1.8 KiB
Haskell
57 lines
1.8 KiB
Haskell
{- git-annex pointer files
|
|
-
|
|
- Copyright 2010-2018 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Content.PointerFile where
|
|
|
|
import System.PosixCompat.Files
|
|
|
|
import Annex.Common
|
|
import Annex.Perms
|
|
import Annex.Link
|
|
import Annex.ReplaceFile
|
|
import Annex.InodeSentinal
|
|
import Utility.InodeCache
|
|
import Annex.Content.LowLevel
|
|
|
|
{- Populates a pointer file with the content of a key.
|
|
-
|
|
- If the file already has some other content, it is not modified.
|
|
-
|
|
- Returns an InodeCache if it populated the pointer file.
|
|
-}
|
|
populatePointerFile :: Restage -> Key -> FilePath -> FilePath -> Annex (Maybe InodeCache)
|
|
populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f)
|
|
where
|
|
go (Just k') | k == k' = do
|
|
destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f
|
|
liftIO $ nukeFile f
|
|
(ic, populated) <- replaceFile f $ \tmp -> do
|
|
ok <- linkOrCopy k obj tmp destmode >>= \case
|
|
Just _ -> thawContent tmp >> return True
|
|
Nothing -> liftIO (writePointerFile tmp k destmode) >> return False
|
|
ic <- withTSDelta (liftIO . genInodeCache tmp)
|
|
return (ic, ok)
|
|
maybe noop (restagePointerFile restage f) ic
|
|
if populated
|
|
then return ic
|
|
else return Nothing
|
|
go _ = return Nothing
|
|
|
|
{- Removes the content from a pointer file, replacing it with a pointer.
|
|
-
|
|
- Does not check if the pointer file is modified. -}
|
|
depopulatePointerFile :: Key -> FilePath -> Annex ()
|
|
depopulatePointerFile key file = do
|
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
|
|
secureErase file
|
|
liftIO $ nukeFile file
|
|
ic <- replaceFile file $ \tmp -> do
|
|
liftIO $ writePointerFile tmp key mode
|
|
withTSDelta (liftIO . genInodeCache tmp)
|
|
maybe noop (restagePointerFile (Restage True) file) ic
|