diff options
Diffstat (limited to 'dev-vcs/darcs/files')
6 files changed, 293 insertions, 0 deletions
diff --git a/dev-vcs/darcs/files/darcs-2.12.4-ghc-8.0.2_rc1.patch b/dev-vcs/darcs/files/darcs-2.12.4-ghc-8.0.2_rc1.patch new file mode 100644 index 000000000000..9602d1d1ccdc --- /dev/null +++ b/dev-vcs/darcs/files/darcs-2.12.4-ghc-8.0.2_rc1.patch @@ -0,0 +1,9 @@ +diff --git a/harness/Darcs/Test/Patch.hs b/harness/Darcs/Test/Patch.hs +index f50f6b9..f0f4e2a 100644 +--- a/harness/Darcs/Test/Patch.hs ++++ b/harness/Darcs/Test/Patch.hs +@@ -244,3 +244,3 @@ properties :: forall thing gen. (Show1 gen, Arbitrary (Sealed gen)) => + properties gen prefix genname tests = +- [ cond name condition check | (name, condition, check) <- tests ] ++ [ cond name condition check | (name, condition :: TestCondition thing, check :: TestCheck thing testable) <- tests ] + where cond :: forall testable. Testable testable diff --git a/dev-vcs/darcs/files/darcs-2.8.4-fix-nonatomic-global.patch b/dev-vcs/darcs/files/darcs-2.8.4-fix-nonatomic-global.patch new file mode 100644 index 000000000000..c3fce6fbc9e8 --- /dev/null +++ b/dev-vcs/darcs/files/darcs-2.8.4-fix-nonatomic-global.patch @@ -0,0 +1,20 @@ +There is a bug in speculateFileOrUrl. +It puts downloaded file nonatomically. + +There is a window when copyFileOrUrl can (and does) +copy partially downloaded file. + +Darcs-bug: http://bugs.darcs.net/issue2364 +diff --git a/src/Darcs/External.hs b/src/Darcs/External.hs +index 2e0e791..d5a0b9f 100644 +--- a/src/Darcs/External.hs ++++ b/src/Darcs/External.hs +@@ -184,7 +184,7 @@ copyFileOrUrl rd fou out _ | isSshUrl fou = copySSH rd (splitSshUrl fou) + copyFileOrUrl _ fou _ _ = fail $ "unknown transport protocol: " ++ fou + + speculateFileOrUrl :: String -> FilePath -> IO () +-speculateFileOrUrl fou out | isHttpUrl fou = speculateRemote fou out ++speculateFileOrUrl fou out | isHttpUrl fou = speculateRemote fou out >> waitUrl fou + | otherwise = return () + + copyLocal :: String -> FilePath -> IO () diff --git a/dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-1.patch b/dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-1.patch new file mode 100644 index 000000000000..3680c29b0440 --- /dev/null +++ b/dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-1.patch @@ -0,0 +1,128 @@ +diff --git a/src/Crypt/SHA256.hs b/src/Crypt/SHA256.hs +index 69a8a4c..606f2ad 100644 +--- a/src/Crypt/SHA256.hs ++++ b/src/Crypt/SHA256.hs +@@ -20,9 +20,10 @@ import Numeric (showHex) + import Foreign.C.String ( withCString ) + import Data.ByteString.Unsafe (unsafeUseAsCStringLen) + import qualified Data.ByteString as B ++import qualified System.IO.Unsafe as U + + sha256sum :: B.ByteString -> String +-sha256sum p = unsafePerformIO $ ++sha256sum p = U.unsafePerformIO $ + withCString (take 64 $ repeat 'x') $ \digestCString -> + unsafeUseAsCStringLen p $ \(ptr,n) -> + do let digest = castPtr digestCString :: Ptr Word8 +diff --git a/src/Darcs/Commands/Get.hs b/src/Darcs/Commands/Get.hs +index e450d28..6b51915 100644 +--- a/src/Darcs/Commands/Get.hs ++++ b/src/Darcs/Commands/Get.hs +@@ -157,7 +157,8 @@ copyRepoAndGoToChosenVersion opts repodir rfsource = do + copyRepo + withRepository opts ((RepoJob $ \repository -> goToChosenVersion repository opts) :: RepoJob ()) + putInfo opts $ text "Finished getting." +- where copyRepo = ++ where copyRepo :: IO () ++ copyRepo = + withRepository opts $ RepoJob $ \repository -> + if formatHas HashedInventory rfsource + then do +diff --git a/src/Darcs/Global.hs b/src/Darcs/Global.hs +index 9792bf0..e17f071 100644 +--- a/src/Darcs/Global.hs ++++ b/src/Darcs/Global.hs +@@ -60,8 +60,9 @@ module Darcs.Global + import Control.Applicative ( (<$>), (<*>) ) + import Control.Monad ( when ) + import Control.Concurrent.MVar +-import Control.Exception.Extensible ( bracket_, catch, catchJust, SomeException +- , block, unblock ++import Control.Exception.Extensible as E ++ ( bracket_, catch, catchJust, SomeException ++ , mask + ) + import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) + import Data.IORef ( modifyIORef ) +@@ -106,12 +107,12 @@ withAtexit prog = + exit + prog + where +- exit = block $ do ++ exit = E.mask $ \restore -> do + Just actions <- swapMVar atexitActions Nothing + -- from now on atexit will not register new actions +- mapM_ runAction actions +- runAction action = +- catch (unblock action) $ \(exn :: SomeException) -> do ++ mapM_ (runAction restore) actions ++ runAction restore action = ++ catch (restore action) $ \(exn :: SomeException) -> do + hPutStrLn stderr $ "Exception thrown by an atexit registered action:" + hPutStrLn stderr $ show exn + +diff --git a/src/Darcs/SignalHandler.hs b/src/Darcs/SignalHandler.hs +index ac0f526..d0ef162 100644 +--- a/src/Darcs/SignalHandler.hs ++++ b/src/Darcs/SignalHandler.hs +@@ -26,8 +26,8 @@ import Prelude hiding ( catch ) + import System.IO.Error ( isUserError, ioeGetErrorString, ioeGetFileName ) + import System.Exit ( exitWith, ExitCode ( ExitFailure ) ) + import Control.Concurrent ( ThreadId, myThreadId ) +-import Control.Exception.Extensible +- ( catch, throw, throwTo, block, unblock, ++import Control.Exception.Extensible as E ++ ( catch, throw, throwTo, mask, + Exception(..), SomeException(..), IOException ) + import System.Posix.Files ( getFdStatus, isNamedPipe ) + import System.Posix.IO ( stdOutput ) +@@ -128,8 +128,8 @@ catchUserErrors comp handler = catch comp handler' + | otherwise = throw ioe + + withSignalsBlocked :: IO a -> IO a +-withSignalsBlocked job = block (job >>= \r -> +- unblock(return r) `catchSignal` couldnt_do r) ++withSignalsBlocked job = E.mask $ \restore -> (job >>= \r -> ++ restore (return r) `catchSignal` couldnt_do r) + where couldnt_do r s | s == sigINT = oops "interrupt" r + | s == sigHUP = oops "HUP" r + | s == sigABRT = oops "ABRT" r +diff --git a/src/Darcs/Test/Patch/Info.hs b/src/Darcs/Test/Patch/Info.hs +index fd27fb3..b35cfef 100644 +--- a/src/Darcs/Test/Patch/Info.hs ++++ b/src/Darcs/Test/Patch/Info.hs +@@ -28,7 +28,6 @@ import Data.Maybe ( isNothing ) + import Data.Text as T ( find, any ) + import Data.Text.Encoding ( decodeUtf8With ) + import Data.Text.Encoding.Error ( lenientDecode ) +-import Foreign ( unsafePerformIO ) + import Test.QuickCheck ( Arbitrary(arbitrary), oneof, listOf, choose, shrink + , Gen ) + import Test.Framework.Providers.QuickCheck2 ( testProperty ) +@@ -39,6 +38,8 @@ import Darcs.Patch.Info ( PatchInfo(..), patchinfo, + piLog, piAuthor, piName ) + import ByteStringUtils ( decodeLocale, packStringToUTF8, unpackPSFromUTF8 ) + ++import qualified System.IO.Unsafe as U ++ + testSuite :: Test + testSuite = testGroup "Darcs.Patch.Info" + [ metadataDecodingTest +@@ -86,7 +87,7 @@ instance Arbitrary UTF8PatchInfo where + sa <- shrink (piAuthor pi) + sl <- shrink (filter (not . isPrefixOf "Ignore-this:") (piLog pi)) + return (UTF8PatchInfo +- (unsafePerformIO $ patchinfo sn ++ (U.unsafePerformIO $ patchinfo sn + (BC.unpack (_piDate pi)) sa sl)) + + instance Arbitrary UTF8OrNotPatchInfo where +@@ -101,7 +102,7 @@ arbitraryUTF8Patch = + d <- arbitrary + a <- asString `fmap` arbitrary + l <- (lines . asString) `fmap` arbitrary +- return $ unsafePerformIO $ patchinfo n d a l ++ return $ U.unsafePerformIO $ patchinfo n d a l + + -- | Generate arbitrary patch metadata that has totally arbitrary byte strings + -- as its name, date, author and log. diff --git a/dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-2.patch b/dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-2.patch new file mode 100644 index 000000000000..33786477b3fa --- /dev/null +++ b/dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-2.patch @@ -0,0 +1,14 @@ +diff --git a/src/Darcs/Test/Patch.hs b/src/Darcs/Test/Patch.hs +index 0f7ed24..078fbc3 100644 +--- a/src/Darcs/Test/Patch.hs ++++ b/src/Darcs/Test/Patch.hs +@@ -2,6 +2,9 @@ + #if __GLASGOW_HASKELL__ >= 700 + {-# LANGUAGE ImpredicativeTypes #-} + #endif ++#if __GLASGOW_HASKELL__ >= 708 ++{-# LANGUAGE AllowAmbiguousTypes #-} ++#endif + -- Copyright (C) 2002-2005,2007 David Roundy + -- + -- This program is free software; you can redistribute it and/or modify diff --git a/dev-vcs/darcs/files/darcs-2.8.4-issue2364-part-2.patch b/dev-vcs/darcs/files/darcs-2.8.4-issue2364-part-2.patch new file mode 100644 index 000000000000..6164a4a00074 --- /dev/null +++ b/dev-vcs/darcs/files/darcs-2.8.4-issue2364-part-2.patch @@ -0,0 +1,52 @@ +Tue May 13 22:07:19 FET 2014 Sergei Trofimovich <slyfox@community.haskell.org> + * resolve issue2364: don't break list of 'bad sources' + + This time the bug manifested on a simple operation: + $ darcs record -a -m "something" + + Attempt to write a patch resulted in something like: + Failed to record patch 'hello' + + HINT: I could not reach the following repositories: + http://repetae.net/repos/jhc + /home/st/.darcs/cache + /home/st/.cache/darcs + /home/st/dev/darcs/jhc + If you're not using them, you should probably delete + + The sequence should be the following: + 1. store patch to inventory/foo + 2. try to store to a writable cache (say, ~/.darcs/cache/patches) + 3. fail to write + 4. filter out bad caches + 5. try again + 6. copy from cache to patches/ + + Due to missing NOINLINE step 4. led to + all caches treated as writable, thus step 5 + failed without a chance for patch to + go to 'patches/'. + + As a side-effect building darcs with -O0 produced seemingly working darcs. + Reported-by: Ivan Miljenovic +diff -rN -u old-darcs.net/src/Darcs/Util/Global.hs new-darcs.net/src/Darcs/Util/Global.hs +--- old-darcs.net/src/Darcs/Global.hs 2014-05-13 22:23:29.897329750 +0300 ++++ new-darcs.net/src/Darcs/Global.hs 2014-05-13 22:23:29.979329754 +0300 +@@ -135,7 +135,7 @@ + + _badSourcesList :: IORef [String] + _badSourcesList = unsafePerformIO $ newIORef [] +-{- NOINLINE _badSourcesList -} ++{-# NOINLINE _badSourcesList #-} + + + addBadSource :: String -> IO () +@@ -154,7 +154,7 @@ + + _reachableSourcesList :: IORef [String] + _reachableSourcesList = unsafePerformIO $ newIORef [] +-{- NOINLINE _reachableSourcesList -} ++{-# NOINLINE _reachableSourcesList #-} + + + addReachableSource :: String -> IO () diff --git a/dev-vcs/darcs/files/darcs-2.8.4-issue2364.patch b/dev-vcs/darcs/files/darcs-2.8.4-issue2364.patch new file mode 100644 index 000000000000..97c4e0f1ad2b --- /dev/null +++ b/dev-vcs/darcs/files/darcs-2.8.4-issue2364.patch @@ -0,0 +1,70 @@ +* resolve issue2364: fix file corruption on double fetch + +The bug is the result of attempt to fetch the same file +(say F) by the same URL (U) multiple times concurrently. + +First time U gets fetched by speculative prefetch logic. +Second time as an ordinary file (while first fetch is not finished). + +The function 'copyUrlWithPriority' sends download request +to 'urlChan' both times (it's already not a nice situation, +fixed by this patch). + +Later urlThread satisfies first request, notifies receiver, +and starts downloading exactly the same U again. + +I don't know exact data corruption mechanics yet, but it has +to do with non-random intermediate file names of downloaded +files and 'truncate' call when temp file is opened for a new +downlaod job. + +All temp names are completely non-random for a single darcs run: + + urlThread :: Chan UrlRequest -> IO () + urlThread ch = do + junk <- flip showHex "" `fmap` randomRIO rrange + evalStateT urlThread' (UrlState Map.empty emptyQ 0 junk) + + createDownloadFileName :: FilePath -> UrlState -> FilePath + createDownloadFileName f st = f ++ "-new_" ++ randomJunk st + +My theory is next download manages to step on toes of previous job. + +I'll try to make file names truly random in other patch. +That way such errors should manifest as read erros instead of data +corruption. + +Thanks! +diff --git a/src/URL.hs b/src/URL.hs +index 4cb85ee..26de278 100644 +--- a/src/URL.hs ++++ b/src/URL.hs +@@ -18,11 +18,12 @@ module URL ( copyUrl, copyUrlFirst, setDebugHTTP, + import Data.IORef ( newIORef, readIORef, writeIORef, IORef ) + import Data.Map ( Map ) + import qualified Data.Map as Map ++import Data.Tuple ( swap ) + import System.Directory ( copyFile ) + import System.IO.Unsafe ( unsafePerformIO ) + import Control.Concurrent ( forkIO ) + import Control.Concurrent.Chan ( isEmptyChan, newChan, readChan, writeChan, Chan ) +-import Control.Concurrent.MVar ( isEmptyMVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, readMVar, withMVar, MVar ) ++import Control.Concurrent.MVar ( isEmptyMVar, modifyMVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, readMVar, withMVar, MVar ) + import Control.Monad ( unless, when ) + import Control.Monad.Trans ( liftIO ) + import Control.Monad.State ( evalStateT, get, modify, put, StateT ) +@@ -196,10 +197,10 @@ copyUrlWithPriority p u f c = do + debugMessage ("URL.copyUrlWithPriority ("++u++"\n"++ + " -> "++f++")") + v <- newEmptyMVar +- let fn _ old_val = old_val +- modifyMVar_ urlNotifications (return . (Map.insertWith fn u v)) +- let r = UrlRequest u f c p +- writeChan urlChan r ++ old_mv <- modifyMVar urlNotifications (return . swap . Map.insertLookupWithKey (\_k _n old -> old) u v) ++ case old_mv of ++ Nothing -> writeChan urlChan $ UrlRequest u f c p -- ok, new URL ++ Just _ -> debugMessage $ "URL.copyUrlWithPriority already in progress, skip (" ++ u ++ "\n" ++ "-> " ++ f ++ ")" + + waitNextUrl :: StateT UrlState IO () + waitNextUrl = do |