blob: 2c4d8249543341b2580ff39119c0aed84514399e (
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
|
{- Builds distributon info files for each git-annex release in a directory
- tree, which must itself be part of a git-annex repository. Only files
- that are present have their info file created. -}
import Common.Annex
import Types.Distribution
import Build.Version
import Utility.UserInfo
import Utility.Path
import qualified Git.Construct
import qualified Annex
import Annex.Content
import Backend
import Git.Command
import Data.Time.Clock
main = do
state <- Annex.new =<< Git.Construct.fromPath =<< getRepoDir
Annex.eval state makeinfos
makeinfos :: Annex ()
makeinfos = do
basedir <- liftIO getRepoDir
version <- liftIO getChangelogVersion
now <- liftIO getCurrentTime
liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir
fs <- liftIO $ dirContentsRecursiveSkipping (const False) True (basedir </> "git-annex")
forM_ fs $ \f -> do
v <- lookupFile f
case v of
Nothing -> noop
Just (k, _b) -> whenM (inAnnex k) $ do
liftIO $ putStrLn f
let infofile = f ++ ".info"
liftIO $ writeFile infofile $ show $ GitAnnexDistribution
{ distributionUrl = mkUrl basedir f
, distributionKey = k
, distributionVersion = version
, distributionReleasedate = now
, distributionUrgentUpgrade = Nothing
}
void $ inRepo $ runBool [Param "add", Param infofile]
void $ inRepo $ runBool
[ Param "commit"
, Param "-m"
, Param $ "publishing 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 -> FilePath -> String
mkUrl basedir f = "https://downloads.kitenet.net/" ++ relPathDirToFile basedir f
|
