Remote/Git: Use SampleVar from SafeSemaphore instead of base

SampleVars from base are unsafe
This commit is contained in:
Ben Gamari 2012-10-05 17:03:58 -04:00
parent cff451b37c
commit 179aeeaacc

View file

@ -38,6 +38,7 @@ import Types.Key
import qualified Fields import qualified Fields
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.MSampleVar
import System.Process (std_in, std_err) import System.Process (std_in, std_err)
remote :: RemoteType remote :: RemoteType
@ -273,9 +274,9 @@ copyFromRemote r key file dest
: maybe [] (\f -> [(Fields.associatedFile, f)]) file : maybe [] (\f -> [(Fields.associatedFile, f)]) file
Just (cmd, params) <- git_annex_shell r "transferinfo" Just (cmd, params) <- git_annex_shell r "transferinfo"
[Param $ key2file key] fields [Param $ key2file key] fields
v <- liftIO $ newEmptySampleVar v <- liftIO $ newEmptySV
tid <- liftIO $ forkIO $ void $ tryIO $ do tid <- liftIO $ forkIO $ void $ tryIO $ do
bytes <- readSampleVar v bytes <- readSV v
p <- createProcess $ p <- createProcess $
(proc cmd (toCommand params)) (proc cmd (toCommand params))
{ std_in = CreatePipe { std_in = CreatePipe
@ -288,8 +289,8 @@ copyFromRemote r key file dest
hFlush h hFlush h
send bytes send bytes
forever $ forever $
send =<< readSampleVar v send =<< readSV v
let feeder = writeSampleVar v let feeder = writeSV v
bracketIO noop (const $ tryIO $ killThread tid) (a feeder) bracketIO noop (const $ tryIO $ killThread tid) (a feeder)
copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool