(in-package :fwoar.cl-git.pack) (defclass pack () ((%pack :initarg :pack :reader pack-file) (%index :initarg :index :reader index-file) (%repository :initarg :repository :reader fwoar.cl-git:repository))) (defun pack (index pack repository) (fw.lu:new 'pack index pack repository)) (defclass packed-ref (fwoar.cl-git.ref:ref) ((%pack :initarg :pack :reader packed-ref-pack) (%offset :initarg :offset :reader packed-ref-offset))) (defmacro with-pack-streams ((idx-sym pack-sym) pack &body body) (alexandria:once-only (pack) `(with-open-file (,idx-sym (index-file ,pack) :element-type 'fwoar.cl-git.types:octet) (with-open-file (,pack-sym (pack-file ,pack) :element-type 'fwoar.cl-git.types:octet) ,@body)))) (defgeneric idx-toc (pack) (:method ((pack pack)) (with-pack-streams (idx-stream _) pack (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 (fwoar.cl-git.utils:sym->plist signature version fanout shas packed-crcs 4-byte-offsets 8-byte-offsets pack-sha idx-sha) object-count))))) (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 extract-object-at-pos (pack pos ref) (with-open-file (p (fwoar.cl-git.pack:pack-file pack) :element-type '(unsigned-byte 8)) (file-position p pos) (read-object-from-pack p (fwoar.cl-git:repository pack) ref))) (defun extract-object-from-pack (pack obj-number ref) (let ((object-offset-in-pack (read-4-byte-offset pack obj-number))) (extract-object-at-pos pack object-offset-in-pack ref))) (defun find-object-in-pack-files (repo id) (dolist (pack-file (fwoar.cl-git::pack-files repo)) (multiple-value-bind (pack mid sha) (find-sha-in-pack pack-file id) (when pack (return-from find-object-in-pack-files (values pack mid sha)))))) (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 (fwoar.cl-git.utils:read-bytes 20 'fwoar.bin-parser:byte-array-to-hex-string s))) (cond ((serapeum:string-prefix-p sha sha-at-mid) (values mid sha-at-mid)) ((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 (values mid sha-at-mid))))))) (defun find-sha-in-pack (pack-file id) (with-open-file (s (fwoar.cl-git.pack:index-file pack-file) :element-type '(unsigned-byte 8)) (let ((binary-sha (ironclad:hex-string-to-byte-array id)) (toc (fwoar.cl-git.pack:idx-toc pack-file))) (multiple-value-bind (_ end) (edges-in-fanout toc s binary-sha) (declare (ignore _)) (multiple-value-bind (midpoint sha) (find-sha-between-terms toc s 0 end id) (and midpoint (values pack-file midpoint sha))))))) (defun get-object-from-pack (s) (let* ((metadata (fwoar.bin-parser:extract-high s)) (type (fwoar.cl-git::object-type->sym (fwoar.cl-git::get-object-type metadata))) (size (fwoar.cl-git::get-object-size metadata))) (case type (:ref-delta (error ":ref-delta not implemented yet")) (:ofs-delta (get-ofs-delta-offset-streaming s))) (let ((decompressed (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s))) (values (concatenate '(vector fwoar.cl-git.types:octet) (ecase type (:commit #.(babel:string-to-octets "commit" :encoding :ascii)) (:blob #.(babel:string-to-octets "blob" :encoding :ascii)) (:tree #.(babel:string-to-octets "tree" :encoding :ascii))) #(32) (babel:string-to-octets (prin1-to-string size ):encoding :ascii) #(0) decompressed) size (length decompressed))))) (defun get-ofs-delta-offset-streaming (buf) (let* ((idx 0)) (flet ((advance () (read-byte buf))) (loop for c = (advance) for ofs = (logand c 127) then (+ (ash (1+ ofs) 7) (logand c 127)) while (> (logand c 128) 0) finally (return (values (- ofs) idx)))))) (defun pack-offset-for-object (index-file obj-number) (let ((offset-offset (getf index-file :4-byte-offsets))) (+ offset-offset (* 4 obj-number)))) (defun packed-ref (repo id) (multiple-value-bind (pack offset sha) (find-object-in-pack-files repo id) (when pack (make-instance 'packed-ref :hash sha :repo repo :offset offset :pack pack)))) (defun raw-object-for-ref (packed-ref) (let ((pack (packed-ref-pack packed-ref))) (fwoar.cl-git.pack:with-pack-streams (i p) pack (file-position p (read-4-byte-offset pack (packed-ref-offset packed-ref))) (get-object-from-pack p)))) (defun read-4-byte-offset (pack obj-number) (fwoar.cl-git.pack:with-pack-streams (s _) pack (file-position s (pack-offset-for-object (fwoar.cl-git.pack:idx-toc pack) obj-number)) (fwoar.cl-git.utils:read-bytes 4 'fwoar.bin-parser:be->int s))) (defun read-object-from-pack (s repository ref) (let* ((pos (file-position s)) (metadata (fwoar.bin-parser:extract-high s)) (type (fwoar.cl-git::object-type->sym (fwoar.cl-git::get-object-type metadata))) (size (fwoar.cl-git::get-object-size metadata)) (delta-base (case type (:ref-delta (error ":ref-delta not implemented yet")) (:ofs-delta (fwoar.cl-git.delta::get-ofs-delta-offset-streaming s)))) (decompressed (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)) (object-data (fwoar.cl-git::extract-object-of-type type decompressed repository pos (pathname s) ref delta-base))) (list (cons :type (fwoar.cl-git::object-type->sym type)) (cons :decompressed-size size) (cons :object-data object-data) (cons :raw-data decompressed)))) (defun seek-to-object-in-pack (pack idx-stream pack-stream obj-number) (let* ((toc (idx-toc pack)) (offset-offset (getf toc :4-byte-offsets))) (file-position idx-stream (+ offset-offset (* 4 obj-number))) (let ((object-offset-in-pack (fwoar.cl-git.utils:read-bytes 4 'fwoar.bin-parser:be->int idx-stream))) (values (file-position pack-stream object-offset-in-pack) object-offset-in-pack)))) (defparameter *want-delta* nil) (defmethod fwoar.cl-git::extract-object ((object packed-ref)) (let ((maybe-delta (data-lens.lenses:view fwoar.cl-git::*object-data-lens* (extract-object-from-pack (fwoar.cl-git.pack::packed-ref-pack object) (fwoar.cl-git.pack::packed-ref-offset object) object)))) (if *want-delta* maybe-delta (fwoar.cl-git.delta:resolve-delta object maybe-delta))))