tar.bend

bend-kit-tar@0.1.0.0 · 591 lines · 0 definitions

1# tar archives (POSIX ustar with PAX path and size records) of regular files and directories over Bytes. Source: https://github.com/paymog/bend-kit/tree/main/tar
2import Base
3import bend-kit-bytes@0.3.0.0/bytes.bend as Bytes
4
5# An archive is a list of entries in order. Names are raw bytes (UTF-8 by convention), kept byte for byte;
6# a directory keeps whatever trailing '/' its name has. Nothing here touches the filesystem.
7#   import ./tar/tar.bend as Tar
8type Entry is Type:
9  File{name: Bytes.Bytes, data: Bytes.Bytes}
10  Dir{name: Bytes.Bytes}
11
12
13# n rounded up to a whole 512-byte block; 0 when that would pass U32.
14def pad(+n: U32) -> U32:
15  ((n + 511 : U32) .&. 4294966784 : U32)
16
17# The sum of w's four bytes.
18def wsum(+w: U32) -> U32:
19  ((w .&. 255) + ((w >> 8n) .&. 255) + ((w >> 16n) .&. 255) + (w >> 24n) : U32)
20
21def bsum.go(n: Nat, r: Array<U32> & U32, +k: U32, +acc: U32) -> Array<U32> & U32:
22  match n:
23    case 0n:
24      (a, w) = r
25      (a, acc)
26    case 1n+p:
27      (a, +w) = r
28      bsum.go(p, Array.get(U32, a, (k + 1 : U32)), (k + 1 : U32), (acc + wsum(w) : U32))
29
30# The sum of the 512 bytes from word k: 0 only for a zero block.
31def bsum(a: Array<U32>, +k: U32) -> Array<U32> & U32:
32  bsum.go(128n, Array.get(U32, a, k), k, 0)
33
34# Octal digits after leading spaces, ended by NUL, space, or the field's end. ph: 0 leading, 1 digits, 2 done.
35def oct.go(n: Nat, r: Array<U32> & U32, +j: U32, +ph: U32, +acc: U32, +ok: Bool) -> Array<U32> & U32 & Bool:
36  match n:
37    case 0n:
38      (a, c) = r
39      (a, acc, ok)
40    case 1n+p:
41      (a, +c) = r
42      +live = U32.is_ne(ph, 2)
43      +dig = live && Bytes.in(48, c, 55)
44      +bad = live && Bool.not(Bytes.in(48, c, 55) || (U32.is_eq(c, 32) || U32.is_eq(c, 0)))
45      +over = dig && U32.is_lt(536870911, acc)
46      +ph2 = Bool.pick(U32, live, Bool.pick(U32, dig, 1, Bool.pick(U32, U32.is_eq(ph, 0) && U32.is_eq(c, 32), 0, 2)), 2)
47      +acc2 = Bool.pick(U32, dig, ((acc << 3n) .|. (c - 48) : U32), acc)
48      oct.go(p, Bytes.peek(a, (j + 1 : U32)), (j + 1 : U32), ph2, acc2, ok && Bool.not(bad || over))
49
50# The octal field of w bytes at j, and whether it is well formed and fits a U32.
51def oct(a: Array<U32>, +j: U32, +w: U32) -> Array<U32> & U32 & Bool:
52  oct.go(U32.to_nat(w), Bytes.peek(a, j), j, 0, 0, True{})
53
54def cstr.go(n: Nat, r: Array<U32> & U32, +j: U32, +k: U32, +done: Bool) -> Array<U32> & U32:
55  match n:
56    case 0n:
57      (a, c) = r
58      (a, k)
59    case 1n+p:
60      (a, +c) = r
61      match done:
62        case True{}:
63          (a, k)
64        case False{}:
65          +stop = U32.is_eq(c, 0)
66          cstr.go(p, Bytes.peek(a, (j + 1 : U32)), (j + 1 : U32), Bool.pick(U32, stop, k, (k + 1 : U32)), stop)
67
68# The count of bytes before the first NUL in the w bytes from j.
69def cstr(a: Array<U32>, +j: U32, +w: U32) -> Array<U32> & U32:
70  cstr.go(U32.to_nat(w), Bytes.peek(a, j), j, 0, False{})
71
72type Dec is Data:
73  Dec{v: U32, j: U32, ok: Bool}
74
75def dpk.of(r: Array<U32> & U32) -> Array<U32> & U32 & Bool:
76  (a, +c) = r
77  (a, c, Bytes.in(48, c, 57))
78
79# Byte j, and whether it is a decimal digit before end.
80def dpk(ok: Bool, a: Array<U32>, +j: U32) -> Array<U32> & U32 & Bool:
81  match ok:
82    case True{}:
83      dpk.of(Bytes.peek(a, j))
84    case False{}:
85      (a, 0, False{})
86
87def dec.go(n: Nat, r: Array<U32> & U32 & Bool, +j: U32, +end: U32, +acc: U32, +ok: Bool) -> Array<U32> & Dec:
88  match n:
89    case 0n:
90      (a, c, d) = r
91      (a, Dec{acc, j, ok})
92    case 1n+p:
93      (a, c, d) = r
94      match d:
95        case False{}:
96          (a, Dec{acc, j, ok})
97        case True{}:
98          +v = (c - 48 : U32)
99          +fit = U32.is_lt(acc, 429496729) || (U32.is_eq(acc, 429496729) && U32.is_le(v, 5))
100          dec.go(p, dpk(U32.is_lt((j + 1 : U32), end), a, (j + 1 : U32)), (j + 1 : U32), end, ((acc * 10) + v : U32), ok && fit)
101
102# Decimal digits from j up to end: the value, the index after the last digit, and whether it fits a U32.
103def dec(a: Array<U32>, +j: U32, +end: U32) -> Array<U32> & Dec:
104  dec.go(U32.to_nat(Bool.pick(U32, U32.is_le(j, end), (end - j : U32), 0)), dpk(U32.is_lt(j, end), a, j), j, end, 0, True{})
105
106# ---- decode ----
107
108# Header i's name: prefix "/" name when the magic is POSIX ustar and the prefix is not empty.
109def name.fin(+total: U32, r: Array<U32> & Array<U32>) -> Array<U32> & Bytes.Bytes:
110  (a, o) = r
111  (a, Bytes.Bytes{total, o})
112
113def name.join(+i: U32, +n: U32, +pl: U32, r: Array<U32> & Array<U32>) -> Array<U32> & Bytes.Bytes:
114  (a, o) = r
115  +some = U32.is_ne(pl, 0)
116  +off = Bool.pick(U32, some, (pl + 1 : U32), 0)
117  name.fin((off + n : U32), Bytes.copy(n, a, Bytes.poke.when(some, o, pl, 47), i, off))
118
119def name.pre(+i: U32, +n: U32, r: Array<U32> & U32) -> Array<U32> & Bytes.Bytes:
120  (a, +pl) = r
121  +off = Bool.pick(U32, U32.is_ne(pl, 0), (pl + 1 : U32), 0)
122  name.join(i, n, pl, Bytes.copy(pl, a, Bytes.alloc((off + n : U32)), (i + 345 : U32), 0))
123
124def pfx.len(ustar: Bool, a: Array<U32>, +i: U32) -> Array<U32> & U32:
125  match ustar:
126    case True{}:
127      cstr(a, (i + 345 : U32), 155)
128    case False{}:
129      (a, 0)
130
131def name.magic(+i: U32, +n: U32, r: Array<U32> & Bool) -> Array<U32> & Bytes.Bytes:
132  (a, ustar) = r
133  name.pre(i, n, pfx.len(ustar, a, i))
134
135def name.len(+i: U32, r: Array<U32> & U32) -> Array<U32> & Bytes.Bytes:
136  (a, +n) = r
137  name.magic(i, n, Bytes.at(a, "ustar\u{0}", (i + 257 : U32)))
138
139def header.name(a: Array<U32>, +i: U32) -> Array<U32> & Bytes.Bytes:
140  name.len(i, cstr(a, i, 100))
141
142# Records from an 'x' header that apply to the next entry.
143type Pax is Type:
144  Pax{path: Maybe<&1, Bytes.Bytes>, size: Maybe<&2, U32>}
145
146type Pst is Type:
147  PGo{p: U32, pax: Pax}
148  PEnd{pax: Pax}
149  PBad{}
150
151def pr.opt(has: Bool, b: Bytes.Bytes) -> Maybe<&1, Bytes.Bytes>:
152  match has:
153    case True{}:
154      Some{b}
155    case False{}:
156      None{}
157
158# An empty value unsets the keyword (POSIX pax), so the header's own name applies.
159def pr.setpath(+next: U32, +m: U32, pax: Pax, r: Array<U32> & Array<U32>) -> Array<U32> & Pst:
160  Pax{old, +size} = pax
161  (a, o) = r
162  (a, PGo{next, Pax{pr.opt(U32.is_ne(m, 0), Bytes.Bytes{m, o}), size}})
163
164def pr.putsize(+next: U32, +v: U32, pax: Pax) -> Pst:
165  Pax{path, old} = pax
166  PGo{next, Pax{path, Some{v}}}
167
168def pr.sized(ok: Bool, a: Array<U32>, +next: U32, +v: U32, pax: Pax) -> Array<U32> & Pst:
169  match ok:
170    case True{}:
171      (a, pr.putsize(next, v, pax))
172    case False{}:
173      (a, PBad{})
174
175def pr.setsize(+vs: U32, +e: U32, +next: U32, pax: Pax, r: Array<U32> & Dec) -> Array<U32> & Pst:
176  (a, d) = r
177  Dec{+v, +j, +ok} = d
178  pr.sized(ok && (U32.is_eq(j, e) && U32.is_lt(vs, j)), a, next, v, pax)
179
180def pr.size(hit: Bool, a: Array<U32>, +q: U32, +e: U32, +next: U32, pax: Pax) -> Array<U32> & Pst:
181  match hit:
182    case True{}:
183      pr.setsize((q + 6 : U32), e, next, pax, dec(a, (q + 6 : U32), e))
184    case False{}:
185      (a, PGo{next, pax})
186
187def pr.ksize(+q: U32, +e: U32, +next: U32, pax: Pax, r: Array<U32> & Bool) -> Array<U32> & Pst:
188  (a, hit) = r
189  pr.size(hit && U32.is_le((q + 6 : U32), e), a, q, e, next, pax)
190
191def pr.path(hit: Bool, a: Array<U32>, +q: U32, +e: U32, +next: U32, pax: Pax) -> Array<U32> & Pst:
192  match hit:
193    case True{}:
194      +m = (e - q - 6 : U32)
195      pr.setpath(next, m, pax, Bytes.copy(m, a, Bytes.alloc(m), (q + 6 : U32), 0))
196    case False{}:
197      pr.ksize(q, e, next, pax, Bytes.at(a, "size=", (q + 1 : U32)))
198
199def pr.kpath(+q: U32, +e: U32, +next: U32, pax: Pax, r: Array<U32> & Bool) -> Array<U32> & Pst:
200  (a, hit) = r
201  pr.path(hit && U32.is_le((q + 6 : U32), e), a, q, e, next, pax)
202
203# Unknown keywords (mtime, uid, ...) are skipped.
204def pr.rec(ok: Bool, a: Array<U32>, +q: U32, +e: U32, pax: Pax) -> Array<U32> & Pst:
205  match ok:
206    case True{}:
207      pr.kpath(q, e, (e + 1 : U32), pax, Bytes.at(a, "path=", (q + 1 : U32)))
208    case False{}:
209      (a, PBad{})
210
211def pr.nl(+good: Bool, +q: U32, +e: U32, pax: Pax, r: Array<U32> & Bool) -> Array<U32> & Pst:
212  (a, lf) = r
213  pr.rec(good && lf, a, q, e, pax)
214
215def pr.sp(+good: Bool, +q: U32, +e: U32, pax: Pax, r: Array<U32> & Bool) -> Array<U32> & Pst:
216  (a, sp) = r
217  pr.nl(good && sp, q, e, pax, Bytes.at(a, "\n", e))
218
219# A record is "<len> <key>=<value>\n", len counting the whole record; q is the space, e the newline.
220def pr.len(+p: U32, +end: U32, pax: Pax, r: Array<U32> & Dec) -> Array<U32> & Pst:
221  (a, d) = r
222  Dec{+l, +q, +ok} = d
223  +e = (p + l - 1 : U32)
224  +good = ok && (U32.is_lt(p, q) && (U32.is_lt((q - p + 1 : U32), l) && U32.is_le(l, (end - p : U32))))
225  pr.sp(good, q, e, pax, Bytes.at(a, " ", q))
226
227def pr.more(more: Bool, a: Array<U32>, +p: U32, +end: U32, pax: Pax) -> Array<U32> & Pst:
228  match more:
229    case True{}:
230      pr.len(p, end, pax, dec(a, p, end))
231    case False{}:
232      (a, PEnd{pax})
233
234# Each record takes at least three bytes; allow one step to reach the end and one to return it.
235def pr.run(fuel: Nat, r: Array<U32> & Pst, +end: U32) -> Array<U32> & Maybe<&1, Pax>:
236  match fuel:
237    case 0n:
238      (a, st) = r
239      (a, None{})
240    case 1n+f:
241      (a, st) = r
242      match st:
243        case PGo{+p, pax}:
244          pr.run(f, pr.more(U32.is_lt(p, end), a, p, end, pax), end)
245        case PEnd{pax}:
246          (a, Some{pax})
247        case PBad{}:
248          (a, None{})
249
250def pr.parse(a: Array<U32>, +s: U32, +size: U32, pax: Pax) -> Array<U32> & Maybe<&1, Pax>:
251  pr.run(U32.to_nat(((size >> 1n) + 2 : U32)), (a, PGo{s, pax}), (s + size : U32))
252
253type St is Type:
254  SHead{i: U32, pax: Pax, acc: List<&1, Entry>}
255  SOk{entries: List<&1, Entry>}
256  SFail{}
257
258def name.of(path: Maybe<&1, Bytes.Bytes>, a: Array<U32>, +i: U32) -> Array<U32> & Bytes.Bytes:
259  match path:
260    case Some{b}:
261      (a, b)
262    case None{}:
263      header.name(a, i)
264
265def file.data(+next: U32, +size: U32, name: Bytes.Bytes, acc: List<&1, Entry>, r: Array<U32> & Array<U32>) -> Array<U32> & St:
266  (a, o) = r
267  (a, SHead{next, Pax{None{}, None{}}, Con{File{name, Bytes.Bytes{size, o}}, acc}})
268
269def file.name(+i: U32, +size: U32, +next: U32, acc: List<&1, Entry>, r: Array<U32> & Bytes.Bytes) -> Array<U32> & St:
270  (a, name) = r
271  file.data(next, size, name, acc, Bytes.copy(size, a, Bytes.alloc(size), (i + 512 : U32), 0))
272
273def entry.file(+i: U32, +size: U32, +next: U32, acc: List<&1, Entry>, pax: Pax, a: Array<U32>) -> Array<U32> & St:
274  Pax{path, s} = pax
275  file.name(i, size, next, acc, name.of(path, a, i))
276
277def dir.name(+next: U32, acc: List<&1, Entry>, r: Array<U32> & Bytes.Bytes) -> Array<U32> & St:
278  (a, name) = r
279  (a, SHead{next, Pax{None{}, None{}}, Con{Dir{name}, acc}})
280
281# A directory's size field is skipped over like data.
282def entry.dir(+i: U32, +next: U32, acc: List<&1, Entry>, pax: Pax, a: Array<U32>) -> Array<U32> & St:
283  Pax{path, s} = pax
284  dir.name(next, acc, name.of(path, a, i))
285
286def step.pax(+next: U32, acc: List<&1, Entry>, r: Array<U32> & Maybe<&1, Pax>) -> Array<U32> & St:
287  (a, m) = r
288  match m:
289    case Some{pax}:
290      (a, SHead{next, pax, acc})
291    case None{}:
292      (a, SFail{})
293
294# '0' and NUL are regular files, '5' directories, 'x' PAX records for the next entry,
295# 'g' global PAX records (skipped). Links, devices, FIFOs, GNU extensions and the rest fail.
296def step.type(+t: U32, a: Array<U32>, +i: U32, +size: U32, +next: U32, pax: Pax, acc: List<&1, Entry>) -> Array<U32> & St:
297  match t:
298    case 0:
299      entry.file(i, size, next, acc, pax, a)
300    case 48:
301      entry.file(i, size, next, acc, pax, a)
302    case 53:
303      entry.dir(i, next, acc, pax, a)
304    case 120:
305      step.pax(next, acc, pr.parse(a, (i + 512 : U32), size, pax))
306    case 103:
307      (a, SHead{next, pax, acc})
308    case _:
309      (a, SFail{})
310
311def step.kind(fit: Bool, +t: U32, a: Array<U32>, +i: U32, +size: U32, +next: U32, pax: Pax, acc: List<&1, Entry>) -> Array<U32> & St:
312  match fit:
313    case True{}:
314      step.type(t, a, i, size, next, pax, acc)
315    case False{}:
316      (a, SFail{})
317
318# The data and its padding to a whole block must be in the archive.
319def step.fit(+len: U32, +i: U32, +size: U32, +ok: Bool, pax: Pax, acc: List<&1, Entry>, r: Array<U32> & U32) -> Array<U32> & St:
320  (a, +t) = r
321  +pd = pad(size)
322  +fit = ok && (U32.is_le(size, pd) && Bytes.fits(len, (i + 512 : U32), pd))
323  step.kind(fit, t, a, i, size, (i + 512 + pd : U32), pax, acc)
324
325
326# A PAX size overrides the header's field, which then need not parse.
327def step.size(+len: U32, +i: U32, pax: Pax, acc: List<&1, Entry>, r: Array<U32> & U32 & Bool) -> Array<U32> & St:
328  Pax{path, +psize} = pax
329  (a, v, ok) = r
330  step.fit(len, i, Maybe.default(&2, U32, psize, v), Maybe.is_some(&2, U32, psize) || ok, Pax{path, psize}, acc, Bytes.peek(a, (i + 156 : U32)))
331
332def step.hdr(ok: Bool, a: Array<U32>, +len: U32, +i: U32, pax: Pax, acc: List<&1, Entry>) -> Array<U32> & St:
333  match ok:
334    case True{}:
335      step.size(len, i, pax, acc, oct(a, (i + 124 : U32), 12))
336    case False{}:
337      (a, SFail{})
338
339# The checksum counts the 8 checksum bytes (words 37 and 38) as spaces.
340def step.ck3(+len: U32, +i: U32, +s: U32, +ck: U32, +ok: Bool, +x: U32, pax: Pax, acc: List<&1, Entry>, r: Array<U32> & U32) -> Array<U32> & St:
341  (a, +w) = r
342  step.hdr(ok && U32.is_eq(ck, (s - x - wsum(w) + 256 : U32)), a, len, i, pax, acc)
343
344def step.ck2(+len: U32, +i: U32, +s: U32, +ck: U32, +ok: Bool, pax: Pax, acc: List<&1, Entry>, r: Array<U32> & U32) -> Array<U32> & St:
345  (a, +w) = r
346  step.ck3(len, i, s, ck, ok, wsum(w), pax, acc, Array.get(U32, a, ((i >> 2n) + 38 : U32)))
347
348def step.ck(+len: U32, +i: U32, +s: U32, pax: Pax, acc: List<&1, Entry>, r: Array<U32> & U32 & Bool) -> Array<U32> & St:
349  (a, ck, ok) = r
350  step.ck2(len, i, s, ck, ok, pax, acc, Array.get(U32, a, ((i >> 2n) + 37 : U32)))
351
352# The end: a second zero block, with no PAX records left waiting for an entry.
353def end.pax(pax: Pax, acc: List<&1, Entry>) -> St:
354  Pax{p, s} = pax
355  match p s:
356    case None{} None{}:
357      SOk{List.reverse(&1, Entry, acc)}
358    case _ _:
359      SFail{}
360
361def end.of(ok: Bool, pax: Pax, acc: List<&1, Entry>) -> St:
362  match ok:
363    case True{}:
364      end.pax(pax, acc)
365    case False{}:
366      SFail{}
367
368def end.sum(pax: Pax, acc: List<&1, Entry>, r: Array<U32> & U32) -> Array<U32> & St:
369  (a, +s) = r
370  (a, end.of(U32.is_eq(s, 0), pax, acc))
371
372def end.fits(ok: Bool, a: Array<U32>, +i: U32, pax: Pax, acc: List<&1, Entry>) -> Array<U32> & St:
373  match ok:
374    case True{}:
375      end.sum(pax, acc, bsum(a, ((i + 512 : U32) >> 2n : U32)))
376    case False{}:
377      (a, SFail{})
378
379def step.zero(zero: Bool, a: Array<U32>, +len: U32, +i: U32, +s: U32, pax: Pax, acc: List<&1, Entry>) -> Array<U32> & St:
380  match zero:
381    case True{}:
382      end.fits(Bytes.fits(len, (i + 512 : U32), 512), a, i, pax, acc)
383    case False{}:
384      step.ck(len, i, s, pax, acc, oct(a, (i + 148 : U32), 8))
385
386def step.sum(+len: U32, +i: U32, pax: Pax, acc: List<&1, Entry>, r: Array<U32> & U32) -> Array<U32> & St:
387  (a, +s) = r
388  step.zero(U32.is_eq(s, 0), a, len, i, s, pax, acc)
389
390def step.fits(ok: Bool, a: Array<U32>, +len: U32, +i: U32, pax: Pax, acc: List<&1, Entry>) -> Array<U32> & St:
391  match ok:
392    case True{}:
393      step.sum(len, i, pax, acc, bsum(a, (i >> 2n : U32)))
394    case False{}:
395      (a, SFail{})
396
397def step(a: Array<U32>, +len: U32, +i: U32, pax: Pax, acc: List<&1, Entry>) -> Array<U32> & St:
398  step.fits(Bytes.fits(len, i, 512), a, len, i, pax, acc)
399
400def run(fuel: Nat, r: Array<U32> & St, +len: U32) -> Maybe<&1, List<&1, Entry>>:
401  match fuel:
402    case 0n:
403      None{}
404    case 1n+f:
405      (a, st) = r
406      match st:
407        case SOk{xs}:
408          Some{xs}
409        case SFail{}:
410          None{}
411        case SHead{+i, pax, acc}:
412          run(f, step(a, len, i, pax, acc), len)
413
414# The entries in archive order. None for a bad header checksum, a malformed size or PAX record,
415# an entry or its padding cut short, a missing end (two zero blocks), or any type but file,
416# directory, and PAX records. Bytes after the end are ignored.
417# fuel: each header step eats a block, so len / 512 + 2 steps are enough.
418def decode(archive: Bytes.Bytes) -> Maybe<&1, List<&1, Entry>>:
419  Bytes.Bytes{+len, buf} = archive
420  run(U32.to_nat(((len >> 9n) + 2 : U32)), (buf, SHead{0, Pax{None{}, None{}}, Nil{}}), len)
421
422# ---- encode ----
423
424def put.str(s: String, a: Array<U32>, +j: U32) -> Array<U32>:
425  match s:
426    case SNil{}:
427      a
428    case SCon{Chr{+c}, t}:
429      put.str(t, Bytes.poke(a, j, c), (j + 1 : U32))
430
431# n octal digits of v ending at j, written back to front.
432def oct.put(n: Nat, a: Array<U32>, +j: U32, +v: U32) -> Array<U32>:
433  match n:
434    case 0n:
435      a
436    case 1n+p:
437      oct.put(p, Bytes.poke(a, j, (48 + (v .&. 7) : U32)), (j - 1 : U32), (v >> 3n : U32))
438
439# n decimal digits of v ending at j, written back to front.
440def dec.put(n: Nat, a: Array<U32>, +j: U32, +v: U32) -> Array<U32>:
441  match n:
442    case 0n:
443      a
444    case 1n+p:
445      dec.put(p, Bytes.poke(a, j, (48 + (v % 10) : U32)), (j - 1 : U32), (v / 10 : U32))
446
447def digits.go(n: Nat, +v: U32, +c: U32) -> U32:
448  match n:
449    case 0n:
450      c
451    case 1n+p:
452      digits.go(p, (v / 10 : U32), Bool.pick(U32, U32.is_le(10, v), (c + 1 : U32), c))
453
454# The count of decimal digits in v.
455def digits(+v: U32) -> U32:
456  digits.go(9n, v, 1)
457
458# mode, uid 0, gid 0, size, mtime 0, the checksum as spaces, type, and the POSIX ustar magic.
459def hdr.fields(+mode: U32, +size: U32, +t: U32, a: Array<U32>) -> Array<U32>:
460  f = oct.put(11n, oct.put(7n, oct.put(7n, oct.put(7n, a, 106, mode), 114, 0), 122, 0), 134, size)
461  put.str("ustar\u{0}00", Bytes.poke(put.str("        ", oct.put(11n, f, 146, 0), 148), 156, t), 257)
462
463# Six octal digits, NUL, space: the last space stays from the fields.
464def hdr.ck(r: Array<U32> & U32) -> Array<U32>:
465  (a, +s) = r
466  oct.put(6n, Bytes.poke(a, 154, 0), 153, s)
467
468def hdr.of(+mode: U32, +size: U32, +t: U32, r: Array<U32> & Array<U32>) -> Array<U32> & Bytes.Bytes:
469  (src, h) = r
470  (src, Bytes.Bytes{512, hdr.ck(bsum(hdr.fields(mode, size, t, h), 0))})
471
472# A header block named by the first n bytes of src, handing src back.
473def hdr(src: Array<U32>, +n: U32, +mode: U32, +size: U32, +t: U32) -> Array<U32> & Bytes.Bytes:
474  hdr.of(mode, size, t, Bytes.copy(n, src, Bytes.alloc(512), 0, 0))
475
476# b with zero bytes up to the next whole block. Bytes past len are already 0, so only len and room grow.
477def blk(b: Bytes.Bytes) -> Bytes.Bytes:
478  Bytes.Bytes{+len, buf} = b
479  +n = pad(len)
480  Bytes.Bytes{n, Bytes.grow(len, buf, n)}
481
482def zeros(b: Bytes.Bytes, +n: U32) -> Bytes.Bytes:
483  Bytes.Bytes{+len, buf} = b
484  Bytes.Bytes{(len + n : U32), Bytes.grow(len, buf, (len + n : U32))}
485
486def rec.fin(+l: U32, r: Array<U32> & Array<U32>) -> Array<U32> & Bytes.Bytes:
487  (nb, o) = r
488  (nb, Bytes.Bytes{l, o})
489
490# A PAX path record's length: nl + 7 plus its own digits, found as in POSIX pax.
491def rec.len(+nl: U32) -> U32:
492  +base = (nl + 7 : U32)
493  (base + digits((base + digits(base) : U32)) : U32)
494
495# "<len> path=<name>\n".
496def pr.record(nb: Array<U32>, +nl: U32) -> Array<U32> & Bytes.Bytes:
497  +l = rec.len(nl)
498  +d = digits(l)
499  o = Bytes.poke(put.str(" path=", dec.put(U32.to_nat(d), Bytes.alloc(l), (d - 1 : U32), l), d), (l - 1 : U32), 10)
500  rec.fin(l, Bytes.copy(nl, nb, o, 0, (d + 6 : U32)))
501
502def hdr.snd(r: Array<U32> & Bytes.Bytes) -> Bytes.Bytes:
503  (a, h) = r
504  h
505
506def xhdr.of(+rl: U32, b: Bytes.Bytes) -> Bytes.Bytes:
507  Bytes.Bytes{+n, buf} = b
508  hdr.snd(hdr(buf, n, 420, rl, 120))
509
510def enc.paxout(out: Bytes.Bytes, rec: Bytes.Bytes) -> Bytes.Bytes:
511  Bytes.Bytes{+rl, rb} = rec
512  blk(Bytes.append(Bytes.append(out, xhdr.of(rl, Bytes.from_string("././@PaxHeader"))), Bytes.Bytes{rl, rb}))
513
514def enc.pax(out: Bytes.Bytes, r: Array<U32> & Bytes.Bytes) -> Array<U32> & Bytes.Bytes:
515  (nb, rec) = r
516  (nb, enc.paxout(out, rec))
517
518def enc.hdr(+dl: U32, db: Array<U32>, out: Bytes.Bytes, r: Array<U32> & Bytes.Bytes) -> Bytes.Bytes:
519  (nb, h) = r
520  blk(Bytes.append(Bytes.append(out, h), Bytes.Bytes{dl, db}))
521
522# The header keeps the name's first 100 bytes; a longer name rides in the PAX record before it.
523def enc.main(+nl: U32, +t: U32, +mode: U32, +dl: U32, db: Array<U32>, r: Array<U32> & Bytes.Bytes) -> Bytes.Bytes:
524  (nb, out) = r
525  enc.hdr(dl, db, out, hdr(nb, U32.min(nl, 100), mode, dl, t))
526
527def enc.long(long: Bool, nb: Array<U32>, +nl: U32, out: Bytes.Bytes, +t: U32, +mode: U32, +dl: U32, db: Array<U32>) -> Bytes.Bytes:
528  match long:
529    case True{}:
530      enc.main(nl, t, mode, dl, db, enc.pax(out, pr.record(nb, nl)))
531    case False{}:
532      enc.main(nl, t, mode, dl, db, (nb, out))
533
534def enc.ok(ok: Bool, nb: Array<U32>, +nl: U32, out: Bytes.Bytes, +t: U32, +mode: U32, +dl: U32, db: Array<U32>) -> Maybe<&1, Bytes.Bytes>:
535  match ok:
536    case True{}:
537      Some{enc.long(U32.is_lt(100, nl), nb, nl, out, t, mode, dl, db)}
538    case False{}:
539      None{}
540
541# Does an entry fit what is left of the U32 length, with room for the end blocks? Every step checks before it subtracts.
542def enc.room(+ol: U32, +dl: U32, +nl: U32, +long: Bool) -> Bool:
543  +r0 = (4294967295 - ol : U32)
544  +pd = pad(dl)
545  +l = rec.len(nl)
546  +pl = pad(l)
547  +okd = U32.is_le(1536, r0) && (U32.is_le(dl, pd) && U32.is_le(pd, (r0 - 1536 : U32)))
548  +r1 = (r0 - 1536 - pd : U32)
549  +okl = Bool.not(long) || (U32.is_le(nl, 4294967040) && (U32.is_le(l, pl) && (U32.is_le(512, r1) && U32.is_le(pl, (r1 - 512 : U32)))))
550  okd && okl
551
552# A name must be non-empty and hold no NUL, which the header's name field could not keep.
553def enc.check(+t: U32, +mode: U32, +dl: U32, db: Array<U32>, out: Bytes.Bytes, r: Bytes.Bytes & Maybe<&2, U32>) -> Maybe<&1, Bytes.Bytes>:
554  Bytes.Bytes{+ol, ob} = out
555  (name, +m) = r
556  Bytes.Bytes{+nl, nb} = name
557  +fits = enc.room(ol, dl, nl, U32.is_lt(100, nl))
558  enc.ok(U32.is_ne(nl, 0) && (Maybe.is_none(&2, U32, m) && fits), nb, nl, Bytes.Bytes{ol, ob}, t, mode, dl, db)
559
560def enc(e: Entry, out: Bytes.Bytes) -> Maybe<&1, Bytes.Bytes>:
561  match e:
562    case File{name, data}:
563      Bytes.Bytes{+dl, db} = data
564      enc.check(48, 420, dl, db, out, Bytes.find(name, "\u{0}"))
565    case Dir{name}:
566      enc.check(53, 493, 0, Bytes.alloc(0), out, Bytes.find(name, "\u{0}"))
567
568def enc.end(m: Maybe<&1, Bytes.Bytes>) -> Maybe<&1, Bytes.Bytes>:
569  match m:
570    case Some{out}:
571      Some{zeros(out, 1024)}
572    case None{}:
573      None{}
574
575def enc.go(xs: List<&1, Entry>, m: Maybe<&1, Bytes.Bytes>) -> Maybe<&1, Bytes.Bytes>:
576  match xs:
577    case Nil{}:
578      enc.end(m)
579    case Con{e, t}:
580      match m:
581        case Some{out}:
582          enc.go(t, enc(e, out))
583        case None{}:
584          None{}
585
586# A POSIX ustar archive of the entries in order, ended by two zero blocks. Files are mode 0644 and
587# directories 0755, with uid, gid, and mtime 0. A name over 100 bytes goes in a PAX path record.
588# None when a name is empty or holds a NUL byte, or when the archive would pass 4 GiB (U32 lengths).
589# ustar's 8 GiB size field holds any U32 length, so encode never needs a PAX size.
590def encode(entries: List<&1, Entry>) -> Maybe<&1, Bytes.Bytes>:
591  enc.go(entries, Some{Bytes.new(0)})