hashed-storage 0.3.5 → 0.3.6
raw patch · 10 files changed
+152/−126 lines, 10 filesdep ~mmapPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: mmap
API changes (from Hackage documentation)
+ Storage.Hashed.Monad: directoryExists :: AnchoredPath -> TreeIO Bool
Files
- Bundled/Posix.hsc +5/−0
- Bundled/SHA256.hs +1/−1
- Bundled/sha2.c +59/−59
- Bundled/sha2.h +8/−27
- Storage/Hashed.hs +1/−1
- Storage/Hashed/AnchoredPath.hs +1/−0
- Storage/Hashed/Index.hs +8/−5
- Storage/Hashed/Monad.hs +15/−5
- Storage/Hashed/Test.hs +43/−25
- hashed-storage.cabal +11/−3
Bundled/Posix.hsc view
@@ -70,9 +70,14 @@ #include <sys/stat.h> +-- lstat is broken on win32 with at least GHC 6.10.3 getSymbolicLinkStatus :: FilePath -> IO FileStatus+##if mingw32_HOST_OS+getSymbolicLinkStatus = getFileStatus+##else getSymbolicLinkStatus fp = do_stat (\p -> (fp `withCString` (`lstat` p)))+##endif getFileStatus :: FilePath -> IO FileStatus getFileStatus fp =
Bundled/SHA256.hs view
@@ -43,5 +43,5 @@ -- void sha256sum(const unsigned char *d, size_t n, unsigned char *md); ---foreign import ccall unsafe "sha2.h sha256" c_sha256+foreign import ccall unsafe "sha2.h hashed_storage_sha256" c_sha256 :: Ptr CChar -> CSize -> Ptr Word8 -> IO ()
Bundled/sha2.c view
@@ -127,27 +127,27 @@ wv[h] = t1 + t2; \ } -uint32 sha224_h0[8] =+static uint32 sha224_h0[8] = {0xc1059ed8, 0x367cd507, 0x3070dd17, 0xf70e5939, 0xffc00b31, 0x68581511, 0x64f98fa7, 0xbefa4fa4}; -uint32 sha256_h0[8] =+static uint32 sha256_h0[8] = {0x6a09e667, 0xbb67ae85, 0x3c6ef372, 0xa54ff53a, 0x510e527f, 0x9b05688c, 0x1f83d9ab, 0x5be0cd19}; -uint64 sha384_h0[8] =+static uint64 sha384_h0[8] = {0xcbbb9d5dc1059ed8ULL, 0x629a292a367cd507ULL, 0x9159015a3070dd17ULL, 0x152fecd8f70e5939ULL, 0x67332667ffc00b31ULL, 0x8eb44a8768581511ULL, 0xdb0c2e0d64f98fa7ULL, 0x47b5481dbefa4fa4ULL}; -uint64 sha512_h0[8] =+static uint64 sha512_h0[8] = {0x6a09e667f3bcc908ULL, 0xbb67ae8584caa73bULL, 0x3c6ef372fe94f82bULL, 0xa54ff53a5f1d36f1ULL, 0x510e527fade682d1ULL, 0x9b05688c2b3e6c1fULL, 0x1f83d9abfb41bd6bULL, 0x5be0cd19137e2179ULL}; -uint32 sha256_k[64] =+static uint32 sha256_k[64] = {0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3,@@ -165,7 +165,7 @@ 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2}; -uint64 sha512_k[80] =+static uint64 sha512_k[80] = {0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL, 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL,@@ -209,8 +209,8 @@ /* SHA-256 functions */ -void sha256_transf(sha256_ctx *ctx, const unsigned char *message,- unsigned int block_nb)+static void sha256_transf(sha256_ctx *ctx, const unsigned char *message,+ unsigned int block_nb) { uint32 w[64]; uint32 wv[8];@@ -324,16 +324,7 @@ } } -void sha256(const unsigned char *message, unsigned int len, unsigned char *digest)-{- sha256_ctx ctx;-- sha256_init(&ctx);- sha256_update(&ctx, message, len);- sha256_final(&ctx, digest);-}--void sha256_init(sha256_ctx *ctx)+static void sha256_init(sha256_ctx *ctx) { #ifndef UNROLL_LOOPS int i;@@ -351,8 +342,8 @@ ctx->tot_len = 0; } -void sha256_update(sha256_ctx *ctx, const unsigned char *message,- unsigned int len)+static void sha256_update(sha256_ctx *ctx, const unsigned char *message,+ unsigned int len) { unsigned int block_nb; unsigned int new_len, rem_len, tmp_len;@@ -385,7 +376,7 @@ ctx->tot_len += (block_nb + 1) << 6; } -void sha256_final(sha256_ctx *ctx, unsigned char *digest)+static void sha256_final(sha256_ctx *ctx, unsigned char *digest) { unsigned int block_nb; unsigned int pm_len;@@ -423,10 +414,19 @@ #endif /* !UNROLL_LOOPS */ } +void hashed_storage_sha256(const unsigned char *message, unsigned int len, unsigned char *digest)+{+ sha256_ctx ctx;++ sha256_init(&ctx);+ sha256_update(&ctx, message, len);+ sha256_final(&ctx, digest);+}+ /* SHA-512 functions */ -void sha512_transf(sha512_ctx *ctx, const unsigned char *message,- unsigned int block_nb)+static void sha512_transf(sha512_ctx *ctx, const unsigned char *message,+ unsigned int block_nb) { uint64 w[80]; uint64 wv[8];@@ -520,17 +520,7 @@ } } -void sha512(const unsigned char *message, unsigned int len,- unsigned char *digest)-{- sha512_ctx ctx;-- sha512_init(&ctx);- sha512_update(&ctx, message, len);- sha512_final(&ctx, digest);-}--void sha512_init(sha512_ctx *ctx)+static void sha512_init(sha512_ctx *ctx) { #ifndef UNROLL_LOOPS int i;@@ -548,8 +538,8 @@ ctx->tot_len = 0; } -void sha512_update(sha512_ctx *ctx, const unsigned char *message,- unsigned int len)+static void sha512_update(sha512_ctx *ctx, const unsigned char *message,+ unsigned int len) { unsigned int block_nb; unsigned int new_len, rem_len, tmp_len;@@ -582,7 +572,7 @@ ctx->tot_len += (block_nb + 1) << 7; } -void sha512_final(sha512_ctx *ctx, unsigned char *digest)+static void sha512_final(sha512_ctx *ctx, unsigned char *digest) { unsigned int block_nb; unsigned int pm_len;@@ -620,19 +610,19 @@ #endif /* !UNROLL_LOOPS */ } -/* SHA-384 functions */--void sha384(const unsigned char *message, unsigned int len,+void hashed_storage_sha512(const unsigned char *message, unsigned int len, unsigned char *digest) {- sha384_ctx ctx;+ sha512_ctx ctx; - sha384_init(&ctx);- sha384_update(&ctx, message, len);- sha384_final(&ctx, digest);+ sha512_init(&ctx);+ sha512_update(&ctx, message, len);+ sha512_final(&ctx, digest); } -void sha384_init(sha384_ctx *ctx)+/* SHA-384 functions */++static void sha384_init(sha384_ctx *ctx) { #ifndef UNROLL_LOOPS int i;@@ -650,8 +640,8 @@ ctx->tot_len = 0; } -void sha384_update(sha384_ctx *ctx, const unsigned char *message,- unsigned int len)+static void sha384_update(sha384_ctx *ctx, const unsigned char *message,+ unsigned int len) { unsigned int block_nb; unsigned int new_len, rem_len, tmp_len;@@ -684,7 +674,7 @@ ctx->tot_len += (block_nb + 1) << 7; } -void sha384_final(sha384_ctx *ctx, unsigned char *digest)+static void sha384_final(sha384_ctx *ctx, unsigned char *digest) { unsigned int block_nb; unsigned int pm_len;@@ -720,19 +710,19 @@ #endif /* !UNROLL_LOOPS */ } -/* SHA-224 functions */--void sha224(const unsigned char *message, unsigned int len,+void hashed_storage_sha384(const unsigned char *message, unsigned int len, unsigned char *digest) {- sha224_ctx ctx;+ sha384_ctx ctx; - sha224_init(&ctx);- sha224_update(&ctx, message, len);- sha224_final(&ctx, digest);+ sha384_init(&ctx);+ sha384_update(&ctx, message, len);+ sha384_final(&ctx, digest); } -void sha224_init(sha224_ctx *ctx)+/* SHA-224 functions */++static void sha224_init(sha224_ctx *ctx) { #ifndef UNROLL_LOOPS int i;@@ -750,8 +740,8 @@ ctx->tot_len = 0; } -void sha224_update(sha224_ctx *ctx, const unsigned char *message,- unsigned int len)+static void sha224_update(sha224_ctx *ctx, const unsigned char *message,+ unsigned int len) { unsigned int block_nb; unsigned int new_len, rem_len, tmp_len;@@ -784,7 +774,7 @@ ctx->tot_len += (block_nb + 1) << 6; } -void sha224_final(sha224_ctx *ctx, unsigned char *digest)+static void sha224_final(sha224_ctx *ctx, unsigned char *digest) { unsigned int block_nb; unsigned int pm_len;@@ -819,6 +809,16 @@ UNPACK32(ctx->h[5], &digest[20]); UNPACK32(ctx->h[6], &digest[24]); #endif /* !UNROLL_LOOPS */+}++void hashed_storage_sha224(const unsigned char *message, unsigned int len,+ unsigned char *digest)+{+ sha224_ctx ctx;++ sha224_init(&ctx);+ sha224_update(&ctx, message, len);+ sha224_final(&ctx, digest); } #ifdef TEST_VECTORS
Bundled/sha2.h view
@@ -72,33 +72,14 @@ typedef sha512_ctx sha384_ctx; typedef sha256_ctx sha224_ctx; -void sha224_init(sha224_ctx *ctx);-void sha224_update(sha224_ctx *ctx, const unsigned char *message,- unsigned int len);-void sha224_final(sha224_ctx *ctx, unsigned char *digest);-void sha224(const unsigned char *message, unsigned int len,- unsigned char *digest);--void sha256_init(sha256_ctx * ctx);-void sha256_update(sha256_ctx *ctx, const unsigned char *message,- unsigned int len);-void sha256_final(sha256_ctx *ctx, unsigned char *digest);-void sha256(const unsigned char *message, unsigned int len,- unsigned char *digest);--void sha384_init(sha384_ctx *ctx);-void sha384_update(sha384_ctx *ctx, const unsigned char *message,- unsigned int len);-void sha384_final(sha384_ctx *ctx, unsigned char *digest);-void sha384(const unsigned char *message, unsigned int len,- unsigned char *digest);--void sha512_init(sha512_ctx *ctx);-void sha512_update(sha512_ctx *ctx, const unsigned char *message,- unsigned int len);-void sha512_final(sha512_ctx *ctx, unsigned char *digest);-void sha512(const unsigned char *message, unsigned int len,- unsigned char *digest);+void hashed_storage_sha224(const unsigned char *message, unsigned int len,+ unsigned char *digest);+void hashed_storage_sha256(const unsigned char *message, unsigned int len,+ unsigned char *digest);+void hashed_storage_sha384(const unsigned char *message, unsigned int len,+ unsigned char *digest);+void hashed_storage_sha512(const unsigned char *message, unsigned int len,+ unsigned char *digest); #ifdef __cplusplus }
Storage/Hashed.hs view
@@ -98,7 +98,7 @@ -- and with a given @hash@. readDarcsHashedDir :: FilePath -> Hash -> IO [(ItemType, Name, Hash)] readDarcsHashedDir dir h = do- compressed <- BL.readFile (dir </> BS.unpack (darcsFormatHash h))+ compressed <- readSegment (dir </> BS.unpack (darcsFormatHash h), Nothing) let content = decompress compressed lines = BL.split '\n' content return $ if BL.null compressed
Storage/Hashed/AnchoredPath.hs view
@@ -62,6 +62,7 @@ floatBS = AnchoredPath . map Name . takeWhile (not . BS.null) . BS.split '/' flatten :: AnchoredPath -> BS.ByteString+flatten (AnchoredPath []) = BS.singleton '.' flatten (AnchoredPath p) = BS.intercalate (BS.singleton '/') [ n | (Name n) <- p ]
Storage/Hashed/Index.hs view
@@ -9,7 +9,7 @@ -- your validity tracking code, you also check for format validity (see -- "indexFormatValid") and scrap and re-create index when needed. ----- The index is a binary file that overlays a hashed tree over the working+-- The index is a binary file, that overlays a hashed tree over the working -- copy. This means that every working file and directory has an entry in the -- index, that contains its path and hash and validity data. The validity data -- is a "last seen" timestamp plus the file size. The file hashes are sha256's@@ -97,6 +97,9 @@ itemIsDir :: Item -> Bool itemIsDir i = BS.last (iPath i) == '/' +noslashpath :: Item -> FilePath+noslashpath i = BS.unpack $ itemIsDir i ? (BS.init $ iPath i, iPath i)+ -- xlatePeek32 = fmap xlate32 . peek xlatePeek64 :: (Storable a, Bits a) => Ptr a -> IO a xlatePeek64 = fmap xlate64 . peek@@ -207,7 +210,7 @@ readDir :: AnchoredPath -> Item -> Int -> Int -> IO (Maybe TreeItem) readDir parent_path item off dl = do dirend <- xlatePeek64 $ iAux item- st <- getFileStatusBS (iPath item)+ st <- getFileStatus (noslashpath item) let this_path = parent_path `appendPath` (Name $ iName item) nl = BS.length (iName item) dl' = dl + (nl == 0) ? (0, 1 + nl)@@ -256,7 +259,7 @@ then return $ Just $ File (Blob readblob $ Just hash) else return Nothing if mmap_size > 0 then- do (_, Just (Stub root h)) <- readItem (AnchoredPath []) 4 0+ do (_, Just (Stub root h)) <- readItem (AnchoredPath []) 4 (-2) tree <- root return (tree { treeHash = h }, item_map) else return (emptyTree, item_map)@@ -312,7 +315,7 @@ return lastOff create (Stub _ _) path _ = fail $ "Cannot create index from stubbed Tree at " ++ show path- pokeBS magic (BS.pack "HSI0")+ pokeBS magic (BS.pack "HSI1") create (SubTree reference) (AnchoredPath []) 4 readIndex indexpath hashtree @@ -324,7 +327,7 @@ magic <- sequence [ hGetChar fd | _ <- [1..4] :: [Int] ] hClose fd return $ case magic of- "HSI0" -> True+ "HSI1" -> True _ -> False -- | DEPRECATED! Read index (just like readIndex). However, also check that the
Storage/Hashed/Monad.hs view
@@ -9,7 +9,7 @@ module Storage.Hashed.Monad ( hashedTreeIO, plainTreeIO, virtualTreeIO , readFile, writeFile, createDirectory, rename, unlink- , fileExists, exists+ , fileExists, directoryExists, exists , tree, cwd, TreeState, TreeIO ) where @@ -20,6 +20,8 @@ import Storage.Hashed.Utils import Storage.Hashed.Darcs +import Control.Exception.Extensible( catch, SomeException(..) )+ import System.Directory( createDirectoryIfMissing, doesFileExist ) import System.FilePath( (</>) ) import Data.List( inits )@@ -91,7 +93,7 @@ expandTo :: AnchoredPath -> TreeIO () expandTo p = do t <- gets tree- t' <- liftIO $ expandPath t p+ t' <- liftIO $ expandPath t p `catch` \(_::SomeException) -> return t modify $ \st -> st { tree = t' } -- | Run a 'TreeIO' @action@ in a hashed setting. The @initial@ tree is assumed@@ -165,6 +167,11 @@ fileExists p = do expandTo p (isJust . (flip findFile p)) `fmap` gets tree +-- | Check for existence of a directory.+directoryExists :: AnchoredPath -> TreeIO Bool+directoryExists p = do expandTo p+ (isJust . (flip findTree p)) `fmap` gets tree+ -- | Check for existence of a node (file or directory, doesn't matter). exists :: AnchoredPath -> TreeIO Bool exists p = do expandTo p@@ -196,17 +203,20 @@ -- flushed to disk, but might be buffered for some time. writeFile :: AnchoredPath -> BL.ByteString -> TreeIO () writeFile p con =- do replaceItem p (Just blob)+ do expandTo p+ replaceItem p (Just blob) markChanged p maybeSync where blob = File $ Blob (return con) hash hash = Just $ hashSetSize (sha256 con) (BL.length con) createDirectory :: AnchoredPath -> TreeIO ()-createDirectory p = replaceItem p $ Just $ SubTree emptyTree+createDirectory p = do expandTo p+ replaceItem p $ Just $ SubTree emptyTree unlink :: AnchoredPath -> TreeIO ()-unlink p = replaceItem p Nothing+unlink p = do expandTo p+ replaceItem p Nothing rename :: AnchoredPath -> AnchoredPath -> TreeIO () rename from to = do expandTo from
Storage/Hashed/Test.hs view
@@ -17,7 +17,10 @@ import Storage.Hashed.Utils import Storage.Hashed.Darcs import System.IO.Unsafe( unsafePerformIO )+import System.Mem( performGC ) +import Bundled.Posix( getFileStatus, getSymbolicLinkStatus, fileSize, fileExists )+ import Test.HUnit import Test.Framework( testGroup ) import Test.QuickCheck@@ -29,11 +32,16 @@ -- Test Data -- -files = [ floatPath "foo_a"- , floatPath "foo_dir/foo_a"- , floatPath "foo_dir/foo_b"- , floatPath "foo_dir/foo_subdir/foo_a" ]+blobs = [ (floatPath "foo_a", BL.pack "a\n")+ , (floatPath "foo_dir/foo_a", BL.pack "a\n")+ , (floatPath "foo_dir/foo_b", BL.pack "b\n")+ , (floatPath "foo_dir/foo_subdir/foo_a", BL.pack "a\n") ] +files = map fst blobs++dirs = [ floatPath "foo_dir"+ , floatPath "foo_dir/foo_subdir" ]+ emptyStub = Stub (return emptyTree) Nothing testTree =@@ -50,7 +58,8 @@ -- Test list -- -tests = [ testGroup "darcs" darcs+tests = [ testGroup "Bundled.Posix" posix+ , testGroup "Storage.Hashed" hashed , testGroup "Storage.Hashed.Index" index , testGroup "Storage.Hashed.Tree" tree , testGroup "Storage.Hashed.Utils" utils ]@@ -59,35 +68,29 @@ -- Tests -- -darcs = [ testCase "specific files" have_files- , testCase "pristine files" have_pristine_files- , testCase "list == darcs show manifest" darcs_manifest- , testCase "content == darcs show contents" darcs_contents ]+hashed = [ testCase "plain has all files" have_files+ , testCase "pristine has all files" have_pristine_files+ , testCase "pristine has no extras" pristine_no_extra+ , testCase "pristine file contents match" pristine_contents ] where check_file t f = assertBool- ("path " ++ show f ++ " is in tree")+ ("path " ++ show f ++ " is missing in tree") (isJust $ find t f) check_files = forM_ files . check_file+ pristine_no_extra = do+ t <- readDarcsPristine "." >>= expand+ forM_ (list t) $ \(path,_) -> assertBool (show path ++ " is extraneous in tree")+ (path `elem` (dirs ++ files)) have_files = readPlainTree "." >>= expand >>= check_files have_pristine_files = readDarcsPristine "." >>= expand >>= check_files - -- NB. When hashed-storage replace slurpies in darcs, the following 2- -- tests become useless, since they just check our code against darcs.- darcs_manifest = do- f <- lines `fmap` readProcess "darcs" ["show", "files" ] ""- t <- readDarcsPristine "." >>= expand- forM_ (f \\ ["."]) (\x -> check_file t (floatPath x))- forM_ (list t)- (\x -> assertBool (show (fst x) ++ " is in darcs show files") $- anchorPath "." (fst x) `elem` f)- darcs_contents = do+ pristine_contents = do t <- readDarcsPristine "." >>= expand sequence_ [- do our <- read b- darcs <- readProcess "darcs" [ "show", "contents",- anchorPath "." p ] ""- assertEqual "contents match" (BL.unpack our) darcs+ do ours <- read b+ let Just stored = Prelude.lookup p blobs+ assertEqual "contents match" ours stored | (p, File b) <- list t ] index = [ testCase "index listing" check_index@@ -97,6 +100,7 @@ build_index = do x <- pristine exist <- doesFileExist "_darcs/index"+ performGC -- required in win32 to trigger file close when exist $ removeFile "_darcs/index" idx <- updateIndexFrom "_darcs/index" darcsTreeHash x >>= expand return (x, idx)@@ -113,7 +117,8 @@ x <- sequence $ zipCommonFiles check_blob_pair plain idx assertBool "files match" (length x > 0) check_index_versions =- do writeFile "_darcs/index" "nonsense index... do not crash!"+ do performGC -- required in win32 to trigger file close+ writeFile "_darcs/index" "nonsense index... do not crash!" pris <- pristine idx <- expand =<< readOrUpgradeIndex "_darcs/index" darcsTreeHash pristine@@ -175,6 +180,19 @@ , testProperty "xlate64" prop_xlate64 ] where prop_xlate32 x = (xlate32 . xlate32) x == x where types = x :: Word32 prop_xlate64 x = (xlate64 . xlate64) x == x where types = x :: Word64++posix = [ testCase "getFileStatus" $ check_stat getFileStatus+ , testCase "getSymbolicLinkStatus" $ check_stat getSymbolicLinkStatus ]+ where check_stat fun = do+ x <- fileSize `fmap` fun "foo_a"+ writeFile "test_empty" ""+ y <- fileSize `fmap` fun "test_empty"+ exist_nonexistent <- fileExists `fmap` fun "test_does_not_exist"+ exist_existent <- fileExists `fmap` fun "test_empty"+ assertEqual "file size" x 2+ assertEqual "file size" y 0+ assertBool "existence check" $ not exist_nonexistent+ assertBool "existence check" exist_existent instance Arbitrary Word32 where arbitrary = do x <- arbitrary :: Gen Int
hashed-storage.cabal view
@@ -1,5 +1,5 @@ name: hashed-storage-version: 0.3.5+version: 0.3.6 synopsis: Hashed file storage support code. description: Support code for reading and manipulating hashed file storage@@ -27,11 +27,17 @@ flag diff default: False +flag hpc+ default: False+ library if impl(ghc >= 6.8) ghc-options: -fwarn-tabs+ ghc-options: -Wall -O2 ghc-prof-options: -prof -auto-all -O2+ if flag(hpc)+ ghc-prof-options: -fhpc exposed-modules:@@ -53,7 +59,7 @@ Storage.Hashed.Utils build-depends: base >= 3 && < 5, directory, filepath, bytestring, zlib,- containers, mtl, extensible-exceptions, mmap+ containers, mtl, extensible-exceptions, mmap >= 0.4 c-sources: Bundled/sha2.c @@ -63,8 +69,10 @@ if impl(ghc >= 6.8) ghc-options: -fwarn-tabs ghc-options: -Wall -O2- ghc-prof-options: -prof -auto-all -O2++ if flag(hpc)+ ghc-prof-options: -fhpc main-is: test.hs other-modules: Bundled.Posix