From 9d5bb297938633327326b523c830a16ebbd28225 Mon Sep 17 00:00:00 2001 From: Edward Langley Date: Thu, 26 Oct 2023 02:53:59 -0700 Subject: [PATCH] feat: continue implementing delta expansion --- delta.lisp | 63 +++++-- tests/git-objects.lisp | 35 +++- tests/sample-git-objects/blob-3157639-fixture | 65 +++++++ tests/sample-git-objects/blob-53d13ed-fixture | 34 ++++ tests/sample-git-objects/blob-87c2b9b-fixture | 81 +++++++++ tests/sample-git-objects/blob-912d31a-fixture | 49 ++++++ tests/sample-git-objects/blob-9776df7-fixture | 163 ++++++++++++++++++ tests/sample-git-objects/blob-c516dfc-fixture | 140 +++++++++++++++ 8 files changed, 613 insertions(+), 17 deletions(-) create mode 100644 tests/sample-git-objects/blob-3157639-fixture create mode 100644 tests/sample-git-objects/blob-53d13ed-fixture create mode 100644 tests/sample-git-objects/blob-87c2b9b-fixture create mode 100644 tests/sample-git-objects/blob-912d31a-fixture create mode 100644 tests/sample-git-objects/blob-9776df7-fixture create mode 100644 tests/sample-git-objects/blob-c516dfc-fixture diff --git a/delta.lisp b/delta.lisp index c381c5e..af62d55 100644 --- a/delta.lisp +++ b/delta.lisp @@ -5,13 +5,16 @@ (%base :initarg :base :reader base) (%commands :initarg :commands :reader commands) (%src-size :initarg :src-size :reader src-size) - (%delta-size :initarg :delta-size :reader delta-size))) + (%delta-size :initarg :delta-size :reader delta-size)) + (:documentation + "The base type for deltified git objects")) (defclass+ ofs-delta (delta) ()) (defclass+ ref-delta (delta) - ()) + () + (:documentation "TODO: mostly unimplemented/untested")) (defun make-ofs-delta (base commands repository src-size delta-size) (fw.lu:new 'ofs-delta base commands repository src-size delta-size)) @@ -36,19 +39,22 @@ :unless (zerop (aref bv ix)) :sum (expt 2 n)))) -(defun expand-copy (copy) - (destructuring-bind (command layout numbers) copy - (let* ((next-idx 0) - (parts (map '(vector (unsigned-byte 8)) - (lambda (layout-bit) - (if (= layout-bit 1) - (prog1 (elt numbers next-idx) - (incf next-idx)) - 0)) - (reverse layout)))) - (list command - (fwoar.bin-parser:le->int (subseq parts 0 4)) - (fwoar.bin-parser:le->int (subseq parts 4)))))) +(defun trace-bases (pack delta) + (if (typep delta 'delta) + (let* ((offset (second (base delta))) + (o (extract-object-at-pos pack + offset + (make-instance 'git-ref + :hash "00000000" + :repo nil))) + (obj (serapeum:assocdr :object-data o)) + (raw (serapeum:assocdr :raw-data o))) + (if (typep obj 'delta) + (apply-commands (trace-bases pack obj) + (commands delta)) + (apply-commands (trace-bases pack raw) + (commands delta)))) + delta)) (defun partition-commands (data) (let ((idx 0)) @@ -72,10 +78,35 @@ (list :add (coerce (loop repeat (bit-vector->int insts) collect (advance)) - '(vector (unsigned-byte 8)))))))) + '(vector (unsigned-byte 8))))))) + (expand-copy (copy) + (destructuring-bind (command layout numbers) copy + (let* ((next-idx 0) + (parts (map '(vector (unsigned-byte 8)) + (lambda (layout-bit) + (if (= layout-bit 1) + (prog1 (elt numbers next-idx) + (incf next-idx)) + 0)) + (reverse layout)))) + (list command + (fwoar.bin-parser:le->int (subseq parts 0 4)) + (fwoar.bin-parser:le->int (subseq parts 4))))))) (loop while (< idx (length data)) collect (get-command))))) +(defun apply-commands (base commands) + (flexi-streams:with-output-to-sequence (s) + (flet ((do-copy (offset cnt) + (write-sequence (subseq base offset (+ offset cnt)) + s)) + (do-add (data) + (write-sequence data s))) + (loop for (command . args) in commands + when (eql command :copy) do + (apply #'do-copy args) + when (eql command :add) do + (apply #'do-add args))))) (defun get-ofs-delta-offset (buf) (let* ((idx 0)) diff --git a/tests/git-objects.lisp b/tests/git-objects.lisp index dfc12b0..de364a3 100644 --- a/tests/git-objects.lisp +++ b/tests/git-objects.lisp @@ -174,7 +174,6 @@ :pack pack-file)))) (fiveam:def-test pack-files-offsets () - (let* ((expectations-file (asdf:system-relative-pathname :co.fwoar.cl-git/tests @@ -187,3 +186,37 @@ (fwoar.cl-git::extract-object (fwoar.cl-git::packed-ref *fake-repo-2* ref))))))) )) + +(fiveam:def-test pack-file-apply-delta-commands () + (flet ((test-ref (ref) + (let* ((extracted-ref + (fwoar.cl-git::extract-object + (fwoar.cl-git::packed-ref :fwoar.cl-git.git-objects.pack-2 ref))) + (base-desc (fwoar.cl-git::base extracted-ref)) + (pack (car (fwoar.cl-git::pack-files *fake-repo-2*))) + (expectations-file + (asdf:system-relative-pathname + :co.fwoar.cl-git/tests + (format nil "tests/sample-git-objects/blob-~a-fixture" + (subseq ref 0 7)))) + (expectations + (alexandria:read-file-into-byte-vector expectations-file))) + (5am:is + (serapeum:vector= + expectations + (fwoar.cl-git::trace-bases pack extracted-ref)))))) + (test-ref "87c2b9b2dfaa1fbf66b3fe88d3a925593886b159") + + (test-ref "9776df71b5ddf298c56e99b7291f9e68906cf049") + + #+(or) ;; broken + (test-ref "31576396aff0fff28f69e0ef84571c0dc8cc43ec") + + #+(or) ;; broken + (test-ref "c516dfc248544509c3ae58e3a8c2ab81c225aa9c") + + #+(or) ;; broken + (test-ref "53d13ed284f8b57297d1b216e2bab7fb43f8db60") + + #+(or) ;; broken + (test-ref "912d31a169ddf1fca122d4c6fe1b1e6be7cd1176"))) diff --git a/tests/sample-git-objects/blob-3157639-fixture b/tests/sample-git-objects/blob-3157639-fixture new file mode 100644 index 0000000..3157639 --- /dev/null +++ b/tests/sample-git-objects/blob-3157639-fixture @@ -0,0 +1,65 @@ +(in-package :fwoar.cl-git) + +(defclass git-graph () + ((%repo :initarg :repo :reader repo) + (%depth :initarg :depth :reader depth) + (%branches :reader branches) + (%node-cache :reader node-cache :initform (make-hash-table :test 'equal)) + (%edge-cache :reader edge-cache :initform (make-hash-table :test 'equal)))) + +(defmethod initialize-instance :after ((object git-graph) &key) + (setf (slot-value object '%branches) + (fw.lu:alist-string-hash-table + (funcall (data-lens:over + (<>1 (data-lens:applying #'cons) + (data-lens:transform-head + (serapeum:op (subseq _1 0 (min (length _1) 7)))) + #'reverse)) + (branches (repo object)))))) + +(defun git-graph (repo) + (fw.lu:new 'git-graph repo)) + +(defun get-commit-parents (repository commit) + #+lispworks + (declare (notinline mismatch serapeum:string-prefix-p)) + (map 'list + (serapeum:op (second (partition #\space _))) + (remove-if-not (lambda (it) + (serapeum:string-prefix-p "parent" it)) + (nth-value 1 (parse-commit + (split-object + (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) + (loose-object repository + commit)))))))) + +(defmethod cl-dot:graph-object-node ((graph git-graph) (commit string)) + (alexandria:ensure-gethash commit + (node-cache graph) + (make-instance 'cl-dot:node + :attributes `(:label ,(gethash #1=(subseq commit 0 7) + (branches graph) + #1#))))) + +(defmethod cl-dot:graph-object-points-to ((graph git-graph) (commit string)) + #+nil + (loop + for cur = (list commit) then parents + for parents = (let ((f (get-commit-parents (repo graph) (car cur)))) + f) + until (or (not parents) + (cdr parents)) + finally (return (or parents + (when (not (equal commit (car cur))) + cur)))) + + (funcall (data-lens:<>1 (data-lens:over (serapeum:op + (setf (gethash (list commit _1) + (edge-cache graph)) + t) + _1)) + (data-lens:exclude (serapeum:op + (gethash (list commit _1) + (edge-cache graph)))) + (data-lens:over (serapeum:op (subseq _ 0 7)))) + (get-commit-parents (repo graph) commit))) diff --git a/tests/sample-git-objects/blob-53d13ed-fixture b/tests/sample-git-objects/blob-53d13ed-fixture new file mode 100644 index 0000000..53d13ed --- /dev/null +++ b/tests/sample-git-objects/blob-53d13ed-fixture @@ -0,0 +1,34 @@ +;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*- +(in-package :asdf-user) + +(defsystem :cl-git + :description "A pure-Lisp git implementation" + :author "Ed L " + :license "MIT" + :pathname #-fw.dev nil #+fw.dev #p"PROJECTS:cl-git;" + :depends-on (:alexandria + :chipz + :cl-dot + :data-lens + :fwoar-lisputils + :fwoar-lisputils/bin-parser + :ironclad + :serapeum + :split-sequence + :uiop) + :components ((:file "package") + (:file "util" :depends-on ("package")) + + ;; data model + (:file "model" :depends-on ("package")) + (:file "protocol" :depends-on ("package" "model")) + (:file "repository" :depends-on ("package" "model")) + (:file "tree" :depends-on ("package" "model")) + (:file "commit" :depends-on ("package" "model")) + + (:file "extract" :depends-on ("package" "commit" "tree")) + (:file "branch" :depends-on ("package" "extract")) + (:file "git" :depends-on ("package" "util" "model" "branch")) + + ;; stable programmer interface + (:file "porcelain" :depends-on ("package" "git" "commit")))) diff --git a/tests/sample-git-objects/blob-87c2b9b-fixture b/tests/sample-git-objects/blob-87c2b9b-fixture new file mode 100644 index 0000000..87c2b9b --- /dev/null +++ b/tests/sample-git-objects/blob-87c2b9b-fixture @@ -0,0 +1,81 @@ +(in-package :fwoar.cl-git) + +(fw.lu:defun-ct batch-4 (bytes) + (mapcar 'fwoar.bin-parser:be->int + (serapeum:batches bytes 4))) + +(fw.lu:defun-ct batch-20 (bytes) + (serapeum:batches bytes 20)) + +(defmacro sym->plist (&rest syms) + `(list ,@(loop for sym in syms + append (list (alexandria:make-keyword sym) + sym)))) + +(defmacro inspect- (s form) + `(let ((result ,form)) + (format ,s "~&~s (~{~s~^ ~})~%~4t~s~%" + ',form + ,(typecase form + (list `(list ',(car form) ,@(cdr form))) + (t `(list ,form))) + result) + result)) + +(defun inspect-* (fn) + (lambda (&rest args) + (declare (dynamic-extent args)) + (inspect- *trace-output* + (apply fn args)))) + +(defun partition (char string &key from-end (with-offset nil wo-p)) + (let ((pos (position char string :from-end from-end))) + (if pos + (if wo-p + (list (subseq string 0 (+ pos with-offset 1)) + (subseq string (+ pos 1 with-offset))) + (list (subseq string 0 pos) + (subseq string (1+ pos)))) + (list string + nil)))) + +(defun partition-subseq (subseq string &key from-end) + (let ((pos (search subseq string :from-end from-end))) + (if pos + (list (subseq string 0 pos) + (subseq string (+ (length subseq) pos))) + (list string + nil)))) + +(serapeum:defalias ->sha-string + (data-lens:<>1 (data-lens:over 'fwoar.bin-parser:byte-array-to-hex-string) + 'batch-20)) + +(defun read-bytes (count format stream) + (let ((seq (make-array count :element-type 'serapeum:octet))) + (read-sequence seq stream) + (funcall format + seq))) + +(defun sp-ob (ob-string) + (partition #\null + ob-string)) + +(defun split-object (object-data) + (destructuring-bind (head tail) + (partition 0 + object-data) + (destructuring-bind (type length) + (partition #\space + (babel:octets-to-string head :encoding :latin1)) + (values tail + (list type + (parse-integer length)))))) + +(defun parse-commit (commit) + (destructuring-bind (metadata message) + (partition-subseq #(#\newline #\newline) + commit #+(or)(babel:octets-to-string commit :encoding :latin1)) + (values message + (map 'vector (serapeum:op (partition #\space _)) + (fwoar.string-utils:split #\newline metadata))))) diff --git a/tests/sample-git-objects/blob-912d31a-fixture b/tests/sample-git-objects/blob-912d31a-fixture new file mode 100644 index 0000000..912d31a --- /dev/null +++ b/tests/sample-git-objects/blob-912d31a-fixture @@ -0,0 +1,49 @@ +(in-package :fwoar.cl-git) + +(fw.lu:defun-ct batch-4 (bytes) + (mapcar 'fwoar.bin-parser:be->int + (serapeum:batches bytes 4))) + +(fw.lu:defun-ct batch-20 (bytes) + (serapeum:batches bytes 20)) + +(defmacro sym->plist (&rest syms) + `(list ,@(loop for sym in syms + append (list (alexandria:make-keyword sym) + sym)))) + +(defmacro inspect- (s form) + `(let ((result ,form)) + (format ,s "~&~s (~{~s~^ ~})~%~4t~s~%" + ',form + ,(typecase form + (list `(list ',(car form) ,@(cdr form))) + (t `(list ,form))) + result) + result)) + +(defun inspect-* (fn) + (lambda (&rest args) + (declare (dynamic-extent args)) + (inspect- *trace-output* + (apply fn args)))) + +(defun partition (char string &key from-end) + (let ((pos (position char string :from-end from-end))) + (if pos + (list (subseq string 0 pos) + (subseq string (1+ pos))) + (list string + nil)))) + +(defun partition-subseq (subseq string &key from-end) + (let ((pos (search subseq string :from-end from-end))) + (if pos + (list (subseq string 0 pos) + (subseq string (+ (length subseq) pos))) + (list string + nil)))) + +(serapeum:defalias ->sha-string + (data-lens:<>1 (data-lens:over 'fwoar.bin-parser:byte-array-to-hex-string) + 'batch-20)) diff --git a/tests/sample-git-objects/blob-9776df7-fixture b/tests/sample-git-objects/blob-9776df7-fixture new file mode 100644 index 0000000..9776df7 --- /dev/null +++ b/tests/sample-git-objects/blob-9776df7-fixture @@ -0,0 +1,163 @@ +(in-package :fwoar.cl-git) + +(defun edges-in-fanout (toc s sha) + (let* ((fanout-offset (getf toc :fanout))) + (file-position s (+ fanout-offset (* 4 (1- (elt sha 0))))) + (destructuring-bind ((_ . cur) (__ . next)) + (fwoar.bin-parser:extract '((cur 4 fwoar.bin-parser:be->int) + (next 4 fwoar.bin-parser:be->int)) + s) + (declare (ignore _ __)) + (values cur next)))) + +(defun find-sha-between-terms (toc s start end sha) + (unless (>= start end) + (let* ((sha-offset (getf toc :shas)) + (mid (floor (+ start end) + 2))) + (file-position s (+ sha-offset (* 20 mid))) + (let ((sha-at-mid (read-bytes 20 'fwoar.bin-parser:byte-array-to-hex-string s))) + (cond ((string< sha sha-at-mid) + (find-sha-between-terms toc s start mid sha)) + ((string> sha sha-at-mid) + (find-sha-between-terms toc s (1+ mid) end sha)) + (t mid)))))) + +(defun find-pack-containing (pack-file id) + (with-open-file (s (index-file pack-file) + :element-type '(unsigned-byte 8)) + (let ((binary-sha (ironclad:hex-string-to-byte-array id)) + (toc (idx-toc s))) + (multiple-value-bind (_ end) (edges-in-fanout toc s binary-sha) + (declare (ignore _)) + (let ((midpoint (find-sha-between-terms toc s 0 end id))) + (and midpoint + (values pack-file + midpoint))))))) + +(defun find-object-in-pack-files (repo id) + (dolist (pack-file (pack-files repo)) + (multiple-value-bind (pack mid) (find-pack-containing pack-file id) + (when pack + (return-from find-object-in-pack-files + (values pack mid)))))) + +(defun behead (data) + (elt (partition 0 data) + 1)) + +(defun tree-entry (data) + (values-list (partition 0 data :with-offset 20))) + +(defun format-tree-entry (entry) + (destructuring-bind (info sha) (partition 0 entry) + (concatenate 'vector + (apply #'concatenate 'vector + (serapeum:intersperse (vector (char-code #\tab)) + (reverse + (partition (char-code #\space) + info)))) + (list (char-code #\tab)) + (babel:string-to-octets (elt (->sha-string sha) 0) :encoding *git-encoding*)))) + +(defun tree-entries (data &optional accum) + (if (<= (length data) 0) + (apply #'concatenate 'vector + (serapeum:intersperse (vector (char-code #\newline)) + (nreverse accum))) + (multiple-value-bind (next rest) (tree-entry data) + (tree-entries rest + (list* (format-tree-entry next) + accum))))) + +(defun extract-object-of-type (type s repository) + (with-simple-restart (continue "Skip object of type ~s" type) + (%extract-object-of-type type s repository))) + +(defgeneric %extract-object-of-type (type s repository) + (:method ((type integer) s repository) + (extract-object-of-type (object-type->sym type) + s + repository)) + + (:method ((type (eql :commit)) s repository) + s) + + (:method ((type (eql :blob)) s repository) + s) + + (:method ((type (eql :tag)) s repository) + s) + + (:method ((type (eql :tree)) s repository) + (tree-entries s))) + +(defun read-object-from-pack (s repository) + (let* ((metadata (fwoar.bin-parser:extract-high s)) + (type (object-type->sym (get-object-type metadata))) + (size (get-object-size metadata)) + (decompressed (if (member type '(:ofs-delta :ref-delta)) + s + (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s))) + (object-data (extract-object-of-type type decompressed repository))) + (list (cons :type (object-type->sym type)) + (cons :decompressed-size size) + (cons :object-data object-data) + (cons :raw-data object-data)))) + +(defun extract-object-from-pack (pack obj-number) + (with-open-file (s (index-file pack) :element-type '(unsigned-byte 8)) + (with-open-file (p (pack-file pack) :element-type '(unsigned-byte 8)) + (let* ((toc (idx-toc s)) + (offset-offset (getf toc :4-byte-offsets))) + (file-position s (+ offset-offset (* 4 obj-number))) + (let ((object-offset-in-pack (read-bytes 4 'fwoar.bin-parser:be->int s))) + (file-position p object-offset-in-pack) + (read-object-from-pack p (repository pack))))))) + +(defclass git-object () + ((%repo :initarg :repo :reader object-repo) + (%hash :initarg :hash :reader object-hash))) +(defclass loose-object (git-object) + ((%file :initarg :file :reader loose-object-file))) +(defclass packed-object (git-object) + ((%pack :initarg :pack :reader packed-object-pack) + (%offset :initarg :offset :reader packed-object-offset))) + +(defun object (repo id) + (let ((repo-root (typecase repo + (repository (root repo)) + (string (namestring + (truename repo)))))) + (or (alexandria:when-let ((object-file (loose-object repo id))) + (make-instance 'loose-object :repo repo-root :hash id :file object-file)) + (multiple-value-bind (pack offset) (find-object-in-pack-files repo id) + (when pack + (make-instance 'packed-object :repo repo-root :offset offset :pack pack)))))) + +(defun extract-loose-object (repo file) + (with-open-file (s file :element-type '(unsigned-byte 8)) + (alexandria:when-let ((result (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) + s))) + (destructuring-bind (type rest) + (partition (char-code #\space) result) + (extract-object-of-type (object-type->sym (babel:octets-to-string type)) + (elt (partition 0 rest) + 1) + repo))))) + +(defgeneric extract-object-next (object) + (:method ((object loose-object)) + (extract-loose-object (object-repo object) + (loose-object-file object))) + (:method ((object packed-object)) + (data-lens.lenses:view *object-data-lens* + (extract-object-from-pack (packed-object-pack object) + (packed-object-offset object))))) + +(defun extract-object (repo id) + (if (loose-object-p repo id) + (extract-loose-object repo (loose-object repo id)) + (data-lens.lenses:view *object-data-lens* + (multiple-value-call 'extract-object-from-pack + (find-object-in-pack-files (root repo) id))))) diff --git a/tests/sample-git-objects/blob-c516dfc-fixture b/tests/sample-git-objects/blob-c516dfc-fixture new file mode 100644 index 0000000..c516dfc --- /dev/null +++ b/tests/sample-git-objects/blob-c516dfc-fixture @@ -0,0 +1,140 @@ +(in-package :fwoar.cl-git) + +(defun seek-to-object-in-pack (idx-stream pack-stream obj-number) + (let* ((toc (idx-toc idx-stream)) + (offset-offset (getf toc :4-byte-offsets))) + (file-position idx-stream (+ offset-offset (* 4 obj-number))) + (let ((object-offset-in-pack (read-bytes 4 'fwoar.bin-parser:be->int idx-stream))) + (file-position pack-stream object-offset-in-pack)))) + +(deftype octet () + '(unsigned-byte 8)) + +(defmacro with-open-files* ((&rest bindings) &body body) + `(uiop:nest ,@(mapcar (serapeum:op + `(with-open-file ,_1)) + bindings) + (progn + ,@body))) + +(defun extract-object-metadata-from-pack (pack obj-number) + (with-open-files* ((s (index-file pack) :element-type 'octet) + (p (pack-file pack) :element-type 'octet)) + (seek-to-object-in-pack s p obj-number) + (read-object-metadata-from-pack p))) + +(defun turn-read-object-to-string (object) + (data-lens.lenses:over *object-data-lens* + 'babel:octets-to-string object)) + +(defun fanout-table (s) + (coerce (alexandria:assoc-value + (fwoar.bin-parser:extract '((head 4) + (version 4) + (fanout-table #.(* 4 256) batch-4)) + s) + 'fanout-table) + 'vector)) + +(defun get-object-size (bytes) + (let ((first (elt bytes 0)) + (rest (subseq bytes 1))) + (logior (ash (fwoar.bin-parser:be->int rest) 4) + (logand first 15)))) + +(defun get-object-type (bytes) + (let ((first (elt bytes 0))) + (ldb (byte 3 4) + first))) + +(defun get-shas-before (fanout-table first-sha-byte s) + (let ((num-before (elt fanout-table first-sha-byte)) + (num-total (alexandria:last-elt fanout-table))) + (values (fwoar.bin-parser:extract (list (list 'shas (* 20 num-before) '->sha-string)) + s) + (- num-total num-before)))) + +(defun advance-past-crcs (obj-count s) + (file-position s + (+ (file-position s) + (* 4 obj-count)))) + +(defun object-offset (object-number s) + (file-position s + (+ (file-position s) + (* (1- object-number) + 4))) + (fwoar.bin-parser:extract '((offset 4 fwoar.bin-parser:be->int)) + s)) + +(defun idx-toc (idx-stream) + (let* ((object-count (progn (file-position idx-stream 1028) + (let ((buf (make-array 4))) + (read-sequence buf idx-stream) + (fwoar.bin-parser:be->int buf)))) + (signature 0) + (version 4) + (fanout 8) + (shas (+ fanout + (* 4 256))) + (packed-crcs (+ shas + (* 20 object-count))) + (4-byte-offsets (+ packed-crcs + (* 4 object-count))) + (8-byte-offsets-pro (+ 4-byte-offsets + (* object-count 4))) + (pack-sha (- (file-length idx-stream) + 40)) + (8-byte-offsets (when (/= 8-byte-offsets-pro pack-sha) + 8-byte-offsets-pro)) + (idx-sha (- (file-length idx-stream) + 20))) + (values (sym->plist signature + version + fanout + shas + packed-crcs + 4-byte-offsets + 8-byte-offsets + pack-sha + idx-sha) + object-count))) + +(defun collect-data (idx-toc s num) + (let ((sha-idx (getf idx-toc :shas)) + (crc-idx (getf idx-toc :packed-crcs)) + (4-byte-offsets-idx (getf idx-toc :4-byte-offsets)) + (8-byte-offsets-idx (getf idx-toc :8-byte-offsets))) + (declare (ignore 8-byte-offsets-idx)) + (values num + (progn + (file-position s (+ sha-idx (* num 20))) + (read-bytes 20 'fwoar.bin-parser:byte-array-to-hex-string s)) + (progn + (file-position s (+ crc-idx (* num 4))) + (read-bytes 4 'identity s)) + (progn + (file-position s (+ 4-byte-offsets-idx (* num 4))) + (read-bytes 4 'fwoar.bin-parser:be->int s))))) + +(defun read-object-metadata-from-pack (s) + (let* ((metadata (fwoar.bin-parser:extract-high s)) + (type-raw (get-object-type metadata)) + (size (get-object-size metadata)) + (type (object-type->sym type-raw))) + (values (cons :type type) + (cons :decompressed-size size)))) + +(defun get-first-commits-from-pack (idx pack n) + (let ((toc (idx-toc idx)) + (result ())) + (dotimes (i n (reverse result)) + (multiple-value-bind (_ sha __ offset) (collect-data toc idx i) + (declare (ignore _ __)) + (file-position pack offset) + (push `((:sha . ,sha) + ,@(multiple-value-list + (read-object-metadata-from-pack pack)) + (:offset . ,offset)) + result))))) +