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
|
{- dfsbuild: CD image builder
Copyright (c) 2006 John Goerzen
Please see COPYRIGHT for more details
-}
module Actions.Mirror where
import Utils
import MissingH.Cmd
import MissingH.ConfigParser
import System.Posix.Directory
import Control.Monad
import Control.Exception
import Data.List
import MissingH.Path
import MissingH.Str
import MissingH.Path.Glob
import System.IO
import Text.Printf
import MissingH.Path
import MissingH.IO.HVFS
mirrorToWorkdir env repos =
do im "Mirroring process starting."
createDirectory mirrordir 0o755
foldM_ (procrepo env) [] repos
where
mirrordir = (wdir env) ++ "/mirror"
procrepo env priorcodenames repo =
do im $ "Running cdebootstrap for " ++ repo
-- First, download the packages.
safeSystem "cdebootstrap" $
archargs ++ debugargs ++ ["-d", suite, targetdir env, mirror]
-- Next, copy them into the mirror.
codename <- getCodeName
(targetdir env ++ "/var/cache/bootstrap/")
dm $ "Codename for this is " ++ codename
mapM_ (\x -> handle (\_ -> return ()) (createDirectory x 0o755))
[mirrordir, mirrordir ++ "/conf"]
safeSystem "touch" [mirrordir ++ "/conf/distributions"]
unless (codename `elem` priorcodenames) $
appendFile (mirrordir ++ "/conf/distributions") $ concat $ intersperse "\n" $
["Origin: Debian",
"Label: Debian",
"Suite: " ++ suite,
"Version: 0.dfs",
"Codename: " ++ codename,
"Architectures: alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc",
"Description: Debian From Scratch cache of " ++ suite,
"Components: main non-free contrib",
"\n\n\n"]
im $ "Running reprepro for " ++ codename
debs <- glob (targetdir env ++ "/var/cache/bootstrap/*.deb")
bracketCWD mirrordir $
mapM_ (\x -> safeSystem "reprepro"
(repdebugargs ++ ["-b", ".", "includedeb",
codename, x])) debs
-- Delete the cdebootstrap cache so the next run has a clean dir
recursiveRemove SystemFS $ targetdir env ++ "/var/cache/bootstrap"
safeSystem "ln" ["-sf", codename, mirrordir ++ "/dists/" ++ suite]
return $ priorcodenames ++ [codename]
where
mirrordir = (wdir env) ++ "/mirror"
sect = "repo " ++ repo
suite = case get (cp env) sect "dlsuite" of
Left _ -> repo
Right x -> strip x
mirror = esget env sect "mirror"
archargs = case get (cp env) sect "arch"
of Left _ -> []
Right a -> ["-a", a]
debugargs = if isDebugging env
then ["--debug", "-v"]
else ["-q"]
repdebugargs = if isDebugging env
then ["-V"]
else []
aptmovecfg = (wdir env) ++ "/apt-move.conf"
|
