diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs --- a/Build/TestConfig.hs +++ b/Build/TestConfig.hs @@ -7,8 +7,6 @@ import Utility.SafeCommand import System.IO -import System.Cmd -import System.Exit import System.FilePath import System.Directory diff --git a/Common.hs b/Common.hs --- a/Common.hs +++ b/Common.hs @@ -16,7 +16,7 @@ import System.IO as X hiding (FilePath) import System.PosixCompat.Files as X #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/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/Version.hs b/Git/Version.hs --- a/Git/Version.hs +++ b/Git/Version.hs @@ -7,6 +7,7 @@ module Git.Version ( installed, + older, normalize, GitVersion, ) where @@ -22,3 +23,8 @@ extract s = case lines s of [] -> "" (l:_) -> unwords $ drop 2 $ words l + +older :: String -> IO Bool +older n = do + v <- installed + return $ v < normalize n 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] 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 -} @@ -38,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 @@ -47,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 @@ -175,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/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 diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +github-backup (1.20150106) unstable; urgency=medium + + * Fix build with process 1.2.1.0. + * Various updates to internal git and utility libraries shared + with git-annex. + + -- Joey Hess Tue, 06 Jan 2015 19:08:08 -0400 + github-backup (1.20141222) unstable; urgency=medium * Added gitriddance(1), a utility to close all issues and pull requests, @@ -5,7 +13,8 @@ issue tracker. * gitriddance depends on github 0.13.1, which has bug fixes for posting comments. - * Various updates to internal git and utility libraries shared with git-annex. + * Various updates to internal git and utility libraries shared + with git-annex. -- Joey Hess Mon, 22 Dec 2014 15:30:08 -0400 diff --git a/github-backup.cabal b/github-backup.cabal --- a/github-backup.cabal +++ b/github-backup.cabal @@ -1,5 +1,5 @@ Name: github-backup -Version: 1.20141222 +Version: 1.20150106 Cabal-Version: >= 1.8 License: GPL Maintainer: Joey Hess diff --git a/github-backup.hs b/github-backup.hs --- a/github-backup.hs +++ b/github-backup.hs @@ -262,7 +262,7 @@ <$> workDir <*> pure (storeLocation filebase req) liftIO $ do - createDirectoryIfMissing True (parentDir file) + createDirectoryIfMissing True (takeDirectory file) writeFile file (ppShow val) storeLocation :: FilePath -> Request -> FilePath @@ -558,7 +558,6 @@ prepare (dir, url) | url `elem` excludeurls = return Nothing | otherwise = do - print url unlessM (doesDirectoryExist dir) $ do putStrLn $ "New repository: " ++ dir ok <- boolSystem "git"