1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
{- git-annex assistant daemon
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-
- Overview of threads and MVars, etc:
-
- Thread 1: parent
- The initial thread run, double forks to background, starts other
- threads, and then stops, waiting for them to terminate,
- or for a ctrl-c.
- Thread 2: watcher
- Notices new files, and calls handlers for events, queuing changes.
- Thread 3: inotify internal
- Used by haskell inotify library to ensure inotify event buffer is
- kept drained.
- Thread 4: inotify startup scanner
- Scans the tree and registers inotify watches for each directory.
- A MVar lock is used to prevent other inotify handlers from running
- until this is complete.
- Thread 5: committer
- Waits for changes to occur, and runs the git queue to update its
- index, then commits. Also queues Transfer events to send added
- files to other remotes.
- Thread 6: pusher
- Waits for commits to be made, and pushes updated branches to remotes,
- in parallel. (Forks a process for each git push.)
- Thread 7: push retryer
- Runs every 30 minutes when there are failed pushes, and retries
- them.
- Thread 8: merger
- Waits for pushes to be received from remotes, and merges the
- updated branches into the current branch. This uses inotify
- on .git/refs/heads, so there are additional inotify threads
- associated with it, too.
- Thread 9: transfer watcher
- Watches for transfer information files being created and removed,
- and maintains the DaemonStatus currentTransfers map. This uses
- inotify on .git/annex/transfer/, so there are additional inotify
- threads associated with it, too.
- Thread 10: status logger
- Wakes up periodically and records the daemon's status to disk.
- Thread 11: sanity checker
- Wakes up periodically (rarely) and does sanity checks.
-
- ThreadState: (MVar)
- The Annex state is stored here, which allows resuscitating the
- Annex monad in IO actions run by the watcher and committer
- threads. Thus, a single state is shared amoung the threads, and
- only one at a time can access it.
- DaemonStatusHandle: (MVar)
- The daemon's current status. This MVar should only be manipulated
- from inside the Annex monad, which ensures it's accessed only
- after the ThreadState MVar.
- ChangeChan: (STM TChan)
- Changes are indicated by writing to this channel. The committer
- reads from it.
- CommitChan: (STM TChan)
- Commits are indicated by writing to this channel. The pusher reads
- from it.
- FailedPushMap (STM TMVar)
- Failed pushes are indicated by writing to this TMVar. The push
- retrier blocks until they're available.
- TransferQueue (STM TChan)
- Transfers to make are indicated by writing to this channel.
-}
module Assistant where
import Common.Annex
import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.Changes
import Assistant.Commits
import Assistant.Pushes
import Assistant.TransferQueue
import Assistant.Threads.Watcher
import Assistant.Threads.Committer
import Assistant.Threads.Pusher
import Assistant.Threads.Merger
import Assistant.Threads.TransferWatcher
import Assistant.Threads.SanityChecker
import qualified Utility.Daemon
import Utility.LogFile
import Utility.ThreadScheduler
import Control.Concurrent
startDaemon :: Bool -> Bool -> Annex ()
startDaemon assistant foreground
| foreground = do
showStart (if assistant then "assistant" else "watch") "."
go id
| otherwise = do
logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile
pidfile <- fromRepo gitAnnexPidFile
go $ Utility.Daemon.daemonize logfd (Just pidfile) False
where
go daemonize = withThreadState $ \st -> do
checkCanWatch
dstatus <- startDaemonStatus
liftIO $ daemonize $ run dstatus st
run dstatus st = do
changechan <- newChangeChan
commitchan <- newCommitChan
pushmap <- newFailedPushMap
transferqueue <- newTransferQueue
mapM_ (void . forkIO)
[ commitThread st changechan commitchan transferqueue dstatus
, pushThread st dstatus commitchan pushmap
, pushRetryThread st pushmap
, mergeThread st
, transferWatcherThread st dstatus
, daemonStatusThread st dstatus
, sanityCheckerThread st dstatus transferqueue changechan
, watchThread st dstatus transferqueue changechan
]
waitForTermination
stopDaemon :: Annex ()
stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile
|