coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib/gitea: fix the fetch-pack-over-HTTP hang — native parse fast path

Browse Source 
The sx-forge native-loop blocker: clone! of the live giles/rose-ash
never returned over gitea/http-app. Root cause was NOT the transport —
pack-line-parse ran every pack line through the interpreted spec parser
(~6.6KB/s on the CEK machine; a full-repo pack = hours), and a non-hex
byte in a pkt length header parsed negative (index-of -1), walking the
scan index backwards forever.

- gitea/parse-obj: use the host reader (open-input-string + read,
  ~3700x faster, value-identical) when the host provides it; hosts
  without string ports keep sx-parse. Feature-detected at load.
- pkt-sections-loop: (< n 4) guard — malformed lengths error instead
  of hanging.
- push-cmd!: haves = every advertised remote ref held locally, so a
  NEW branch pushes only its delta, not the whole repo closure.
- tests/wire.sx: malformed-len errors, truncated-pkt clamps, parse-obj
  = sx-parse equivalence (blob/commit + cid). 83/83.
- tests/wire-http.sh + wire-http-client.sx: end-to-end over REAL
  http-listen/http-request on :8943 — ls-remote/clone/push-new-branch/
  fresh-clone-verify/delete. The coverage gap that hid all this.

Proven vs the live forge (in sx-gitea-1): full 4468-file clone in 77s
(was: hang), commit, push heads/sx-smoke-test ok, branch advertised on
sx.sx-web.org. Conformance 620/620.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
giles
2026-07-04 00:30:59 +00:00
parent 72e461cf2c
commit 8ed44f7770
6 changed files with 257 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
lib/gitea/wire.sx
View File

@@ -80,7 +80,10 @@
(fn (lines) (str (join "" (map gitea/pkt lines)) gitea/pkt-flush))
sections))))
; parse framed data into sections (lists of lines) split on flush pkts
; parse framed data into sections (lists of lines) split on flush pkts.
; A non-hex byte in a length header parses negative (index-of -> -1);
; the (< n 4) guard makes that an error — without it i walks backwards
; and the loop never terminates (a malformed body must not hang).
(define
gitea/pkt-sections-loop
(fn
@@ -90,18 +93,21 @@
(reverse (if (empty? cur) sections (cons (reverse cur) sections)))
(let
((n (gitea/hex4-parse (substr data i 4))))
(if
(= n 0)
(gitea/pkt-sections-loop
data
(+ i 4)
(list)
(cons (reverse cur) sections))
(gitea/pkt-sections-loop
data
(+ i n)
(cons (substr data (+ i 4) (- n 4)) cur)
sections))))))
(cond
((= n 0)
(gitea/pkt-sections-loop
data
(+ i 4)
(list)
(cons (reverse cur) sections)))
((< n 4)
(error (str "gitea/pkt-sections: malformed pkt-len at " i)))
(else
(gitea/pkt-sections-loop
data
(+ i n)
(cons (substr data (+ i 4) (- n 4)) cur)
sections)))))))
(define
gitea/pkt-sections
@@ -188,6 +194,18 @@
gitea/pack-line
(fn (grepo cid) (str cid " " (serialize (git/read grepo cid)))))
; parse one serialized object. sx-parse (the spec parser) is interpreted —
; ~6KB/s on the CEK machine, which turns a full-repo pack into hours; the
; host reader (open-input-string + read) parses the same grammar natively
; (~3700x faster, value-identical). Feature-detect at load: hosts without
; string ports keep the spec parser.
(define
gitea/parse-obj
(if
(and (primitive? "open-input-string") (primitive? "read"))
(fn (s) (read (open-input-string s)))
(fn (s) (first (sx-parse s)))))
; parse "<cid> <sx>" and verify the cid matches the bytes
(define
gitea/pack-line-parse
@@ -200,7 +218,7 @@
{:error "malformed"}
(let
((cid (substr line 0 sp))
(obj (first (sx-parse (substr line (+ sp 1))))))
(obj (gitea/parse-obj (substr line (+ sp 1)))))
(if (= (git/cid obj) cid) {:obj obj :cid cid} {:error "cid-mismatch" :cid cid}))))))
; verify + store every pack line; => {:stored n} | {:error ...}
@@ -400,7 +418,7 @@
; A remote is any dream app fn plus repo coordinates and a token — the
; same code drives an in-memory forge or a real HTTP transport.
(define gitea/remote (fn (app owner name token) {:name name :token token :owner owner :app app}))
(define gitea/remote (fn (app owner name token) {:name name :owner owner :token token :app app}))
(define
gitea/remote-call
@@ -535,9 +553,15 @@
(nil? ls)
{:error 404}
(let
((old (or (get (get ls :refs) refname) gitea/zero-ref)))
((old (or (get (get ls :refs) refname) gitea/zero-ref))
(haves
(filter
(fn (c) (git/has? grepo c))
(map
(fn (k) (get (get ls :refs) k))
(keys (get ls :refs))))))
(let
((pack (if (equal? new gitea/zero-ref) (list) (gitea/pack-cids grepo (list new) (if (equal? old gitea/zero-ref) (list) (list old))))))
((pack (if (equal? new gitea/zero-ref) (list) (gitea/pack-cids grepo (list new) haves))))
(let
((resp (gitea/remote-call remote "POST" "/git-receive-pack" (gitea/pkt-render (list (list (str old " " new " " refname)) (map (fn (c) (gitea/pack-line grepo c)) pack))))))
(if
@@ -564,4 +588,4 @@
gitea/push-delete!
(fn
(remote grepo refname)
(gitea/push-cmd! remote grepo refname gitea/zero-ref)))
(gitea/push-cmd! remote grepo refname gitea/zero-ref)))