From 60da0d6ad28bff7c601ba631a8ec65030f940367 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 2 Aug 2012 00:42:33 -0400 Subject: [PATCH] full autostart support git annex assistant --autostart will start separate daemons in each listed autostart repo running the webapp outside any git-annex repo will open it on the first listed autostart repo --- Assistant/WebApp/Configurators.hs | 6 +++- Build/InstallDesktopFile.hs | 4 +++ Command/Assistant.hs | 58 +++++++++++++++++++++++++++++-- Command/Watch.hs | 9 ++--- Command/WebApp.hs | 39 ++++++++++++++++----- Locations/UserConfig.hs | 26 ++++++++++++++ Utility/FreeDesktop.hs | 2 -- doc/git-annex.mdwn | 13 +++++-- 8 files changed, 134 insertions(+), 23 deletions(-) create mode 100644 Locations/UserConfig.hs diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index e1fcfcd971..01245b4bc1 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -21,6 +21,7 @@ import Init import qualified Git.Construct import qualified Git.Config import qualified Annex +import Locations.UserConfig import Yesod import Data.Text (Text) @@ -159,7 +160,10 @@ makeRepo path = do error "git init failed!" g <- Git.Config.read =<< Git.Construct.fromPath path state <- Annex.new g - Annex.eval state $ initialize $ Just "new repo" + Annex.eval state $ initialize $ Just "new repo" -- TODO better description + autostart <- autoStartFile + createDirectoryIfMissing True (parentDir autostart) + appendFile autostart $ path ++ "\n" getAddRepositoryR :: Handler RepHtml getAddRepositoryR = bootstrap (Just Config) $ do diff --git a/Build/InstallDesktopFile.hs b/Build/InstallDesktopFile.hs index a08743f3da..3bc796315a 100644 --- a/Build/InstallDesktopFile.hs +++ b/Build/InstallDesktopFile.hs @@ -46,6 +46,10 @@ writeDesktop command = do writeDesktopMenuFile (autostart command) $ autoStartPath "git-annex" configdir + programfile <- programFile + createDirectoryIfMissing True (parentDir programFile) + writeFile programfile command + main = getArgs >>= go where go [] = error "specify git-annex command" diff --git a/Command/Assistant.hs b/Command/Assistant.hs index 60eac5d219..24cc3ec6c9 100644 --- a/Command/Assistant.hs +++ b/Command/Assistant.hs @@ -7,12 +7,66 @@ module Command.Assistant where +import Common.Annex import Command +import qualified Option import qualified Command.Watch +import Init +import Locations.UserConfig + +import System.Environment +import System.Posix.Directory def :: [Command] -def = [withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption] $ +def = [noRepo checkAutoStart $ dontCheck repoExists $ + withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption, autoStartOption] $ command "assistant" paramNothing seek "automatically handle changes"] +autoStartOption :: Option +autoStartOption = Option.flag [] "autostart" "start in known repositories" + seek :: [CommandSeek] -seek = Command.Watch.mkSeek True +seek = [withFlag Command.Watch.stopOption $ \stopdaemon -> + withFlag Command.Watch.foregroundOption $ \foreground -> + withFlag autoStartOption $ \autostart -> + withNothing $ start foreground stopdaemon autostart] + +start :: Bool -> Bool -> Bool -> CommandStart +start foreground stopdaemon autostart + | autostart = do + liftIO $ autoStart + stop + | otherwise = do + ensureInitialized + Command.Watch.start True foreground stopdaemon + +{- Run outside a git repository. Check to see if any parameter is + - --autostart and enter autostart mode. -} +checkAutoStart :: IO () +checkAutoStart = ifM (any (== "--autostart") <$> getArgs) + ( autoStart + , error "Not in a git repository." + ) + +autoStart :: IO () +autoStart = do + autostartfile <- autoStartFile + let nothing = error $ "Nothing listed in " ++ autostartfile + ifM (doesFileExist autostartfile) + ( do + dirs <- lines <$> readFile autostartfile + programfile <- programFile + program <- catchDefaultIO (readFile programfile) "git-annex" + when (null dirs) nothing + forM_ dirs $ \d -> do + putStrLn $ "git-annex autostart in " ++ d + ifM (catchBoolIO $ go program d) + ( putStrLn "ok" + , putStrLn "failed" + ) + , nothing + ) + where + go program dir = do + changeWorkingDirectory dir + boolSystem program [Param "assistant"] diff --git a/Command/Watch.hs b/Command/Watch.hs index 61c859106f..eb70ef6b10 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -16,13 +16,10 @@ def :: [Command] def = [withOptions [foregroundOption, stopOption] $ command "watch" paramNothing seek "watch for changes"] -mkSeek :: Bool -> [CommandSeek] -mkSeek assistant = [withFlag stopOption $ \stopdaemon -> - withFlag foregroundOption $ \foreground -> - withNothing $ start assistant foreground stopdaemon] - seek :: [CommandSeek] -seek = mkSeek False +seek = [withFlag stopOption $ \stopdaemon -> + withFlag foregroundOption $ \foreground -> + withNothing $ start False foreground stopdaemon] foregroundOption :: Option foregroundOption = Option.flag [] "foreground" "do not daemonize" diff --git a/Command/WebApp.hs b/Command/WebApp.hs index f143d8667b..d3153f6304 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -18,12 +18,14 @@ import Utility.Daemon (checkDaemon, lockPidFile) import Init import qualified Git.CurrentRepo import qualified Annex +import Locations.UserConfig +import System.Posix.Directory import Control.Concurrent import Control.Concurrent.STM def :: [Command] -def = [oneShot $ noRepo firstRun $ dontCheck repoExists $ +def = [oneShot $ noRepo startNoRepo $ dontCheck repoExists $ command "webapp" paramNothing seek "launch webapp"] seek :: [CommandSeek] @@ -31,7 +33,7 @@ seek = [withNothing start] start :: CommandStart start = notBareRepo $ do - ifM (isInitialized) ( go , liftIO firstRun ) + ifM (isInitialized) ( go , liftIO startNoRepo ) stop where go = do @@ -46,14 +48,24 @@ start = notBareRepo $ do liftIO $ isJust <$> checkDaemon pidfile checkshim f = liftIO $ doesFileExist f -openBrowser :: FilePath -> IO () -openBrowser htmlshim = unlessM (runBrowser url) $ - error $ "failed to start web browser on url " ++ url - where - url = fileUrl htmlshim +{- When run without a repo, see if there is an autoStartFile, + - and if so, start the first available listed repository. + - If not, it's our first time being run! -} +startNoRepo :: IO () +startNoRepo = do + autostartfile <- autoStartFile + ifM (doesFileExist autostartfile) ( autoStart autostartfile , firstRun ) -fileUrl :: FilePath -> String -fileUrl file = "file://" ++ file +autoStart :: FilePath -> IO () +autoStart autostartfile = do + dirs <- lines <$> readFile autostartfile + edirs <- filterM doesDirectoryExist dirs + case edirs of + [] -> firstRun -- what else can I do? Nothing works.. + (d:_) -> do + changeWorkingDirectory d + state <- Annex.new =<< Git.CurrentRepo.get + void $ Annex.eval state $ doCommand start {- Run the webapp without a repository, which prompts the user, makes one, - changes to it, starts the regular assistant, and redirects the @@ -92,3 +104,12 @@ firstRun = do {- Set up the pid file in the new repo. -} dummydaemonize = do liftIO . lockPidFile =<< fromRepo gitAnnexPidFile + +openBrowser :: FilePath -> IO () +openBrowser htmlshim = unlessM (runBrowser url) $ + error $ "failed to start web browser on url " ++ url + where + url = fileUrl htmlshim + +fileUrl :: FilePath -> String +fileUrl file = "file://" ++ file diff --git a/Locations/UserConfig.hs b/Locations/UserConfig.hs new file mode 100644 index 0000000000..9b04aed619 --- /dev/null +++ b/Locations/UserConfig.hs @@ -0,0 +1,26 @@ +{- git-annex user config files + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Locations.UserConfig where + +import Utility.FreeDesktop + +import System.FilePath + +{- ~/.config/git-annex/file -} +userConfigFile :: FilePath -> IO FilePath +userConfigFile file = do + dir <- userConfigDir + return $ dir "git-annex" file + +autoStartFile :: IO FilePath +autoStartFile = userConfigFile "autostart" + +{- The path to git-annex is written here; which is useful when cabal + - has installed it to some aweful non-PATH location. -} +programFile :: IO FilePath +programFile = userConfigFile "program" diff --git a/Utility/FreeDesktop.hs b/Utility/FreeDesktop.hs index 5bab4950ab..784473b275 100644 --- a/Utility/FreeDesktop.hs +++ b/Utility/FreeDesktop.hs @@ -23,10 +23,8 @@ module Utility.FreeDesktop ( ) where import Utility.Exception -import Utility.Directory import Utility.Path -import System.IO import System.Environment import System.Directory import System.FilePath diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 0a6df035be..6a1c70a4c3 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -809,10 +809,17 @@ For example, this makes two copies be needed for wav files: # FILES -These files are used by git-annex, in your git repository: +These files are used by git-annex: -`.git/annex/objects/` contains the annexed file contents that are currently -available. Annexed files in your git repository symlink to that content. +`.git/annex/objects/` in your git repository contains the annexed file +contents that are currently available. Annexed files in your git +repository symlink to that content. + +`.git/annex/` in your git repository contains other run-time information +used by git-annex. + +`~/.config/git-annex/autostart` is a list of git repositories +to start the git-annex assistant in. # SEE ALSO