summaryrefslogtreecommitdiff
path: root/Command/ReKey.hs
blob: d14edb06d73d0796ce6b864a13d0b44e4c5cb7ae (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
{- git-annex command
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Command.ReKey where

import Common.Annex
import Command
import qualified Annex
import Types.Key
import Annex.Content
import qualified Command.Add
import Logs.Web
import Config
import Utility.CopyFile

def :: [Command]
def = [notDirect $ command "rekey"
	(paramOptional $ paramRepeating $ paramPair paramPath paramKey)
	seek SectionPlumbing "change keys used for files"]

seek :: [CommandSeek]
seek = [withPairs start]

start :: (FilePath, String) -> CommandStart
start (file, keyname) = ifAnnexed file go stop
  where
	newkey = fromMaybe (error "bad key") $ file2key keyname
	go (oldkey, _)
		| oldkey == newkey = stop
		| otherwise = do
			showStart "rekey" file
			next $ perform file oldkey newkey

perform :: FilePath -> Key -> Key -> CommandPerform
perform file oldkey newkey = do
	present <- inAnnex oldkey
	_ <- if present
		then linkKey oldkey newkey
		else do
			unlessM (Annex.getState Annex.force) $
				error $ file ++ " is not available (use --force to override)"
			return True
	next $ cleanup file oldkey newkey

{- Make a hard link to the old key content, to avoid wasting disk space. -}
linkKey :: Key -> Key -> Annex Bool
linkKey oldkey newkey = getViaTmpUnchecked newkey $ \tmp -> do
	src <- calcRepo $ gitAnnexLocation oldkey
	ifM (liftIO $ doesFileExist tmp)
		( return True
		, ifM crippledFileSystem
			( liftIO $ copyFileExternal src tmp
			, do
				liftIO $ createLink src tmp
				return True
			)
		)

cleanup :: FilePath -> Key -> Key -> CommandCleanup
cleanup file oldkey newkey = do
	-- If the old key had some associated urls, record them for
	-- the new key as well.
	urls <- getUrls oldkey
	unless (null urls) $
		mapM_ (setUrlPresent newkey) urls

	-- Update symlink to use the new key.
	liftIO $ removeFile file
	Command.Add.cleanup file newkey True