filestore 0.3.3 → 0.3.3.1
raw patch · 5 files changed
+47/−12 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES +12/−0
- Data/FileStore/Darcs.hs +1/−1
- Data/FileStore/Git.hs +12/−8
- Tests.lhs +21/−2
- filestore.cabal +1/−1
CHANGES view
@@ -1,3 +1,15 @@+Version 0.3.3.1 released 22 Nov 2009++* Raise an IllegalResourceName error if the user tries to+ delete a file inside .git or _darcs subdirectory.++* Have gitSearch return no matches, instead of raising an error,+ if error status = 1. Recent versions of git-grep return 1 if+ no matches found.++* Fix git log parsing so that it allows log comments to start with ':'+ Thanks to thorben for uncovering the bug.+ Version 0.3.3 released 06 Nov 2009 * isInsideDir is again exported.
Data/FileStore/Darcs.hs view
@@ -106,7 +106,7 @@ -- | Delete a resource from the repository. darcsDelete :: FilePath -> FilePath -> Author -> Description -> IO ()-darcsDelete repo name author logMsg = do+darcsDelete repo name author logMsg = withSanityCheck repo ["_darcs"] name $ do runShellCommand repo Nothing "rm" [name] darcsCommit repo [name] author logMsg
Data/FileStore/Git.hs view
@@ -26,7 +26,7 @@ import qualified Text.ParserCombinators.Parsec as P import Codec.Binary.UTF8.String (decodeString, encodeString) import Data.Char (chr)-import Control.Monad (liftM, when)+import Control.Monad (when) import System.FilePath ((</>)) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, executable, getPermissions, setPermissions) import Control.Exception (throwIO)@@ -120,7 +120,7 @@ -- | Delete a resource from the repository. gitDelete :: FilePath -> FilePath -> Author -> Description -> IO ()-gitDelete repo name author logMsg = do+gitDelete repo name author logMsg = withSanityCheck repo [".git"] name $ do (statusAdd, errRm, _) <- runGitCommand repo "rm" [name] if statusAdd == ExitSuccess then gitCommit repo [name] author logMsg@@ -150,7 +150,7 @@ -- | Get revision information for a particular revision ID, or latest revision. gitGetRevision :: FilePath -> RevisionId -> IO Revision gitGetRevision repo revid = do- (status, _, output) <- runGitCommand repo "whatchanged" ["--pretty=format:%h%n%ct%n%an%n%ae%n%s%n", "--max-count=1", revid]+ (status, _, output) <- runGitCommand repo "whatchanged" ["--pretty=format:" ++ gitLogFormat, "--max-count=1", revid] if status == ExitSuccess then case P.parse parseGitLog "" (toString output) of Left err' -> throwIO $ UnknownError $ "error parsing git log: " ++ show err'@@ -195,9 +195,10 @@ ["--word-regexp" | queryWholeWords query] (status, errOutput, output) <- runGitCommand repo "grep" (opts ++ concatMap (\term -> ["-e", escapeRegexSpecialChars term]) (queryPatterns query))- if status == ExitSuccess- then return $ map parseMatchLine $ lines $ toString output- else throwIO $ UnknownError $ "git grep returned error status.\n" ++ errOutput+ case status of+ ExitSuccess -> return $ map parseMatchLine $ lines $ toString output+ ExitFailure 1 -> return [] -- status of 1 means no matches in recent versions of git+ ExitFailure _ -> throwIO $ UnknownError $ "git grep returned error status.\n" ++ errOutput -- Auxiliary function for searchResults parseMatchLine :: String -> SearchMatch@@ -221,12 +222,15 @@ else throwIO $ UnknownError $ "git diff returned error:\n" ++ err' -} +gitLogFormat :: String+gitLogFormat = "%H%n%ct%n%an%n%ae%n%s%n%x00"+ -- | Return list of log entries for the given time frame and list of resources. -- If list of resources is empty, log entries for all resources are returned. gitLog :: FilePath -> [FilePath] -> TimeRange -> IO [Revision] gitLog repo names (TimeRange mbSince mbUntil) = do (status, err, output) <- runGitCommand repo "whatchanged" $- ["--pretty=format:%h%n%ct%n%an%n%ae%n%s%n"] +++ ["--pretty=format:" ++ gitLogFormat] ++ (case mbSince of Just since -> ["--since='" ++ show since ++ "'"] Nothing -> []) ++@@ -259,7 +263,7 @@ date <- nonblankLine author <- wholeLine email <- wholeLine- subject <- liftM unlines (P.manyTill wholeLine (P.eof P.<|> (P.lookAhead (P.char ':') >> return ())))+ subject <- P.manyTill P.anyChar (P.satisfy (=='\x00')) P.spaces changes <- P.many gitLogChange P.spaces
Tests.lhs view
@@ -43,7 +43,7 @@ > , ("retrieve resource with non-ascii name", retrieveTest3) > , ("retrieve subdirectory (should raise error)", retrieveTest4) > , ("modify resource", modifyTest)-> , ("delete resource", deleteTest)+> , ("delete resource", deleteTest fsName) > , ("rename resource", renameTest) > , ("test for matching IDs", matchTest) > , ("history and revision", historyTest)@@ -212,7 +212,7 @@ *** Delete a resource: -> deleteTest fs = TestCase $ do+> deleteTest fsName fs = TestCase $ do Create a file and verify that it's there. @@ -227,6 +227,16 @@ > ind <- index fs > assertBool "index does not contain resource that was deleted" (toBeDeleted `notElem` ind) + Try to delete a file somewhere we shouldn't be able to delete++> let (realpath, special) = case fsName of+> "Data.FileStore.Git" -> ("tmp" </> "gitfs" </> ".git" </> "newfile", ".git/newfile")+> "Data.FileStore.Darcs" -> ("tmp" </> "darcsfs" </> "_darcs" </> "newfile", "_darcs/newfile")+> _ -> error "Unknown filestore type! Add a test case."+> catch (delete fs special testAuthor "description of change" >>+> (assertFailure $ "did not return error from delete " ++ special)) $+> \e -> assertEqual ("error from delete " ++ special) IllegalResourceName e + *** Rename a resource: > renameTest fs = TestCase $ do@@ -252,6 +262,15 @@ > catch (rename fs "nonexistent file" "other name" testAuthor "rename" >> > assertFailure "rename of nonexistent file did not throw error") $ > \e -> assertEqual "error status from rename of nonexistent file" NotFound e++ Try to rename a file to a location we shouldn't be able to write in.++> let badName = "../eek"+> let cmd = "rename " ++ newName ++ " " ++ badName+> catch (rename fs newName badName testAuthor "description of change" >>+> (assertFailure $ "did not return error from " ++ cmd)) $+> \e -> assertEqual ("error from " ++ cmd) IllegalResourceName e + *** Test history and revision
filestore.cabal view
@@ -1,5 +1,5 @@ Name: filestore-Version: 0.3.3+Version: 0.3.3.1 Cabal-version: >= 1.2 Build-type: Custom Tested-with: GHC==6.10.1