forked from jthornber/thin-provisioning-tools
-
Notifications
You must be signed in to change notification settings - Fork 0
/
xml.scm
41 lines (37 loc) · 1.5 KB
/
xml.scm
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
(library
(thin xml)
(export generate-xml)
(import (rnrs)
(list-utils)
(generators)
(xml)
(fmt fmt)
(only (srfi s1 lists) iota))
(define (div-down n d)
(floor (/ n d)))
(define (generate-dev dev-id nr-mappings data-offset)
(tag 'device `((dev-id . ,dev-id)
(mapped-blocks . ,nr-mappings)
(transaction . 1)
(creation-time . 0)
(snap-time . 0))
(tag 'range_mapping `((origin-begin . 0)
(data-begin . ,data-offset)
(length . ,nr-mappings)
(time . 1)))))
(define (generate-xml max-thins max-mappings . needs-check)
(let ((nr-thins ((make-uniform-generator 1 max-thins)))
(nr-mappings-g (make-uniform-generator (div-down max-mappings 2)
max-mappings)))
(let ((nr-mappings (iterate nr-mappings-g nr-thins)))
(tag 'superblock `((uuid . "")
(time . 1)
(transaction . 1)
(flags . ,(if (null? needs-check) 0 (car needs-check)))
(version . 2)
(data-block-size . 128)
(nr-data-blocks . ,(apply + nr-mappings)))
(vcat (map generate-dev
(iota nr-thins)
nr-mappings
(accumulate nr-mappings))))))))