From 9fb8038166122c4f9e5a80a0833233a3647de072 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 17 Jun 2014 19:10:51 -0400
Subject: [PATCH] Windows: Assistant now logs to daemon.log.

Yes, this means that git annex webapp on windows execs git-annex, which
execs itself to set env, and the execs itself again to redirect logs.

This is disgusting. This is Windows(TM).
---
 Assistant.hs                       | 42 +++++++++++++++++++++++-------
 Assistant/Threads/SanityChecker.hs |  2 +-
 Utility/LogFile.hs                 |  7 ++---
 debian/changelog                   |  1 +
 doc/todo/windows_support.mdwn      |  5 ----
 5 files changed, 36 insertions(+), 21 deletions(-)

diff --git a/Assistant.hs b/Assistant.hs
index 5dd6a7ece5..03864c4208 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -52,9 +52,12 @@ import qualified Utility.Daemon
 import Utility.ThreadScheduler
 import Utility.HumanTime
 import qualified Build.SysConfig as SysConfig
-#ifndef mingw32_HOST_OS
-import Utility.LogFile
 import Annex.Perms
+import Utility.LogFile
+#ifdef mingw32_HOST_OS
+import Utility.Env
+import Config.Files
+import System.Environment (getArgs)
 #endif
 
 import System.Log.Logger
@@ -72,10 +75,10 @@ startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName
 startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do
 	Annex.changeState $ \s -> s { Annex.daemon = True }
 	pidfile <- fromRepo gitAnnexPidFile
-#ifndef mingw32_HOST_OS
 	logfile <- fromRepo gitAnnexLogFile
+#ifndef mingw32_HOST_OS
 	createAnnexDirectory (parentDir logfile)
-	logfd <- liftIO $ openLog logfile
+	logfd <- liftIO $ handleToFd =<< openLog logfile
 	if foreground
 		then do
 			origout <- liftIO $ catchMaybeIO $ 
@@ -92,13 +95,32 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 		else
 			start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
 #else
-	-- Windows is always foreground, and has no log file.
+	-- Windows doesn't daemonize, but does redirect output to the
+	-- log file. The only way to do so is to restart the program.
 	when (foreground || not foreground) $ do
-		liftIO $ Utility.Daemon.lockPidFile pidfile
-		start id $ do
-			case startbrowser of
-				Nothing -> Nothing
-				Just a -> Just $ a Nothing Nothing
+		let flag = "GIT_ANNEX_OUTPUT_REDIR"
+		createAnnexDirectory (parentDir logfile)
+		ifM (liftIO $ isNothing <$> getEnv flag)
+			( liftIO $ withFile devNull WriteMode $ \nullh -> do
+				Utility.Daemon.lockPidFile pidfile
+				when (not foreground) $
+					debugM desc $ "logging to " ++ logfile
+				loghandle <- openLog logfile
+				e <- getEnvironment
+				cmd <- readProgramFile
+				ps <- getArgs
+				(_, _, _, pid) <- createProcess (proc cmd ps)
+					{ env = Just (addEntry flag "1" e)
+					, std_in = UseHandle nullh
+					, std_out = UseHandle loghandle
+					, std_err = UseHandle loghandle
+					}
+				exitWith =<< waitForProcess pid
+			, start id $ do
+				case startbrowser of
+					Nothing -> Nothing
+					Just a -> Just $ a Nothing Nothing
+			)
 #endif
   where
   	desc
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index c4f2723f0e..bc5be9c75f 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -224,7 +224,7 @@ checkLogSize n = do
 	totalsize <- liftIO $ sum <$> mapM filesize logs
 	when (totalsize > 2 * oneMegabyte) $ do
 		notice ["Rotated logs due to size:", show totalsize]
-		liftIO $ openLog f >>= redirLog
+		liftIO $ openLog f >>= handleToFd >>= redirLog
 		when (n < maxLogs + 1) $ do
 			df <- liftIO $ getDiskFree $ takeDirectory f
 			case df of
diff --git a/Utility/LogFile.hs b/Utility/LogFile.hs
index e84b72b2ea..e4f90d4188 100644
--- a/Utility/LogFile.hs
+++ b/Utility/LogFile.hs
@@ -15,13 +15,10 @@ import Common
 import System.Posix.Types
 #endif
 
-#ifndef mingw32_HOST_OS
-openLog :: FilePath -> IO Fd
+openLog :: FilePath -> IO Handle
 openLog logfile = do
 	rotateLog logfile
-	openFd logfile WriteOnly (Just stdFileMode)
-		defaultFileFlags { append = True }
-#endif
+	openFile logfile AppendMode
 
 rotateLog :: FilePath -> IO ()
 rotateLog logfile = go 0
diff --git a/debian/changelog b/debian/changelog
index 663c86500c..999270db85 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,7 @@ git-annex (5.20140614) UNRELEASED; urgency=medium
     on login.
   * Windows: Fix opening file browser from webapp when repo is in a
     directory with spaces.
+  * Windows: Assistant now logs to daemon.log.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 16 Jun 2014 11:28:42 -0400
 
diff --git a/doc/todo/windows_support.mdwn b/doc/todo/windows_support.mdwn
index 90af6112fc..a48fcbc4e4 100644
--- a/doc/todo/windows_support.mdwn
+++ b/doc/todo/windows_support.mdwn
@@ -5,11 +5,6 @@ usable!
 
 * XMPP library not yet built. (See below.)
 
-* View debug log is empty in windows -- all logs go to console.
-  This messes up a few parts of UI that direct user to the debug log.
-  To fix, redirect output to some file when running git-annex via the
-  VBScript hack.
-
 * Local pairing seems to fail, after acking on Linux box, it stalls.
   (Also, of course, the Windows box is unlikely to have a ssh server,
   so only pairing with a !Windows box will work.)