diff options
author | 2010-11-09 15:59:49 -0400 | |
---|---|---|
committer | 2010-11-09 15:59:49 -0400 | |
commit | 536bc97d25479ac969273b49442c2fd8c31358c4 (patch) | |
tree | aeb19878fd34ff88e69f0f1c3faa019e8cc180c5 | |
parent | d56feda25dd82ffa34fe5e3f28eff3ecf9eac5b5 (diff) |
lock and unlock subcommands
-rw-r--r-- | CmdLine.hs | 6 | ||||
-rw-r--r-- | Command/Lock.hs | 41 | ||||
-rw-r--r-- | Command/Unlock.hs | 36 |
3 files changed, 83 insertions, 0 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index 3823c7247..adcf25e9a 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -30,6 +30,8 @@ import qualified Command.SetKey import qualified Command.Fix import qualified Command.Init import qualified Command.Fsck +import qualified Command.Unlock +import qualified Command.Lock subCmds :: [SubCommand] subCmds = @@ -41,6 +43,10 @@ subCmds = "indicate content of files not currently wanted" , SubCommand "move" path (withFilesInGit Command.Move.start) "transfer content of files to/from another repository" + , SubCommand "unlock" path (withFilesInGit Command.Unlock.start) + "unlock files for modification" + , SubCommand "lock" path (withFilesInGit Command.Lock.start) + "undo unlock command" , SubCommand "init" desc (withDescription Command.Init.start) "initialize git-annex with repository description" , SubCommand "unannex" path (withFilesInGit Command.Unannex.start) diff --git a/Command/Lock.hs b/Command/Lock.hs new file mode 100644 index 000000000..c28e64327 --- /dev/null +++ b/Command/Lock.hs @@ -0,0 +1,41 @@ +{- git-annex command + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Lock where + +import Control.Monad.State (liftIO) +import System.Directory +import System.Posix.Files + +import Command +import Messages +import qualified Annex +import qualified GitRepo as Git + +{- Undo unlock -} +start :: SubCmdStartString +start file = do + -- Want to avoid calling git checkout on files that are not + -- annexed -- but without the symlink to the annex, cannot tell + -- for sure if the file was annexed. So, check if git thinks the + -- file's type has changed (from a symlink to a regular file). + g <- Annex.gitRepo + test <- liftIO $ + Git.pipeRead g ["diff", "--name-only", "--diff-filter=T", file] + s <- liftIO $ getSymbolicLinkStatus file + if (null test || isSymbolicLink s) + then return Nothing + else do + showStart "lock" file + return $ Just $ perform file + +perform :: FilePath -> SubCmdPerform +perform file = do + liftIO $ removeFile file + g <- Annex.gitRepo + liftIO $ Git.run g ["checkout", file] + return $ Just $ return True -- no cleanup needed diff --git a/Command/Unlock.hs b/Command/Unlock.hs new file mode 100644 index 000000000..57d4ad87a --- /dev/null +++ b/Command/Unlock.hs @@ -0,0 +1,36 @@ +{- git-annex command + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Unlock where + +import Control.Monad.State (liftIO) +import System.Directory + +import Command +import qualified Annex +import Types +import Messages +import Locations +import Utility + +{- The unlock subcommand replaces the symlink with a copy of the file's + - content. -} +start :: SubCmdStartString +start file = isAnnexed file $ \(key, _) -> do + showStart "unlock" file + return $ Just $ perform file key + +perform :: FilePath -> Key -> SubCmdPerform +perform dest key = do + g <- Annex.gitRepo + let src = annexLocation g key + liftIO $ removeFile dest + showNote "copying..." + ok <- liftIO $ boolSystem "cp" ["-p", src, dest] + if ok + then return $ Just $ return True -- no cleanup needed + else error "cp failed!" |