git-annex/Assistant/WebApp/Control.hs
Joey Hess bad9b6761d restart UI
Browser behavior is not ideal; a new tab is opened on restart.
Browsers won't let me redirect to a file:// so I cannot use the old tab.
2013-01-03 18:50:30 -04:00

42 lines
1.3 KiB
Haskell

{- git-annex assistant webapp control
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP, TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
module Assistant.WebApp.Control where
import Assistant.WebApp.Common
import Locations.UserConfig
import Control.Concurrent
import System.Posix (getProcessID, signalProcess, sigTERM)
getShutdownR :: Handler RepHtml
getShutdownR = page "Shutdown" Nothing $
$(widgetFile "control/shutdown")
getShutdownConfirmedR :: Handler RepHtml
getShutdownConfirmedR = page "Shutdown" Nothing $ do
{- Wait 2 seconds before shutting down, to give the web page time
- to display. -}
void $ liftIO $ forkIO $ do
threadDelay 2000000
signalProcess sigTERM =<< getProcessID
$(widgetFile "control/shutdownconfirmed")
{- Quite a hack, and doesn't redirect the browser window. -}
getRestartR :: Handler RepHtml
getRestartR = page "Restarting" Nothing $ do
void $ liftIO $ forkIO $ do
threadDelay 2000000
program <- readProgramFile
unlessM (boolSystem "sh" [Param "-c", Param $ restartcommand program]) $
error "restart failed"
$(widgetFile "control/restarting")
where
restartcommand program = program ++ " assistant --stop; " ++
program ++ " webapp"