standalone linux app nearly ready

also made several fixes that apply to the OSX app
This commit is contained in:
Joey Hess 2012-09-28 19:08:13 -04:00
parent f0d75cd928
commit e88e3ba85b
11 changed files with 187 additions and 20 deletions

View file

@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Assistant.Install where
import Assistant.Common
@ -12,14 +14,15 @@ import Assistant.Install.AutoStart
import Assistant.Ssh
import Locations.UserConfig
import Utility.FileMode
import Utility.FreeDesktop
import Utility.OSX
import System.Posix.Env
standaloneOSXAppBase :: IO (Maybe FilePath)
standaloneOSXAppBase = getEnv "GIT_ANNEX_OSX_APP_BASE"
standaloneAppBase :: IO (Maybe FilePath)
standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE"
{- The OSX git-annex.app does not have an installation process.
{- The standalone app does not have an installation process.
- So when it's run, it needs to set up autostarting of the assistant
- daemon, as well as writing the programFile, and putting a
- git-annex-shell wrapper into ~/.ssh
@ -28,16 +31,21 @@ standaloneOSXAppBase = getEnv "GIT_ANNEX_OSX_APP_BASE"
- it around, the paths this sets up won't break.
-}
ensureInstalled :: IO ()
ensureInstalled = go =<< standaloneOSXAppBase
ensureInstalled = go =<< standaloneAppBase
where
go Nothing = noop
go (Just base) = do
let program = base ++ "/bin/git-annex"
let program = base ++ "runshell git-annex"
programfile <- programFile
createDirectoryIfMissing True (parentDir programfile)
writeFile programfile program
autostartfile <- userAutoStart autoStartLabel
#ifdef darwin_HOST_OS
autostartfile <- userAutoStart osxAutoStartLabel
#else
autostartfile <- autoStartPath "git-annex"
<$> userConfigDir
#endif
installAutoStart program autostartfile
{- This shim is only updated if it doesn't
@ -52,7 +60,7 @@ ensureInstalled = go =<< standaloneOSXAppBase
, "exec", base </> "runshell" ++
" git-annex-shell -c \"$SSH_ORIGINAL_COMMAND\""
]
curr <- catchDefaultIO "" $ readFile shim
curr <- catchDefaultIO "" $ readFileStrict shim
when (curr /= content) $ do
createDirectoryIfMissing True (parentDir shim)
writeFile shim content

View file

@ -1,23 +1,37 @@
{- Assistant OSX autostart file installation
{- Assistant autostart file installation
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Assistant.Install.AutoStart where
import Utility.FreeDesktop
import Utility.OSX
import Utility.Path
import System.Directory
{- Installs an autostart plist file for OSX. -}
installAutoStart :: FilePath -> FilePath -> IO ()
installAutoStart command file = do
#ifdef darwin_HOST_OS
createDirectoryIfMissing True (parentDir file)
writeFile file $ genOSXAutoStartFile autoStartLabel command
writeFile file $ genOSXAutoStartFile osxAutoStartLabel command
["assistant", "--autostart"]
#else
writeDesktopMenuFile (fdoAutostart command) file
#endif
autoStartLabel :: String
autoStartLabel = "com.branchable.git-annex.assistant"
osxAutoStartLabel :: String
osxAutoStartLabel = "com.branchable.git-annex.assistant"
fdoAutostart :: FilePath -> DesktopEntry
fdoAutostart command = genDesktopEntry
"Git Annex Assistant"
"Autostart"
False
(command ++ " assistant --autostart")
[]

View file

@ -13,7 +13,7 @@ import Assistant.Common
import Assistant.WebApp
import Assistant.WebApp.Types
import Assistant.WebApp.SideBar
import Assistant.Install (standaloneOSXAppBase)
import Assistant.Install (standaloneAppBase)
import Utility.Yesod
import Build.SysConfig (packageversion)
@ -23,7 +23,7 @@ import Yesod
- be read in and displayed. -}
licenseFile :: IO (Maybe FilePath)
licenseFile = do
base <- standaloneOSXAppBase
base <- standaloneAppBase
return $ (</> "LICENSE") <$> base
getAboutR :: Handler RepHtml
@ -39,7 +39,7 @@ getLicenseR = do
case v of
Nothing -> redirect AboutR
Just f -> bootstrap (Just About) $ do
sideBarDisplay
-- no sidebar, just pages of legalese..
setTitle "License"
license <- liftIO $ readFile f
$(widgetFile "documentation/license")