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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
{- git repository destroyer
-
- Use with caution!
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Git.Destroyer (
Damage(..),
generateDamage,
applyDamage
) where
import Common
import Git
import Utility.QuickCheck
import Utility.FileMode
import qualified Data.ByteString as B
import Data.Word
import System.PosixCompat.Types
{- Ways to damange a git repository. -}
data Damage = Damage DamageAction FileSelector
deriving (Read, Show)
instance Arbitrary Damage where
arbitrary = Damage <$> arbitrary <*> arbitrary
data DamageAction
= Empty
| Delete
| Reverse
| AppendGarbage B.ByteString
| PrependGarbage B.ByteString
| CorruptByte Int Word8
| ScrambleFileMode FileMode
deriving (Read, Show)
instance Arbitrary DamageAction where
arbitrary = oneof
[ pure Empty
, pure Delete
, pure Reverse
, AppendGarbage <$> garbage
, PrependGarbage <$> garbage
, CorruptByte
<$> nonNegative arbitrarySizedIntegral
<*> arbitrary
, ScrambleFileMode <$> nonNegative arbitrarySizedIntegral
]
where
garbage = B.pack <$> arbitrary `suchThat` (not . null)
{- To select a given file in a git repository, all files in the repository
- are enumerated, sorted, and this is used as an index
- into the list. (Wrapping around if higher than the length.) -}
data FileSelector = FileSelector Int
deriving (Read, Show)
instance Arbitrary FileSelector where
arbitrary = FileSelector <$> nonNegative arbitrarySizedIntegral
selectFile :: [FilePath] -> FileSelector -> FilePath
selectFile sortedfs (FileSelector n) = sortedfs !! (n `mod` length sortedfs)
{- Generates random Damage.
-
- TODO: sample' only seems to go up to 20 for files? -}
generateDamage :: IO [Damage]
generateDamage = sample' (arbitrary :: Gen Damage)
{- Applies Damage to a Repo, in a reproducible fashion
- (as long as the Repo contains the same files each time). -}
applyDamage :: [Damage] -> Repo -> IO ()
applyDamage l r = do
contents <- sort . filter (not . skipped . takeFileName)
<$> dirContentsRecursive (localGitDir r)
forM_ l $ \(Damage action fileselector) -> do
let f = selectFile contents fileselector
-- Symlinks might be dangling, so are skipped.
-- If the file was already removed by a previous Damage,
-- it's skipped.
whenM (doesFileExist f) $
applyDamageAction action f
`catchIO` \e -> error ("Failed to apply " ++ show action ++ " " ++ show f ++ ": " ++ show e ++ "(total damage: " ++ show l ++ ")")
where
-- A broken .git/config is not recoverable.
skipped f = f `elem` [ "config" ]
applyDamageAction :: DamageAction -> FilePath -> IO ()
applyDamageAction Empty f = withSaneMode f $ do
nukeFile f
writeFile f ""
applyDamageAction Reverse f = withSaneMode f $
B.writeFile f =<< B.reverse <$> B.readFile f
applyDamageAction Delete f = nukeFile f
applyDamageAction (AppendGarbage garbage) f = withSaneMode f $
B.appendFile f garbage
applyDamageAction (PrependGarbage garbage) f = withSaneMode f $ do
b <- B.readFile f
B.writeFile f $ B.concat [garbage, b]
-- When the byte is past the end of the file, wrap around.
-- Does nothing to empty file.
applyDamageAction (CorruptByte n garbage) f = withSaneMode f $ do
b <- B.readFile f
let len = B.length b
unless (len == 0) $ do
let n' = n `mod` len
let (prefix, rest) = B.splitAt n' b
B.writeFile f $ B.concat
[prefix
, B.singleton garbage
, B.drop 1 rest
]
applyDamageAction (ScrambleFileMode mode) f = setFileMode f mode
withSaneMode :: FilePath -> IO () -> IO ()
withSaneMode f = withModifiedFileMode f (addModes [ownerWriteMode, ownerReadMode])
|
