aboutsummaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-11-08 19:26:37 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-11-08 19:26:37 -0400
commit1d32d902c95a49c53c46951641852c209476cb3d (patch)
tree56b7ae1ebb6da1b3924e4abbbe608aabf95aa172 /Command
parent8dd9f8e49eae081e7503facff6d5a53285194c09 (diff)
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.)
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs9
-rw-r--r--Command/Drop.hs17
-rw-r--r--Command/DropKey.hs8
-rw-r--r--Command/SetKey.hs22
-rw-r--r--Command/Unannex.hs9
5 files changed, 23 insertions, 42 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index 3cc681f69..6c5d24f84 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -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
diff --git a/Command/Drop.hs b/Command/Drop.hs
index d1ebd7f64..48433b14c 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -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
diff --git a/Command/DropKey.hs b/Command/DropKey.hs
index 8076e6fd3..e0b20918c 100644
--- a/Command/DropKey.hs
+++ b/Command/DropKey.hs
@@ -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
diff --git a/Command/SetKey.hs b/Command/SetKey.hs
index 9286e740b..50e9a590b 100644
--- a/Command/SetKey.hs
+++ b/Command/SetKey.hs
@@ -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
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index e0848cd4a..a9c18f765 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -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