blob: 1bcba70fdf8b06b517478703de75dfef778bf202 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
{- Generating and installing a desktop menu entry file
- and a desktop autostart file. (And OSX equivilants.)
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Build.InstallDesktopFile where
import Utility.Exception
import Utility.FreeDesktop
import Utility.Path
import Utility.Monad
import Locations.UserConfig
import Utility.OSX
import Assistant.Install.AutoStart
import Control.Applicative
import System.Directory
import System.Environment
import System.Posix.User
import System.Posix.Files
import System.FilePath
import Data.Maybe
{- The command can be either just "git-annex", or the full path to use
- to run it. -}
desktop :: FilePath -> DesktopEntry
desktop command = genDesktopEntry
"Git Annex"
"Track and sync the files in your Git Annex"
False
(command ++ " webapp")
["Network", "FileTransfer"]
autostart :: FilePath -> DesktopEntry
autostart command = genDesktopEntry
"Git Annex Assistant"
"Autostart"
False
(command ++ " assistant --autostart")
[]
systemwideInstall :: IO Bool
systemwideInstall = isroot <||> destdirset
where
isroot = do
uid <- fromIntegral <$> getRealUserID
return $ uid == (0 :: Int)
destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR")
inDestDir :: FilePath -> IO FilePath
inDestDir f = do
destdir <- catchDefaultIO "" (getEnv "DESTDIR")
return $ destdir ++ "/" ++ f
writeFDODesktop :: FilePath -> IO ()
writeFDODesktop command = do
datadir <- ifM systemwideInstall ( return systemDataDir, userDataDir )
writeDesktopMenuFile (desktop command)
=<< inDestDir (desktopMenuFilePath "git-annex" datadir)
configdir <- ifM systemwideInstall ( return systemConfigDir, userConfigDir )
installAutoStart command
=<< inDestDir (autoStartPath "git-annex" configdir)
writeOSXDesktop :: FilePath -> IO ()
writeOSXDesktop command = do
installAutoStart command =<< inDestDir =<< ifM systemwideInstall
( return $ systemAutoStart osxAutoStartLabel
, userAutoStart osxAutoStartLabel
)
{- Install the OSX app in non-self-contained mode. -}
let appdir = "git-annex.app"
installOSXAppFile appdir "Contents/Info.plist" Nothing
installOSXAppFile appdir "Contents/Resources/git-annex.icns" Nothing
installOSXAppFile appdir "Contents/MacOS/git-annex-webapp" (Just webappscript)
where
webappscript = unlines
[ "#!/bin/sh"
, command ++ " webapp"
]
installOSXAppFile :: FilePath -> FilePath -> Maybe String -> IO ()
installOSXAppFile appdir appfile mcontent = do
let src = "standalone" </> "osx" </> appdir </> appfile
home <- myHomeDir
dest <- ifM systemwideInstall
( return $ "/Applications" </> appdir </> appfile
, return $ home </> "Desktop" </> appdir </> appfile
)
createDirectoryIfMissing True (parentDir dest)
case mcontent of
Just content -> writeFile dest content
Nothing -> copyFile src dest
mode <- fileMode <$> getFileStatus src
setFileMode dest mode
install :: FilePath -> IO ()
install command = do
#ifdef darwin_HOST_OS
writeOSXDesktop command
#else
writeFDODesktop command
#endif
ifM systemwideInstall
( return ()
, do
programfile <- inDestDir =<< programFile
createDirectoryIfMissing True (parentDir programfile)
writeFile programfile command
)
main :: IO ()
main = getArgs >>= go
where
go [] = error "specify git-annex command"
go (command:_) = install command
|
