summaryrefslogtreecommitdiff
path: root/Backend/SHA1.hs
blob: a7f592b73e804b1354b7f97c900f33525fe37967 (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
{- git-annex "SHA1" backend
 -
 - Copyright 2010 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Backend.SHA1 (backend) where

import Control.Monad.State
import Data.String.Utils
import System.Cmd.Utils
import System.IO
import System.Directory

import qualified Backend.File
import BackendTypes
import Messages
import qualified Annex
import Locations
import Content
import Types
import Utility

backend :: Backend Annex
backend = Backend.File.backend {
	name = "SHA1",
	getKey = keyValue,
	fsckKey = Backend.File.checkKey checkKeySHA1
}

sha1 :: FilePath -> Annex String
sha1 file = do
	showNote "checksum..."
	liftIO $ pOpen ReadFromPipe "sha1sum" (toShell [File file]) $ \h -> do
		line <- hGetLine h
		let bits = split " " line
		if null bits
			then error "sha1sum parse error"
			else return $ head bits

-- A key is a sha1 of its contents.
keyValue :: FilePath -> Annex (Maybe Key)
keyValue file = do
	s <- sha1 file	
	return $ Just  $ Key (name backend, s)

-- A key's sha1 is checked during fsck.
checkKeySHA1 :: Key -> Annex Bool
checkKeySHA1 key = do
	g <- Annex.gitRepo
	let file = gitAnnexLocation g key
	present <- liftIO $ doesFileExist file
	if not present
		then return True
		else do
			s <- sha1 file
			if s == keyName key
				then return True
				else do
					dest <- moveBad key
					warning $ "Bad file content; moved to " ++ filePathToString dest
					return False