diff options
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 1 | ||||
| -rw-r--r-- | Command/Assistant.hs | 26 | ||||
| -rw-r--r-- | Command/WebApp.hs | 17 | ||||
| -rw-r--r-- | Locations/UserConfig.hs | 26 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/design/assistant/webapp.mdwn | 2 |
6 files changed, 46 insertions, 28 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index e2eed4588..39b9c95c3 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -24,6 +24,7 @@ import Assistant.WebApp.Configurators.Pairing import Assistant.WebApp.Configurators.AWS import Assistant.WebApp.Configurators.WebDAV import Assistant.WebApp.Configurators.XMPP +import Assistant.WebApp.Configurators.Preferences import Assistant.WebApp.Documentation import Assistant.WebApp.Control import Assistant.WebApp.OtherRepos diff --git a/Command/Assistant.hs b/Command/Assistant.hs index ea8a87a3d..69a127b50 100644 --- a/Command/Assistant.hs +++ b/Command/Assistant.hs @@ -50,21 +50,17 @@ checkAutoStart = ifM (elem "--autostart" <$> getArgs) autoStart :: IO () autoStart = do - autostartfile <- autoStartFile - let nothing = error $ "Nothing listed in " ++ autostartfile - ifM (doesFileExist autostartfile) - ( do - dirs <- nub . lines <$> readFile autostartfile - program <- readProgramFile - when (null dirs) nothing - forM_ dirs $ \d -> do - putStrLn $ "git-annex autostart in " ++ d - ifM (catchBoolIO $ go program d) - ( putStrLn "ok" - , putStrLn "failed" - ) - , nothing - ) + dirs <- liftIO readAutoStartFile + when (null dirs) $ do + f <- autoStartFile + error $ "Nothing listed in " ++ f + program <- readProgramFile + forM_ dirs $ \d -> do + putStrLn $ "git-annex autostart in " ++ d + ifM (catchBoolIO $ go program d) + ( putStrLn "ok" + , putStrLn "failed" + ) where go program dir = do changeWorkingDirectory dir diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 274a00c93..5e461ed21 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -64,20 +64,13 @@ start' allowauto = do liftIO $ isJust <$> checkDaemon pidfile checkshim f = liftIO $ doesFileExist f -{- 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! -} +{- When run without a repo, start the first available listed repository in + - the autostart file. If not, it's our first time being run! -} startNoRepo :: IO () startNoRepo = do - autostartfile <- autoStartFile - ifM (doesFileExist autostartfile) ( autoStart autostartfile , firstRun ) - -autoStart :: FilePath -> IO () -autoStart autostartfile = do - dirs <- nub . lines <$> readFile autostartfile - edirs <- filterM doesDirectoryExist dirs - case edirs of - [] -> firstRun -- what else can I do? Nothing works.. + dirs <- liftIO $ filterM doesDirectoryExist =<< readAutoStartFile + case dirs of + [] -> firstRun (d:_) -> do changeWorkingDirectory d state <- Annex.new =<< Git.CurrentRepo.get diff --git a/Locations/UserConfig.hs b/Locations/UserConfig.hs index 3a6a27e91..429ed8fd5 100644 --- a/Locations/UserConfig.hs +++ b/Locations/UserConfig.hs @@ -8,6 +8,7 @@ module Locations.UserConfig where import Common +import Utility.TempFile import Utility.FreeDesktop {- ~/.config/git-annex/file -} @@ -19,6 +20,31 @@ userConfigFile file = do autoStartFile :: IO FilePath autoStartFile = userConfigFile "autostart" +{- Returns anything listed in the autostart file (which may not exist). -} +readAutoStartFile :: IO [FilePath] +readAutoStartFile = do + f <- autoStartFile + nub . lines <$> catchDefaultIO "" (readFile f) + +{- Adds a directory to the autostart file. -} +addAutoStartFile :: FilePath -> IO () +addAutoStartFile path = do + dirs <- readAutoStartFile + when (path `notElem` dirs) $ do + f <- autoStartFile + createDirectoryIfMissing True (parentDir f) + viaTmp writeFile f $ unlines $ dirs ++ [path] + +{- Removes a directory from the autostart file. -} +removeAutoStartFile :: FilePath -> IO () +removeAutoStartFile path = do + dirs <- readAutoStartFile + when (path `elem` dirs) $ do + f <- autoStartFile + createDirectoryIfMissing True (parentDir f) + viaTmp writeFile f $ unlines $ + filter (not . equalFilePath path) dirs + {- 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 diff --git a/debian/changelog b/debian/changelog index dab3e7b5b..a241d4bfc 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,8 @@ git-annex (4.20130228) UNRELEASED; urgency=low automatic commits from causing git-gc runs. * assistant: If gc.auto=0, run git-gc once a day, packing loose objects very non-aggressively. + * webapp: New preferences page allows enabling/disabling debug logging + at runtime, as well as configuring numcopies and diskreserve. -- Joey Hess <joeyh@debian.org> Wed, 27 Feb 2013 23:20:40 -0400 diff --git a/doc/design/assistant/webapp.mdwn b/doc/design/assistant/webapp.mdwn index f71490373..b55d1b860 100644 --- a/doc/design/assistant/webapp.mdwn +++ b/doc/design/assistant/webapp.mdwn @@ -30,7 +30,7 @@ The webapp is a web server that displays a shiny interface. * Display something sane when kqueue runs out of file descriptors. * allow removing git remotes **done** * allow disabling syncing to here, which should temporarily disable all - local syncing. + local syncing. **done** ## first start **done** |