Annexed file contents are now made unwritable and put in unwriteable directories, to avoid them accidentially being removed or modified. (Thanks Josh Triplett for the idea.)
This commit is contained in:
parent
8dd9f8e49e
commit
1d32d902c9
8 changed files with 74 additions and 49 deletions
|
@ -9,12 +9,9 @@ module Command.Add where
|
|||
|
||||
import Control.Monad.State (liftIO)
|
||||
import System.Posix.Files
|
||||
import System.Directory
|
||||
|
||||
import Command
|
||||
import qualified Annex
|
||||
import Utility
|
||||
import Locations
|
||||
import qualified Backend
|
||||
import LocationLog
|
||||
import Types
|
||||
|
@ -42,11 +39,9 @@ perform (file, backend) = do
|
|||
|
||||
cleanup :: FilePath -> Key -> SubCmdCleanup
|
||||
cleanup file key = do
|
||||
moveAnnex key file
|
||||
logStatus key ValuePresent
|
||||
g <- Annex.gitRepo
|
||||
let dest = annexLocation g key
|
||||
liftIO $ createDirectoryIfMissing True (parentDir dest)
|
||||
liftIO $ renameFile file dest
|
||||
|
||||
link <- calcGitLink file key
|
||||
liftIO $ createSymbolicLink link file
|
||||
Annex.queue "add" [] file
|
||||
|
|
|
@ -7,12 +7,9 @@
|
|||
|
||||
module Command.Drop where
|
||||
|
||||
import Control.Monad.State (liftIO)
|
||||
import System.Directory
|
||||
import Control.Monad (when)
|
||||
|
||||
import Command
|
||||
import qualified Annex
|
||||
import Locations
|
||||
import qualified Backend
|
||||
import LocationLog
|
||||
import Types
|
||||
|
@ -39,13 +36,7 @@ perform key backend = do
|
|||
|
||||
cleanup :: Key -> SubCmdCleanup
|
||||
cleanup key = do
|
||||
logStatus key ValueMissing
|
||||
inannex <- inAnnex key
|
||||
if (inannex)
|
||||
then do
|
||||
g <- Annex.gitRepo
|
||||
let loc = annexLocation g key
|
||||
liftIO $ removeFile loc
|
||||
return True
|
||||
else return True
|
||||
|
||||
when (inannex) $ removeAnnex key
|
||||
logStatus key ValueMissing
|
||||
return True
|
||||
|
|
|
@ -7,12 +7,8 @@
|
|||
|
||||
module Command.DropKey where
|
||||
|
||||
import Control.Monad.State (liftIO)
|
||||
import System.Directory
|
||||
|
||||
import Command
|
||||
import qualified Annex
|
||||
import Locations
|
||||
import qualified Backend
|
||||
import LocationLog
|
||||
import Types
|
||||
|
@ -36,9 +32,7 @@ start keyname = do
|
|||
|
||||
perform :: Key -> SubCmdPerform
|
||||
perform key = do
|
||||
g <- Annex.gitRepo
|
||||
let loc = annexLocation g key
|
||||
liftIO $ removeFile loc
|
||||
removeAnnex key
|
||||
return $ Just $ cleanup key
|
||||
|
||||
cleanup :: Key -> SubCmdCleanup
|
||||
|
|
|
@ -13,7 +13,6 @@ import Control.Monad (when)
|
|||
import Command
|
||||
import qualified Annex
|
||||
import Utility
|
||||
import Locations
|
||||
import qualified Backend
|
||||
import LocationLog
|
||||
import Types
|
||||
|
@ -22,21 +21,22 @@ import Messages
|
|||
|
||||
{- Sets cached content for a key. -}
|
||||
start :: SubCmdStartString
|
||||
start tmpfile = do
|
||||
start file = do
|
||||
keyname <- Annex.flagGet "key"
|
||||
when (null keyname) $ error "please specify the key with --key"
|
||||
backends <- Backend.list
|
||||
let key = genKey (backends !! 0) keyname
|
||||
showStart "setkey" tmpfile
|
||||
return $ Just $ perform tmpfile key
|
||||
showStart "setkey" file
|
||||
return $ Just $ perform file key
|
||||
perform :: FilePath -> Key -> SubCmdPerform
|
||||
perform tmpfile key = do
|
||||
g <- Annex.gitRepo
|
||||
let loc = annexLocation g key
|
||||
ok <- liftIO $ boolSystem "mv" [tmpfile, loc]
|
||||
if (not ok)
|
||||
then error "mv failed!"
|
||||
else return $ Just $ cleanup key
|
||||
perform file key = do
|
||||
-- the file might be on a different filesystem, so mv is used
|
||||
-- rather than simply calling moveToObjectDir key file
|
||||
ok <- getViaTmp key $ \dest -> liftIO $ boolSystem "mv" [file, dest]
|
||||
if ok
|
||||
then return $ Just $ cleanup key
|
||||
else error "mv failed!"
|
||||
|
||||
cleanup :: Key -> SubCmdCleanup
|
||||
cleanup key = do
|
||||
logStatus key ValuePresent
|
||||
|
|
|
@ -13,7 +13,6 @@ import System.Directory
|
|||
import Command
|
||||
import qualified Annex
|
||||
import Utility
|
||||
import Locations
|
||||
import qualified Backend
|
||||
import LocationLog
|
||||
import Types
|
||||
|
@ -38,12 +37,14 @@ perform file key backend = do
|
|||
|
||||
cleanup :: FilePath -> Key -> SubCmdCleanup
|
||||
cleanup file key = do
|
||||
logStatus key ValueMissing
|
||||
g <- Annex.gitRepo
|
||||
let src = annexLocation g key
|
||||
|
||||
liftIO $ removeFile file
|
||||
liftIO $ Git.run g ["rm", "--quiet", file]
|
||||
-- git rm deletes empty directories; put them back
|
||||
liftIO $ createDirectoryIfMissing True (parentDir file)
|
||||
liftIO $ renameFile src file
|
||||
|
||||
fromAnnex key file
|
||||
logStatus key ValueMissing
|
||||
|
||||
return True
|
||||
|
|
53
Core.hs
53
Core.hs
|
@ -144,7 +144,7 @@ getViaTmp key action = do
|
|||
success <- action tmp
|
||||
if (success)
|
||||
then do
|
||||
moveToObjectDir key tmp
|
||||
moveAnnex key tmp
|
||||
logStatus key ValuePresent
|
||||
return True
|
||||
else do
|
||||
|
@ -152,14 +152,53 @@ getViaTmp key action = do
|
|||
-- to resume its transfer
|
||||
return False
|
||||
|
||||
{- Removes the write bits from a file. -}
|
||||
preventWrite :: FilePath -> IO ()
|
||||
preventWrite f = unsetFileMode f writebits
|
||||
where
|
||||
writebits = foldl unionFileModes ownerWriteMode
|
||||
[groupWriteMode, otherWriteMode]
|
||||
|
||||
{- Turns a file's write bit back on. -}
|
||||
allowWrite :: FilePath -> IO ()
|
||||
allowWrite f = do
|
||||
s <- getFileStatus f
|
||||
setFileMode f $ (fileMode s) `unionFileModes` ownerWriteMode
|
||||
|
||||
{- Moves a file into .git/annex/objects/ -}
|
||||
moveToObjectDir :: Key -> FilePath -> Annex ()
|
||||
moveToObjectDir key src = do
|
||||
moveAnnex :: Key -> FilePath -> Annex ()
|
||||
moveAnnex key src = do
|
||||
g <- Annex.gitRepo
|
||||
let dest = annexLocation g key
|
||||
liftIO $ createDirectoryIfMissing True (parentDir dest)
|
||||
liftIO $ renameFile src dest
|
||||
-- TODO directory and file mode tweaks
|
||||
let dir = parentDir dest
|
||||
liftIO $ do
|
||||
createDirectoryIfMissing True dir
|
||||
renameFile src dest
|
||||
preventWrite dest
|
||||
preventWrite dir
|
||||
|
||||
{- Removes a key's file from .git/annex/objects/ -}
|
||||
removeAnnex :: Key -> Annex ()
|
||||
removeAnnex key = do
|
||||
g <- Annex.gitRepo
|
||||
let file = annexLocation g key
|
||||
let dir = parentDir file
|
||||
liftIO $ do
|
||||
allowWrite dir
|
||||
removeFile file
|
||||
removeDirectory dir
|
||||
|
||||
{- Moves a key's file out of .git/annex/objects/ -}
|
||||
fromAnnex :: Key -> FilePath -> Annex ()
|
||||
fromAnnex key dest = do
|
||||
g <- Annex.gitRepo
|
||||
let file = annexLocation g key
|
||||
let dir = parentDir file
|
||||
liftIO $ do
|
||||
allowWrite dir
|
||||
allowWrite file
|
||||
renameFile file dest
|
||||
removeDirectory dir
|
||||
|
||||
{- List of keys whose content exists in .git/annex/objects/ -}
|
||||
getKeysPresent :: Annex [Key]
|
||||
|
@ -202,7 +241,7 @@ upgradeFrom0 = do
|
|||
-- do the reorganisation of the files
|
||||
let olddir = annexDir g
|
||||
keys <- getKeysPresent' olddir
|
||||
_ <- mapM (\k -> moveToObjectDir k $ olddir ++ "/" ++ keyFile k) keys
|
||||
_ <- mapM (\k -> moveAnnex k $ olddir ++ "/" ++ keyFile k) keys
|
||||
|
||||
-- update the symlinks to the files
|
||||
files <- liftIO $ Git.inRepo g $ Git.workTree g
|
||||
|
|
3
debian/changelog
vendored
3
debian/changelog
vendored
|
@ -8,6 +8,9 @@ git-annex (0.04) UNRELEASED; urgency=low
|
|||
git-annex is used in a repository with the old layout.
|
||||
* Note that git-annex 0.04 cannot transfer content from old repositories
|
||||
that have not yet been upgraded.
|
||||
* Annexed file contents are now made unwritable and put in unwriteable
|
||||
directories, to avoid them accidentially being removed or modified.
|
||||
(Thanks Josh Triplett for the idea.)
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Mon, 08 Nov 2010 12:36:39 -0400
|
||||
|
||||
|
|
|
@ -4,3 +4,5 @@
|
|||
> josh: Oh, I just thought of another slightly crazy but handy idea.
|
||||
> josh: I'd hate to run into a program which somehow followed the symlink and then did an unlink to replace the file.
|
||||
> josh: To break that, you could create a new directory under annex's internal directory for each file, and make the directory have no write permission.
|
||||
|
||||
[[done]] and done --[[Joey]]
|
||||
|
|
Loading…
Reference in a new issue