webapp: Now always logs to .git/annex/daemon.log

It used to not log to daemon.log when a repository was first created, and
when starting the webapp. Now both do. Redirecting stdout and stderr to the
log is tricky when starting the webapp, because the web browser may want to
communicate with the user. (Either a console web browser, or web.browser = echo)
This is handled by restoring the original fds when running the browser.
This commit is contained in:
Joey Hess 2013-01-15 13:34:59 -04:00
parent f9ec512c8f
commit d7ca6fb856
6 changed files with 74 additions and 55 deletions

View file

@ -163,28 +163,40 @@ type NamedThread = IO () -> IO (String, IO ())
stopDaemon :: Annex ()
stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile
startDaemon :: Bool -> Bool -> Maybe (String -> FilePath -> IO ()) -> Annex ()
startDaemon assistant foreground webappwaiter
| foreground = do
showStart (if assistant then "assistant" else "watch") "."
liftIO . Utility.Daemon.lockPidFile =<< fromRepo gitAnnexPidFile
go id
| otherwise = do
logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile
pidfile <- fromRepo gitAnnexPidFile
go $ Utility.Daemon.daemonize logfd (Just pidfile) False
{- Starts the daemon. If the daemon is run in the foreground, once it's
- running, can start the browser.
-
- startbrowser is passed the url and html shim file, as well as the original
- stdout and stderr descriptors. -}
startDaemon :: Bool -> Bool -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex ()
startDaemon assistant foreground startbrowser = do
pidfile <- fromRepo gitAnnexPidFile
logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile
if foreground
then do
liftIO $ Utility.Daemon.lockPidFile pidfile
origout <- liftIO $ catchMaybeIO $
fdToHandle =<< dup stdOutput
origerr <- liftIO $ catchMaybeIO $
fdToHandle =<< dup stdError
liftIO $ Utility.Daemon.redirLog logfd
showStart (if assistant then "assistant" else "watch") "."
start id $
case startbrowser of
Nothing -> Nothing
Just a -> Just $ a origout origerr
else
start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
where
go d = startAssistant assistant d webappwaiter
start daemonize webappwaiter = withThreadState $ \st -> do
checkCanWatch
when assistant $ checkEnvironment
dstatus <- startDaemonStatus
liftIO $ daemonize $
flip runAssistant (go webappwaiter)
=<< newAssistantData st dstatus
startAssistant :: Bool -> (IO () -> IO ()) -> Maybe (String -> FilePath -> IO ()) -> Annex ()
startAssistant assistant daemonize webappwaiter = withThreadState $ \st -> do
checkCanWatch
when assistant $ checkEnvironment
dstatus <- startDaemonStatus
liftIO $ daemonize $
flip runAssistant go =<< newAssistantData st dstatus
where
go = do
go webappwaiter = do
d <- getAssistant id
#ifdef WITH_WEBAPP
urlrenderer <- liftIO newUrlRenderer
@ -216,6 +228,7 @@ startAssistant assistant daemonize webappwaiter = withThreadState $ \st -> do
, assist $ glacierThread
, watch $ watchThread
]
liftIO waitForTermination
watch a = (True, a)

View file

@ -97,6 +97,7 @@ startupScan scanner = do
void $ liftIO $ cleanup
liftAnnex $ showAction "started"
liftIO $ putStrLn ""
modifyDaemonStatus_ $ \s -> s { scanComplete = True }

View file

@ -16,7 +16,7 @@ import Assistant.Threads.WebApp
import Assistant.WebApp
import Assistant.Install
import Utility.WebApp
import Utility.Daemon (checkDaemon, lockPidFile)
import Utility.Daemon (checkDaemon)
import Init
import qualified Git
import qualified Git.Config
@ -27,6 +27,7 @@ import Locations.UserConfig
import System.Posix.Directory
import Control.Concurrent
import Control.Concurrent.STM
import System.Process (env, std_out, std_err)
def :: [Command]
def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $
@ -48,9 +49,10 @@ start' allowauto = do
browser <- fromRepo webBrowser
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
ifM (checkpid <&&> checkshim f)
( liftIO $ openBrowser browser f
, startDaemon True True $ Just $
const $ openBrowser browser
( liftIO $ openBrowser browser f Nothing Nothing
, startDaemon True True $ Just $
\origout origerr _url htmlshim ->
openBrowser browser htmlshim origout origerr
)
auto
| allowauto = liftIO startNoRepo
@ -117,30 +119,30 @@ firstRun = do
takeMVar v
mainthread v _url htmlshim = do
browser <- maybe Nothing webBrowser <$> Git.Config.global
openBrowser browser htmlshim
openBrowser browser htmlshim Nothing Nothing
_wait <- takeMVar v
state <- Annex.new =<< Git.CurrentRepo.get
Annex.eval state $ do
dummydaemonize
startAssistant True id $ Just $ sendurlback v
sendurlback v url _htmlshim = putMVar v url
Annex.eval state $
startDaemon True True $ Just $ sendurlback v
sendurlback v _origout _origerr url _htmlshim = putMVar v url
{- Set up the pid file in the new repo. -}
dummydaemonize = liftIO . lockPidFile =<< fromRepo gitAnnexPidFile
openBrowser :: Maybe FilePath -> FilePath -> IO ()
openBrowser cmd htmlshim = go $ maybe runBrowser runCustomBrowser cmd
openBrowser :: Maybe FilePath -> FilePath -> Maybe Handle -> Maybe Handle -> IO ()
openBrowser cmd htmlshim outh errh = do
hPutStrLn (fromMaybe stdout outh) $ "Launching web browser on " ++ url
environ <- cleanEnvironment
(_, _, _, pid) <- createProcess p
{ env = environ
, std_out = maybe Inherit UseHandle outh
, std_err = maybe Inherit UseHandle errh
}
exitcode <- waitForProcess pid
unless (exitcode == ExitSuccess) $
hPutStrLn (fromMaybe stderr errh) "failed to start web browser"
where
url = fileUrl htmlshim
go a = do
putStrLn ""
putStrLn $ "Launching web browser on " ++ url
env <- cleanEnvironment
unlessM (a url env) $
error $ "failed to start web browser"
runCustomBrowser c u = boolSystemEnv c [Param u]
p = proc (fromMaybe browserCommand cmd) [htmlshim]
{- web.browser is a generic git config setting for a web browser program -}
webBrowser :: Git.Repo -> Maybe FilePath

View file

@ -34,16 +34,22 @@ daemonize logfd pidfile changedirectory a = do
when changedirectory $
setCurrentDirectory "/"
nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
_ <- redir nullfd stdInput
mapM_ (redir logfd) [stdOutput, stdError]
closeFd logfd
redir nullfd stdInput
redirLog logfd
a
out
redir newh h = do
closeFd h
dupTo newh h
out = exitImmediately ExitSuccess
redirLog :: Fd -> IO ()
redirLog logfd = do
mapM_ (redir logfd) [stdOutput, stdError]
closeFd logfd
redir :: Fd -> Fd -> IO ()
redir newh h = do
closeFd h
void $ dupTo newh h
{- Locks the pid file, with an exclusive, non-blocking lock.
- Writes the pid to the file, fully atomically.
- Fails if the pid file is already locked by another process. -}

View file

@ -40,16 +40,12 @@ import Control.Concurrent
localhost :: String
localhost = "localhost"
{- Runs a web browser on a given url.
-
- Note: The url *will* be visible to an attacker. -}
runBrowser :: String -> (Maybe [(String, String)]) -> IO Bool
runBrowser url env = boolSystemEnv cmd [Param url] env
where
{- Command to use to run a web browser. -}
browserCommand :: FilePath
#ifdef darwin_HOST_OS
cmd = "open"
browserCommand = "open"
#else
cmd = "xdg-open"
browserCommand = "xdg-open"
#endif
{- Binds to a socket on localhost, and runs a webapp on it.

1
debian/changelog vendored
View file

@ -4,6 +4,7 @@ git-annex (3.20130115) UNRELEASED; urgency=low
variable quoting in different versions of shakespeare-js.
* webapp: Avoid an error if a transfer is stopped just as it finishes.
Closes: #698184
* webapp: Now always logs to .git/annex/daemon.log.
-- Joey Hess <joeyh@debian.org> Mon, 14 Jan 2013 18:35:01 -0400