diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,11 @@ +git-repair (1.20150106) unstable; urgency=medium + + * Debian package is now maintained by Gergely Nagy. + * Fix build with process 1.2.1.0. + * Merge from git-annex. + + -- Joey Hess Tue, 06 Jan 2015 19:09:23 -0400 + git-repair (1.20141027) unstable; urgency=medium * Adjust cabal file to support network-uri split. diff --git a/Common.hs b/Common.hs --- a/Common.hs +++ b/Common.hs @@ -16,7 +16,7 @@ import System.Directory as X import System.IO as X hiding (FilePath) #ifndef mingw32_HOST_OS -import System.Posix.IO as X +import System.Posix.IO as X hiding (createPipe) #endif import System.Exit as X diff --git a/Git.hs b/Git.hs --- a/Git.hs +++ b/Git.hs @@ -30,6 +30,8 @@ attributes, hookPath, assertLocal, + adjustPath, + relPath, ) where import Network.URI (uriPath, uriScheme, unEscapeString) @@ -139,3 +141,29 @@ #else isexecutable f = isExecutable . fileMode <$> getFileStatus f #endif + +{- Makes the path to a local Repo be relative to the cwd. -} +relPath :: Repo -> IO Repo +relPath = adjustPath torel + where + torel p = do + p' <- relPathCwdToFile p + if null p' + then return "." + else return p' + +{- Adusts the path to a local Repo using the provided function. -} +adjustPath :: (FilePath -> IO FilePath) -> Repo -> IO Repo +adjustPath f r@(Repo { location = l@(Local { gitdir = d, worktree = w }) }) = do + d' <- f d + w' <- maybe (pure Nothing) (Just <$$> f) w + return $ r + { location = l + { gitdir = d' + , worktree = w' + } + } +adjustPath f r@(Repo { location = LocalUnknown d }) = do + d' <- f d + return $ r { location = LocalUnknown d' } +adjustPath _ r = pure r diff --git a/Git/Branch.hs b/Git/Branch.hs --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -43,6 +43,9 @@ | null l = Nothing | otherwise = Just $ Git.Ref l +currentSha :: Repo -> IO (Maybe Git.Sha) +currentSha r = maybe (pure Nothing) (`Git.Ref.sha` r) =<< current r + {- Checks if the second branch has any commits not present on the first - branch. -} changed :: Branch -> Branch -> Repo -> IO Bool diff --git a/Git/Construct.hs b/Git/Construct.hs --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -46,8 +46,8 @@ r <- checkForRepo dir case r of Nothing -> case parentDir dir of - "" -> return Nothing - d -> seekUp d + Nothing -> return Nothing + Just d -> seekUp d Just loc -> Just <$> newFrom loc {- Local Repo constructor, accepts a relative or absolute path. -} diff --git a/Git/DiffTreeItem.hs b/Git/DiffTreeItem.hs new file mode 100644 --- /dev/null +++ b/Git/DiffTreeItem.hs @@ -0,0 +1,24 @@ +{- git diff-tree item + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.DiffTreeItem ( + DiffTreeItem(..), +) where + +import System.Posix.Types + +import Git.FilePath +import Git.Types + +data DiffTreeItem = DiffTreeItem + { srcmode :: FileMode + , dstmode :: FileMode + , srcsha :: Sha -- nullSha if file was added + , dstsha :: Sha -- nullSha if file was deleted + , status :: String + , file :: TopFilePath + } deriving Show diff --git a/Git/Index.hs b/Git/Index.hs --- a/Git/Index.hs +++ b/Git/Index.hs @@ -11,6 +11,9 @@ import Git import Utility.Env +indexEnv :: String +indexEnv = "GIT_INDEX_FILE" + {- Forces git to use the specified index file. - - Returns an action that will reset back to the default @@ -25,7 +28,7 @@ return $ reset res where var = "GIT_INDEX_FILE" - reset (Just v) = setEnv var v True + reset (Just v) = setEnv indexEnv v True reset _ = unsetEnv var indexFile :: Repo -> FilePath @@ -34,3 +37,19 @@ {- Git locks the index by creating this file. -} indexFileLock :: Repo -> FilePath indexFileLock r = indexFile r ++ ".lock" + +{- When the pre-commit hook is run, and git commit has been run with + - a file or files specified to commit, rather than committing the staged + - index, git provides the pre-commit hook with a "false index file". + - + - Changes made to this index will influence the commit, but won't + - affect the real index file. + - + - This detects when we're in this situation, using a heuristic, which + - might be broken by changes to git. Any use of this should have a test + - case to make sure it works. + -} +haveFalseIndex :: IO Bool +haveFalseIndex = maybe (False) check <$> getEnv indexEnv + where + check f = "next-index" `isPrefixOf` takeFileName f diff --git a/Git/Remote.hs b/Git/Remote.hs --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -12,8 +12,6 @@ import Common import Git import Git.Types -import qualified Git.Command -import qualified Git.BuildVersion import Data.Char import qualified Data.Map as M @@ -44,17 +42,6 @@ legal '.' = True legal c = isAlphaNum c -remove :: RemoteName -> Repo -> IO () -remove remotename = Git.Command.run - [ Param "remote" - -- name of this subcommand changed - , Param $ - if Git.BuildVersion.older "1.8.0" - then "rm" - else "remove" - , Param remotename - ] - data RemoteLocation = RemoteUrl String | RemotePath FilePath remoteLocationIsUrl :: RemoteLocation -> Bool diff --git a/Git/Repair.hs b/Git/Repair.hs --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -241,7 +241,7 @@ where makeref (sha, ref) = do let dest = localGitDir r fromRef ref - createDirectoryIfMissing True (parentDir dest) + createDirectoryIfMissing True (takeDirectory dest) unlessM (doesFileExist dest) $ writeFile dest (fromRef sha) diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -19,7 +19,8 @@ updateIndexLine, stageFile, unstageFile, - stageSymlink + stageSymlink, + stageDiffTreeItem, ) where import Common @@ -28,6 +29,7 @@ import Git.Command import Git.FilePath import Git.Sha +import qualified Git.DiffTreeItem as Diff {- Streamers are passed a callback and should feed it lines in the form - read by update-index, and generated by ls-tree. -} @@ -95,8 +97,11 @@ unstageFile :: FilePath -> Repo -> IO Streamer unstageFile file repo = do p <- toTopFilePath file repo - return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p + return $ unstageFile' p +unstageFile' :: TopFilePath -> Streamer +unstageFile' p = pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p + {- A streamer that adds a symlink to the index. -} stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer stageSymlink file sha repo = do @@ -105,6 +110,12 @@ <*> pure SymlinkBlob <*> toTopFilePath file repo return $ pureStreamer line + +{- A streamer that applies a DiffTreeItem to the index. -} +stageDiffTreeItem :: Diff.DiffTreeItem -> Streamer +stageDiffTreeItem d = case toBlobType (Diff.dstmode d) of + Nothing -> unstageFile' (Diff.file d) + Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d) indexPath :: TopFilePath -> InternalGitPath indexPath = toInternalGitPath . getTopFilePath diff --git a/Git/Version.hs b/Git/Version.hs --- a/Git/Version.hs +++ b/Git/Version.hs @@ -5,18 +5,17 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Git.Version where +module Git.Version ( + installed, + older, + normalize, + GitVersion, +) where import Common - -data GitVersion = GitVersion String Integer - deriving (Eq) - -instance Ord GitVersion where - compare (GitVersion _ x) (GitVersion _ y) = compare x y +import Utility.DottedVersion -instance Show GitVersion where - show (GitVersion s _) = s +type GitVersion = DottedVersion installed :: IO GitVersion installed = normalize . extract <$> readProcess "git" ["--version"] @@ -25,19 +24,7 @@ [] -> "" (l:_) -> unwords $ drop 2 $ words l -{- To compare dotted versions like 1.7.7 and 1.8, they are normalized to - - a somewhat arbitrary integer representation. -} -normalize :: String -> GitVersion -normalize v = GitVersion v $ - sum $ mult 1 $ reverse $ extend precision $ take precision $ - map readi $ split "." v - where - extend n l = l ++ replicate (n - length l) 0 - mult _ [] = [] - mult n (x:xs) = (n*x) : mult (n*10^width) xs - readi :: String -> Integer - readi s = case reads s of - ((x,_):_) -> x - _ -> 0 - precision = 10 -- number of segments of the version to compare - width = length "yyyymmddhhmmss" -- maximum width of a segment +older :: String -> IO Bool +older n = do + v <- installed + return $ v < normalize n diff --git a/Utility/DottedVersion.hs b/Utility/DottedVersion.hs new file mode 100644 --- /dev/null +++ b/Utility/DottedVersion.hs @@ -0,0 +1,36 @@ +{- dotted versions, such as 1.0.1 + - + - Copyright 2011-2014 Joey Hess + - + - License: BSD-2-clause + -} + +module Utility.DottedVersion where + +import Common + +data DottedVersion = DottedVersion String Integer + deriving (Eq) + +instance Ord DottedVersion where + compare (DottedVersion _ x) (DottedVersion _ y) = compare x y + +instance Show DottedVersion where + show (DottedVersion s _) = s + +{- To compare dotted versions like 1.7.7 and 1.8, they are normalized to + - a somewhat arbitrary integer representation. -} +normalize :: String -> DottedVersion +normalize v = DottedVersion v $ + sum $ mult 1 $ reverse $ extend precision $ take precision $ + map readi $ split "." v + where + extend n l = l ++ replicate (n - length l) 0 + mult _ [] = [] + mult n (x:xs) = (n*x) : mult (n*10^width) xs + readi :: String -> Integer + readi s = case reads s of + ((x,_):_) -> x + _ -> 0 + precision = 10 -- number of segments of the version to compare + width = length "yyyymmddhhmmss" -- maximum width of a segment diff --git a/Utility/Metered.hs b/Utility/Metered.hs --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -99,33 +99,43 @@ {- This is like L.hGetContents, but after each chunk is read, a meter - is updated based on the size of the chunk. - + - All the usual caveats about using unsafeInterleaveIO apply to the + - meter updates, so use caution. + -} +hGetContentsMetered :: Handle -> MeterUpdate -> IO L.ByteString +hGetContentsMetered h = hGetUntilMetered h (const True) + +{- Reads from the Handle, updating the meter after each chunk. + - - Note that the meter update is run in unsafeInterleaveIO, which means that - it can be run at any time. It's even possible for updates to run out - of order, as different parts of the ByteString are consumed. - - - All the usual caveats about using unsafeInterleaveIO apply to the - - meter updates, so use caution. + - Stops at EOF, or when keepgoing evaluates to False. + - Closes the Handle at EOF, but otherwise leaves it open. -} -hGetContentsMetered :: Handle -> MeterUpdate -> IO L.ByteString -hGetContentsMetered h meterupdate = lazyRead zeroBytesProcessed +hGetUntilMetered :: Handle -> (Integer -> Bool) -> MeterUpdate -> IO L.ByteString +hGetUntilMetered h keepgoing meterupdate = lazyRead zeroBytesProcessed where lazyRead sofar = unsafeInterleaveIO $ loop sofar loop sofar = do - c <- S.hGetSome h defaultChunkSize + c <- S.hGet h defaultChunkSize if S.null c then do hClose h return $ L.empty else do - let sofar' = addBytesProcessed sofar $ - S.length c + let sofar' = addBytesProcessed sofar (S.length c) meterupdate sofar' - {- unsafeInterleaveIO causes this to be - - deferred until the data is read from the - - ByteString. -} - cs <- lazyRead sofar' - return $ L.append (L.fromChunks [c]) cs + if keepgoing (fromBytesProcessed sofar') + then do + {- unsafeInterleaveIO causes this to be + - deferred until the data is read from the + - ByteString. -} + cs <- lazyRead sofar' + return $ L.append (L.fromChunks [c]) cs + else return $ L.fromChunks [c] {- Same default chunk size Lazy ByteStrings use. -} defaultChunkSize :: Int @@ -133,3 +143,36 @@ where k = 1024 chunkOverhead = 2 * sizeOf (undefined :: Int) -- GHC specific + +{- Parses the String looking for a command's progress output, and returns + - Maybe the number of bytes rsynced so far, and any any remainder of the + - string that could be an incomplete progress output. That remainder + - should be prepended to future output, and fed back in. This interface + - allows the command's output to be read in any desired size chunk, or + - even one character at a time. + -} +type ProgressParser = String -> (Maybe BytesProcessed, String) + +{- Runs a command and runs a ProgressParser on its output, in order + - to update the meter. The command's output is also sent to stdout. -} +commandMeter :: ProgressParser -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool +commandMeter progressparser meterupdate cmd params = liftIO $ catchBoolIO $ + withHandle StdoutHandle createProcessSuccess p $ + feedprogress zeroBytesProcessed [] + where + p = proc cmd (toCommand params) + + feedprogress prev buf h = do + s <- hGetSomeString h 80 + if null s + then return True + else do + putStr s + hFlush stdout + let (mbytes, buf') = progressparser (buf++s) + case mbytes of + Nothing -> feedprogress prev buf' h + (Just bytes) -> do + when (bytes /= prev) $ + meterupdate bytes + feedprogress bytes buf' h diff --git a/Utility/Path.hs b/Utility/Path.hs --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -21,6 +21,7 @@ import qualified System.FilePath.Posix as Posix #else import System.Posix.Files +import Utility.Exception #endif import qualified "MissingH" System.Path as MissingH @@ -76,14 +77,12 @@ todos = replace "/" "\\" #endif -{- Returns the parent directory of a path. - - - - To allow this to be easily used in loops, which terminate upon reaching the - - top, the parent of / is "" -} -parentDir :: FilePath -> FilePath +{- Just the parent directory of a path, or Nothing if the path has no + - parent (ie for "/") -} +parentDir :: FilePath -> Maybe FilePath parentDir dir - | null dirs = "" - | otherwise = joinDrive drive (join s $ init dirs) + | null dirs = Nothing + | otherwise = Just $ joinDrive drive (join s $ init dirs) where -- on Unix, the drive will be "/" when the dir is absolute, otherwise "" (drive, path) = splitDrive dir @@ -93,8 +92,8 @@ prop_parentDir_basics :: FilePath -> Bool prop_parentDir_basics dir | null dir = True - | dir == "/" = parentDir dir == "" - | otherwise = p /= dir + | dir == "/" = parentDir dir == Nothing + | otherwise = p /= Just dir where p = parentDir dir @@ -255,7 +254,9 @@ fileNameLengthLimit _ = return 255 #else fileNameLengthLimit dir = do - l <- fromIntegral <$> getPathVar dir FileNameLimit + -- getPathVar can fail due to statfs(2) overflow + l <- catchDefaultIO 0 $ + fromIntegral <$> getPathVar dir FileNameLimit if l <= 0 then return 255 else return $ minimum [l, 255] @@ -267,7 +268,8 @@ - sane FilePath. - - All spaces and punctuation and other wacky stuff are replaced - - with '_', except for '.' "../" will thus turn into ".._", which is safe. + - with '_', except for '.' + - "../" will thus turn into ".._", which is safe. -} sanitizeFilePath :: String -> FilePath sanitizeFilePath = map sanitize diff --git a/Utility/Process.hs b/Utility/Process.hs --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -1,7 +1,7 @@ {- System.Process enhancements, including additional ways of running - processes, and logging. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} @@ -13,6 +13,7 @@ CreateProcess(..), StdHandle(..), readProcess, + readProcess', readProcessEnv, writeReadProcessEnv, forceSuccessProcess, @@ -37,7 +38,7 @@ ) where import qualified System.Process -import System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess) +import qualified System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess) import System.Process hiding (createProcess, readProcess) import System.Exit import System.IO @@ -46,7 +47,7 @@ import qualified Control.Exception as E import Control.Monad #ifndef mingw32_HOST_OS -import System.Posix.IO +import qualified System.Posix.IO #else import Control.Applicative #endif @@ -66,17 +67,19 @@ readProcess cmd args = readProcessEnv cmd args Nothing readProcessEnv :: FilePath -> [String] -> Maybe [(String, String)] -> IO String -readProcessEnv cmd args environ = - withHandle StdoutHandle createProcessSuccess p $ \h -> do - output <- hGetContentsStrict h - hClose h - return output +readProcessEnv cmd args environ = readProcess' p where p = (proc cmd args) { std_out = CreatePipe , env = environ } +readProcess' :: CreateProcess -> IO String +readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do + output <- hGetContentsStrict h + hClose h + return output + {- Runs an action to write to a process on its stdin, - returns its output, and also allows specifying the environment. -} @@ -172,9 +175,9 @@ #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order - the process writes them. -} - (readf, writef) <- createPipe - readh <- fdToHandle readf - writeh <- fdToHandle writef + (readf, writef) <- System.Posix.IO.createPipe + readh <- System.Posix.IO.fdToHandle readf + writeh <- System.Posix.IO.fdToHandle writef p@(_, _, _, pid) <- createProcess $ (proc cmd opts) { std_in = if isJust input then CreatePipe else Inherit diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -5,6 +5,8 @@ - License: BSD-2-clause -} +{-# LANGUAGE CPP #-} + module Utility.Rsync where import Common @@ -53,37 +55,18 @@ {- On Windows, rsync is from Cygwin, and expects to get Cygwin formatted - paths to files. (It thinks that C:foo refers to a host named "C"). - - Fix up all Files in the Params appropriately. -} + - Fix up the Params appropriately. -} rsyncParamsFixup :: [CommandParam] -> [CommandParam] +#ifdef mingw32_HOST_OS rsyncParamsFixup = map fixup where fixup (File f) = File (toCygPath f) + fixup (Param s) + | rsyncUrlIsPath s = Param (toCygPath s) fixup p = p - -{- Runs rsync, but intercepts its progress output and updates a meter. - - The progress output is also output to stdout. - - - - The params must enable rsync's --progress mode for this to work. - -} -rsyncProgress :: MeterUpdate -> [CommandParam] -> IO Bool -rsyncProgress meterupdate params = catchBoolIO $ - withHandle StdoutHandle createProcessSuccess p (feedprogress 0 []) - where - p = proc "rsync" (toCommand $ rsyncParamsFixup params) - feedprogress prev buf h = do - s <- hGetSomeString h 80 - if null s - then return True - else do - putStr s - hFlush stdout - let (mbytes, buf') = parseRsyncProgress (buf++s) - case mbytes of - Nothing -> feedprogress prev buf' h - (Just bytes) -> do - when (bytes /= prev) $ - meterupdate $ toBytesProcessed bytes - feedprogress bytes buf' h +#else +rsyncParamsFixup = id +#endif {- Checks if an rsync url involves the remote shell (ssh or rsh). - Use of such urls with rsync requires additional shell @@ -103,17 +86,21 @@ {- Checks if a rsync url is really just a local path. -} rsyncUrlIsPath :: String -> Bool rsyncUrlIsPath s +#ifdef mingw32_HOST_OS + | not (null (takeDrive s)) = True +#endif | rsyncUrlIsShell s = False | otherwise = ':' `notElem` s -{- Parses the String looking for rsync progress output, and returns - - Maybe the number of bytes rsynced so far, and any any remainder of the - - string that could be an incomplete progress output. That remainder - - should be prepended to future output, and fed back in. This interface - - allows the output to be read in any desired size chunk, or even one - - character at a time. +{- Runs rsync, but intercepts its progress output and updates a meter. + - The progress output is also output to stdout. - - - Strategy: Look for chunks prefixed with \r (rsync writes a \r before + - The params must enable rsync's --progress mode for this to work. + -} +rsyncProgress :: MeterUpdate -> [CommandParam] -> IO Bool +rsyncProgress meterupdate = commandMeter parseRsyncProgress meterupdate "rsync" . rsyncParamsFixup + +{- Strategy: Look for chunks prefixed with \r (rsync writes a \r before - the first progress output, and each thereafter). The first number - after the \r is the number of bytes processed. After the number, - there must appear some whitespace, or we didn't get the whole number, @@ -122,20 +109,23 @@ - In some locales, the number will have one or more commas in the middle - of it. -} -parseRsyncProgress :: String -> (Maybe Integer, String) +parseRsyncProgress :: ProgressParser parseRsyncProgress = go [] . reverse . progresschunks where go remainder [] = (Nothing, remainder) go remainder (x:xs) = case parsebytes (findbytesstart x) of Nothing -> go (delim:x++remainder) xs - Just b -> (Just b, remainder) + Just b -> (Just (toBytesProcessed b), remainder) delim = '\r' + {- Find chunks that each start with delim. - The first chunk doesn't start with it - (it's empty when delim is at the start of the string). -} progresschunks = drop 1 . split [delim] findbytesstart s = dropWhile isSpace s + + parsebytes :: String -> Maybe Integer parsebytes s = case break isSpace s of ([], _) -> Nothing (_, []) -> Nothing diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -24,8 +24,8 @@ {- Runs an action like writeFile, writing to a temp file first and - then moving it into place. The temp file is stored in the same - directory as the final file to avoid cross-device renames. -} -viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO () -viaTmp a file content = bracket setup cleanup use +viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> String -> m ()) -> FilePath -> String -> m () +viaTmp a file content = bracketIO setup cleanup use where (dir, base) = splitFileName file template = base ++ ".tmp" @@ -36,9 +36,9 @@ _ <- tryIO $ hClose h tryIO $ removeFile tmpfile use (tmpfile, h) = do - hClose h + liftIO $ hClose h a tmpfile content - rename tmpfile file + liftIO $ rename tmpfile file {- Runs an action with a tmp file located in the system's tmp directory - (or in "." if there is none) then removes the file. -} @@ -61,15 +61,15 @@ {- Runs an action with a tmp directory located within the system's tmp - directory (or within "." if there is none), then removes the tmp - directory and all its contents. -} -withTmpDir :: Template -> (FilePath -> IO a) -> IO a +withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a withTmpDir template a = do - tmpdir <- catchDefaultIO "." getTemporaryDirectory + tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory withTmpDirIn tmpdir template a {- Runs an action with a tmp directory located within a specified directory, - then removes the tmp directory and all its contents. -} -withTmpDirIn :: FilePath -> Template -> (FilePath -> IO a) -> IO a -withTmpDirIn tmpdir template = bracket create remove +withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a +withTmpDirIn tmpdir template = bracketIO create remove where remove d = whenM (doesDirectoryExist d) $ do #if mingw32_HOST_OS diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs --- a/Utility/UserInfo.hs +++ b/Utility/UserInfo.hs @@ -13,8 +13,10 @@ myUserGecos, ) where -import Control.Applicative import System.PosixCompat +#ifndef mingw32_HOST_OS +import Control.Applicative +#endif import Utility.Env @@ -40,16 +42,20 @@ env = ["USERNAME", "USER", "LOGNAME"] #endif -myUserGecos :: IO String -#ifdef __ANDROID__ -myUserGecos = return "" -- userGecos crashes on Android +myUserGecos :: IO (Maybe String) +-- userGecos crashes on Android and is not available on Windows. +#if defined(__ANDROID__) || defined(mingw32_HOST_OS) +myUserGecos = return Nothing #else -myUserGecos = myVal [] userGecos +myUserGecos = Just <$> myVal [] userGecos #endif myVal :: [String] -> (UserEntry -> String) -> IO String -myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars +myVal envvars extract = go envvars where - check [] = return Nothing - check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v - getpwent = getUserEntryForID =<< getEffectiveUserID +#ifndef mingw32_HOST_OS + go [] = extract <$> (getUserEntryForID =<< getEffectiveUserID) +#else + go [] = error $ "environment not set: " ++ show envvars +#endif + go (v:vs) = maybe (go vs) return =<< getEnv v diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +git-repair (1.20150106) unstable; urgency=medium + + * Debian package is now maintained by Gergely Nagy. + * Fix build with process 1.2.1.0. + * Merge from git-annex. + + -- Joey Hess Tue, 06 Jan 2015 19:09:23 -0400 + git-repair (1.20141027) unstable; urgency=medium * Adjust cabal file to support network-uri split. diff --git a/debian/control b/debian/control --- a/debian/control +++ b/debian/control @@ -17,7 +17,7 @@ libghc-utf8-string-dev, libghc-async-dev, libghc-optparse-applicative-dev (>= 0.10.0) -Maintainer: Joey Hess +Maintainer: Gergely Nagy Standards-Version: 3.9.5 Vcs-Git: git://git-repair.branchable.com/ Homepage: http://git-repair.branchable.com/ diff --git a/doc/index.mdwn b/doc/index.mdwn --- a/doc/index.mdwn +++ b/doc/index.mdwn @@ -49,3 +49,7 @@ Since this command unpacks all packs in the repository, you may want to run `git gc` afterwards. + +## news + +[[!inline pages="news/* and !*/Discussion" show="4" archive=yes]] diff --git a/doc/news/version_1.20141027.mdwn b/doc/news/version_1.20141027.mdwn new file mode 100644 --- /dev/null +++ b/doc/news/version_1.20141027.mdwn @@ -0,0 +1,1 @@ +git-repair 1.20140613 released diff --git a/git-repair.cabal b/git-repair.cabal --- a/git-repair.cabal +++ b/git-repair.cabal @@ -1,5 +1,5 @@ Name: git-repair -Version: 1.20141027 +Version: 1.20150106 Cabal-Version: >= 1.8 License: GPL Maintainer: Joey Hess