git.fiddlerwoaroof.com
extract.lisp
347e97b1
 (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)))
744c84b5
         (cond ((serapeum:string-prefix-p sha sha-at-mid)
                (values mid sha-at-mid))
               ((string< sha sha-at-mid)
347e97b1
                (find-sha-between-terms toc s start mid sha))
               ((string> sha sha-at-mid)
                (find-sha-between-terms toc s (1+ mid) end sha))
744c84b5
               (t (values mid sha-at-mid)))))))
347e97b1
 
 (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 _))
744c84b5
         (multiple-value-bind (midpoint sha)
             (find-sha-between-terms toc s 0 end id)
347e97b1
           (and midpoint
                (values pack-file
744c84b5
                        midpoint
                        sha)))))))
347e97b1
 
 (defun find-object-in-pack-files (repo id)
   (dolist (pack-file (pack-files repo))
744c84b5
     (multiple-value-bind (pack mid sha) (find-pack-containing pack-file id)
347e97b1
       (when pack
         (return-from find-object-in-pack-files
744c84b5
           (values pack mid sha))))))
347e97b1
 
744c84b5
 (defun read-object-from-pack (s repository ref)
4cc1ee49
   (let* ((pos (file-position s))
          (metadata (fwoar.bin-parser:extract-high s))
077088c8
          (type (object-type->sym (get-object-type metadata)))
e079ee4a
          (size (get-object-size metadata))
077088c8
          (decompressed (if (member type '(:ofs-delta :ref-delta))
4cc1ee49
                            (let ((buffer (make-array size :element-type '(unsigned-byte 8))))
                              (read-sequence buffer s)
                              buffer)
077088c8
                            (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)))
744c84b5
          (object-data (extract-object-of-type type decompressed repository pos (pathname s) ref)))
e079ee4a
     (list (cons :type (object-type->sym type))
           (cons :decompressed-size size)
           (cons :object-data object-data)
ee4281cb
           (cons :raw-data decompressed))))
e079ee4a
 
744c84b5
 (defun extract-object-of-type (type s repository pos packfile ref)
   (with-simple-restart (continue "Skip object of type ~s at position ~d"
                                  type
                                  pos)
4cc1ee49
     (-extract-object-of-type (object-type->sym type)
                              s
                              repository
b27750d1
                              :offset-from pos
744c84b5
                              :packfile packfile
                              :hash (ref-hash ref))))
4cc1ee49
 
744c84b5
 (defun pack-offset-for-object (index-file obj-number)
   (let ((offset-offset (getf index-file
                              :4-byte-offsets)))
     (+ offset-offset
        (* 4 obj-number))))
 
801495d4
 (defun extract-object-at-pos (pack pos ref)
   (with-open-file (p (pack-file pack) :element-type '(unsigned-byte 8))
     (file-position p pos)
     (read-object-from-pack p
                            (repository pack)
                            ref)))
 
744c84b5
 (defun extract-object-from-pack (pack obj-number ref)
347e97b1
   (with-open-file (s (index-file pack) :element-type '(unsigned-byte 8))
801495d4
     (file-position s (pack-offset-for-object (idx-toc s)
                                              obj-number))
     (let ((object-offset-in-pack (read-bytes 4 'fwoar.bin-parser:be->int s)))
       (extract-object-at-pos pack
                              object-offset-in-pack
                              ref))))
347e97b1
 
744c84b5
 (defun extract-loose-object (repo file ref)
500325f0
   (with-open-file (s file :element-type '(unsigned-byte 8))
347e97b1
     (alexandria:when-let ((result (chipz:decompress nil (chipz:make-dstate 'chipz:zlib)
                                                     s)))
077088c8
       (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)
4cc1ee49
                                 repo
b27750d1
                                 0
744c84b5
                                 nil
                                 ref)))))
4cc1ee49
 
 (defgeneric extract-object (object)
   (:method ((object loose-ref))
     (extract-loose-object (ref-repo object)
744c84b5
                           (loose-ref-file object)
                           object))
4cc1ee49
   (:method ((object packed-ref))
500325f0
     (data-lens.lenses:view *object-data-lens*
4cc1ee49
                            (extract-object-from-pack (packed-ref-pack object)
744c84b5
                                                      (packed-ref-offset object)
                                                      object))))