summaryrefslogtreecommitdiff
path: root/Assistant/Threads/Transferrer.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-27 13:43:03 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-27 13:43:03 -0400
commit2433f6ca5a602f55986bcd85c20034c88cc44a3b (patch)
tree03c10c84666301aa7252219f096867c08d662079 /Assistant/Threads/Transferrer.hs
parentb12db9ef9214d801280310222fc5e9d16f8af3de (diff)
use the ~/.config/git-annex/program file to find command when running transfers
Diffstat (limited to 'Assistant/Threads/Transferrer.hs')
-rw-r--r--Assistant/Threads/Transferrer.hs20
1 files changed, 10 insertions, 10 deletions
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index cb6f642bf..ae0adf300 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -18,6 +18,7 @@ import Logs.Location
import Annex.Content
import qualified Remote
import Types.Key
+import Locations.UserConfig
import System.Process (create_group)
@@ -30,23 +31,23 @@ maxTransfers = 1
{- Dispatches transfers from the queue. -}
transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> IO ()
-transfererThread st dstatus transferqueue slots = go
+transfererThread st dstatus transferqueue slots = go =<< readProgramFile
where
- go = getNextTransfer transferqueue dstatus notrunning >>= handle
- handle Nothing = go
- handle (Just (t, info)) = do
+ go program = getNextTransfer transferqueue dstatus notrunning >>= handle program
+ handle program Nothing = go program
+ handle program (Just (t, info)) = do
ifM (runThreadState st $ shouldTransfer t info)
( do
debug thisThread [ "Transferring:" , show t ]
notifyTransfer dstatus
- transferThread dstatus slots t info inTransferSlot
+ transferThread dstatus slots t info inTransferSlot program
, do
debug thisThread [ "Skipping unnecessary transfer:" , show t ]
-- getNextTransfer added t to the
-- daemonstatus's transfer map.
void $ removeTransfer dstatus t
)
- go
+ go program
{- Skip transfers that are already running. -}
notrunning i = startedTime i == Nothing
@@ -79,8 +80,8 @@ shouldTransfer t info
- the transfer info; the thread will also be killed when a transfer is
- stopped, to avoid it displaying any alert about the transfer having
- failed. -}
-transferThread :: DaemonStatusHandle -> TransferSlots -> Transfer -> TransferInfo -> TransferSlotRunner -> IO ()
-transferThread dstatus slots t info runner = case (transferRemote info, associatedFile info) of
+transferThread :: DaemonStatusHandle -> TransferSlots -> Transfer -> TransferInfo -> TransferSlotRunner -> FilePath -> IO ()
+transferThread dstatus slots t info runner program = case (transferRemote info, associatedFile info) of
(Nothing, _) -> noop
(_, Nothing) -> noop
(Just remote, Just file) -> do
@@ -93,14 +94,13 @@ transferThread dstatus slots t info runner = case (transferRemote info, associat
transferprocess remote file = void $ do
(_, _, _, pid)
- <- createProcess (proc command $ toCommand params)
+ <- createProcess (proc program $ toCommand params)
{ create_group = True }
status <- waitForProcess pid
addAlert dstatus $
makeAlertFiller (status == ExitSuccess) $
transferFileAlert direction file
where
- command = "git-annex"
params =
[ Param "transferkey"
, Param $ key2file $ transferKey t