git.fiddlerwoaroof.com
git.lisp
488cc861
 (in-package :fwoar.cl-git)
 
b7739814
 (defun seek-to-object-in-pack (pack idx-stream pack-stream obj-number)
   (let* ((toc (idx-toc pack))
991d0162
          (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)))
6df34ee9
       (values (file-position pack-stream object-offset-in-pack)
               object-offset-in-pack))))
991d0162
 
 (defun extract-object-metadata-from-pack (pack obj-number)
b7739814
   (with-pack-streams (s p) pack
     (seek-to-object-in-pack pack s p obj-number)
500325f0
     (read-object-metadata-from-pack p)))
991d0162
 
488cc861
 (defun turn-read-object-to-string (object)
500325f0
   (data-lens.lenses:over *object-data-lens*
                          'babel:octets-to-string object))
488cc861
 
 (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)
6df34ee9
   (loop for c across bytes
         for next = (logand c 15) then (logand c #x7f)
         for shift = 0 then (if (= shift 0) 4 (+ shift 7))
         for size = next then (+ size (ash next shift))
         while (> (logand c #x80) 0)
         finally (return size)))
488cc861
 
 (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))
 
b7739814
 (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 (sym->plist signature
                             version
                             fanout
                             shas
                             packed-crcs
                             4-byte-offsets
                             8-byte-offsets
                             pack-sha
                             idx-sha)
                 object-count)))))
488cc861
 
 (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)))
991d0162
     (declare (ignore 8-byte-offsets-idx))
488cc861
     (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))
88e003ec
          (type-raw (get-object-type metadata))
          (size (get-object-size metadata))
          (type (object-type->sym type-raw)))
     (values (cons :type type)
488cc861
             (cons :decompressed-size size))))
 
b7739814
 (defun get-first-commits-from-pack (pack n)
   (let ((toc (idx-toc pack))
488cc861
         (result ()))
b7739814
     (with-pack-streams (idx pack-s) pack
       (dotimes (i n (reverse result))
         (multiple-value-bind (_ sha __ offset) (collect-data toc idx i)
           (declare (ignore _ __))
           (file-position pack-s offset)
           (push `((:sha . ,sha)
                   ,@(multiple-value-list
                      (read-object-metadata-from-pack pack-s))
                   (:offset . ,offset))
                 result))))))