[gentoo-commits] gentoo-x86 commit in dev-vcs/darcs/files: darcs-2.8.4-ghc-7.8-part-2.patch darcs-2.8.4-issue2364.patch darcs-2.8.4-fix-nonatomic-global.patch darcs-2.8.4-issue2364-part-2.patch

[Mark Wright (gienah)]

gienah      14/07/03 13:11:08

  Added:                darcs-2.8.4-ghc-7.8-part-2.patch
                        darcs-2.8.4-issue2364.patch
                        darcs-2.8.4-fix-nonatomic-global.patch
                        darcs-2.8.4-issue2364-part-2.patch
  Log:
  Update darcs-2.8.4-r6 from the gentoo-haskell overlay so it will build with recent haskell packages and ghc 7.8
  
  (Portage version: 2.2.10/cvs/Linux x86_64, signed Manifest commit with key 618E971F)

Revision  Changes    Path
1.1                  dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-2.patch

file : http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-2.patch?rev=1.1&view=markup
plain: http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-vcs/darcs/files/darcs-2.8.4-ghc-7.8-part-2.patch?rev=1.1&content-type=text/plain

Index: darcs-2.8.4-ghc-7.8-part-2.patch
===================================================================
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



1.1                  dev-vcs/darcs/files/darcs-2.8.4-issue2364.patch

file : http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-vcs/darcs/files/darcs-2.8.4-issue2364.patch?rev=1.1&view=markup
plain: http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-vcs/darcs/files/darcs-2.8.4-issue2364.patch?rev=1.1&content-type=text/plain

Index: darcs-2.8.4-issue2364.patch
===================================================================
* 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



1.1                  dev-vcs/darcs/files/darcs-2.8.4-fix-nonatomic-global.patch

file : http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-vcs/darcs/files/darcs-2.8.4-fix-nonatomic-global.patch?rev=1.1&view=markup
plain: http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-vcs/darcs/files/darcs-2.8.4-fix-nonatomic-global.patch?rev=1.1&content-type=text/plain

Index: darcs-2.8.4-fix-nonatomic-global.patch
===================================================================
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 ()



1.1                  dev-vcs/darcs/files/darcs-2.8.4-issue2364-part-2.patch

file : http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-vcs/darcs/files/darcs-2.8.4-issue2364-part-2.patch?rev=1.1&view=markup
plain: http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-vcs/darcs/files/darcs-2.8.4-issue2364-part-2.patch?rev=1.1&content-type=text/plain

Index: darcs-2.8.4-issue2364-part-2.patch
===================================================================
Tue May 13 22:07:19 FET 2014  Sergei Trofimovich <slyfox@×××××××××××××××××.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 ()