File: Assistant.hs

package info (click to toggle)
git-annex 10.20230126-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 69,344 kB
  • sloc: haskell: 74,654; javascript: 9,103; sh: 1,304; makefile: 203; perl: 136; ansic: 44
file content (137 lines) | stat: -rw-r--r-- 3,753 bytes parent folder | download
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
{- git-annex assistant
 -
 - Copyright 2012-2017 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module Command.Assistant where

import Command
import qualified Command.Watch
import Annex.Init
import Annex.Path
import Config.Files
import Config.Files.AutoStart
import qualified BuildInfo
import Utility.HumanTime
import Assistant.Install
import Remote.List

import Control.Concurrent.Async

cmd :: Command
cmd = dontCheck repoExists $ notBareRepo $
	noRepo (startNoRepo <$$> optParser) $
		command "assistant" SectionCommon
			"automatically sync changes"
			paramNothing (seek <$$> optParser)

data AssistantOptions = AssistantOptions
	{ daemonOptions :: DaemonOptions
	, autoStartOption :: Bool
	, startDelayOption :: Maybe Duration
	, autoStopOption :: Bool
	}

optParser :: CmdParamsDesc -> Parser AssistantOptions
optParser _ = AssistantOptions
	<$> parseDaemonOptions True
	<*> switch
		( long "autostart"
		<> help "start in known repositories"
		)
	<*> optional (option (eitherReader parseDuration)
		( long "startdelay" <> metavar paramNumber
		<> help "delay before running startup scan"
		))
	<*> switch
		( long "autostop"
		<> help "stop in known repositories"
		)

seek :: AssistantOptions -> CommandSeek
seek = commandAction . start

start :: AssistantOptions -> CommandStart
start o
	| autoStartOption o = do
		liftIO $ autoStart o
		stop
	| autoStopOption o = do
		liftIO autoStop
		stop
	| otherwise = do
		liftIO ensureInstalled
		ensureInitialized remoteList
		Command.Watch.start True (daemonOptions o) (startDelayOption o)

startNoRepo :: AssistantOptions -> IO ()
startNoRepo o
	| autoStartOption o = autoStart o
	| autoStopOption o = autoStop
	| otherwise = giveup "Not in a git repository."

-- Does not return
autoStart :: AssistantOptions -> IO ()
autoStart o = do
	dirs <- liftIO readAutoStartFile
	when (null dirs) $ do
		f <- autoStartFile
		giveup $ "Nothing listed in " ++ f
	program <- programPath
	haveionice <- pure BuildInfo.ionice <&&> inSearchPath "ionice"
	pids <- forM dirs $ \d -> do
		putStrLn $ "git-annex autostart in " ++ d
		mpid <- catchMaybeIO $ go haveionice program d
		if foregroundDaemonOption (daemonOptions o)
			then return mpid
			else do
				case mpid of
					Nothing -> putStrLn "failed"
					Just pid -> ifM (checkSuccessProcess pid)
						( putStrLn "ok"
						, putStrLn "failed"
						)
				return Nothing
	-- Wait for any foreground jobs to finish and propigate exit status.
	ifM (all (== True) <$> mapConcurrently checkSuccessProcess (catMaybes pids))
		( exitSuccess
		, exitFailure
		)
  where
	go haveionice program dir = do
		setCurrentDirectory dir
		-- First stop any old daemon running in this directory, which
		-- might be a leftover from an old login session. Such a
		-- leftover might be left in an environment where it is
		-- unable to use the ssh agent or other login session
		-- resources.
		void $ boolSystem program [Param "assistant", Param "--stop"]
		(Nothing, Nothing, Nothing, pid) <- createProcess p
		return pid
	  where
		p
			| haveionice = proc "ionice"
				(toCommand $ Param "-c3" : Param program : baseparams)
			| otherwise = proc program
				(toCommand baseparams)
		baseparams = catMaybes
			[ Just $ Param "assistant"
			, Just $ Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) (startDelayOption o))
			, if foregroundDaemonOption (daemonOptions o)
				then Just $ Param "--foreground"
				else Nothing
			]

autoStop :: IO ()
autoStop = do
	dirs <- liftIO readAutoStartFile
	program <- programPath
	forM_ dirs $ \d -> do
		putStrLn $ "git-annex autostop in " ++ d
		setCurrentDirectory d
		ifM (boolSystem program [Param "assistant", Param "--stop"])
			( putStrLn "ok"
			, putStrLn "failed"
			)