From 619c8bd261a4fee0b0d40b664e55c51782e062f7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 21 Jul 2014 16:35:23 -0400 Subject: Merge from git-annex. --- Git/Branch.hs | 64 +++++++++++++++++++++----- Git/Command.hs | 9 ---- Git/Config.hs | 1 - Git/CurrentRepo.hs | 8 ++-- Git/Fsck.hs | 1 - Git/Index.hs | 4 ++ Git/LsFiles.hs | 4 +- Git/UpdateIndex.hs | 1 - Utility/Applicative.hs | 2 +- Utility/Batch.hs | 3 +- Utility/CoProcess.hs | 8 ++-- Utility/Data.hs | 2 +- Utility/Directory.hs | 103 ++++++++++++++++++++++++++++++++++++++++-- Utility/Env.hs | 2 +- Utility/Exception.hs | 4 +- Utility/FileMode.hs | 2 +- Utility/FileSystemEncoding.hs | 2 +- Utility/Format.hs | 2 +- Utility/Metered.hs | 2 +- Utility/Misc.hs | 2 +- Utility/Monad.hs | 2 +- Utility/Path.hs | 2 +- Utility/PosixFiles.hs | 2 +- Utility/Process.hs | 39 ++++++---------- Utility/QuickCheck.hs | 2 +- Utility/Rsync.hs | 2 +- Utility/SafeCommand.hs | 3 +- Utility/ThreadScheduler.hs | 5 +- Utility/Tmp.hs | 23 ++++++---- Utility/URI.hs | 2 +- Utility/UserInfo.hs | 2 +- debian/changelog | 6 +++ 32 files changed, 222 insertions(+), 94 deletions(-) diff --git a/Git/Branch.hs b/Git/Branch.hs index d182ceb..0b7d888 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -14,6 +14,7 @@ import Git import Git.Sha import Git.Command import qualified Git.Ref +import qualified Git.BuildVersion {- The currently checked out branch. - @@ -52,7 +53,22 @@ changed origbranch newbranch repo diffs = pipeReadStrict [ Param "log" , Param (fromRef origbranch ++ ".." ++ fromRef newbranch) - , Params "--oneline -n1" + , Param "-n1" + , Param "--pretty=%H" + ] repo + +{- Check if it's possible to fast-forward from the old + - ref to the new ref. + - + - This requires there to be a path from the old to the new. -} +fastForwardable :: Ref -> Ref -> Repo -> IO Bool +fastForwardable old new repo = not . null <$> + pipeReadStrict + [ Param "log" + , Param $ fromRef old ++ ".." ++ fromRef new + , Param "-n1" + , Param "--pretty=%H" + , Param "--ancestry-path" ] repo {- Given a set of refs that are all known to have commits not @@ -74,7 +90,7 @@ fastForward branch (first:rest) repo = where no_ff = return False do_ff to = do - run [Param "update-ref", Param $ fromRef branch, Param $ fromRef to] repo + update branch to repo return True findbest c [] = return $ Just c findbest c (r:rs) @@ -88,6 +104,31 @@ fastForward branch (first:rest) repo = (False, True) -> findbest c rs -- worse (False, False) -> findbest c rs -- same +{- The user may have set commit.gpgsign, indending all their manual + - commits to be signed. But signing automatic/background commits could + - easily lead to unwanted gpg prompts or failures. + -} +data CommitMode = ManualCommit | AutomaticCommit + deriving (Eq) + +applyCommitMode :: CommitMode -> [CommandParam] -> [CommandParam] +applyCommitMode commitmode ps + | commitmode == AutomaticCommit && not (Git.BuildVersion.older "2.0.0") = + Param "--no-gpg-sign" : ps + | otherwise = ps + +{- Commit via the usual git command. -} +commitCommand :: CommitMode -> [CommandParam] -> Repo -> IO Bool +commitCommand = commitCommand' runBool + +{- Commit will fail when the tree is clean. This suppresses that error. -} +commitQuiet :: CommitMode -> [CommandParam] -> Repo -> IO () +commitQuiet commitmode ps = void . tryIO . commitCommand' runQuiet commitmode ps + +commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> [CommandParam] -> Repo -> IO a +commitCommand' runner commitmode ps = runner $ + Param "commit" : applyCommitMode commitmode ps + {- Commits the index into the specified branch (or other ref), - with the specified parent refs, and returns the committed sha. - @@ -97,30 +138,31 @@ fastForward branch (first:rest) repo = - Unlike git-commit, does not run any hooks, or examine the work tree - in any way. -} -commit :: Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha) -commit allowempty message branch parentrefs repo = do +commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha) +commit commitmode allowempty message branch parentrefs repo = do tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo ifM (cancommit tree) ( do - sha <- getSha "commit-tree" $ pipeWriteRead - (map Param $ ["commit-tree", fromRef tree] ++ ps) - (Just $ flip hPutStr message) repo + sha <- getSha "commit-tree" $ + pipeWriteRead ([Param "commit-tree", Param (fromRef tree)] ++ ps) sendmsg repo update branch sha repo return $ Just sha , return Nothing ) where - ps = concatMap (\r -> ["-p", fromRef r]) parentrefs + ps = applyCommitMode commitmode $ + map Param $ concatMap (\r -> ["-p", fromRef r]) parentrefs cancommit tree | allowempty = return True | otherwise = case parentrefs of [p] -> maybe False (tree /=) <$> Git.Ref.tree p repo _ -> return True + sendmsg = Just $ flip hPutStr message -commitAlways :: String -> Branch -> [Ref] -> Repo -> IO Sha -commitAlways message branch parentrefs repo = fromJust - <$> commit True message branch parentrefs repo +commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha +commitAlways commitmode message branch parentrefs repo = fromJust + <$> commit commitmode True message branch parentrefs repo {- A leading + makes git-push force pushing a branch. -} forcePush :: String -> String diff --git a/Git/Command.hs b/Git/Command.hs index a0c7c4b..30d2dcb 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -9,13 +9,10 @@ module Git.Command where -import System.Process (std_out, env) - import Common import Git import Git.Types import qualified Utility.CoProcess as CoProcess -import Utility.Batch {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] @@ -33,12 +30,6 @@ runBool :: [CommandParam] -> Repo -> IO Bool runBool params repo = assertLocal repo $ boolSystemEnv "git" (gitCommandLine params repo) (gitEnv repo) -{- Runs git in batch mode. -} -runBatch :: BatchCommandMaker -> [CommandParam] -> Repo -> IO Bool -runBatch batchmaker params repo = assertLocal repo $ do - let (cmd, params') = batchmaker ("git", gitCommandLine params repo) - boolSystemEnv cmd params' (gitEnv repo) - {- Runs git in the specified repo, throwing an error if it fails. -} run :: [CommandParam] -> Repo -> IO () run params repo = assertLocal repo $ diff --git a/Git/Config.hs b/Git/Config.hs index b5c1be0..d998fd1 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -9,7 +9,6 @@ module Git.Config where import qualified Data.Map as M import Data.Char -import System.Process (cwd, env) import Control.Exception.Extensible import Common diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs index ee91a6b..23ebbbc 100644 --- a/Git/CurrentRepo.hs +++ b/Git/CurrentRepo.hs @@ -37,8 +37,8 @@ get = do case wt of Nothing -> return r Just d -> do - cwd <- getCurrentDirectory - unless (d `dirContains` cwd) $ + curr <- getCurrentDirectory + unless (d `dirContains` curr) $ setCurrentDirectory d return $ addworktree wt r where @@ -57,8 +57,8 @@ get = do configure Nothing (Just r) = Git.Config.read r configure (Just d) _ = do absd <- absPath d - cwd <- getCurrentDirectory - r <- newFrom $ Local { gitdir = absd, worktree = Just cwd } + curr <- getCurrentDirectory + r <- newFrom $ Local { gitdir = absd, worktree = Just curr } Git.Config.read r configure Nothing Nothing = error "Not in a git repository." diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 80f76dd..c6002f6 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -23,7 +23,6 @@ import Utility.Batch import qualified Git.Version import qualified Data.Set as S -import System.Process (std_out, std_err) import Control.Concurrent.Async type MissingObjects = S.Set Sha diff --git a/Git/Index.hs b/Git/Index.hs index d9d5b03..d712245 100644 --- a/Git/Index.hs +++ b/Git/Index.hs @@ -30,3 +30,7 @@ override index = do indexFile :: Repo -> FilePath indexFile r = localGitDir r "index" + +{- Git locks the index by creating this file. -} +indexFileLock :: Repo -> FilePath +indexFileLock r = indexFile r ++ ".lock" diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index e155845..2aa05ba 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -132,8 +132,8 @@ typeChanged' ps l repo = do -- git diff returns filenames relative to the top of the git repo; -- convert to filenames relative to the cwd, like git ls-files. let top = repoPath repo - cwd <- getCurrentDirectory - return (map (\f -> relPathDirToFile cwd $ top f) fs, cleanup) + currdir <- getCurrentDirectory + return (map (\f -> relPathDirToFile currdir $ top f) fs, cleanup) where prefix = [Params "diff --name-only --diff-filter=T -z"] suffix = Param "--" : (if null l then [File "."] else map File l) diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 4ecd773..7de2f1b 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -30,7 +30,6 @@ import Git.FilePath import Git.Sha import Control.Exception (bracket) -import System.Process (std_in) {- Streamers are passed a callback and should feed it lines in the form - read by update-index, and generated by ls-tree. -} diff --git a/Utility/Applicative.hs b/Utility/Applicative.hs index 64400c8..fd8944b 100644 --- a/Utility/Applicative.hs +++ b/Utility/Applicative.hs @@ -2,7 +2,7 @@ - - Copyright 2012 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} module Utility.Applicative where diff --git a/Utility/Batch.hs b/Utility/Batch.hs index 3f21478..d6dadae 100644 --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -2,7 +2,7 @@ - - Copyright 2013 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} @@ -16,7 +16,6 @@ import Control.Concurrent.Async import System.Posix.Process #endif import qualified Control.Exception as E -import System.Process (env) {- Runs an operation, at batch priority. - diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs index c113401..332c09d 100644 --- a/Utility/CoProcess.hs +++ b/Utility/CoProcess.hs @@ -3,7 +3,7 @@ - - Copyright 2012-2013 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} @@ -37,8 +37,8 @@ data CoProcessSpec = CoProcessSpec } start :: Int -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle -start numrestarts cmd params env = do - s <- start' $ CoProcessSpec numrestarts cmd params env +start numrestarts cmd params environ = do + s <- start' $ CoProcessSpec numrestarts cmd params environ newMVar s start' :: CoProcessSpec -> IO CoProcessState @@ -62,7 +62,7 @@ query ch send receive = do s <- readMVar ch restartable s (send $ coProcessTo s) $ const $ restartable s (hFlush $ coProcessTo s) $ const $ - restartable s (receive $ coProcessFrom s) $ + restartable s (receive $ coProcessFrom s) return where restartable s a cont diff --git a/Utility/Data.hs b/Utility/Data.hs index 3592582..2df12b3 100644 --- a/Utility/Data.hs +++ b/Utility/Data.hs @@ -2,7 +2,7 @@ - - Copyright 2013 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} module Utility.Data where diff --git a/Utility/Directory.hs b/Utility/Directory.hs index f1bcfad..ade5ef8 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -1,8 +1,8 @@ -{- directory manipulation +{- directory traversal and manipulation - - Copyright 2011-2014 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} @@ -11,12 +11,20 @@ module Utility.Directory where import System.IO.Error import System.Directory -import Control.Exception (throw) +import Control.Exception (throw, bracket) import Control.Monad import Control.Monad.IfElse import System.FilePath import Control.Applicative +import Control.Concurrent import System.IO.Unsafe (unsafeInterleaveIO) +import Data.Maybe + +#ifdef mingw32_HOST_OS +import qualified System.Win32 as Win32 +#else +import qualified System.Posix as Posix +#endif import Utility.PosixFiles import Utility.SafeCommand @@ -43,7 +51,7 @@ dirContents d = map (d ) . filter (not . dirCruft) <$> getDirectoryContents d - When the directory does not exist, no exception is thrown, - instead, [] is returned. -} dirContentsRecursive :: FilePath -> IO [FilePath] -dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) True topdir +dirContentsRecursive = dirContentsRecursiveSkipping (const False) True {- Skips directories whose basenames match the skipdir. -} dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath] @@ -133,3 +141,90 @@ nukeFile file = void $ tryWhenExists go #else go = removeFile file #endif + +#ifndef mingw32_HOST_OS +data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream +#else +data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ()) +#endif + +type IsOpen = MVar () -- full when the handle is open + +openDirectory :: FilePath -> IO DirectoryHandle +openDirectory path = do +#ifndef mingw32_HOST_OS + dirp <- Posix.openDirStream path + isopen <- newMVar () + return (DirectoryHandle isopen dirp) +#else + (h, fdat) <- Win32.findFirstFile (path "*") + -- Indicate that the fdat contains a filename that readDirectory + -- has not yet returned, by making the MVar be full. + -- (There's always at least a "." entry.) + alreadyhave <- newMVar () + isopen <- newMVar () + return (DirectoryHandle isopen h fdat alreadyhave) +#endif + +closeDirectory :: DirectoryHandle -> IO () +#ifndef mingw32_HOST_OS +closeDirectory (DirectoryHandle isopen dirp) = + whenOpen isopen $ + Posix.closeDirStream dirp +#else +closeDirectory (DirectoryHandle isopen h _ alreadyhave) = + whenOpen isopen $ do + _ <- tryTakeMVar alreadyhave + Win32.findClose h +#endif + where + whenOpen :: IsOpen -> IO () -> IO () + whenOpen mv f = do + v <- tryTakeMVar mv + when (isJust v) f + +{- |Reads the next entry from the handle. Once the end of the directory +is reached, returns Nothing and automatically closes the handle. +-} +readDirectory :: DirectoryHandle -> IO (Maybe FilePath) +#ifndef mingw32_HOST_OS +readDirectory hdl@(DirectoryHandle _ dirp) = do + e <- Posix.readDirStream dirp + if null e + then do + closeDirectory hdl + return Nothing + else return (Just e) +#else +readDirectory hdl@(DirectoryHandle _ h fdat mv) = do + -- If the MVar is full, then the filename in fdat has + -- not yet been returned. Otherwise, need to find the next + -- file. + r <- tryTakeMVar mv + case r of + Just () -> getfn + Nothing -> do + more <- Win32.findNextFile h fdat + if more + then getfn + else do + closeDirectory hdl + return Nothing + where + getfn = do + filename <- Win32.getFindDataFileName fdat + return (Just filename) +#endif + +-- True only when directory exists and contains nothing. +-- Throws exception if directory does not exist. +isDirectoryEmpty :: FilePath -> IO Bool +isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check + where + check h = do + v <- readDirectory h + case v of + Nothing -> return True + Just f + | not (dirCruft f) -> return False + | otherwise -> check h diff --git a/Utility/Env.hs b/Utility/Env.hs index 90ed58f..6763c24 100644 --- a/Utility/Env.hs +++ b/Utility/Env.hs @@ -2,7 +2,7 @@ - - Copyright 2013 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} diff --git a/Utility/Exception.hs b/Utility/Exception.hs index cf2c615..1fecf65 100644 --- a/Utility/Exception.hs +++ b/Utility/Exception.hs @@ -2,7 +2,7 @@ - - Copyright 2011-2012 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE ScopedTypeVariables #-} @@ -18,7 +18,7 @@ import Utility.Data {- Catches IO errors and returns a Bool -} catchBoolIO :: IO Bool -> IO Bool -catchBoolIO a = catchDefaultIO False a +catchBoolIO = catchDefaultIO False {- Catches IO errors and returns a Maybe -} catchMaybeIO :: IO a -> IO (Maybe a) diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index 9c15da8..c2ef683 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -2,7 +2,7 @@ - - Copyright 2010-2012 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs index 690942c..b81fdc5 100644 --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -2,7 +2,7 @@ - - Copyright 2012-2014 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} diff --git a/Utility/Format.hs b/Utility/Format.hs index e7a2751..2a5ae5c 100644 --- a/Utility/Format.hs +++ b/Utility/Format.hs @@ -2,7 +2,7 @@ - - Copyright 2010, 2011 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} module Utility.Format ( diff --git a/Utility/Metered.hs b/Utility/Metered.hs index 7ad9b12..0d94c1c 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -2,7 +2,7 @@ - - Copyright 2012, 2013 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE TypeSynonymInstances #-} diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 9c19df8..949f41e 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -2,7 +2,7 @@ - - Copyright 2010-2011 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} diff --git a/Utility/Monad.hs b/Utility/Monad.hs index 1ba43c5..eba3c42 100644 --- a/Utility/Monad.hs +++ b/Utility/Monad.hs @@ -2,7 +2,7 @@ - - Copyright 2010-2012 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} module Utility.Monad where diff --git a/Utility/Path.hs b/Utility/Path.hs index 570350d..99c9438 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -2,7 +2,7 @@ - - Copyright 2010-2014 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE PackageImports, CPP #-} diff --git a/Utility/PosixFiles.hs b/Utility/PosixFiles.hs index 23edc25..5abbb57 100644 --- a/Utility/PosixFiles.hs +++ b/Utility/PosixFiles.hs @@ -4,7 +4,7 @@ - - Copyright 2014 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} diff --git a/Utility/Process.hs b/Utility/Process.hs index 3f93dc2..1f722af 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -3,14 +3,14 @@ - - Copyright 2012 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP, Rank2Types #-} module Utility.Process ( module X, - CreateProcess, + CreateProcess(..), StdHandle(..), readProcess, readProcessEnv, @@ -167,10 +167,10 @@ processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) processTranscript cmd opts input = processTranscript' cmd opts Nothing input processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool) +processTranscript' cmd opts environ input = do #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order - the process writes them. -} -processTranscript' cmd opts environ input = do (readf, writef) <- createPipe readh <- fdToHandle readf writeh <- fdToHandle writef @@ -184,24 +184,13 @@ processTranscript' cmd opts environ input = do hClose writeh get <- mkreader readh - - -- now write and flush any input - case input of - Just s -> do - let inh = stdinHandle p - unless (null s) $ do - hPutStr inh s - hFlush inh - hClose inh - Nothing -> return () - + writeinput input p transcript <- get ok <- checkSuccessProcess pid return (transcript, ok) #else {- This implementation for Windows puts stderr after stdout. -} -processTranscript' cmd opts environ input = do p@(_, _, _, pid) <- createProcess $ (proc cmd opts) { std_in = if isJust input then CreatePipe else Inherit @@ -212,17 +201,9 @@ processTranscript' cmd opts environ input = do getout <- mkreader (stdoutHandle p) geterr <- mkreader (stderrHandle p) - - case input of - Just s -> do - let inh = stdinHandle p - unless (null s) $ do - hPutStr inh s - hFlush inh - hClose inh - Nothing -> return () - + writeinput input p transcript <- (++) <$> getout <*> geterr + ok <- checkSuccessProcess pid return (transcript, ok) #endif @@ -237,6 +218,14 @@ processTranscript' cmd opts environ input = do takeMVar v return s + writeinput (Just s) p = do + let inh = stdinHandle p + unless (null s) $ do + hPutStr inh s + hFlush inh + hClose inh + writeinput Nothing _ = return () + {- Runs a CreateProcessRunner, on a CreateProcess structure, that - is adjusted to pipe only from/to a single StdHandle, and passes - the resulting Handle to an action. -} diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs index 7f7234c..a498ee6 100644 --- a/Utility/QuickCheck.hs +++ b/Utility/QuickCheck.hs @@ -2,7 +2,7 @@ - - Copyright 2012-2014 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# OPTIONS_GHC -fno-warn-orphans #-} diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index 82166f6..6038126 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -2,7 +2,7 @@ - - Copyright 2010-2013 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} module Utility.Rsync where diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs index c8318ec..86e60db 100644 --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -2,14 +2,13 @@ - - Copyright 2010-2013 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} module Utility.SafeCommand where import System.Exit import Utility.Process -import System.Process (env) import Data.String.Utils import Control.Applicative import System.FilePath diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs index dd88dc8..e6a81ae 100644 --- a/Utility/ThreadScheduler.hs +++ b/Utility/ThreadScheduler.hs @@ -3,7 +3,7 @@ - Copyright 2012, 2013 Joey Hess - Copyright 2011 Bas van Dijk & Roel van Dijk - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} @@ -57,8 +57,7 @@ unboundDelay time = do waitForTermination :: IO () waitForTermination = do #ifdef mingw32_HOST_OS - runEvery (Seconds 600) $ - void getLine + forever $ threadDelaySeconds (Seconds 6000) #else lock <- newEmptyMVar let check sig = void $ diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index f46e1a5..bed30bb 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -2,7 +2,7 @@ - - Copyright 2010-2013 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} @@ -25,13 +25,20 @@ type Template = String - 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 = do - let (dir, base) = splitFileName file - createDirectoryIfMissing True dir - (tmpfile, handle) <- openTempFile dir (base ++ ".tmp") - hClose handle - a tmpfile content - rename tmpfile file +viaTmp a file content = bracket setup cleanup use + where + (dir, base) = splitFileName file + template = base ++ ".tmp" + setup = do + createDirectoryIfMissing True dir + openTempFile dir template + cleanup (tmpfile, handle) = do + _ <- tryIO $ hClose handle + tryIO $ removeFile tmpfile + use (tmpfile, handle) = do + hClose handle + a tmpfile content + 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. -} diff --git a/Utility/URI.hs b/Utility/URI.hs index 39c2f22..30c6be3 100644 --- a/Utility/URI.hs +++ b/Utility/URI.hs @@ -2,7 +2,7 @@ - - Copyright 2014 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs index 9c3bfd4..617c3e9 100644 --- a/Utility/UserInfo.hs +++ b/Utility/UserInfo.hs @@ -2,7 +2,7 @@ - - Copyright 2012 Joey Hess - - - Licensed under the GNU GPL version 3 or higher. + - License: BSD-2-clause -} {-# LANGUAGE CPP #-} diff --git a/debian/changelog b/debian/changelog index bff8411..5d5f70a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +git-repair (1.20140424) UNRELEASED; urgency=medium + + * Merge from git-annex. + + -- Joey Hess Mon, 21 Jul 2014 16:35:16 -0400 + git-repair (1.20140423) unstable; urgency=medium * Improve memory usage when git fsck finds a great many broken objects. -- cgit v1.2.3