webapp: New preferences page allows enabling/disabling debug logging at runtime, as well as configuring numcopies and diskreserve.

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**