mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

webapp now starts up when run not in a git repo

Browse source
This commit is contained in:
Joey Hess 2012-07-31 12:17:31 -04:00
parent b9b0097876
commit 04794eafc0
8 changed files with 96 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Assistant.hs
View file

@ -122,7 +122,7 @@ import Utility.ThreadScheduler
import Control.Concurrent import Control.Concurrent
startDaemon :: Bool -> Bool -> Maybe (IO ()) -> Annex () startDaemon :: Bool -> Bool -> Maybe (FilePath -> IO ()) -> Annex ()
startDaemon assistant foreground webappwaiter startDaemon assistant foreground webappwaiter
| foreground = do | foreground = do
showStart (if assistant then "assistant" else "watch") "." showStart (if assistant then "assistant" else "watch") "."
@ -155,7 +155,7 @@ startDaemon assistant foreground webappwaiter
, mountWatcherThread st dstatus scanremotes , mountWatcherThread st dstatus scanremotes
, transferScannerThread st dstatus scanremotes transferqueue , transferScannerThread st dstatus scanremotes transferqueue
#ifdef WITH_WEBAPP #ifdef WITH_WEBAPP
, webAppThread st dstatus transferqueue webappwaiter , webAppThread (Just st) dstatus transferqueue webappwaiter
#endif #endif
, watchThread st dstatus transferqueue changechan , watchThread st dstatus transferqueue changechan
] ]

55
Assistant/Threads/WebApp.hs
View file

@ -1,4 +1,4 @@
{- git-annex assistant webapp {- git-annex assistant webapp thread
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
@ -38,47 +38,46 @@ thisThread = "WebApp"
mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes") mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
webAppThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Maybe (IO ()) -> IO () webAppThread :: (Maybe ThreadState) -> DaemonStatusHandle -> TransferQueue -> Maybe (FilePath -> IO ()) -> IO ()
webAppThread st dstatus transferqueue onstartup = do webAppThread mst dstatus transferqueue onstartup = do
webapp <- mkWebApp webapp <- WebApp
<$> pure mst
<*> pure dstatus
<*> pure transferqueue
<*> (pack <$> genRandomToken)
<*> getreldir mst
<*> pure $(embed "static")
<*> newWebAppState
app <- toWaiAppPlain webapp app <- toWaiAppPlain webapp
app' <- ifM debugEnabled app' <- ifM debugEnabled
( return $ httpDebugLogger app ( return $ httpDebugLogger app
, return app , return app
) )
runWebApp app' $ \port -> do runWebApp app' $ \port -> case mst of
runThreadState st $ writeHtmlShim webapp port Nothing -> withTempFile "webapp.html" $ \tmpfile _ -> go port webapp tmpfile
maybe noop id onstartup Just st -> go port webapp =<< runThreadState st (fromRepo gitAnnexHtmlShim)
where where
mkWebApp = do getreldir Nothing = return Nothing
getreldir (Just st) = do
dir <- absPath =<< runThreadState st (fromRepo repoPath) dir <- absPath =<< runThreadState st (fromRepo repoPath)
home <- myHomeDir home <- myHomeDir
let reldir = if dirContains home dir return $ Just $ if dirContains home dir
then relPathDirToFile home dir then relPathDirToFile home dir
else dir else dir
token <- genRandomToken go port webapp htmlshim = do
s <- newWebAppState writeHtmlShim webapp port htmlshim
return $ WebApp maybe noop (\a -> a htmlshim) onstartup
{ threadState = Just st
, daemonStatus = dstatus
, transferQueue = transferqueue
, secretToken = pack token
, relDir = reldir
, getStatic = $(embed "static")
, webAppState = s
}
{- Creates a html shim file that's used to redirect into the webapp, {- Creates a html shim file that's used to redirect into the webapp,
- to avoid exposing the secretToken when launching the web browser. -} - to avoid exposing the secretToken when launching the web browser. -}
writeHtmlShim :: WebApp -> PortNumber -> Annex () writeHtmlShim :: WebApp -> PortNumber -> FilePath -> IO ()
writeHtmlShim webapp port = do writeHtmlShim webapp port file = do
liftIO $ debug thisThread ["running on port", show port] debug thisThread ["running on port", show port]
htmlshim <- fromRepo gitAnnexHtmlShim viaTmp go file $ genHtmlShim webapp port
liftIO $ viaTmp go htmlshim $ genHtmlShim webapp port
where where
go file content = do go tmpfile content = do
h <- openFile file WriteMode h <- openFile tmpfile WriteMode
modifyFileMode file $ removeModes [groupReadMode, otherReadMode] modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
hPutStr h content hPutStr h content
hClose h hClose h

2
Assistant/WebApp.hs
View file

@ -34,7 +34,7 @@ data WebApp = WebApp
, daemonStatus :: DaemonStatusHandle , daemonStatus :: DaemonStatusHandle
, transferQueue :: TransferQueue , transferQueue :: TransferQueue
, secretToken :: Text , secretToken :: Text
, relDir :: FilePath , relDir :: Maybe FilePath
, getStatic :: Static , getStatic :: Static
, webAppState :: TMVar WebAppState , webAppState :: TMVar WebAppState
} }

1
Assistant/WebApp/Configurators.hs
View file

@ -25,7 +25,6 @@ import Data.Text (Text)
introDisplay :: Text -> Widget introDisplay :: Text -> Widget
introDisplay ident = do introDisplay ident = do
webapp <- lift getYesod webapp <- lift getYesod
let reldir = relDir webapp
l <- lift $ runAnnex [] $ do l <- lift $ runAnnex [] $ do
u <- getUUID u <- getUUID
rs <- map Remote.uuid <$> Remote.remoteList rs <- map Remote.uuid <$> Remote.remoteList

31
Command/WebApp.hs
View file

@ -10,12 +10,19 @@ module Command.WebApp where
import Common.Annex import Common.Annex
import Command import Command
import Assistant import Assistant
import Assistant.DaemonStatus
import Assistant.TransferQueue
import Assistant.Threads.WebApp
import Utility.WebApp import Utility.WebApp
import Utility.ThreadScheduler
import Utility.Daemon (checkDaemon) import Utility.Daemon (checkDaemon)
import qualified Command.Watch import qualified Command.Watch
import Control.Concurrent.STM
def :: [Command] def :: [Command]
def = [withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption] $ def = [oneShot $ noRepo firstRun $ dontCheck repoExists $
withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption] $
command "webapp" paramNothing seek "launch webapp"] command "webapp" paramNothing seek "launch webapp"]
seek :: [CommandSeek] seek :: [CommandSeek]
@ -30,8 +37,8 @@ start foreground stopdaemon = notBareRepo $ do
else do else do
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
ifM (checkpid <&&> checkshim f) $ ifM (checkpid <&&> checkshim f) $
( liftIO $ go f ( liftIO $ openBrowser f
, startDaemon True foreground $ Just $ go f , startDaemon True foreground $ Just openBrowser
) )
stop stop
where where
@ -39,7 +46,17 @@ start foreground stopdaemon = notBareRepo $ do
pidfile <- fromRepo gitAnnexPidFile pidfile <- fromRepo gitAnnexPidFile
liftIO $ isJust <$> checkDaemon pidfile liftIO $ isJust <$> checkDaemon pidfile
checkshim f = liftIO $ doesFileExist f checkshim f = liftIO $ doesFileExist f
go f = unlessM (runBrowser url) $
error $ "failed to start web browser on url " ++ url openBrowser :: FilePath -> IO ()
where openBrowser htmlshim = unlessM (runBrowser url) $
url = "file://" ++ f error $ "failed to start web browser on url " ++ url
where
url = "file://" ++ htmlshim
firstRun :: IO ()
firstRun = do
dstatus <- atomically . newTMVar =<< newDaemonStatus
transferqueue <- newTransferQueue
webAppThread Nothing dstatus transferqueue $ Just $ \f -> do
openBrowser f
waitForTermination

6
templates/bootstrap.hamlet
View file

@ -1,7 +1,11 @@
$doctype 5 $doctype 5
<html> <html>
<head> <head>
<title>#{relDir webapp} #{pageTitle page} <title>
$maybe reldir <- relDir webapp
#{reldir} #{pageTitle page}
$nothing
#{pageTitle page}
<link rel="icon" href=@{StaticR favicon_ico} type="image/x-icon"> <link rel="icon" href=@{StaticR favicon_ico} type="image/x-icon">
<meta name="viewport" content="width=device-width,initial-scale=1.0"> <meta name="viewport" content="width=device-width,initial-scale=1.0">
^{pageHead page} ^{pageHead page}

51
templates/configurators/intro.hamlet
View file

@ -1,27 +1,28 @@
<div .span9 ##{ident} .hero-unit> <div .span9 ##{ident} .hero-unit>
<h2> $maybe reldir <- relDir webapp
git-annex is watching over your files in <small><tt>#{reldir}</tt></small> <h2>
<p> git-annex is watching over your files in <small><tt>#{reldir}</tt></small>
It will automatically notice changes, and keep files in sync between # <p>
$if notenough It will automatically notice changes, and keep files in sync between #
repositories on your devices ... $if notenough
<h2> repositories on your devices ...
But no other repositories are set up yet. <h2>
<a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a> But no other repositories are set up yet.
$else <a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a>
$if barelyenough
<span .badge .badge-warning>#{numrepos}</span>
$else $else
<span .badge .badge-success>#{numrepos}</span> $if barelyenough
\ repositories and devices: <span .badge .badge-warning>#{numrepos}</span>
<table .table .table-striped .table-condensed> $else
<tbody> <span .badge .badge-success>#{numrepos}</span>
$forall (num, name) <- remotelist \ repositories and devices:
<tr> <table .table .table-striped .table-condensed>
<td> <tbody>
#{num} $forall (num, name) <- remotelist
<td> <tr>
#{name} <td>
<a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a> #{num}
<p> <td>
Or just sit back, watch the magic, and get on with using your files. #{name}
<a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a>
<p>
Or just sit back, watch the magic, and get on with using your files.

21
templates/page.hamlet
View file

@ -7,16 +7,17 @@
$forall (name, route, isactive) <- navbar $forall (name, route, isactive) <- navbar
<li :isactive:.active> <li :isactive:.active>
<a href="@{route}">#{name}</a> <a href="@{route}">#{name}</a>
<ul .nav .pull-right> $maybe reldir <- relDir webapp
<li .dropdown #menu1> <ul .nav .pull-right>
<a .dropdown-toggle data-toggle="dropdown" href="#menu1"> <li .dropdown #menu1>
Current Repository: #{relDir webapp} <a .dropdown-toggle data-toggle="dropdown" href="#menu1">
<b .caret></b> Current Repository: #{reldir}
<ul .dropdown-menu> <b .caret></b>
<li><a href="#">#{relDir webapp}</a></li> <ul .dropdown-menu>
<li .divider></li> <li><a href="#">#{reldir}</a></li>
<li><a href="@{AddRepositoryR}">Add another repository</a></li> <li .divider></li>
<li><a href="@{AddRepositoryR}">Add another repository</a></li>
$nothing
<div .container-fluid> <div .container-fluid>
<div .row-fluid> <div .row-fluid>
^{content} ^{content}