make the standalone OSX app automatically install itself when run
This commit is contained in:
		
					parent
					
						
							
								521b64f7ee
							
						
					
				
			
			
				commit
				
					
						3da78cc241
					
				
			
		
					 6 changed files with 117 additions and 42 deletions
				
			
		
							
								
								
									
										45
									
								
								Assistant/Install.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										45
									
								
								Assistant/Install.hs
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
					@ -0,0 +1,45 @@
 | 
				
			||||||
 | 
					{- Assistant installation
 | 
				
			||||||
 | 
					 -
 | 
				
			||||||
 | 
					 - Copyright 2012 Joey Hess <joey@kitenet.net>
 | 
				
			||||||
 | 
					 -
 | 
				
			||||||
 | 
					 - Licensed under the GNU GPL version 3 or higher.
 | 
				
			||||||
 | 
					 -}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					module Assistant.Install where
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					import Locations.UserConfig
 | 
				
			||||||
 | 
					import Utility.OSX
 | 
				
			||||||
 | 
					import Utility.Path
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					import System.Posix.Env
 | 
				
			||||||
 | 
					import System.Directory
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					{- The OSX git-annex.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.
 | 
				
			||||||
 | 
					 -
 | 
				
			||||||
 | 
					 - Note that this is done every time it's started, so if the user moves
 | 
				
			||||||
 | 
					 - it around, the paths this sets up won't break.
 | 
				
			||||||
 | 
					 -}
 | 
				
			||||||
 | 
					ensureInstalled :: IO ()
 | 
				
			||||||
 | 
					ensureInstalled = do
 | 
				
			||||||
 | 
						e <- getEnv "OSX_GIT_ANNEX_APP_PROGRAM"
 | 
				
			||||||
 | 
						case e of
 | 
				
			||||||
 | 
							Nothing -> return ()
 | 
				
			||||||
 | 
							Just program -> do
 | 
				
			||||||
 | 
								programfile <- programFile
 | 
				
			||||||
 | 
								createDirectoryIfMissing True (parentDir programfile)
 | 
				
			||||||
 | 
								writeFile programfile program
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
								autostartfile <- userAutoStart autoStartLabel
 | 
				
			||||||
 | 
								installAutoStart program autostartfile
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					{- Installs an autostart plist file for OSX. -}
 | 
				
			||||||
 | 
					installAutoStart :: FilePath -> FilePath -> IO ()
 | 
				
			||||||
 | 
					installAutoStart command file = do
 | 
				
			||||||
 | 
						createDirectoryIfMissing True (parentDir file)
 | 
				
			||||||
 | 
						writeFile file $ genOSXAutoStartFile autoStartLabel command
 | 
				
			||||||
 | 
							["assistant", "--autostart"]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					autoStartLabel :: String
 | 
				
			||||||
 | 
					autoStartLabel = "com.branchable.git-annex.assistant"
 | 
				
			||||||
| 
						 | 
					@ -15,13 +15,13 @@ import Utility.FreeDesktop
 | 
				
			||||||
import Utility.Path
 | 
					import Utility.Path
 | 
				
			||||||
import Utility.Monad
 | 
					import Utility.Monad
 | 
				
			||||||
import Locations.UserConfig
 | 
					import Locations.UserConfig
 | 
				
			||||||
 | 
					import Utility.OSX
 | 
				
			||||||
 | 
					import Assistant.OSX
 | 
				
			||||||
 | 
					
 | 
				
			||||||
import Control.Applicative
 | 
					import Control.Applicative
 | 
				
			||||||
import Control.Monad
 | 
					 | 
				
			||||||
import System.Directory
 | 
					import System.Directory
 | 
				
			||||||
import System.Environment
 | 
					import System.Environment
 | 
				
			||||||
import System.Posix.User
 | 
					import System.Posix.User
 | 
				
			||||||
import System.Posix.Types
 | 
					 | 
				
			||||||
import System.Posix.Files
 | 
					import System.Posix.Files
 | 
				
			||||||
import System.FilePath
 | 
					import System.FilePath
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -46,7 +46,7 @@ autostart command = genDesktopEntry
 | 
				
			||||||
isRoot :: IO Bool
 | 
					isRoot :: IO Bool
 | 
				
			||||||
isRoot = do
 | 
					isRoot = do
 | 
				
			||||||
	uid <- fromIntegral <$> getRealUserID
 | 
						uid <- fromIntegral <$> getRealUserID
 | 
				
			||||||
	return $ uid == 0
 | 
						return $ uid == (0 :: Int)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
inDestDir :: FilePath -> IO FilePath
 | 
					inDestDir :: FilePath -> IO FilePath
 | 
				
			||||||
inDestDir f = do
 | 
					inDestDir f = do
 | 
				
			||||||
| 
						 | 
					@ -63,29 +63,19 @@ writeFDODesktop command = do
 | 
				
			||||||
	writeDesktopMenuFile (autostart command) 
 | 
						writeDesktopMenuFile (autostart command) 
 | 
				
			||||||
		=<< inDestDir (autoStartPath "git-annex" configdir)
 | 
							=<< inDestDir (autoStartPath "git-annex" configdir)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
	ifM isRoot
 | 
					 | 
				
			||||||
		( return ()
 | 
					 | 
				
			||||||
		, do
 | 
					 | 
				
			||||||
			programfile <- inDestDir =<< programFile
 | 
					 | 
				
			||||||
			createDirectoryIfMissing True (parentDir programfile)
 | 
					 | 
				
			||||||
			writeFile programfile command
 | 
					 | 
				
			||||||
		)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
writeOSXDesktop :: FilePath -> IO ()
 | 
					writeOSXDesktop :: FilePath -> IO ()
 | 
				
			||||||
writeOSXDesktop command = do
 | 
					writeOSXDesktop command = do
 | 
				
			||||||
	home <- myHomeDir
 | 
						installAutoStart command =<< inDestDir =<< ifM isRoot
 | 
				
			||||||
 | 
							( return $ systemAutoStart autoStartLabel
 | 
				
			||||||
	let base = "Library" </> "LaunchAgents" </> label ++ ".plist"
 | 
							, userAutoStart autoStartLabel
 | 
				
			||||||
	autostart <- ifM isRoot ( inDestDir $ "/" </> base , inDestDir $ home </> base)
 | 
							)
 | 
				
			||||||
	createDirectoryIfMissing True (parentDir autostart)
 | 
					 | 
				
			||||||
	writeFile autostart $ genOSXAutoStartFile label command
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
						{- Install the OSX app in non-self-contained mode. -}
 | 
				
			||||||
	let appdir = "git-annex.app"
 | 
						let appdir = "git-annex.app"
 | 
				
			||||||
	installOSXAppFile appdir "Contents/Info.plist" Nothing
 | 
						installOSXAppFile appdir "Contents/Info.plist" Nothing
 | 
				
			||||||
	installOSXAppFile appdir "Contents/Resources/git-annex.icns" Nothing
 | 
						installOSXAppFile appdir "Contents/Resources/git-annex.icns" Nothing
 | 
				
			||||||
	installOSXAppFile appdir "Contents/MacOS/git-annex-webapp" (Just webappscript)
 | 
						installOSXAppFile appdir "Contents/MacOS/git-annex-webapp" (Just webappscript)
 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
		label = "com.branchable.git-annex.assistant"
 | 
					 | 
				
			||||||
		webappscript = unlines
 | 
							webappscript = unlines
 | 
				
			||||||
			[ "#!/bin/sh"
 | 
								[ "#!/bin/sh"
 | 
				
			||||||
			, command ++ " webapp"
 | 
								, command ++ " webapp"
 | 
				
			||||||
| 
						 | 
					@ -106,33 +96,20 @@ installOSXAppFile appdir appfile mcontent = do
 | 
				
			||||||
	mode <- fileMode <$> getFileStatus src
 | 
						mode <- fileMode <$> getFileStatus src
 | 
				
			||||||
	setFileMode dest mode
 | 
						setFileMode dest mode
 | 
				
			||||||
 | 
					
 | 
				
			||||||
genOSXAutoStartFile :: String -> String -> String
 | 
					install :: FilePath -> IO ()
 | 
				
			||||||
genOSXAutoStartFile label command = unlines
 | 
					install = do
 | 
				
			||||||
	[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
 | 
					 | 
				
			||||||
	, "<!DOCTYPE plist PUBLIC \"-//Apple//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">"
 | 
					 | 
				
			||||||
	, "<plist version=\"1.0\">"
 | 
					 | 
				
			||||||
	, "<dict>"
 | 
					 | 
				
			||||||
	, "<key>Label</key>"
 | 
					 | 
				
			||||||
	, "<string>" ++ label ++ "</string>"
 | 
					 | 
				
			||||||
	, "<key>ProgramArguments</key>"
 | 
					 | 
				
			||||||
	, "<array>"
 | 
					 | 
				
			||||||
	, "<string>" ++ command ++ "</string>"
 | 
					 | 
				
			||||||
	, "<string>assistant</string>"
 | 
					 | 
				
			||||||
	, "<string>--autostart</string>"
 | 
					 | 
				
			||||||
	, "</array>"
 | 
					 | 
				
			||||||
	, "<key>RunAtLoad</key>"
 | 
					 | 
				
			||||||
	, "</dict>"
 | 
					 | 
				
			||||||
	, "</plist>"
 | 
					 | 
				
			||||||
	]
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
writeDesktop :: FilePath -> IO ()
 | 
					 | 
				
			||||||
#ifdef darwin_HOST_OS
 | 
					#ifdef darwin_HOST_OS
 | 
				
			||||||
writeDesktop = writeOSXDesktop
 | 
						writeOSXDesktop
 | 
				
			||||||
#else
 | 
					#else
 | 
				
			||||||
writeDesktop = writeFDODesktop
 | 
						writeFDODesktop
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
 | 
						unlessM isRoot $ do
 | 
				
			||||||
 | 
							programfile <- inDestDir =<< programFile
 | 
				
			||||||
 | 
							createDirectoryIfMissing True (parentDir programfile)
 | 
				
			||||||
 | 
							writeFile programfile command
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					main :: IO ()
 | 
				
			||||||
main = getArgs >>= go
 | 
					main = getArgs >>= go
 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
		go [] = error "specify git-annex command"
 | 
							go [] = error "specify git-annex command"
 | 
				
			||||||
		go (command:_) = writeDesktop command
 | 
							go (command:_) = install command
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -17,6 +17,7 @@ import Assistant.TransferQueue
 | 
				
			||||||
import Assistant.TransferSlots
 | 
					import Assistant.TransferSlots
 | 
				
			||||||
import Assistant.Threads.WebApp
 | 
					import Assistant.Threads.WebApp
 | 
				
			||||||
import Assistant.WebApp
 | 
					import Assistant.WebApp
 | 
				
			||||||
 | 
					import Assistant.Install
 | 
				
			||||||
import Utility.WebApp
 | 
					import Utility.WebApp
 | 
				
			||||||
import Utility.Daemon (checkDaemon, lockPidFile)
 | 
					import Utility.Daemon (checkDaemon, lockPidFile)
 | 
				
			||||||
import Init
 | 
					import Init
 | 
				
			||||||
| 
						 | 
					@ -39,6 +40,7 @@ seek = [withNothing start]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
start :: CommandStart
 | 
					start :: CommandStart
 | 
				
			||||||
start = notBareRepo $ do
 | 
					start = notBareRepo $ do
 | 
				
			||||||
 | 
						liftIO $ ensureInstalled
 | 
				
			||||||
	ifM isInitialized ( go , liftIO startNoRepo )
 | 
						ifM isInitialized ( go , liftIO startNoRepo )
 | 
				
			||||||
	stop
 | 
						stop
 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										2
									
								
								Setup.hs
									
										
									
									
									
								
							
							
						
						
									
										2
									
								
								Setup.hs
									
										
									
									
									
								
							| 
						 | 
					@ -58,6 +58,6 @@ installManpages copyDest verbosity pkg lbi =
 | 
				
			||||||
 | 
					
 | 
				
			||||||
installDesktopFile :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
 | 
					installDesktopFile :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
 | 
				
			||||||
installDesktopFile copyDest verbosity pkg lbi =
 | 
					installDesktopFile copyDest verbosity pkg lbi =
 | 
				
			||||||
	InstallDesktopFile.writeDesktop $ dstBinDir </> "git-annex"
 | 
						InstallDesktopFile.install $ dstBinDir </> "git-annex"
 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
		dstBinDir = bindir $ absoluteInstallDirs pkg lbi copyDest
 | 
							dstBinDir = bindir $ absoluteInstallDirs pkg lbi copyDest
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										43
									
								
								Utility/OSX.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										43
									
								
								Utility/OSX.hs
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
					@ -0,0 +1,43 @@
 | 
				
			||||||
 | 
					{- OSX stuff
 | 
				
			||||||
 | 
					 -
 | 
				
			||||||
 | 
					 - Copyright 2012 Joey Hess <joey@kitenet.net>
 | 
				
			||||||
 | 
					 -
 | 
				
			||||||
 | 
					 - Licensed under the GNU GPL version 3 or higher.
 | 
				
			||||||
 | 
					 -}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					module Utility.OSX where
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					import Utility.Path
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					import System.FilePath
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					autoStartBase :: String -> FilePath
 | 
				
			||||||
 | 
					autoStartBase label = "Library" </> "LaunchAgents" </> label ++ ".plist"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					systemAutoStart :: String -> FilePath
 | 
				
			||||||
 | 
					systemAutoStart label = "/" </> autoStartBase label
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					userAutoStart :: String -> IO FilePath
 | 
				
			||||||
 | 
					userAutoStart label = do
 | 
				
			||||||
 | 
						home <- myHomeDir
 | 
				
			||||||
 | 
						return $ home </> autoStartBase label
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					{- Generates an OSX autostart plist file with a given label, command, and
 | 
				
			||||||
 | 
					 - params to run at boot or login. -}
 | 
				
			||||||
 | 
					genOSXAutoStartFile :: String -> String -> [String] -> String
 | 
				
			||||||
 | 
					genOSXAutoStartFile label command params = unlines
 | 
				
			||||||
 | 
						[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
 | 
				
			||||||
 | 
						, "<!DOCTYPE plist PUBLIC \"-//Apple//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">"
 | 
				
			||||||
 | 
						, "<plist version=\"1.0\">"
 | 
				
			||||||
 | 
						, "<dict>"
 | 
				
			||||||
 | 
						, "<key>Label</key>"
 | 
				
			||||||
 | 
						, "<string>" ++ label ++ "</string>"
 | 
				
			||||||
 | 
						, "<key>ProgramArguments</key>"
 | 
				
			||||||
 | 
						, "<array>"
 | 
				
			||||||
 | 
						, unlines $ map (\v -> "<string>" ++ v ++ "</string>") (command:params)
 | 
				
			||||||
 | 
						, "</array>"
 | 
				
			||||||
 | 
						, "<key>RunAtLoad</key>"
 | 
				
			||||||
 | 
						, "</dict>"
 | 
				
			||||||
 | 
						, "</plist>"
 | 
				
			||||||
 | 
						]
 | 
				
			||||||
 | 
						
 | 
				
			||||||
| 
						 | 
					@ -8,4 +8,12 @@ if [ ! -e "$base/runshell" ]; then
 | 
				
			||||||
	echo "** cannot find $base/runshell" >&2
 | 
						echo "** cannot find $base/runshell" >&2
 | 
				
			||||||
	exit 1
 | 
						exit 1
 | 
				
			||||||
fi
 | 
					fi
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					# If this is a standalone app, set a variable that git-annex can use to
 | 
				
			||||||
 | 
					# install itself.
 | 
				
			||||||
 | 
					if [ -e "$base/bin/git-annex" ]; then
 | 
				
			||||||
 | 
						GIT_ANNEX_OSX_WEBAPP_PROGRAM="$base/bin/git-annex"
 | 
				
			||||||
 | 
						export OSX_GIT_ANNEX_APP_PROGRAM
 | 
				
			||||||
 | 
					fi
 | 
				
			||||||
 | 
					
 | 
				
			||||||
"$base/runshell" git-annex webapp "$@"
 | 
					"$base/runshell" git-annex webapp "$@"
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue