giles
07d74db211
Import from an IMMUTABLE snapshot (git archive), not the live tree — a
replay diverges the moment a source file changes (the forge's own
non-fast-forward check caught exactly that). import-stage-msg! carries
the source SHA in the commit message; import-delete-remote! + push
replaces a partial import's history in two requests.
rose-ash mirrored to sx.sx-web.org/giles/rose-ash: 4468 files @
4a7c05a2, one commit, zero skipped, single push under the linear wire.
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
114 lines
3.8 KiB
Plaintext
114 lines
3.8 KiB
Plaintext
; lib/gitea/import.sx — working-tree importer.
|
|
;
|
|
; Reads files from the local filesystem (file-read), builds commits in an
|
|
; in-memory sx-git repo, and pushes them to a live forge over the wire
|
|
; protocol — gitea/http-app adapts the Phase 3 client (which drives any
|
|
; dream-app-shaped fn) to the kernel's http-request primitive, so the
|
|
; same push! that syncs two in-memory forges talks to a real server.
|
|
;
|
|
; Staging and pushing are SEPARATE: import-stage! adds one manifest of
|
|
; files and commits (deterministic — fixed :time/:author/:message, so a
|
|
; replay reproduces identical CIDs and can resume an interrupted import
|
|
; without re-pushing), import-push! sends the delta between the remote's
|
|
; advertised head and the local one in a single request. Pushing per
|
|
; batch is quadratic (every push walks the full closure on both sides);
|
|
; stage many, push once. Import from an IMMUTABLE snapshot (git archive)
|
|
; — replaying against a live tree diverges the moment a file changes.
|
|
;
|
|
; Files whose pack line would exceed the pkt-line limit are skipped and
|
|
; reported per batch (wire limit; see lib/gitea/wire.sx).
|
|
;
|
|
; Requires: the wire client stack (lib/gitea/{repo,access,web,wire}.sx
|
|
; and deps) on a host with the file-read + http-request primitives.
|
|
|
|
; a dream-app-shaped fn over real HTTP: request dict in, response dict out
|
|
(define
|
|
gitea/http-app
|
|
(fn
|
|
(base)
|
|
(fn
|
|
(req)
|
|
(http-request
|
|
(get req :method)
|
|
(str base (get req :target))
|
|
(get req :headers)
|
|
(get req :body)))))
|
|
|
|
(define gitea/import-state false)
|
|
|
|
(define
|
|
gitea/import-init!
|
|
(fn
|
|
(base token owner name)
|
|
(let
|
|
((repo (git/init! (persist/mem-backend) "import")))
|
|
(begin (set! gitea/import-state {:batch 0 :remote (gitea/remote (gitea/http-app base) owner name token) :repo repo}) true))))
|
|
|
|
(define
|
|
gitea/import-lines
|
|
(fn
|
|
(path)
|
|
(filter (fn (l) (not (= l ""))) (split (file-read path) "\n"))))
|
|
|
|
; will this file's pack line fit one pkt? (escaping can double the size)
|
|
(define
|
|
gitea/import-fits?
|
|
(fn (data) (gitea/pkt-fits? (str "x" (serialize (git/blob data))))))
|
|
|
|
; read + stage one manifest of paths and commit with the given message —
|
|
; NO push. => {:batch n :files k :skipped (paths) :cid commit-cid}
|
|
(define
|
|
gitea/import-stage-msg!
|
|
(fn
|
|
(root manifest message time)
|
|
(let
|
|
((st gitea/import-state))
|
|
(let
|
|
((paths (gitea/import-lines manifest))
|
|
(repo (get st :repo))
|
|
(n (+ 1 (get st :batch))))
|
|
(let
|
|
((skipped (reduce (fn (acc p) (let ((data (file-read (str root "/" p)))) (if (gitea/import-fits? data) (begin (git/add! repo p data) acc) (append acc (list p))))) (list) paths)))
|
|
(let
|
|
((cid (git/commit! repo {:message message :time time :author "giles"})))
|
|
(begin (set! gitea/import-state (assoc st :batch n)) {:batch n :files (- (len paths) (len skipped)) :skipped skipped :cid cid})))))))
|
|
|
|
(define
|
|
gitea/import-stage!
|
|
(fn
|
|
(root manifest)
|
|
(let
|
|
((n (+ 1 (get gitea/import-state :batch))))
|
|
(gitea/import-stage-msg!
|
|
root
|
|
manifest
|
|
(str "import rose-ash: batch " n)
|
|
n))))
|
|
|
|
; one delta push of everything staged since the remote's advertised head
|
|
(define
|
|
gitea/import-push!
|
|
(fn
|
|
()
|
|
(let
|
|
((st gitea/import-state))
|
|
(gitea/push! (get st :remote) (get st :repo) "heads/main"))))
|
|
|
|
; delete the remote branch (for replacing an import's history)
|
|
(define
|
|
gitea/import-delete-remote!
|
|
(fn
|
|
()
|
|
(let
|
|
((st gitea/import-state))
|
|
(gitea/push-delete! (get st :remote) (get st :repo) "heads/main"))))
|
|
|
|
; stage + push in one step (fine for small imports)
|
|
(define
|
|
gitea/import-batch!
|
|
(fn
|
|
(root manifest)
|
|
(let
|
|
((res (gitea/import-stage! root manifest)))
|
|
(assoc res :push (gitea/import-push!)))))
|