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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
{- Downloads git-annex autobuilds and installs them into the git-annex
- repository in ~/lib/downloads that is used to distribute git-annex
- releases.
-
- Generates info files, containing the version (of the corresponding file
- from the autobuild).
-
- Also gpg signs the files.
-}
import Annex.Common
import Types.Distribution
import Build.Version (getChangelogVersion, Version)
import Utility.UserInfo
import Utility.Url
import Utility.Tmp.Dir
import Utility.Metered
import qualified Git.Construct
import qualified Annex
import Annex.Content
import Annex.WorkTree
import Git.Command
import Data.Time.Clock
import Data.Char
import System.Posix.Directory
-- git-annex distribution signing key (for Joey Hess)
signingKey :: String
signingKey = "89C809CB"
-- URL to an autobuilt git-annex file, and the place to install
-- it in the repository.
autobuilds :: [(URLString, FilePath)]
autobuilds =
(map linuxarch ["i386", "amd64", "armel", "arm64", "i386-ancient"]) ++
[ (autobuild "x86_64-apple-yosemite/git-annex.dmg", "git-annex/OSX/current/10.10_Yosemite/git-annex.dmg")
, (autobuild "windows/git-annex-installer.exe", "git-annex/windows/current/git-annex-installer.exe")
]
where
linuxarch a =
( autobuild (a ++ "/git-annex-standalone-" ++ a ++ ".tar.gz")
, "git-annex/linux/current/git-annex-standalone-" ++ a ++ ".tar.gz"
)
autobuild f = "https://downloads.kitenet.net/git-annex/autobuild/" ++ f
main :: IO ()
main = do
useFileSystemEncoding
version <- liftIO getChangelogVersion
repodir <- getRepoDir
changeWorkingDirectory repodir
updated <- catMaybes <$> mapM (getbuild repodir) autobuilds
state <- Annex.new =<< Git.Construct.fromPath "."
Annex.eval state (makeinfos updated version)
-- Download a build from the autobuilder, virus check it, and return its
-- version.
-- It's very important that the version matches the build, otherwise
-- auto-upgrades can loop reatedly. So, check build-version before
-- and after downloading the file.
getbuild :: FilePath -> (URLString, FilePath) -> IO (Maybe (FilePath, Version))
getbuild repodir (url, f) = do
bv1 <- getbv
let dest = repodir </> f
let tmp = dest ++ ".tmp"
nukeFile tmp
createDirectoryIfMissing True (parentDir dest)
let oops s = do
nukeFile tmp
putStrLn $ "*** " ++ s
return Nothing
uo <- defUrlOptions
ifM (download nullMeterUpdate url tmp uo)
( ifM (liftIO $ virusFree tmp)
( do
bv2 <- getbv
case bv2 of
Nothing -> oops $ "no build-version file for " ++ url
(Just v)
| bv2 == bv1 -> do
nukeFile dest
renameFile tmp dest
-- remove git rev part of version
let v' = takeWhile (/= '-') v
return $ Just (f, v')
| otherwise -> oops $ "build version changed while downloading " ++ url ++ " " ++ show (bv1, bv2)
, oops $ "VIRUS detected in " ++ url
)
, oops $ "failed to download " ++ url
)
where
bvurl = takeDirectory url ++ "/build-version"
getbv = do
bv <- catchDefaultIO "" $ readProcess "curl" ["--silent", bvurl]
return $ if null bv || any (not . versionchar) bv then Nothing else Just bv
versionchar c = isAlphaNum c || c == '.' || c == '-'
makeinfos :: [(FilePath, Version)] -> Version -> Annex ()
makeinfos updated version = do
mapM_ (\f -> inRepo $ runBool [Param "annex", Param "add", File f]) (map fst updated)
void $ inRepo $ runBool
[ Param "commit"
, Param "-a"
, Param ("-S" ++ signingKey)
, Param "-m"
, Param $ "publishing git-annex " ++ version
]
now <- liftIO getCurrentTime
liftIO $ putStrLn $ "building info files"
forM_ updated $ \(f, bv) -> do
v <- lookupFile f
case v of
Nothing -> noop
Just k -> whenM (inAnnex k) $ do
liftIO $ putStrLn f
let infofile = f ++ ".info"
let d = GitAnnexDistribution
{ distributionUrl = mkUrl f
, distributionKey = k
, distributionVersion = bv
, distributionReleasedate = now
, distributionUrgentUpgrade = Just "6.20180626"
}
liftIO $ writeFile infofile $ formatInfoFile d
void $ inRepo $ runBool [Param "add", File infofile]
signFile infofile
signFile f
void $ inRepo $ runBool
[ Param "commit"
, Param ("-S" ++ signingKey)
, Param "-m"
, Param $ "updated info files for git-annex " ++ version
]
void $ inRepo $ runBool
[ Param "annex"
, Param "move"
, Param "--to"
, Param "website"
]
void $ inRepo $ runBool
[ Param "annex"
, Param "sync"
]
-- Check for out of date info files.
infos <- liftIO $ filter (".info" `isSuffixOf`)
<$> dirContentsRecursive "git-annex"
ds <- liftIO $ forM infos (readish <$$> readFile)
let dis = zip infos ds
let ood = filter outofdate dis
unless (null ood) $
error $ "Some info files are out of date: " ++ show (map fst ood)
where
outofdate (_, md) = case md of
Nothing -> True
Just d -> distributionVersion d /= version
getRepoDir :: IO FilePath
getRepoDir = do
home <- liftIO myHomeDir
return $ home </> "lib" </> "downloads"
mkUrl :: FilePath -> String
mkUrl f = "https://downloads.kitenet.net/" ++ f
signFile :: FilePath -> Annex ()
signFile f = do
void $ liftIO $ boolSystem "gpg"
[ Param "-a"
, Param $ "--default-key=" ++ signingKey
, Param "--detach-sign"
, File f
]
liftIO $ rename (f ++ ".asc") (f ++ ".sig")
void $ inRepo $ runBool [Param "add", File (f ++ ".sig")]
-- clamscan should handle unpacking archives, but did not in my
-- testing, so do it manually.
virusFree :: FilePath -> IO Bool
virusFree f
| ".tar.gz" `isSuffixOf` f = unpack $ \tmpdir ->
boolSystem "tar" [ Param "xf", File f, Param "-C", File tmpdir ]
| ".dmg" `isSuffixOf` f = unpack $ \tmpdir -> do
-- 7z can extract partitions from a dmg, and then
-- run on partitions can extract their files
unhfs tmpdir f
parts <- filter (".hfs" `isSuffixOf`) <$> getDirectoryContents tmpdir
forM_ parts $ unhfs tmpdir
return True
| otherwise = clamscan f
where
clamscan f' = boolSystem "clamscan"
[ Param "--no-summary"
, Param "-r"
, Param f'
]
unpack unpacker = withTmpDir "clamscan" $ \tmpdir -> do
unlessM (unpacker tmpdir) $
error $ "Failed to unpack " ++ f ++ " for virus scan"
clamscan tmpdir
unhfs dest f' = unlessM (boolSystem "7z" [ Param "x", Param ("-o" ++ dest), File f' ]) $
error $ "Failed extracting hfs " ++ f'
|
