aboutsummaryrefslogtreecommitdiff
path: root/Assistant.hs
blob: 4042c6ede5ca4da2b08307c72147aff8c29cdd19 (plain)
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
{- 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.
 - Thread 6: status logger
 - 	Wakes up periodically and records the daemon's status to disk.
 - Thread 7: 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 inotify 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.
 -}

module Assistant where

import Common.Annex
import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.Watcher
import Assistant.Committer
import Assistant.SanityChecker
import qualified Annex
import qualified Utility.Daemon
import Utility.LogFile
import qualified Build.SysConfig as SysConfig

import Control.Concurrent

startDaemon :: Bool -> Annex ()
startDaemon foreground
	| foreground = do
		showStart "watch" "."
		go id
	| otherwise = do
		logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile
		pidfile <- fromRepo gitAnnexPidFile
		go $ Utility.Daemon.daemonize logfd (Just pidfile) False
	where
		go a
			| SysConfig.lsof = start a
			| otherwise =
				ifM (Annex.getState Annex.force)
					(start a, needlsof)
		start a = withThreadState $ \st -> do
			dstatus <- startDaemonStatus
			liftIO $ a $ do
				changechan <- newChangeChan
				-- The commit thread is started early,
				-- so that the user can immediately
				-- begin adding files and having them
				-- committed, even while the startup scan
				-- is taking place.
				_ <- forkIO $ commitThread st changechan
				_ <- forkIO $ daemonStatusThread st dstatus
				_ <- forkIO $ sanityCheckerThread st dstatus changechan
				watchThread st dstatus changechan

		-- this message is optimised away when lsof is available
		needlsof = error $ unlines
			[ "The lsof command is needed for watch mode to be safe."
			, "But this build of git-annex was made without lsof available. Giving up..."
			, ""
			, "You can use --force if lsof is available now. Please make very sure it is."
			, "If run with --force and without lsof available, files can be added to the"
			, "annex while a process still has them opened for writing. This can"
			, "corrupt data in the annex, and make fsck complain."
			, "Use the --force with caution, Luke!"
			]

stopDaemon :: Annex ()
stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile