2012-06-13 16:36:33 +00:00
|
|
|
{- 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.
|
2012-07-27 01:51:47 +00:00
|
|
|
- Thread 2: Watcher
|
2012-06-13 16:36:33 +00:00
|
|
|
- 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.
|
2012-06-13 23:32:09 +00:00
|
|
|
- Thread 4: inotify startup scanner
|
|
|
|
- Scans the tree and registers inotify watches for each directory.
|
2012-06-13 16:36:33 +00:00
|
|
|
- A MVar lock is used to prevent other inotify handlers from running
|
|
|
|
- until this is complete.
|
2012-07-27 01:51:47 +00:00
|
|
|
- Thread 5: Committer
|
2012-06-13 16:36:33 +00:00
|
|
|
- Waits for changes to occur, and runs the git queue to update its
|
2012-07-05 16:21:22 +00:00
|
|
|
- index, then commits. Also queues Transfer events to send added
|
|
|
|
- files to other remotes.
|
2012-07-27 01:51:47 +00:00
|
|
|
- Thread 6: Pusher
|
2012-06-22 21:01:08 +00:00
|
|
|
- Waits for commits to be made, and pushes updated branches to remotes,
|
|
|
|
- in parallel. (Forks a process for each git push.)
|
2012-07-27 01:51:47 +00:00
|
|
|
- Thread 7: PushRetryer
|
2012-06-25 20:38:12 +00:00
|
|
|
- Runs every 30 minutes when there are failed pushes, and retries
|
|
|
|
- them.
|
2012-07-27 01:51:47 +00:00
|
|
|
- Thread 8: Merger
|
2012-06-22 21:01:08 +00:00
|
|
|
- Waits for pushes to be received from remotes, and merges the
|
2012-07-06 00:57:06 +00:00
|
|
|
- updated branches into the current branch.
|
|
|
|
- (This uses inotify on .git/refs/heads, so there are additional
|
|
|
|
- inotify threads associated with it, too.)
|
2012-07-27 01:51:47 +00:00
|
|
|
- Thread 9: TransferWatcher
|
2012-07-03 14:58:40 +00:00
|
|
|
- Watches for transfer information files being created and removed,
|
2012-07-23 03:16:56 +00:00
|
|
|
- and maintains the DaemonStatus currentTransfers map.
|
2012-07-06 00:57:06 +00:00
|
|
|
- (This uses inotify on .git/annex/transfer/, so there are
|
|
|
|
- additional inotify threads associated with it, too.)
|
2012-08-28 18:04:28 +00:00
|
|
|
- Thread 10: TransferPoller
|
|
|
|
- Polls to determine how much of each ongoing transfer is complete.
|
|
|
|
- Thread 11: Transferrer
|
2012-07-05 20:34:20 +00:00
|
|
|
- Waits for Transfers to be queued and does them.
|
2012-08-28 18:04:28 +00:00
|
|
|
- Thread 12: StatusLogger
|
2012-06-13 16:36:33 +00:00
|
|
|
- Wakes up periodically and records the daemon's status to disk.
|
2012-08-28 18:04:28 +00:00
|
|
|
- Thread 13: SanityChecker
|
2012-06-13 23:32:09 +00:00
|
|
|
- Wakes up periodically (rarely) and does sanity checks.
|
2012-08-28 18:04:28 +00:00
|
|
|
- Thread 14: MountWatcher
|
2012-07-19 17:01:41 +00:00
|
|
|
- Either uses dbus to watch for drive mount events, or, when
|
|
|
|
- there's no dbus, polls to find newly mounted filesystems.
|
2012-07-23 03:16:56 +00:00
|
|
|
- Once a filesystem that contains a remote is mounted, updates
|
|
|
|
- state about that remote, pulls from it, and queues a push to it,
|
|
|
|
- as well as an update, and queues it onto the
|
|
|
|
- ConnectedRemoteChan
|
2012-08-28 18:04:28 +00:00
|
|
|
- Thread 15: NetWatcher
|
2012-08-21 23:58:53 +00:00
|
|
|
- Deals with network connection interruptions, which would cause
|
|
|
|
- transfers to fail, and can be recovered from by waiting for a
|
|
|
|
- network connection, and syncing with all network remotes.
|
|
|
|
- Uses dbus to watch for network connections, or when dbus
|
|
|
|
- cannot be used, assumes there's been one every 30 minutes.
|
2012-08-28 18:04:28 +00:00
|
|
|
- Thread 16: TransferScanner
|
2012-07-23 03:16:56 +00:00
|
|
|
- Does potentially expensive checks to find data that needs to be
|
|
|
|
- transferred from or to remotes, and queues Transfers.
|
2012-09-08 19:07:44 +00:00
|
|
|
- Uses the ScanRemotes map.a
|
|
|
|
- Thread 17: PairListener
|
|
|
|
- Listens for incoming pairing traffic, and takes action.
|
add ConfigMonitor thread
Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.
Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.
A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.
Also added a uuid.log cache. All other config files already had caches.
2012-10-20 20:37:06 +00:00
|
|
|
- Thread 18: ConfigMonitor
|
|
|
|
- Triggered by changes to the git-annex branch, checks for changed
|
|
|
|
- config files, and reloads configs.
|
2012-11-03 18:16:17 +00:00
|
|
|
- Thread 19: XMPPClient
|
|
|
|
- Built-in XMPP client.
|
2012-10-24 17:35:43 +00:00
|
|
|
- Thread 20: WebApp
|
2012-07-27 01:51:47 +00:00
|
|
|
- Spawns more threads as necessary to handle clients.
|
|
|
|
- Displays the DaemonStatus.
|
2012-11-29 18:49:20 +00:00
|
|
|
- Thread 21: Glacier
|
|
|
|
- Deals with retrieving files from Amazon Glacier.
|
2012-06-13 16:36:33 +00:00
|
|
|
-
|
|
|
|
- ThreadState: (MVar)
|
|
|
|
- The Annex state is stored here, which allows resuscitating the
|
2012-06-28 17:04:02 +00:00
|
|
|
- Annex monad in IO actions run by the watcher and committer
|
2012-06-13 16:36:33 +00:00
|
|
|
- threads. Thus, a single state is shared amoung the threads, and
|
|
|
|
- only one at a time can access it.
|
2012-07-28 22:02:11 +00:00
|
|
|
- DaemonStatusHandle: (STM TMVar)
|
|
|
|
- The daemon's current status.
|
2012-06-13 16:36:33 +00:00
|
|
|
- ChangeChan: (STM TChan)
|
|
|
|
- Changes are indicated by writing to this channel. The committer
|
|
|
|
- reads from it.
|
2012-06-22 21:01:08 +00:00
|
|
|
- CommitChan: (STM TChan)
|
|
|
|
- Commits are indicated by writing to this channel. The pusher reads
|
|
|
|
- from it.
|
2012-06-26 21:33:34 +00:00
|
|
|
- FailedPushMap (STM TMVar)
|
|
|
|
- Failed pushes are indicated by writing to this TMVar. The push
|
|
|
|
- retrier blocks until they're available.
|
2012-07-03 14:58:40 +00:00
|
|
|
- TransferQueue (STM TChan)
|
|
|
|
- Transfers to make are indicated by writing to this channel.
|
2012-07-06 00:57:06 +00:00
|
|
|
- TransferSlots (QSemN)
|
|
|
|
- Count of the number of currently available transfer slots.
|
|
|
|
- Updated by the transfer watcher, this allows other threads
|
|
|
|
- to block until a slot is available.
|
|
|
|
- This MVar should only be manipulated from inside the Annex monad,
|
|
|
|
- which ensures it's accessed only after the ThreadState MVar.
|
2012-07-23 03:16:56 +00:00
|
|
|
- ScanRemotes (STM TMVar)
|
|
|
|
- Remotes that have been disconnected, and should be scanned
|
|
|
|
- are indicated by writing to this TMVar.
|
2012-10-24 17:35:43 +00:00
|
|
|
- BranchChanged (STM SampleVar)
|
|
|
|
- Changes to the git-annex branch are indicated by updating this
|
|
|
|
- SampleVar.
|
2012-11-08 20:44:23 +00:00
|
|
|
- NetMessager (STM TChan, TMVar, SampleVar)
|
|
|
|
- Used to feed messages to the built-in XMPP client, handle
|
|
|
|
- pushes, and signal it when it needs to restart due to configuration
|
|
|
|
- or networking changes.
|
2012-09-08 23:57:15 +00:00
|
|
|
- UrlRenderer (MVar)
|
|
|
|
- A Yesod route rendering function is stored here. This allows
|
|
|
|
- things that need to render Yesod routes to block until the webapp
|
|
|
|
- has started up and such rendering is possible.
|
2012-06-13 16:36:33 +00:00
|
|
|
-}
|
|
|
|
|
2012-07-26 01:26:13 +00:00
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
|
2012-06-13 16:36:33 +00:00
|
|
|
module Assistant where
|
|
|
|
|
2012-07-20 23:29:59 +00:00
|
|
|
import Assistant.Common
|
2012-06-13 16:36:33 +00:00
|
|
|
import Assistant.DaemonStatus
|
2012-10-30 18:34:48 +00:00
|
|
|
import Assistant.NamedThread
|
2012-10-29 23:07:10 +00:00
|
|
|
import Assistant.Types.ThreadedMonad
|
2012-09-06 18:56:04 +00:00
|
|
|
import Assistant.Threads.DaemonStatus
|
2012-06-25 20:10:10 +00:00
|
|
|
import Assistant.Threads.Watcher
|
|
|
|
import Assistant.Threads.Committer
|
|
|
|
import Assistant.Threads.Pusher
|
|
|
|
import Assistant.Threads.Merger
|
2012-07-03 14:58:40 +00:00
|
|
|
import Assistant.Threads.TransferWatcher
|
2012-07-05 20:34:20 +00:00
|
|
|
import Assistant.Threads.Transferrer
|
2012-06-25 20:10:10 +00:00
|
|
|
import Assistant.Threads.SanityChecker
|
2013-03-12 09:48:41 +00:00
|
|
|
#ifdef WITH_CLIBS
|
2012-07-19 17:01:41 +00:00
|
|
|
import Assistant.Threads.MountWatcher
|
2013-03-12 09:48:41 +00:00
|
|
|
#endif
|
2012-08-21 23:58:53 +00:00
|
|
|
import Assistant.Threads.NetWatcher
|
2012-07-23 03:16:56 +00:00
|
|
|
import Assistant.Threads.TransferScanner
|
2012-08-28 18:04:28 +00:00
|
|
|
import Assistant.Threads.TransferPoller
|
add ConfigMonitor thread
Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.
Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.
A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.
Also added a uuid.log cache. All other config files already had caches.
2012-10-20 20:37:06 +00:00
|
|
|
import Assistant.Threads.ConfigMonitor
|
2012-11-29 18:49:20 +00:00
|
|
|
import Assistant.Threads.Glacier
|
2012-07-26 01:26:13 +00:00
|
|
|
#ifdef WITH_WEBAPP
|
2012-09-08 23:57:15 +00:00
|
|
|
import Assistant.WebApp
|
2012-07-26 01:26:13 +00:00
|
|
|
import Assistant.Threads.WebApp
|
2012-09-08 19:07:44 +00:00
|
|
|
#ifdef WITH_PAIRING
|
|
|
|
import Assistant.Threads.PairListener
|
|
|
|
#endif
|
2012-11-03 21:34:19 +00:00
|
|
|
#ifdef WITH_XMPP
|
|
|
|
import Assistant.Threads.XMPPClient
|
|
|
|
#endif
|
2012-07-27 16:14:57 +00:00
|
|
|
#else
|
|
|
|
#warning Building without the webapp. You probably need to install Yesod..
|
2013-04-04 05:48:26 +00:00
|
|
|
import Assistant.Types.UrlRenderer
|
2012-07-26 01:26:13 +00:00
|
|
|
#endif
|
2013-01-06 17:34:08 +00:00
|
|
|
import Assistant.Environment
|
2012-06-13 16:36:33 +00:00
|
|
|
import qualified Utility.Daemon
|
|
|
|
import Utility.LogFile
|
2013-01-26 06:09:33 +00:00
|
|
|
import Utility.ThreadScheduler
|
2013-03-17 18:45:24 +00:00
|
|
|
import qualified Build.SysConfig as SysConfig
|
2012-09-06 18:56:04 +00:00
|
|
|
|
2013-03-27 16:37:15 +00:00
|
|
|
import System.Log.Logger
|
2013-04-08 19:04:35 +00:00
|
|
|
import Network.Socket (HostName)
|
2013-03-27 16:37:15 +00:00
|
|
|
|
2012-08-01 20:10:26 +00:00
|
|
|
stopDaemon :: Annex ()
|
|
|
|
stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile
|
|
|
|
|
2013-01-15 17:34:59 +00:00
|
|
|
{- Starts the daemon. If the daemon is run in the foreground, once it's
|
|
|
|
- running, can start the browser.
|
|
|
|
-
|
|
|
|
- startbrowser is passed the url and html shim file, as well as the original
|
|
|
|
- stdout and stderr descriptors. -}
|
2013-04-08 19:04:35 +00:00
|
|
|
startDaemon :: Bool -> Bool -> Maybe HostName -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex ()
|
|
|
|
startDaemon assistant foreground listenhost startbrowser = do
|
2013-01-15 17:34:59 +00:00
|
|
|
pidfile <- fromRepo gitAnnexPidFile
|
2013-03-27 16:37:15 +00:00
|
|
|
logfile <- fromRepo gitAnnexLogFile
|
|
|
|
logfd <- liftIO $ openLog logfile
|
2013-01-15 17:34:59 +00:00
|
|
|
if foreground
|
|
|
|
then do
|
2013-03-27 16:37:15 +00:00
|
|
|
liftIO $ debugM desc $ "logging to " ++ logfile
|
2013-01-15 17:34:59 +00:00
|
|
|
liftIO $ Utility.Daemon.lockPidFile pidfile
|
|
|
|
origout <- liftIO $ catchMaybeIO $
|
|
|
|
fdToHandle =<< dup stdOutput
|
|
|
|
origerr <- liftIO $ catchMaybeIO $
|
|
|
|
fdToHandle =<< dup stdError
|
2013-03-01 17:30:48 +00:00
|
|
|
liftIO $ Utility.LogFile.redirLog logfd
|
2013-03-12 10:45:56 +00:00
|
|
|
showStart "." desc
|
2013-01-15 17:34:59 +00:00
|
|
|
start id $
|
|
|
|
case startbrowser of
|
|
|
|
Nothing -> Nothing
|
|
|
|
Just a -> Just $ a origout origerr
|
|
|
|
else
|
|
|
|
start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
|
2012-10-29 02:09:09 +00:00
|
|
|
where
|
2013-03-12 10:45:56 +00:00
|
|
|
desc
|
|
|
|
| assistant = "assistant"
|
|
|
|
| otherwise = "watch"
|
2013-01-15 17:34:59 +00:00
|
|
|
start daemonize webappwaiter = withThreadState $ \st -> do
|
|
|
|
checkCanWatch
|
2013-04-03 07:52:41 +00:00
|
|
|
when assistant
|
|
|
|
checkEnvironment
|
2013-01-15 17:34:59 +00:00
|
|
|
dstatus <- startDaemonStatus
|
2013-03-27 16:37:15 +00:00
|
|
|
logfile <- fromRepo gitAnnexLogFile
|
|
|
|
liftIO $ debugM desc $ "logging to " ++ logfile
|
2013-01-15 17:34:59 +00:00
|
|
|
liftIO $ daemonize $
|
|
|
|
flip runAssistant (go webappwaiter)
|
|
|
|
=<< newAssistantData st dstatus
|
2012-08-01 20:10:26 +00:00
|
|
|
|
2013-04-03 21:44:34 +00:00
|
|
|
|
2012-09-23 15:48:09 +00:00
|
|
|
#ifdef WITH_WEBAPP
|
2013-04-03 21:44:34 +00:00
|
|
|
go webappwaiter = do
|
2013-01-26 03:14:32 +00:00
|
|
|
d <- getAssistant id
|
2013-02-06 19:38:41 +00:00
|
|
|
#else
|
2013-04-03 21:44:34 +00:00
|
|
|
go _webappwaiter = do
|
2012-09-23 15:48:09 +00:00
|
|
|
#endif
|
2013-04-03 21:44:34 +00:00
|
|
|
notice ["starting", desc, "version", SysConfig.packageversion]
|
|
|
|
urlrenderer <- liftIO newUrlRenderer
|
|
|
|
mapM_ (startthread urlrenderer)
|
2012-10-29 15:40:22 +00:00
|
|
|
[ watch $ commitThread
|
2012-08-02 13:09:06 +00:00
|
|
|
#ifdef WITH_WEBAPP
|
2013-04-08 19:04:35 +00:00
|
|
|
, assist $ webAppThread d urlrenderer False listenhost Nothing webappwaiter
|
2012-09-08 19:07:44 +00:00
|
|
|
#ifdef WITH_PAIRING
|
2012-10-29 18:07:12 +00:00
|
|
|
, assist $ pairListenerThread urlrenderer
|
2012-09-08 19:07:44 +00:00
|
|
|
#endif
|
2012-11-03 21:34:19 +00:00
|
|
|
#ifdef WITH_XMPP
|
|
|
|
, assist $ xmppClientThread urlrenderer
|
|
|
|
#endif
|
2012-08-02 13:09:06 +00:00
|
|
|
#endif
|
2012-10-29 15:40:22 +00:00
|
|
|
, assist $ pushThread
|
|
|
|
, assist $ pushRetryThread
|
|
|
|
, assist $ mergeThread
|
2012-10-29 17:09:58 +00:00
|
|
|
, assist $ transferWatcherThread
|
2012-10-29 06:21:04 +00:00
|
|
|
, assist $ transferPollerThread
|
2012-10-29 18:07:12 +00:00
|
|
|
, assist $ transfererThread
|
2012-10-29 06:21:04 +00:00
|
|
|
, assist $ daemonStatusThread
|
2013-03-01 17:30:48 +00:00
|
|
|
, assist $ sanityCheckerDailyThread
|
|
|
|
, assist $ sanityCheckerHourlyThread
|
2013-03-12 09:48:41 +00:00
|
|
|
#ifdef WITH_CLIBS
|
2012-10-29 17:09:58 +00:00
|
|
|
, assist $ mountWatcherThread
|
2013-03-12 09:48:41 +00:00
|
|
|
#endif
|
2012-10-29 06:21:04 +00:00
|
|
|
, assist $ netWatcherThread
|
|
|
|
, assist $ netWatcherFallbackThread
|
2013-04-03 21:01:40 +00:00
|
|
|
, assist $ transferScannerThread urlrenderer
|
2012-10-29 15:40:22 +00:00
|
|
|
, assist $ configMonitorThread
|
2012-11-29 18:49:20 +00:00
|
|
|
, assist $ glacierThread
|
2012-10-29 13:55:40 +00:00
|
|
|
, watch $ watchThread
|
2012-10-29 02:09:09 +00:00
|
|
|
]
|
2013-01-15 17:34:59 +00:00
|
|
|
|
2013-01-26 06:09:33 +00:00
|
|
|
liftIO waitForTermination
|
2012-10-25 19:30:49 +00:00
|
|
|
|
2012-10-29 02:09:09 +00:00
|
|
|
watch a = (True, a)
|
|
|
|
assist a = (False, a)
|
2013-01-26 06:09:33 +00:00
|
|
|
startthread urlrenderer (watcher, t)
|
2013-02-06 19:38:41 +00:00
|
|
|
| watcher || assistant = startNamedThread urlrenderer t
|
2012-10-29 02:09:09 +00:00
|
|
|
| otherwise = noop
|