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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
{- Assistant installation
-
- Copyright 2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Assistant.Install where
import Assistant.Common
import Assistant.Install.AutoStart
import Config.Files
import Utility.FileMode
import Utility.Shell
import Utility.Tmp
import Utility.Env
import Utility.SshConfig
import qualified Utility.FileIO as F
#ifdef darwin_HOST_OS
import Utility.OSX
#else
import Utility.FreeDesktop
import Assistant.Install.Menu
import Utility.UserInfo
import Utility.Android
#endif
import System.PosixCompat.Files (ownerExecuteMode)
import qualified Data.ByteString.Char8 as S8
standaloneAppBase :: IO (Maybe OsPath)
standaloneAppBase = fmap toOsPath <$> getEnv "GIT_ANNEX_APP_BASE"
{- 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 the
- git-annex-shell and git-annex-wrapper wrapper scripts into ~/.ssh
-
- 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.
-
- File manager hook script installation is done even for
- packaged apps, since it has to go into the user's home directory.
-}
ensureInstalled :: IO ()
ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL")
( go Nothing
, go =<< standaloneAppBase
)
where
go Nothing = installFileManagerHooks (literalOsPath "git-annex")
go (Just base) = do
let program = base </> literalOsPath "git-annex"
programfile <- programFile
createDirectoryIfMissing True (parentDir programfile)
writeFile (fromOsPath programfile) (fromOsPath program)
#ifdef darwin_HOST_OS
autostartfile <- userAutoStart osxAutoStartLabel
installAutoStart (fromOsPath program) autostartfile
#else
ifM osAndroid
( do
-- Integration with the Termux:Boot app.
home <- myHomeDir
let bootfile = toOsPath home </> literalOsPath ".termux" </> literalOsPath "boot" </> literalOsPath "git-annex"
unlessM (doesFileExist bootfile) $ do
createDirectoryIfMissing True (takeDirectory bootfile)
writeFile (fromOsPath bootfile) "git-annex assistant --autostart"
, do
menufile <- desktopMenuFilePath "git-annex" <$> userDataDir
icondir <- iconDir <$> userDataDir
installMenu (fromOsPath program) menufile base icondir
autostartfile <- autoStartPath "git-annex" <$> userConfigDir
installAutoStart (fromOsPath program) autostartfile
)
#endif
sshdir <- sshDir
let runshell var = "exec " ++ fromOsPath (base </> literalOsPath "runshell ") ++ var
let rungitannexshell var = runshell $ "git-annex-shell -c \"" ++ var ++ "\""
installWrapper (sshdir </> literalOsPath "git-annex-shell") $
[ shebang
, "set -e"
, "if [ \"x$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then"
, rungitannexshell "$SSH_ORIGINAL_COMMAND"
, "else"
, rungitannexshell "$@"
, "fi"
]
installWrapper (sshdir </> literalOsPath "git-annex-wrapper") $
[ shebang
, "set -e"
, runshell "\"$@\""
]
installFileManagerHooks program
installWrapper :: OsPath -> [String] -> IO ()
installWrapper file content = do
let content' = map encodeBS content
curr <- catchDefaultIO [] $ fileLines' <$> F.readFile' file
when (curr /= content') $ do
createDirectoryIfMissing True (parentDir file)
viaTmp F.writeFile' file $ linesFile' (S8.unlines content')
modifyFileMode file $ addModes [ownerExecuteMode]
installFileManagerHooks :: OsPath -> IO ()
#ifdef linux_HOST_OS
installFileManagerHooks program = unlessM osAndroid $ do
let actions = ["get", "drop", "undo"]
-- Gnome
nautilusScriptdir <- (\d -> d </> literalOsPath "nautilus" </> literalOsPath "scripts") <$> userDataDir
createDirectoryIfMissing True nautilusScriptdir
forM_ actions $
genNautilusScript nautilusScriptdir
-- KDE
userdata <- userDataDir
let kdeServiceMenusdir = userdata </> literalOsPath "kservices5" </> literalOsPath "ServiceMenus"
createDirectoryIfMissing True kdeServiceMenusdir
writeFile (fromOsPath (kdeServiceMenusdir </> literalOsPath "git-annex.desktop"))
(kdeDesktopFile actions)
where
genNautilusScript scriptdir action =
installscript (scriptdir </> toOsPath (scriptname action)) $ unlines
[ shebang
, autoaddedcomment
, "exec " ++ fromOsPath program ++ " " ++ action ++ " --notify-start --notify-finish -- \"$@\""
]
scriptname action = "git-annex " ++ action
installscript f c = whenM (safetoinstallscript f) $ do
writeFile (fromOsPath f) c
modifyFileMode f $ addModes [ownerExecuteMode]
safetoinstallscript f = catchDefaultIO True $
elem (encodeBS autoaddedcomment) . fileLines'
<$> F.readFile' f
autoaddedcomment = "# " ++ autoaddedmsg ++ " (To disable, chmod 600 this file.)"
autoaddedmsg = "Automatically added by git-annex, do not edit."
kdeDesktopFile actions = unlines $ concat $
kdeDesktopHeader actions : map kdeDesktopAction actions
kdeDesktopHeader actions =
[ "# " ++ autoaddedmsg
, "[Desktop Entry]"
, "Type=Service"
, "ServiceTypes=all/allfiles"
, "MimeType=all/all;"
, "Actions=" ++ intercalate ";" (map kdeDesktopSection actions)
, "X-KDE-Priority=TopLevel"
, "X-KDE-Submenu=Git-Annex"
, "X-KDE-Icon=git-annex"
, "X-KDE-ServiceTypes=KonqPopupMenu/Plugin"
]
kdeDesktopSection command = "GitAnnex" ++ command
kdeDesktopAction command =
[ ""
, "[Desktop Action " ++ kdeDesktopSection command ++ "]"
, "Name=" ++ command
, "Icon=git-annex"
, unwords
[ "Exec=sh -c 'cd \"$(dirname \"$1\")\" &&"
, fromOsPath program
, command
, "--notify-start --notify-finish -- \"$1\"'"
, "false" -- this becomes $0 in sh, so unused
, "%f"
]
]
#else
installFileManagerHooks _ = noop
#endif
|
