src/sha/nar.bend

ezx@1.6.0.0 · 456 lines · 0 definitions

1# sha/nar: the SRI `nix hash path --sri` would give for a directory, computed
2# without nix. A NAR is the tree as length-prefixed strings; its sha256, in
3# SRI form, is what fetchgit records as narHash.
4#
5# The tree is read in one listing, then every regular file's text, and the
6# NAR is built from what was read by a pure, fuelled state machine: each step
7# places one path or closes one directory, the way lock/resolve and pkg/walk
8# carry on, since two Bend defs may not call each other. What the NAR holds
9# of a path is what nix's dumper takes: the owner's exec bit of the mode,
10# every name and link target as it is, and a file's bytes. The reading is
11# sha/dump's, since it runs `find` through foreign code a law may not import.
12import Base
13import ezx@1.6.0.0/src/pkg/pkg.bend as K
14import ezx@1.6.0.0/src/share/sha.bend as Sha
15
16# A directory child is a `K.Item`: its name in `at` and the NAR serial of its
17# node in `sum`. That is a package file's shape, a name and the text that
18# stands for it, so the walk sorts children with the same `K.file.sort` a
19# package sorts its files with, and what is proved of that sort is proved of
20# the NAR.
21
22# one byte as a character. NAR is a byte stream held in a Bend string.
23def byte(+code: U32) -> Char:
24  Chr{(code .&. 255 : U32)}
25
26def nat.byte(+value: Nat) -> Char:
27  byte(U32.from_nat(Nat.mod(value, 256n)))
28
29def le64.go(width: Nat, +value: Nat) -> String:
30  match width:
31    case 0n:
32      ""
33    case 1n+f:
34      SCon{nat.byte(value), le64.go(f, Nat.div(value, 256n))}
35
36# a length as NAR writes it: eight bytes, little-endian
37def le64(+value: Nat) -> String:
38  le64.go(8n, value)
39
40# that many NUL bytes, the padding after a string
41def zeros(count: Nat) -> String:
42  match count:
43    case 0n:
44      ""
45    case 1n+p:
46      SCon{Chr{0}, zeros(p)}
47
48def pad.of(+len: Nat) -> Nat:
49  Nat.mod(Nat.sub(8n, Nat.mod(len, 8n)), 8n)
50
51# one NAR string: its length, its bytes, then zeros up to a multiple of eight
52def str(+text: String) -> String:
53  +n = String.length(text)
54  le64(n) ++ text ++ zeros(pad.of(n))
55
56def exec.fields(ex: Bool) -> String:
57  match ex:
58    case False{}:
59      ""
60    case True{}:
61      str("executable") ++ str("")
62
63# a regular file's node, marked executable when it is
64def regular(ex: Bool, +contents: String) -> String:
65  str("(") ++ str("type") ++ str("regular") ++ exec.fields(ex)
66    ++ str("contents") ++ str(Sha.utf8(contents)) ++ str(")")
67
68# a symlink's node
69def symlink(+target: String) -> String:
70  str("(") ++ str("type") ++ str("symlink") ++ str("target")
71    ++ str(Sha.utf8(target)) ++ str(")")
72
73# one directory entry: its name and its node
74def entry(+ent: K.Item) -> String:
75  K.Item{name, node} = ent
76  str("entry") ++ str("(") ++ str("name") ++ str(Sha.utf8(name))
77    ++ str("node") ++ node ++ str(")")
78
79# a directory's entries, in the order given
80def entries(es: List<&2, K.Item>) -> String:
81  match es:
82    case []:
83      ""
84    case h <> t:
85      entry(h) ++ entries(t)
86
87# a directory's node, its entries in the order given
88def directory(es: List<&2, K.Item>) -> String:
89  str("(") ++ str("type") ++ str("directory") ++ entries(es) ++ str(")")
90
91# a directory's node as NAR writes it: its entries sorted by name, whatever
92# order they were listed in. `String.is_le` is codepoint order, which is nix's
93# byte order for the UTF-8 of valid names. Every directory the walk serializes
94# goes through here, so the order `find` printed its names in never reaches
95# the NAR.
96def dir(es: List<&2, K.Item>) -> String:
97  directory(K.file.sort(es))
98
99# a whole NAR: the magic, then the root node
100def archive(+node: String) -> String:
101  str("nix-archive-1") ++ node
102
103def b64.digit.plus(plus: Bool) -> Char:
104  match plus:
105    case True{}:
106      '+'
107    case False{}:
108      '/'
109
110def b64.digit.lt62(small: Bool, +index: U32) -> Char:
111  match small:
112    case True{}:
113      Chr{U32.add(48, U32.sub(index, 52))}
114    case False{}:
115      b64.digit.plus(U32.is_eq(index, 62))
116
117def b64.digit.lt52(small: Bool, +index: U32) -> Char:
118  match small:
119    case True{}:
120      Chr{U32.add(97, U32.sub(index, 26))}
121    case False{}:
122      b64.digit.lt62(U32.is_lt(index, 62), index)
123
124def b64.digit.lt26(small: Bool, +index: U32) -> Char:
125  match small:
126    case True{}:
127      Chr{U32.add(65, index)}
128    case False{}:
129      b64.digit.lt52(U32.is_lt(index, 52), index)
130
131def b64.digit(+index: U32) -> Char:
132  b64.digit.lt26(U32.is_lt(index, 26), index)
133
134def b64.triple(+first: U32, +second: U32, +third: U32) -> String:
135  +n = (U32.shln(first, 16n) .|. U32.shln(second, 8n) .|. third : U32)
136  SCon{b64.digit(U32.shrn(n, 18n)),
137    SCon{b64.digit((U32.shrn(n, 12n) .&. 63 : U32)),
138      SCon{b64.digit((U32.shrn(n, 6n) .&. 63 : U32)),
139        SCon{b64.digit((n .&. 63 : U32)), SNil{}}}}}
140
141def b64.one(+first: U32) -> String:
142  SCon{b64.digit(U32.shrn(first, 2n)),
143    SCon{b64.digit(U32.shln((first .&. 3 : U32), 4n)),
144      SCon{'=', SCon{'=', SNil{}}}}}
145
146def b64.two(+first: U32, +second: U32) -> String:
147  +n = (U32.shln(first, 8n) .|. second : U32)
148  SCon{b64.digit(U32.shrn(n, 10n)),
149    SCon{b64.digit((U32.shrn(n, 4n) .&. 63 : U32)),
150      SCon{b64.digit(U32.shln((n .&. 15 : U32), 2n)),
151        SCon{'=', SNil{}}}}}
152
153# standard base64, padded with `=`
154def b64(text: String) -> String:
155  match text:
156    case SNil{}:
157      ""
158    case SCon{a, SNil{}}:
159      b64.one(Char.to_u32(a))
160    case SCon{a, SCon{b, SNil{}}}:
161      b64.two(Char.to_u32(a), Char.to_u32(b))
162    case SCon{a, SCon{b, SCon{c, t}}}:
163      b64.triple(Char.to_u32(a), Char.to_u32(b), Char.to_u32(c)) ++ b64(t)
164
165def hex.val.upper(is_upper: Bool, +code: U32) -> U32:
166  match is_upper:
167    case True{}:
168      U32.sub(code, 55)
169    case False{}:
170      0
171
172def hex.val.lower(is_lower: Bool, +code: U32) -> U32:
173  match is_lower:
174    case True{}:
175      U32.sub(code, 87)
176    case False{}:
177      hex.val.upper(Bool.and(U32.is_ge(code, 65), U32.is_le(code, 70)), code)
178
179def hex.val.digit(is_digit: Bool, +code: U32) -> U32:
180  match is_digit:
181    case True{}:
182      U32.sub(code, 48)
183    case False{}:
184      hex.val.lower(Bool.and(U32.is_ge(code, 97), U32.is_le(code, 102)), code)
185
186def hex.val(+ch: Char) -> U32:
187  +u = Char.to_u32(ch)
188  hex.val.digit(Bool.and(U32.is_ge(u, 48), U32.is_le(u, 57)), u)
189
190def hex.bytes(text: String) -> String:
191  match text:
192    case SNil{}:
193      ""
194    case SCon{_a, SNil{}}:
195      ""
196    case SCon{a, SCon{b, t}}:
197      SCon{byte((U32.shln(hex.val(a), 4n) + hex.val(b) : U32)), hex.bytes(t)}
198
199def sri.hex(+hex: String) -> String:
200  "sha256-" ++ b64(hex.bytes(hex))
201
202# the SRI of some bytes: `sha256-` and the base64 of their digest
203def sri(+bytes: String) -> String:
204  sri.hex(Sha.raw(bytes))
205
206# the node of an empty directory
207def empty() -> String:
208  dir([])
209
210
211# ---------------------------------------------------------------------------
212# the listing
213#
214# The tree is listed once, by one `find` from its top, and every field of
215# every path is ended by a NUL, the one byte no name or target can hold. So a
216# name is read as it is, a space at either end and a newline inside it
217# included, and no field is ever trimmed. The paths inside the tree are never
218# handed to a program as arguments, since the process effect separates
219# arguments by newlines; only the top is, and a file's text is read by its
220# path through the file effect, which takes any name.
221
222# the NUL that ends every field of the listing
223def nul() -> Char:
224  Chr{0}
225
226# a char put in front of the first field, which a text that does not end with
227# a NUL leaves open
228def push(+ch: Char, fs: List<&2, String>) -> List<&2, String>:
229  match fs:
230    case []:
231      [SCon{ch, SNil{}}]
232    case h <> t:
233      SCon{ch, h} <> t
234
235# one char of the listing read: a NUL ends a field, any other char is the
236# next of the field it is in
237def cut.at(ends: Bool, +ch: Char, fs: List<&2, String>) -> List<&2, String>:
238  match ends:
239    case True{}:
240      "" <> fs
241    case False{}:
242      push(ch, fs)
243
244# the fields of a listing, each ended by a NUL, exactly as they were printed
245def cut(text: String) -> List<&2, String>:
246  match text:
247    case SNil{}:
248      []
249    case SCon{+c, t}:
250      cut.at(Char.is_eq(c, nul()), c, cut(t))
251
252# whether a text holds no NUL, as no name and no link target can
253def clean(text: String) -> Bool:
254  match text:
255    case SNil{}:
256      True{}
257    case SCon{c, t}:
258      +rest = clean(t)
259      Bool.and(Bool.not(Char.is_eq(c, nul())), rest)
260
261# fields as the listing prints them, each ended by a NUL
262def joined(fs: List<&2, String>) -> String:
263  match fs:
264    case []:
265      ""
266    case h <> t:
267      String.append(h, SCon{nul(), joined(t)})
268
269# whether every field holds no NUL
270def clean.all(fs: List<&2, String>) -> Bool:
271  match fs:
272    case []:
273      True{}
274    case h <> t:
275      +rest = clean.all(t)
276      Bool.and(clean(h), rest)
277
278# whether a file's owner may execute it, from the mode `find` prints as
279# `%M`, `-rwxr-xr-x`: the fourth character is `x`, or `s` when the setuid
280# bit is set as well. This is the mode bit nix's NAR dumper reads
281# (`S_IXUSR`), not an access check, so a file the owner may not execute is
282# not executable whoever weighs it.
283def owner.exec(mode: String) -> Bool:
284  match mode:
285    case SCon{_t, SCon{_r, SCon{_w, SCon{+x, _rest}}}}:
286      Bool.or(Char.is_eq(x, 'x'), Char.is_eq(x, 's'))
287    case _:
288      False{}
289
290# one path of the listing: its type as `%y` gives it (`d`, `f`, `l`), its
291# mode (`%M`), its name (`%f`), its path from the top (`%P`) and a symlink's
292# target (`%l`)
293type Row is Data:
294  Row{kind: String, mode: String, name: String, at: String, target: String}
295
296# the listing's fields, five to a path. A path the listing cut short is not
297# read.
298def rows(fs: List<&2, String>) -> List<&2, Row>:
299  match fs:
300    case Con{y, Con{m, Con{f, Con{p, Con{l, rest}}}}}:
301      Row{y, m, f, p, l} <> rows(rest)
302    case _:
303      []
304
305# what `find` is asked to print of every path under `top`, the top first,
306# each field ended by a NUL. `find` lists a directory before what is in it
307# and all of it before the next entry, which is the order `build` reads.
308def listing.argv(+top: String) -> List<&2, String>:
309  ["find", top, "-printf", "%y\\0%M\\0%f\\0%P\\0%l\\0"]
310
311# ---------------------------------------------------------------------------
312# the tree
313
314# one path of the tree with what the NAR holds of it: a file's text, or a
315# symlink's target, as `body`
316type Ent is Data:
317  Ent{kind: String, exec: Bool, name: String, at: String, body: String}
318
319# a directory still open: its path from the top, its name, and the entries
320# found in it so far
321type Frame is Data:
322  Frame{at: String, name: String, kids: List<&2, K.Item>}
323
324# where the build stands: the paths still to place, the directory they are
325# being placed in, and the directories around it
326type State is Data:
327  State{es: List<&2, Ent>, top: Frame, up: List<&2, Frame>}
328
329# a step of the build: another state, or the finished node of the top
330type Move is Data:
331  Next{st: State}
332  Built{node: String}
333
334def leaf.of(link: Bool, ex: Bool, +body: String) -> String:
335  match link:
336    case True{}:
337      symlink(body)
338    case False{}:
339      regular(ex, body)
340
341# a file's or a symlink's node
342def leaf(entry: Ent) -> String:
343  Ent{+kind, ex, _name, _at, body} = entry
344  leaf.of(String.eq(kind, "l"), ex, body)
345
346# the path of an entry named `name` inside the directory at `at`
347def under(+at: String, +name: String) -> String:
348  Bool.pick(String, String.is_empty(at), name, at ++ "/" ++ name)
349
350# the directory on top finished: its node is an entry of the one around it,
351# or the whole tree when there is none
352def close(top: Frame, up: List<&2, Frame>, es: List<&2, Ent>) -> Move:
353  Frame{_at, +name, kids} = top
354  match up:
355    case []:
356      Built{dir(kids)}
357    case Frame{pat, pname, pkids} <> rest:
358      Next{State{es, Frame{pat, pname, K.Item{name, dir(kids)} <> pkids}, rest}}
359
360# an entry's type, name and path, and an open directory's path
361def ent.kind(entry: Ent) -> String:
362  Ent{kind, _ex, _name, _at, _body} = entry
363  kind
364
365# an entry's name
366def ent.name(entry: Ent) -> String:
367  Ent{_kind, _ex, name, _at, _body} = entry
368  name
369
370# an entry's path from the top
371def ent.at(entry: Ent) -> String:
372  Ent{_kind, _ex, _name, at, _body} = entry
373  at
374
375# an open directory's path from the top
376def frame.at(frame: Frame) -> String:
377  Frame{at, _name, _kids} = frame
378  at
379
380# a path inside the directory on top: a directory is opened, anything else
381# is an entry of it, with its leaf's node
382def place(
383  is_dir: Bool,
384  +name: String,
385  +at: String,
386  +node: String,
387  more: List<&2, Ent>,
388  top: Frame,
389  up: List<&2, Frame>
390) -> Move:
391  match is_dir:
392    case True{}:
393      Next{State{more, Frame{at, name, []}, top <> up}}
394    case False{}:
395      Frame{a, n, ks} = top
396      Next{State{more, Frame{a, n, K.Item{name, node} <> ks}, up}}
397
398# the next path: placed when it is inside the directory on top, which closes
399# otherwise
400def step.ent(
401  inside: Bool,
402  +entry: Ent,
403  more: List<&2, Ent>,
404  top: Frame,
405  up: List<&2, Frame>
406) -> Move:
407  match inside:
408    case True{}:
409      place(String.eq(ent.kind(entry), "d"), ent.name(entry), ent.at(entry), leaf(entry), more, top, up)
410    case False{}:
411      close(top, up, entry <> more)
412
413# one step of the build
414def step(st: State) -> Move:
415  State{es, +top, up} = st
416  match es:
417    case []:
418      close(top, up, [])
419    case +e <> t:
420      step.ent(String.eq(ent.at(e), under(frame.at(top), ent.name(e))), e, t, top, up)
421
422# the build, under fuel
423def build.go(fuel: Nat, mv: Move) -> Maybe<&2, String>:
424  match fuel:
425    case 0n:
426      None{}
427    case 1n+f:
428      match mv:
429        case Next{st}:
430          build.go(f, step(st))
431        case Built{node}:
432          Some{node}
433
434# the node of a directory, from its paths in the order `find` lists them. Each
435# step places a path or closes a directory, and each directory is closed
436# once, so twice the paths and two more is fuel enough.
437def build(+es: List<&2, Ent>) -> Maybe<&2, String>:
438  +n = List.length(&2, Ent, es)
439  build.go(Nat.add(Nat.add(n, n), 2n), Next{State{es, Frame{"", "", []}, []}})
440
441# the node of the whole tree, from its listing with the top first: a
442# directory is built, a file or a symlink is a leaf
443def tree.top(is_dir: Bool, top: Ent, more: List<&2, Ent>) -> Maybe<&2, String>:
444  match is_dir:
445    case True{}:
446      build(more)
447    case False{}:
448      Some{leaf(top)}
449
450# the node of the whole tree, or none for an empty listing
451def tree(es: List<&2, Ent>) -> Maybe<&2, String>:
452  match es:
453    case []:
454      None{}
455    case Ent{+kind, ex, name, at, body} <> t:
456      tree.top(String.eq(kind, "d"), Ent{kind, ex, name, at, body}, t)