summaryrefslogtreecommitdiff
path: root/Propellor/Property/Docker.hs
blob: e05a8dd310614b8ff990b0bd13a03fe196275185 (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
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
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
{-# LANGUAGE BangPatterns #-}

-- | Docker support for propellor
--
-- The existance of a docker container is just another Property of a system,
-- which propellor can set up. See config.hs for an example.

module Propellor.Property.Docker where

import Propellor
import Propellor.SimpleSh
import Propellor.Types.Attr
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Docker.Shim as Shim
import Utility.SafeCommand
import Utility.Path

import Control.Concurrent.Async
import System.Posix.Directory
import System.Posix.Process
import Data.List
import Data.List.Utils

-- | Configures docker with an authentication file, so that images can be
-- pushed to index.docker.io.
configured :: Property
configured = property "docker configured" go `requires` installed
  where
	go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $ 
		"/root/.dockercfg" `File.hasContent` (lines cfg)

installed :: Property
installed = Apt.installed ["docker.io"]

-- | A short descriptive name for a container.
-- Should not contain whitespace or other unusual characters,
-- only [a-zA-Z0-9_-] are allowed
type ContainerName = String

-- | Starts accumulating the properties of a Docker container.
--
-- > container "web-server" "debian"
-- >    & publish "80:80"
-- >    & Apt.installed {"apache2"]
-- >    & ...
container :: ContainerName -> Image -> Host
container cn image = Host [] (\_ -> attr)
  where
	attr = (newAttr (cn2hn cn)) { _dockerImage = Just image }

cn2hn :: ContainerName -> HostName
cn2hn cn = cn ++ ".docker"

-- | Ensures that a docker container is set up and running. The container
-- has its own Properties which are handled by running propellor
-- inside the container.
--
-- Reverting this property ensures that the container is stopped and
-- removed.
docked
	:: [Host]
	-> ContainerName
	-> RevertableProperty
docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown)
  where
	go desc a = property (desc ++ " " ++ cn) $ do
		hn <- getHostName
  		let cid = ContainerId hn cn
		ensureProperties [findContainer hosts cid cn $ a cid]

	setup cid (Container image runparams) =
		provisionContainer cid
			`requires`
		runningContainer cid image runparams
			`requires`
		installed

	teardown cid (Container image _runparams) =
		combineProperties ("undocked " ++ fromContainerId cid)
			[ stoppedContainer cid
			, property ("cleaned up " ++ fromContainerId cid) $
				liftIO $ report <$> mapM id
					[ removeContainer cid
					, removeImage image
					]
			]

findContainer
	:: [Host]
	-> ContainerId
	-> ContainerName
	-> (Container -> Property)
	-> Property
findContainer hosts cid cn mk = case findHost hosts (cn2hn cn) of
	Nothing -> cantfind
	Just h -> maybe cantfind mk (mkContainer cid h)
  where
	cantfind = containerDesc cid $ property "" $ do
		liftIO $ warningMessage $
			"missing definition for docker container \"" ++ cn2hn cn
		return FailedChange

mkContainer :: ContainerId -> Host -> Maybe Container
mkContainer cid@(ContainerId hn _cn) h = Container
	<$> _dockerImage attr
	<*> pure (map (\a -> a hn) (_dockerRunParams attr))
  where
	attr = hostAttr h'
  	h' = h
		-- expose propellor directory inside the container
		& volume (localdir++":"++localdir)
		-- name the container in a predictable way so we
		-- and the user can easily find it later
		& name (fromContainerId cid)

-- | Causes *any* docker images that are not in use by running containers to
-- be deleted. And deletes any containers that propellor has set up
-- before that are not currently running. Does not delete any containers
-- that were not set up using propellor.
--
-- Generally, should come after the properties for the desired containers.
garbageCollected :: Property
garbageCollected = propertyList "docker garbage collected"
	[ gccontainers
	, gcimages
	]
  where
	gccontainers = property "docker containers garbage collected" $
		liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
	gcimages = property "docker images garbage collected" $ do
		liftIO $ report <$> (mapM removeImage =<< listImages)

data Container = Container Image [RunParam]

-- | Parameters to pass to `docker run` when creating a container.
type RunParam = String

-- | A docker image, that can be used to run a container.
type Image = String

-- | Set custom dns server for container.
dns :: String -> Property
dns = runProp "dns"

-- | Set container host name.
hostname :: String -> Property
hostname = runProp "hostname"

-- | Set name for container. (Normally done automatically.)
name :: String -> Property
name = runProp "name"

-- | Publish a container's port to the host
-- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
publish :: String -> Property
publish = runProp "publish"

-- | Username or UID for container.
user :: String -> Property
user = runProp "user"

-- | Mount a volume
-- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]
-- With just a directory, creates a volume in the container.
volume :: String -> Property
volume = runProp "volume"

-- | Mount a volume from the specified container into the current
-- container.
volumes_from :: ContainerName -> Property
volumes_from cn = genProp "volumes-from" $ \hn ->
	fromContainerId (ContainerId hn cn)

-- | Work dir inside the container. 
workdir :: String -> Property
workdir = runProp "workdir"

-- | Memory limit for container.
--Format: <number><optional unit>, where unit = b, k, m or g
memory :: String -> Property
memory = runProp "memory"

-- | Link with another container on the same host.
link :: ContainerName -> ContainerAlias -> Property
link linkwith alias = genProp "link" $ \hn ->
	fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias

-- | A short alias for a linked container.
-- Each container has its own alias namespace.
type ContainerAlias = String

-- | A container is identified by its name, and the host
-- on which it's deployed.
data ContainerId = ContainerId HostName ContainerName
	deriving (Eq, Read, Show)

-- | Two containers with the same ContainerIdent were started from
-- the same base image (possibly a different version though), and
-- with the same RunParams.
data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
	deriving (Read, Show, Eq)

ident2id :: ContainerIdent -> ContainerId
ident2id (ContainerIdent _ hn cn _) = ContainerId hn cn

toContainerId :: String -> Maybe ContainerId
toContainerId s
	| myContainerSuffix `isSuffixOf` s = case separate (== '.') (desuffix s) of
		(cn, hn)
			| null hn || null cn -> Nothing
			| otherwise -> Just $ ContainerId hn cn
	| otherwise = Nothing
  where
	desuffix = reverse . drop len . reverse
	len = length myContainerSuffix

fromContainerId :: ContainerId -> String
fromContainerId (ContainerId hn cn) = cn++"."++hn++myContainerSuffix

containerHostName :: ContainerId -> HostName
containerHostName (ContainerId _ cn) = cn2hn cn

myContainerSuffix :: String
myContainerSuffix = ".propellor"

containerDesc :: ContainerId -> Property -> Property
containerDesc cid p = p `describe` desc
  where
	desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p

runningContainer :: ContainerId -> Image -> [RunParam] -> Property
runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
	l <- liftIO $ listContainers RunningContainers
	if cid `elem` l
		then do
			-- Check if the ident has changed; if so the
			-- parameters of the container differ and it must
			-- be restarted.
			runningident <- liftIO $ getrunningident
			if runningident == Just ident
				then noChange
				else do
					void $ liftIO $ stopContainer cid
					restartcontainer
		else ifM (liftIO $ elem cid <$> listContainers AllContainers)
			( restartcontainer
			, go image
			)
  where
	ident = ContainerIdent image hn cn runps

	restartcontainer = do
		oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
		void $ liftIO $ removeContainer cid
		go oldimage

	getrunningident :: IO (Maybe ContainerIdent)
	getrunningident = simpleShClient (namedPipe cid) "cat" [propellorIdent] $ \rs -> do
		let !v = extractident rs
		return v

	extractident :: [Resp] -> Maybe ContainerIdent
	extractident = headMaybe . catMaybes . map readish . catMaybes . map getStdout

	go img = do
		liftIO $ do
			clearProvisionedFlag cid
			createDirectoryIfMissing True (takeDirectory $ identFile cid)
		shim <- liftIO $ Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
		liftIO $ writeFile (identFile cid) (show ident)
		ensureProperty $ boolProperty "run" $ runContainer img
			(runps ++ ["-i", "-d", "-t"])
			[shim, "--docker", fromContainerId cid]

-- | Called when propellor is running inside a docker container.
-- The string should be the container's ContainerId.
--
-- This process is effectively init inside the container.
-- It even needs to wait on zombie processes!
--
-- Fork a thread to run the SimpleSh server in the background.
-- In the foreground, run an interactive bash (or sh) shell,
-- so that the user can interact with it when attached to the container.
--
-- When the system reboots, docker restarts the container, and this is run
-- again. So, to make the necessary services get started on boot, this needs
-- to provision the container then. However, if the container is already
-- being provisioned by the calling propellor, it would be redundant and
-- problimatic to also provisoon it here.
--
-- The solution is a flag file. If the flag file exists, then the container
-- was already provisioned. So, it must be a reboot, and time to provision
-- again. If the flag file doesn't exist, don't provision here.
chain :: String -> IO ()
chain s = case toContainerId s of
	Nothing -> error $ "Invalid ContainerId: " ++ s
	Just cid -> do
		changeWorkingDirectory localdir
		writeFile propellorIdent . show =<< readIdentFile cid
		-- Run boot provisioning before starting simpleSh,
		-- to avoid ever provisioning twice at the same time.
		whenM (checkProvisionedFlag cid) $ do
			let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
			unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ containerHostName cid]) $
				warningMessage "Boot provision failed!"
		void $ async $ job reapzombies
		void $ async $ job $ simpleSh $ namedPipe cid
		job $ do
			void $ tryIO $ ifM (inPath "bash")
				( boolSystem "bash" [Param "-l"]
				, boolSystem "/bin/sh" []
				)
			putStrLn "Container is still running. Press ^P^Q to detach."
  where
	job = forever . void . tryIO
	reapzombies = void $ getAnyProcessStatus True False

-- | Once a container is running, propellor can be run inside
-- it to provision it.
--
-- Note that there is a race here, between the simplesh
-- server starting up in the container, and this property
-- being run. So, retry connections to the client for up to
-- 1 minute.
provisionContainer :: ContainerId -> Property
provisionContainer cid = containerDesc cid $ property "provision" $ liftIO $ do
	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
	r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
	when (r /= FailedChange) $
		setProvisionedFlag cid 
	return r
  where
	params = ["--continue", show $ Chain $ containerHostName cid]

	go lastline (v:rest) = case v of
		StdoutLine s -> do
			debug ["stdout: ", show s]
			maybe noop putStrLn lastline
			hFlush stdout
			go (Just s) rest
		StderrLine s -> do
			debug ["stderr: ", show s]
			maybe noop putStrLn lastline
			hFlush stdout
			hPutStrLn stderr s
			hFlush stderr
			go Nothing rest
		Done -> ret lastline
	go lastline [] = ret lastline

	ret lastline = return $ fromMaybe FailedChange $
		readish =<< lastline

stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]

stoppedContainer :: ContainerId -> Property
stoppedContainer cid = containerDesc cid $ property desc $ 
	ifM (liftIO $ elem cid <$> listContainers RunningContainers)
		( liftIO cleanup `after` ensureProperty 
			(boolProperty desc $ stopContainer cid)
		, return NoChange
		)
  where
	desc = "stopped"
	cleanup = do
		nukeFile $ namedPipe cid
		nukeFile $ identFile cid
		removeDirectoryRecursive $ shimdir cid
		clearProvisionedFlag cid

removeContainer :: ContainerId -> IO Bool
removeContainer cid = catchBoolIO $
	snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing

removeImage :: Image -> IO Bool
removeImage image = catchBoolIO $
	snd <$> processTranscript dockercmd ["rmi", image ] Nothing

runContainer :: Image -> [RunParam] -> [String] -> IO Bool
runContainer image ps cmd = boolSystem dockercmd $ map Param $
	"run" : (ps ++ image : cmd)

commitContainer :: ContainerId -> IO (Maybe Image)
commitContainer cid = catchMaybeIO $
	takeWhile (/= '\n') 
		<$> readProcess dockercmd ["commit", fromContainerId cid]

data ContainerFilter = RunningContainers | AllContainers
	deriving (Eq)

-- | Only lists propellor managed containers.
listContainers :: ContainerFilter -> IO [ContainerId]
listContainers status = 
	catMaybes . map toContainerId . concat . map (split ",")
		. catMaybes . map (lastMaybe . words) . lines
		<$> readProcess dockercmd ps
  where
	ps
		| status == AllContainers = baseps ++ ["--all"]
		| otherwise = baseps
	baseps = ["ps", "--no-trunc"]

listImages :: IO [Image]
listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]

runProp :: String -> RunParam -> Property
runProp field val = pureAttrProperty (param) $ \attr ->
	attr { _dockerRunParams = _dockerRunParams attr ++ [\_ -> "--"++param] }
  where
	param = field++"="++val

genProp :: String -> (HostName -> RunParam) -> Property
genProp field mkval = pureAttrProperty field $ \attr ->
	attr { _dockerRunParams = _dockerRunParams attr ++ [\hn -> "--"++field++"=" ++ mkval hn] }

-- | The ContainerIdent of a container is written to
-- /.propellor-ident inside it. This can be checked to see if
-- the container has the same ident later.
propellorIdent :: FilePath
propellorIdent = "/.propellor-ident"

-- | Named pipe used for communication with the container.
namedPipe :: ContainerId -> FilePath
namedPipe cid = "docker" </> fromContainerId cid

provisionedFlag :: ContainerId -> FilePath
provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"

clearProvisionedFlag :: ContainerId -> IO ()
clearProvisionedFlag = nukeFile . provisionedFlag

setProvisionedFlag :: ContainerId -> IO ()
setProvisionedFlag cid = do
	createDirectoryIfMissing True (takeDirectory (provisionedFlag cid))
	writeFile (provisionedFlag cid) "1"

checkProvisionedFlag :: ContainerId -> IO Bool
checkProvisionedFlag = doesFileExist . provisionedFlag

shimdir :: ContainerId -> FilePath
shimdir cid = "docker" </> fromContainerId cid ++ ".shim"

identFile :: ContainerId -> FilePath
identFile cid = "docker" </> fromContainerId cid ++ ".ident"

readIdentFile :: ContainerId -> IO ContainerIdent
readIdentFile cid = fromMaybe (error "bad ident in identFile")
	. readish <$> readFile (identFile cid)

dockercmd :: String
dockercmd = "docker.io"

report :: [Bool] -> Result
report rmed
	| or rmed = MadeChange
	| otherwise = NoChange
d1 01 b4 4c 96 1e d4 08 f6 51 d0 96 37 4d fd 88 |\g.#...U.d...k....L.....Q..7M.. 42c0 d6 56 be 93 87 75 de b5 96 f8 84 87 1c 1b 05 c5 6c c9 62 e7 a8 b5 af 5f ab ad b3 fd ba b6 46 c1 .V...u..........l.b...._......F. 42e0 5b c5 c8 1a 5f 69 c3 e7 78 0c fb 6c 20 9e 20 33 d9 c1 35 dc 2b 9e 42 8c 24 38 d3 21 5d 21 1a b6 [..._i..x..l...3..5.+.B.$8.!]!.. 4300 2c 91 16 9a 42 61 28 f4 17 65 f2 95 d7 12 a4 ed be 81 75 71 d7 81 96 b7 8a 91 39 25 20 58 b0 9f ,...Ba(..e........uq......9%.X.. 4320 7a 33 5c 6f 49 76 68 b2 bc 22 07 86 90 a9 9d af 9d b2 46 ce f5 74 32 0c ba 60 9e 2a 2b 0e 2a e9 z3\oIvh.."........F..t2..`.*+.*. 4340 6c 4b 85 15 aa e7 ab fb b6 42 c5 5b c5 88 9c 52 1d 86 5e 34 e3 7e b3 8a 4e 42 96 21 49 11 ec eb lK.......B.[...R..^4.~..NB.!I... 4360 30 6c c0 6c 3f e7 1e b3 a6 8d 93 7d 2d 16 03 fd 72 fc 79 81 ac 83 ea 86 5e 2a 8c 70 c6 df 5b 76 0l.l?......}-...r.y.....^*.p..[v 4380 74 3f 79 ab 18 41 76 ad db 5a 53 ee 37 cb d1 16 64 b7 6e 0c 73 3c 44 5d a5 2b e7 5c bf 6a 95 d6 t?y..Av..ZS.7...d.n.s<D].+.\.j.. 43a0 6d dd 87 04 5f 92 96 25 02 2a 10 b1 37 9f be b3 f2 9a 1c d5 a6 bf 8a 91 09 54 ed 7e 73 bd 38 60 m..._..%.*..7............T.~s.8` 43c0 bc f0 5d 70 2d 81 5a f3 7c 33 20 cd 5a b5 d3 e9 54 8e dc 83 b1 e3 6c 6a c3 fb e8 57 6a b5 5a ab ..]p-.Z.|3..Z...T.....lj...Wj.Z. 43e0 d4 34 8b 72 db 36 8a 02 f7 56 ef 07 b0 0c 42 03 0f b8 a2 38 64 d9 9f ec 62 e8 a3 39 ad 7a a4 6f .4.r.6...V....B....8d...b..9.z.o 4400 95 59 ee 44 f6 0c 95 8b c7 5e 20 1a 94 aa fd 7e a5 b4 7d 2a 4b d7 d5 55 fb 73 01 ad 82 be 21 b4 .Y.D.....^.....~..}*K..U.s....!. 4420 97 c7 bc c6 15 5a 15 a7 76 3f 5f bf 3e 33 54 29 bb b3 6d 23 a2 74 f2 10 6a 34 fb 24 c3 f6 01 0a .....Z..v?_.>3T)..m#.t..j4.$.... 4440 88 ec e7 93 06 cd 25 76 d3 0c f0 d7 0b c5 66 ab d5 2c e6 dd c7 be 8b 55 75 c7 b5 7e 09 7c 47 90 ......%v......f..,.....Uu..~.|G. 4460 d2 05 eb 1e 4d f5 36 0b a5 56 ad dd ae 54 aa 1d 53 c5 9f 77 35 51 16 64 91 ec 82 ec e4 d0 18 43 ....M.6..V...T..S..w5Q.d.......C 4480 cb 64 03 9e 30 f0 d1 ba a4 d8 aa d5 9a fb 88 de d0 ed b0 37 8d 52 45 92 aa 53 2b da d9 a4 45 07 .d..0..............7.RE..S+...E. 44a0 dd fd df d4 c6 58 54 16 e3 61 26 ea f5 46 b1 a5 29 9b ab f1 51 8b fe 2a 06 95 c6 50 7f f6 5f 07 .....XT..a&..F..)...Q..*...P.._. 44c0 69 02 f7 06 7f 6c d9 52 e2 b5 f5 5b 3b 9b 34 70 44 81 88 2e b4 75 69 62 f5 9f 51 ab 79 da c7 56 i....l.R...[;.4pD....uib..Q.y..V 44e0 77 56 f1 2a 6d 1d a5 27 6f 0b a8 34 e1 6a 76 12 64 88 b2 cb e0 b9 75 4f 9e 1e 97 c9 00 3c 4e e3 wV.*m..'o..4.jv.d.....uO.....<N. 4500 43 83 2b 4a 25 57 76 d5 fb c0 aa 4a e5 5b a0 6a 5c 2c 33 ce b0 73 9a f6 a9 d5 13 8b f0 a2 3e 74 C.+J%Wv....J.[.j\,3..s........>t 4520 dd df 48 c0 eb c1 d5 d4 ff aa 28 fb b7 14 aa 2b cb ee 18 07 b6 bd 74 47 f9 f2 8f cc 0f 79 ad 7c ..H.......(....+......tG.....y.| 4540 f7 04 e0 75 22 96 1b 96 bc 7f 95 d2 17 19 4f b8 92 3c d1 c9 ca 95 f4 0c 69 96 0b 62 c6 fa 8c 4b ...u".........O..<......i..b...K 4560 00 98 dd 9b 2a d9 a5 65 77 4d 03 9b 0f b6 a4 3b 14 ed 1f da 47 8a f6 a0 ee 28 57 81 61 8d 33 9a ....*..ewM.....;....G....(W.a.3. 4580 25 6b 16 a7 4a d8 76 24 b7 d3 83 22 8a 9f 9b 2f a8 50 36 5e 2a 93 f8 03 5f c3 35 b4 ed 86 68 f8 %k..J.v$...".../.P6^*..._.5...h. 45a0 17 c6 a8 52 46 f7 e8 bb f9 78 3b 71 00 4c e2 87 e6 39 90 39 dc f1 77 d6 fa f7 9d 29 1c f3 a5 50 ...RF....x;q.L...9.9..w....)...P 45c0 09 a3 c7 3b 01 ef bc 6a 96 bd 64 ac f8 74 ae ea be 4c 64 f1 4f 3d c9 fe f6 b6 18 6f 63 dd eb 92 ...;...j..d..t...Ld.O=.....oc... 45e0 29 1f ea 9e e2 2d 34 fd dd 54 3b da 57 5c 48 59 82 60 7c 2c 68 d8 7d a2 ad ce ba ae 76 46 e9 07 )....-4..T;.W\HY.`|,h.}.....vF.. 4600 9e ec 5a 34 3b 98 8e 94 46 75 7f b2 6f 29 66 ea e5 c8 73 6c 7f 6c 24 0c 87 7d 76 bc 88 e8 fb 9b ..Z4;...Fu..o)f...sl.l$..}v..... 4620 9c d0 17 9e a1 0e 14 9f cc 8e 83 ec 99 2b 3e a1 98 bb 96 ac 92 ca 9f a6 fb a7 19 c8 be 45 d9 63 .............+>..............E.c 4640 88 6e b1 f4 e1 3d 05 1a 3f 77 7c 39 c7 64 6c 13 9a 69 87 97 05 af c4 8e fd c5 da 59 e7 7d a1 7a .n...=..?w|9.dl..i.........Y.}.z 4660 9c 6b a9 8e 51 c1 18 f7 5c 81 cc 64 cf 5c 09 76 30 60 fb b8 63 dc c7 d1 1f 51 2d 97 9a 4d 38 6b .k..Q...\..d.\.v0`..c....Q-..M8k 4680 52 af 42 81 02 df 4b b9 95 f5 97 10 54 cf 1a a9 0d 90 67 7c 2d 19 d4 7a 96 60 4c 26 b2 67 ae 04 R.B...K.....T.....g|-..z.`L&.g.. 46a0 3b 18 d0 0f ed 5f 05 15 e4 72 84 be d7 fb 3c 25 ff 4a 8d f8 99 83 a6 ad 2c 17 3e d4 b2 d2 55 03 ;...._...r....<%.J......,.>...U. 46c0 79 b2 fa e5 cc 86 59 1b e6 7d 2d 39 25 50 2c 90 ee 9f 66 22 fb 7c c7 5a 99 8f 43 2e ab 54 0e e7 y.....Y..}-9%P,...f".|.Z..C..T.. 46e0 16 d5 aa d1 c4 ff 9a be c6 9d 6c 0f ec a3 c5 1d 79 f5 7a 88 56 90 ba 7e f3 3f f2 e6 4b 55 b2 0f ..........l.....y.z.V..~.?..KU.. 4700 26 d6 93 5e e7 53 88 b4 23 c0 0e 82 3d 93 fd 6d fb 64 ea 47 03 b0 8c 0a 7e eb c8 23 29 a2 7b 82 &..^.S..#...=..m.d.G....~..#).{. 4720 84 d3 58 d6 a4 91 f2 05 91 60 c8 3e 76 34 d0 4e 56 a7 45 1b f5 20 ac 40 83 2f d5 95 d5 68 f9 92 ..X......`.>v4.NV.E....@./...h.. 4740 11 1d bd 16 f7 34 5b e4 31 1b d9 f5 a2 df 13 82 64 9f c7 1c e7 a2 5e e7 f2 b5 02 2d a1 d9 e6 69 .....4[.1.......d.....^....-...i 4760 86 bb 89 29 17 21 00 eb 7c 03 a0 f0 7c 74 5a b6 8d 31 85 e8 3d 55 e5 6b 35 da fd 6f 9d 72 31 9f ...).!..|...|tZ..1..=U.k5..o.r1. 4780 df 78 10 a6 ea aa 9c ac de dc 37 40 e7 86 07 7f 7d 32 a8 12 4b e7 0b 1f 17 71 a5 56 bf 9c 7a 01 .x........7@....}2..K....q.V..z. 47a0 27 57 d5 c0 cb 81 11 7b ac 10 cf a9 74 03 b0 a2 19 67 d2 c7 6f 07 bc 90 d5 29 cd 6b db a2 dc a3 'W.....{....t....g..o....).k.... 47c0 21 cf 7d a7 54 06 a8 32 30 8f c8 a3 4f 6d 8c c2 6e 15 bf 1f 8d 5c b1 58 4c fd 99 6d 5b d0 41 b2 !.}.T..20...Om..n....\.XL..m[.A. 47e0 53 d7 ec 64 69 59 93 7a 24 2c 64 f7 cd ea 04 3e 43 a8 e5 b5 a6 65 3c c6 44 f5 7c bb d4 33 43 85 S..diY.z$,d....>C....e<.D.|..3C. 4800 d9 53 3b 37 de 3c aa 1e 21 b2 8e 49 3a 3d d8 b7 a0 83 40 21 36 fd f4 70 79 65 fe 81 68 87 c9 2d .S;7.<..!..I:=....@!6..pye..h..- 4820 ef 78 08 9c 63 6f 39 ab ea 64 c5 d7 0b 62 e6 88 42 fb 9a 46 69 b4 b3 84 d9 d3 ea d9 e9 93 71 b6 .x..co9..d...b..B..Fi.........q. 4840 28 d9 39 02 88 86 67 1c 58 58 4b 0c 30 42 64 f7 f6 11 a1 6a a2 8b 69 40 ec a7 9d fa 31 ae 6b da (.9...g.XXK.0Bd....j..i@....1.k. 4860 a9 ca 29 79 84 d9 dd 9d 4a b6 3b 9f 2b ac 7b 54 31 3b 71 87 95 25 e4 ad 9e 4b d1 6b 2b cb 8e de ..)y....J.;.+.{T1;q..%...K.k+... 4880 15 75 44 f2 1d fd 59 ed 64 4f 77 59 2e 0b d5 ad c8 4e f5 a0 1a 58 9c 6c a0 dd 0b 4e ae 83 5c 14 .uD...Y.dOwY.....N...X.l...N..\. 48a0 92 c4 b6 5c a4 3a 11 8a d6 f6 e1 5e 2e a0 7a 1a f3 8c a0 81 91 f1 c9 cb 5b 3e 42 ed 6a 9a f1 04 ...\.:.....^..z.........[>B.j... 48c0 b2 91 5d f0 77 e8 43 f6 3d 07 da 73 c5 56 bb 52 a9 58 22 cb 7b 87 ce f5 4e bb 86 d4 b9 62 0a 0c ..].w.C.=..s.V.R.X".{...N....b.. 48e0 07 da 48 ab d4 87 ba 07 74 6d 33 4c b3 b0 4d f1 0d 81 fb 96 c4 4b 51 01 a5 2d d2 ae 67 8f 6c d5 ..H.....tm3L..M......KQ..-..g.l. 4900 02 d6 b9 31 34 76 e9 48 d5 90 03 9b 9c 0f 92 dc d6 12 f3 ed 62 e8 c8 15 40 4c 5d 49 88 3c b0 d0 ...14v.H............b...@L]I.<.. 4920 d6 08 89 24 1c b0 fd 30 42 9f 81 7a 98 bb 6d 11 53 da 18 03 2d e4 2f 9e 33 6f c4 d6 2f 6a 1f ac ...$...0B..z..m.S...-./.3o../j.. 4940 37 00 d9 3d 72 4a 6f ef f4 44 30 0b f6 15 7b ac 17 d1 16 95 3d 66 fc ea 36 d1 9a 47 2f 28 27 eb 7..=rJo..D0...{.....=f..6..G/('. 4960 01 63 0c 82 85 20 fb 6e 25 bb 34 ff 20 5c 03 e3 9a ae 13 dc 28 d5 6a 25 75 25 d1 66 6f 7c ed 57 .c.....n%.4..\......(.j%u%.fo|.W 4980 6b b5 5a bb 6a 04 d3 d5 53 a2 19 78 66 c5 c3 b5 00 90 bd e5 58 57 2d 91 90 3d 70 2d 72 97 c8 ba k.Z.j...S..xf.......XW-..=p-r... 49a0 56 89 06 b1 b3 3c 63 68 b8 51 6c d5 36 02 c8 b8 70 97 2a fd 7e 95 3e 39 c8 7a 02 22 2a 67 0f a4 V....<ch.Ql.6...p.*.~.>9.z."*g.. 49c0 81 c0 55 c0 4a 76 75 9f 02 f5 38 47 7d 4a 90 2c b2 56 bd 19 ce 58 a2 7a 83 40 19 e5 6b fd 6f df ..U.Jvu...8G}J.,.V...X.z.@..k.o. 49e0 be f5 ab ed 72 33 7f 8d 36 3d 46 4e 91 bd e4 93 17 15 25 00 b6 55 bf 08 fb 88 3d 36 6a 44 55 61 ....r3..6=FN......%..U....=6jDUa 4a00 16 21 93 07 19 72 1c 68 4b 0c 2b 95 cf 41 22 06 66 2a f3 f2 56 3a 3b 64 75 34 d5 03 e9 70 8c f5 .!...r.hK.+..A".f*..V:;du4...p.. 4a20 98 a8 f6 2d 95 ea 74 04 13 25 b4 c4 68 3d 97 cb d5 af a6 2e 80 06 28 7a dc fc 08 cb 54 75 62 cc ...-..t..%..h=........(z....Tub. 4a40 67 77 61 f7 d8 63 a1 4c 16 d0 7a b7 4c e6 b4 39 87 30 fe 20 ed a3 69 db 61 c4 03 cf d1 2d 90 ef gwa..c.L..z.L..9.0....i.a....-.. 4a60 a1 4a de 8a 9f 52 0a a0 1a f5 b8 af b6 82 f6 3a f8 00 ea 91 e9 6c a7 8a 16 ae 1d 0d 45 f6 f0 47 .J...R.........:.....l......E..G 4a80 1d a6 91 58 df bc e1 c4 ae 45 be 64 5d 4a 08 7d 74 a7 05 39 43 00 41 2e 4a c5 6c 2a 08 18 89 c1 ...X.....E.d]J.}t..9C.A.J.l*.... 4aa0 15 28 8a 65 f0 82 a0 c4 b7 bd 2c 5d 7e 16 f0 e6 31 67 a9 5a 17 c8 75 f8 e4 29 2b 35 be 96 af dc .(.e......,]~...1g.Z..u..)+5.... 4ac0 88 93 68 20 cb 6e 5f ce 2e a0 ed 54 4a c1 4e 75 8f 5d 7b f7 b2 9f 65 a7 86 5a 80 22 47 6d 06 0b ..h..n_....TJ.Nu.]{...e..Z."Gm.. 4ae0 00 34 ec 9a 62 a2 1f 04 48 6b 8d aa 28 0f 15 0c ae c3 ef d0 bc c4 68 fb 38 c0 bb 2f b8 0a 5e 3a .4..b...Hk..(.........h.8../..^: 4b00 e7 3c bf fb e3 90 fb 04 34 7b 84 b1 33 28 83 b6 e5 a5 62 97 ba 47 cb 3a 2d 0b 2b 4c d0 43 2d 80 .<......4{..3(....b..G.:-.+L.C-. 4b20 8e b1 6b 0f 60 36 2b d6 bf c0 da 60 90 44 b5 e6 df d5 81 00 e7 41 0b e6 6b fb 14 ea fa 71 85 8e ..k.`6+....`.D.......A..k....q.. 4b40 b9 ad 46 2d 5c 8c 7a bd 3e a8 13 f5 8e 4e 76 bc f3 4e 47 a6 4a b0 1d c2 31 d6 75 5a d1 af e9 f1 ..F-\.z.>....Nv..NG.J...1.uZ.... 4b60 63 5a f2 9f 80 68 6d eb f3 81 63 82 d9 07 86 4b a3 53 90 b3 b4 22 41 a8 10 0a 38 0f 46 9b 53 a5 cZ...hm...c....K.S..."A...8.F.S. 4b80 94 2c 2b 0d 1a c5 96 fe 47 2d 3d 4b 4e d9 fb 5a 65 aa db 40 90 fd e6 c6 21 65 32 d5 0b 6c 1f 8e .,+.....G-=KN..Ze..@....!e2..l.. 4ba0 e9 ba 66 0d 75 d2 13 30 39 4b 1b 3e a4 0b 48 7c e2 50 26 48 e3 e3 e0 0a 0c be 63 0b ae de ae 55 ..f.u..09K.>..H|.P&H......c....U 4bc0 61 a9 d0 0b 54 fb d4 16 b4 6a 25 1c 2c ed 13 84 2a 68 8b ec bf 56 5b 57 57 02 90 01 30 ce ae 6e a...T....j%.,...*h...V[WW...0..n 4be0 d5 b7 55 2b 08 9f d3 2f ab b4 6d 38 26 ef 12 a4 1e b3 80 ac 82 16 d2 05 48 12 7c 7a c0 1f 10 75 ..U+.../..m8&...........H.|z...u 4c00 60 6a 46 4b ef ab 83 63 6d d4 cf c9 f7 54 a5 1f 99 0a aa a4 20 28 94 6a 95 70 f9 48 b8 cf b7 78 `jFK...cm....T.......(.j.p.H...x 4c20 45 a5 e9 5b 41 d5 c6 40 2b 36 b3 46 5b 44 bd 8b 57 56 69 cb 70 4c 9e 94 eb 61 9e b0 56 2b 79 e4 E..[A..@+6.F[D..WVi.pL...a..V+y. 4c40 d5 ad a1 0a d4 70 9a b7 70 1a c6 56 20 bd 90 30 d2 0c 28 78 45 2b e1 a8 2a df 1b c7 5e 5e 1d f6 .....p..p..V...0..(xE+..*...^^.. 4c60 60 62 10 22 fd 6b 61 80 42 b0 09 fc c2 6c 21 77 62 37 a4 03 5b 85 63 48 ae 57 1c f3 fc 35 58 83 `b.".ka.B....l!wb7..[.cH.W...5X. 4c80 d0 b8 e1 14 54 2b 62 4d a2 3c 57 90 e8 c1 61 50 3d 03 94 b7 1e 03 05 b2 35 4f 0b 2e 3a 70 2d e3 ....T+bM.<W...aP=.......5O..:p-. 4ca0 2e 3e 12 60 46 d2 db 08 96 29 5a 8c bb 08 b4 fb d4 16 6c 57 1d d3 25 34 48 96 6a 54 2b d7 75 fd .>.`F....)Z.......lW..%4H.jT+.u. 4cc0 a3 2c 38 22 12 f0 36 65 04 4f 0b 83 1a 2d ca e0 31 d6 48 91 22 3b f6 04 ea 3e 33 c5 ce 79 ef e5 .,8"..6e.O...-..1.H.";...>3..y.. 4ce0 e9 00 74 2a e9 1b 4d 49 e5 2e 02 2c 7e b1 c7 2d 3a f3 4c bd 8e 87 b0 a4 c1 e0 7a b8 7a ae d5 6a ..t*..MI...,~..-:.L.......z.z..j 4d00 99 ab e7 94 73 88 0c 35 a8 11 4c f4 46 57 4b 4e 11 2d ca ea 6a 60 ed 26 55 9c d6 b3 58 ee ca f9 ....s..5..L.FWKN.-..j`.&U...X... 4d20 f0 05 af ab a1 e8 c3 a0 f5 a0 a2 60 e1 8c 30 df d9 62 8f d9 3d 54 bd a4 ef 6b 3f db 1e 3a 5d af ...........`..0..b..=T...k?..:]. 4d40 57 ec 25 7e 54 8d f9 0d 0a 9a 47 0f cd eb 25 0b 54 3b be 62 b2 b5 32 1d e4 87 f4 9c 4f d1 39 9d W.%~T.....G...%.T;.b..2.....O.9. 4d60 97 e3 e6 fb 02 58 32 13 d3 13 75 5c ac 0c 69 2e e8 eb d7 be 91 d9 43 35 a6 b0 54 b2 0d ec d4 d6 .....X2...u\..i.......C5..T..... 4d80 2c 56 9d 26 51 32 14 05 da 41 34 b0 68 14 d7 7c b5 6c d0 00 c6 d9 e6 a1 82 4f 66 14 7d d5 cd ca ,V.&Q2...A4.h..|.l.......Of.}... 4da0 4e 81 b6 6b 7b 1e 23 13 8c b9 31 da 72 f6 f1 9c a6 6f dd 2b 1c 93 d9 43 d5 af e8 19 6b 3c b4 21 N..k{.#...1.r....o.+...C....k<.! 4dc0 2e 29 fb c1 94 e2 81 8a 18 5c 1b fa 66 91 b8 a5 1d 1f 9d 10 1a 70 91 80 f9 d7 ba b1 31 26 44 a5 .).......\..f........p......1&D. 4de0 94 75 38 2f c3 01 62 22 18 de 8a a4 6b 99 4c 45 be 59 3d 54 6d 74 7a e6 e6 77 64 86 fb 69 15 22 .u8/..b"....k.LE.Y=Tmtz..wd..i." 4e00 4a b0 40 af d2 5d 2d 6e f1 3f 81 d0 b7 85 4d 80 1f 4a 17 b2 e5 5b b0 47 a5 5f 29 ef 65 75 25 43 J.@..]-n.?....M..J...[.G._).eu%C 4e20 81 9a f5 b8 c0 fd 74 53 14 97 11 86 df 2f 1c 93 cd 43 0d b4 19 2c 59 43 10 c8 39 4d 4f b4 d2 a2 ......tS...../...C...,YC..9MO... 4e40 1d 4f 0b c0 a8 d8 9e 13 5c 52 6c 39 54 f0 e6 ec 85 c0 8d 62 33 1c d3 d8 2c 5e 71 8f c5 c7 21 47 .O......\Rl9T......b3...,^q...!G 4e60 ae fc 1d e0 eb ff 12 98 f1 6c e1 98 6c 1e aa 16 49 c9 5a bb 87 ae 0b 7d 8f ec 93 54 0e 30 7b 64 .........l..l...I.Z....}...T.0{d 4e80 76 6c ca a7 74 14 a0 29 11 62 1b db 98 57 4f c4 31 f3 e3 20 a0 c7 0b e8 eb 7b c7 52 a2 8b 70 8c vl..t..).b...WO.1........{.R..p. 4ea0 5f 75 4c 36 0f 15 cb d6 cc f1 36 14 b0 f6 39 29 2a 7a 0e 4e 86 6d 71 4c a7 e5 0a 0b 81 d7 b6 5d _uL6......6...9)*z.N.mqL.......] 4ec0 8f d4 5d 58 88 1f 09 30 ab 84 04 88 46 53 41 77 b1 63 c0 af 3a 26 d3 84 01 6c 53 33 af b1 43 fa ..]X...0....FSAw.c..:&...lS3..C. 4ee0 c3 cb 78 2a 5f 14 1e 2c 32 0e 98 56 4c 08 6a 5c 6c 2f 9d 13 4f 7c 35 23 a2 4f 0e 2a d0 ae 8d f1 ..x*_..,2..VL.j\l/..O|5#.O.*.... 4f00 5d 68 d5 e8 f5 84 ee 22 36 e9 e7 a1 66 a9 f2 45 2a 26 fb 84 7c 28 f8 fd e6 b0 e4 e5 fd e9 be 23 ]h....."6...f..E*&..|(.........# 4f20 f9 5e d2 33 b8 3e 7b 16 73 51 3f ad 7d b3 3b e3 a3 01 62 8f fa 30 0d 63 37 fb 38 24 78 36 0f 35 .^.3.>{.sQ?.}.;...b..0.c7.8$x6.5 4f40 4b 95 2f 92 21 99 cd 5f 1e 3e da cf b5 ad 93 95 88 7a 5e aa 6d c9 4b 35 4a 2d 55 96 06 07 8e da K./.!.._.>.......z^.m.K5J-U..... 4f60 af 01 dd 66 d3 36 53 9d 71 00 14 ec 64 7f 9b 0f f4 5f 66 e3 aa 8a 00 8b 5f 0e 35 83 68 47 73 e4 ...f.6S.q...d...._f....._.5.hGs. 4f80 b2 af 27 f5 19 cc a5 43 1e 2f 78 1d c1 9b 78 4b b6 f8 5f 3c e1 42 24 02 e0 ab 5f df ac ad 73 01 ..'....C./x...xK.._<.B$..._...s. 4fa0 1d 8e 11 d0 b5 cc cd cd 4a 84 ce fd a6 82 65 48 2b a1 55 5c 99 d7 d0 a2 7e 4e 5f ba 29 f1 01 b5 ........J.....eH+.U\....~N_.)... 4fc0 05 b8 c2 74 52 1f 9a 28 74 48 76 d6 29 27 0b 15 8e 21 27 b4 af ad 6c f5 cb a1 fa a7 95 f2 50 3b ...tR..(tHv.)'...!'...l.......P; 4fe0 64 56 31 30 17 e4 3d 6a a3 48 be 1e 7c 2a db b1 51 de 70 6c f9 61 ea 97 cb b6 4e 16 35 9b 87 2a dV10..=j.H..|*..Q.pl.a....N.5..* 5000 30 b1 0c 28 dd b7 68 47 d1 94 cc 64 df 8a 6d 2a 32 0f 85 0f d4 53 b6 2b 8c 0a d9 c4 76 1c 1e 10 0..(..hG...d..m*2....S.+....v... 5020 b6 ec 27 8b 92 43 b4 c7 78 d7 c3 90 31 3c 45 bb b7 f8 46 64 f7 1c 0d a3 00 b7 71 79 07 72 14 ad ..'..C..x...1<E...Fd......qy.r.. 5040 51 53 12 0c 0b d1 cc 6d e9 77 80 2a 8a 35 fb c9 02 78 a8 d6 41 be f3 01 41 f7 fa c0 4b c8 78 8b QS.....m.w.*.5...x..A...A...K.x. 5060 f6 3c 24 fb d7 1a f2 8d 83 6e a1 d8 2c 6d 50 2c d0 4c 86 5e a5 b7 8a b1 25 7a a0 69 27 33 b1 f0 .<$......n..,mP,.L.^....%z.i'3.. 5080 32 d2 d5 6f ca 30 7e 9a 71 60 80 9e 6b c7 5a 25 92 ee 37 2b 0f be 7b 47 da b5 d4 65 b5 54 c8 05 2..o.0~.q`..k.Z%..7+..{G...e.T.. 50a0 41 d0 cd 37 4b b5 4a 5f fd ad 5f 6d 11 2d 7a 30 21 95 21 1b 4f 7b a8 78 e4 a8 11 c6 ec c2 18 a9 A..7K.J_.._m.-z0!.!.O{.x........ 50c0 38 59 2a 8c c9 2a e6 84 d1 4e 13 ed 09 dd 69 ed 3e 1d 8c dc 61 19 ff f2 18 23 75 d9 0f a1 df 18 8Y*..*...N....i.>...a....#u..... 50e0 a2 63 34 2f 41 0d 94 c1 41 a4 3d 54 ed ad e0 3a 01 6d a8 9e a4 76 23 16 52 3c 8d eb a4 91 2e da .c4/A...A.=T...:.m...v#.R<...... 5100 05 26 b4 24 99 8d 27 0e 03 ef 1f 69 4f 6d 4f 83 a8 e1 f8 37 b4 c5 19 e8 d6 25 a7 b9 e8 95 0b 7d .&.$..'....iOmO....7.....%.....} 5120 b9 5e b7 d1 ac e1 d3 07 25 53 b3 5c 2e 5f e5 94 ff 33 42 de 43 b4 0b ac 97 16 41 3a dc 10 de f2 .^......%S.\._...3B.C.....A:.... 5140 60 ef f2 98 86 b5 de 90 02 2e 76 87 64 cf 60 d9 55 67 94 e6 11 eb ad ac 9d 76 38 f1 df 1c 5d c4 `.........v.d.`.Ug.......v8...]. 5160 35 5d e7 85 a0 e3 a7 63 62 2c 06 b6 55 49 c1 86 f0 23 a2 3c cc bf a6 3d c3 c4 a0 10 96 91 47 99 5].....cb,..UI...#.<...=......G. 5180 e2 dc 64 0e 15 fd c1 09 0e a9 9f 1b 6a de 3a 26 31 ef 8e cd 60 f5 e9 78 b2 9e a3 67 f1 17 ed c6 ..d.........j.:&1...`..x...g.... 51a0 e8 43 7f b6 c3 38 77 96 18 bd 92 4e 5a d4 25 f0 99 e7 c2 85 e9 67 87 62 06 1d 13 b3 3d e5 09 83 .C...8w....NZ.%......g.b....=... 51c0 e1 6a 43 f9 85 e0 bc ff d6 3c 7a 16 98 1d 4a 9d e7 c1 ad 59 4a 0d 9a c4 73 c5 f0 98 5e c4 b5 ba .jC......<z...J....YJ...s...^... 51e0 e7 07 50 1e e3 a1 63 36 98 fb 45 92 67 1b ce 0f 26 eb 51 86 c9 d5 85 6c 6c 57 63 01 60 dc d2 3a .