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
|
{- 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 Common.Annex
import Types.Distribution
import Build.Version
import Utility.UserInfo
import Utility.Url
import qualified Git.Construct
import qualified Annex
import Annex.Content
import Backend
import Git.Command
import Data.Default
import Data.Time.Clock
import Data.Char
-- 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"]) ++
(map androidversion ["4.0", "4.3"]) ++
[ (autobuild "x86_64-apple-mavericks/git-annex.dmg", "git-annex/OSX/current/10.9_Mavericks/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"
)
androidversion v =
( autobuild ("android/" ++ v ++ "/git-annex.apk")
, "git-annex/android/current/" ++ v ++ "/git-annex.apk"
)
autobuild f = "https://downloads.kitenet.net/git-annex/autobuild/" ++ f
main :: IO ()
main = do
repodir <- getRepoDir
updated <- catMaybes <$> mapM (getbuild repodir) autobuilds
state <- Annex.new =<< Git.Construct.fromPath repodir
Annex.eval state (makeinfos updated)
-- Download a build from the autobuilder, 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
ifM (download url tmp def)
( 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 $ "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)] -> Annex ()
makeinfos updated = do
version <- liftIO getChangelogVersion
void $ inRepo $ runBool
[ Param "commit"
, Param "-a"
, Param "-m"
, Param $ "publishing git-annex " ++ version
]
basedir <- liftIO getRepoDir
now <- liftIO getCurrentTime
liftIO $ putStrLn $ "building info files in " ++ basedir
forM_ updated $ \(f, bv) -> do
v <- lookupFile (basedir </> f)
case v of
Nothing -> noop
Just k -> whenM (inAnnex k) $ do
liftIO $ putStrLn f
let infofile = basedir </> f ++ ".info"
liftIO $ writeFile infofile $ show $ GitAnnexDistribution
{ distributionUrl = mkUrl f
, distributionKey = k
, distributionVersion = bv
, distributionReleasedate = now
, distributionUrgentUpgrade = Nothing
}
void $ inRepo $ runBool [Param "add", File infofile]
signFile infofile
signFile (basedir </> f)
void $ inRepo $ runBool
[ Param "commit"
, Param "-m"
, Param $ "updated info files for git-annex " ++ version
]
void $ inRepo $ runBool
[ Param "annex"
, Params "move --to website"
]
void $ inRepo $ runBool
[ Param "annex"
, Params "sync"
]
-- Check for out of date info files.
infos <- liftIO $ filter (".info" `isSuffixOf`)
<$> dirContentsRecursive (basedir </> "git-annex")
ds <- liftIO $ forM infos (readish <$$> readFile)
let dis = zip infos ds
let ood = filter (outofdate version) dis
unless (null ood) $
error $ "Some info files are out of date: " ++ show (map fst ood)
where
outofdate version (_, 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")]
|