Browse code
refactor: move more stuff into pack package
Edward Langley authored on 08/11/2023 11:05:22
Showing 9 changed files
Showing 9 changed files
- co.fwoar.cl-git.asd
- delta.lisp
- extract.lisp
- git.lisp
- model.lisp
- pack.lisp
- repository.lisp
- tests/git-objects.lisp
- util.lisp
... | ... |
@@ -48,11 +48,12 @@ |
48 | 48 |
(defun trace-bases (pack delta) |
49 | 49 |
(assert (typep delta 'delta)) |
50 | 50 |
(let* ((offset (second (base delta))) |
51 |
- (o (extract-object-at-pos pack |
|
52 |
- offset |
|
53 |
- (make-instance 'git-ref |
|
54 |
- :hash "00000000" |
|
55 |
- :repo nil))) |
|
51 |
+ (o (fwoar.cl-git.pack::extract-object-at-pos |
|
52 |
+ pack |
|
53 |
+ offset |
|
54 |
+ (make-instance 'git-ref |
|
55 |
+ :hash "00000000" |
|
56 |
+ :repo nil))) |
|
56 | 57 |
(obj (serapeum:assocdr :object-data o)) |
57 | 58 |
(raw (serapeum:assocdr :raw-data o))) |
58 | 59 |
(if (typep obj 'delta) |
... | ... |
@@ -68,8 +69,9 @@ |
68 | 69 |
|
69 | 70 |
(defun resolve-delta (ref maybe-delta) |
70 | 71 |
(typecase maybe-delta |
71 |
- (delta (multiple-value-bind (raw-data type) (trace-bases (packed-ref-pack ref) |
|
72 |
- maybe-delta) |
|
72 |
+ (delta (multiple-value-bind (raw-data type) (trace-bases |
|
73 |
+ (fwoar.cl-git.pack::packed-ref-pack ref) |
|
74 |
+ maybe-delta) |
|
73 | 75 |
(-extract-object-of-type type |
74 | 76 |
raw-data |
75 | 77 |
(ref-repo ref) |
... | ... |
@@ -1,106 +1,5 @@ |
1 | 1 |
(in-package :fwoar.cl-git) |
2 | 2 |
|
3 |
-(defun edges-in-fanout (toc s sha) |
|
4 |
- (let* ((fanout-offset (getf toc :fanout))) |
|
5 |
- (file-position s (+ fanout-offset (* 4 (1- (elt sha 0))))) |
|
6 |
- (destructuring-bind ((_ . cur) (__ . next)) |
|
7 |
- (fwoar.bin-parser:extract '((cur 4 fwoar.bin-parser:be->int) |
|
8 |
- (next 4 fwoar.bin-parser:be->int)) |
|
9 |
- s) |
|
10 |
- (declare (ignore _ __)) |
|
11 |
- (values cur next)))) |
|
12 |
- |
|
13 |
-(defun find-sha-between-terms (toc s start end sha) |
|
14 |
- (unless (>= start end) |
|
15 |
- (let* ((sha-offset (getf toc :shas)) |
|
16 |
- (mid (floor (+ start end) |
|
17 |
- 2))) |
|
18 |
- (file-position s (+ sha-offset (* 20 mid))) |
|
19 |
- (let ((sha-at-mid (read-bytes 20 'fwoar.bin-parser:byte-array-to-hex-string s))) |
|
20 |
- (cond ((serapeum:string-prefix-p sha sha-at-mid) |
|
21 |
- (values mid sha-at-mid)) |
|
22 |
- ((string< sha sha-at-mid) |
|
23 |
- (find-sha-between-terms toc s start mid sha)) |
|
24 |
- ((string> sha sha-at-mid) |
|
25 |
- (find-sha-between-terms toc s (1+ mid) end sha)) |
|
26 |
- (t (values mid sha-at-mid))))))) |
|
27 |
- |
|
28 |
-(defun find-sha-in-pack (pack-file id) |
|
29 |
- (with-open-file (s (index-file pack-file) |
|
30 |
- :element-type '(unsigned-byte 8)) |
|
31 |
- (let ((binary-sha (ironclad:hex-string-to-byte-array id)) |
|
32 |
- (toc (idx-toc pack-file))) |
|
33 |
- (multiple-value-bind (_ end) (edges-in-fanout toc s binary-sha) |
|
34 |
- (declare (ignore _)) |
|
35 |
- (multiple-value-bind (midpoint sha) |
|
36 |
- (find-sha-between-terms toc s 0 end id) |
|
37 |
- (and midpoint |
|
38 |
- (values pack-file |
|
39 |
- midpoint |
|
40 |
- sha))))))) |
|
41 |
- |
|
42 |
-(defun find-object-in-pack-files (repo id) |
|
43 |
- (dolist (pack-file (pack-files repo)) |
|
44 |
- (multiple-value-bind (pack mid sha) (find-sha-in-pack pack-file id) |
|
45 |
- (when pack |
|
46 |
- (return-from find-object-in-pack-files |
|
47 |
- (values pack mid sha)))))) |
|
48 |
- |
|
49 |
-(defun raw-object-for-ref (packed-ref) |
|
50 |
- (let ((pack (packed-ref-pack packed-ref))) |
|
51 |
- (with-pack-streams (i p) pack |
|
52 |
- (file-position p (read-4-byte-offset pack (packed-ref-offset packed-ref))) |
|
53 |
- (get-object-from-pack p)))) |
|
54 |
- |
|
55 |
-(defun get-object-from-pack (s) |
|
56 |
- (let* ((metadata (fwoar.bin-parser:extract-high s)) |
|
57 |
- (type (object-type->sym (get-object-type metadata))) |
|
58 |
- (size (get-object-size metadata))) |
|
59 |
- (case type |
|
60 |
- (:ref-delta (error ":ref-delta not implemented yet")) |
|
61 |
- (:ofs-delta (get-ofs-delta-offset-streaming s))) |
|
62 |
- (let ((decompressed (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s))) |
|
63 |
- (values (concatenate |
|
64 |
- '(vector fwoar.cl-git.types:octet) |
|
65 |
- (ecase type |
|
66 |
- (:commit #.(babel:string-to-octets "commit" :encoding :ascii)) |
|
67 |
- (:blob #.(babel:string-to-octets "blob" :encoding :ascii)) |
|
68 |
- (:tree #.(babel:string-to-octets "tree" :encoding :ascii))) |
|
69 |
- #(32) |
|
70 |
- (babel:string-to-octets (prin1-to-string size ):encoding :ascii) |
|
71 |
- #(0) |
|
72 |
- decompressed) |
|
73 |
- size |
|
74 |
- (length decompressed))))) |
|
75 |
- |
|
76 |
-(defun get-ofs-delta-offset-streaming (buf) |
|
77 |
- (let* ((idx 0)) |
|
78 |
- (flet ((advance () |
|
79 |
- (read-byte buf))) |
|
80 |
- (loop |
|
81 |
- for c = (advance) |
|
82 |
- for ofs = (logand c 127) then (+ (ash (1+ ofs) |
|
83 |
- 7) |
|
84 |
- (logand c 127)) |
|
85 |
- while (> (logand c 128) 0) |
|
86 |
- finally |
|
87 |
- (return (values (- ofs) idx)))))) |
|
88 |
- |
|
89 |
-(defun read-object-from-pack (s repository ref) |
|
90 |
- (let* ((pos (file-position s)) |
|
91 |
- (metadata (fwoar.bin-parser:extract-high s)) |
|
92 |
- (type (object-type->sym (get-object-type metadata))) |
|
93 |
- (size (get-object-size metadata)) |
|
94 |
- (delta-base (case type |
|
95 |
- (:ref-delta (error ":ref-delta not implemented yet")) |
|
96 |
- (:ofs-delta (get-ofs-delta-offset-streaming s)))) |
|
97 |
- (decompressed (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)) |
|
98 |
- (object-data (extract-object-of-type type decompressed repository pos (pathname s) ref delta-base))) |
|
99 |
- (list (cons :type (object-type->sym type)) |
|
100 |
- (cons :decompressed-size size) |
|
101 |
- (cons :object-data object-data) |
|
102 |
- (cons :raw-data decompressed)))) |
|
103 |
- |
|
104 | 3 |
(defun extract-object-of-type (type s repository pos packfile ref delta-base) |
105 | 4 |
(with-simple-restart (continue "Skip object of type ~s at position ~d" |
106 | 5 |
type |
... | ... |
@@ -113,32 +12,6 @@ |
113 | 12 |
:hash (ref-hash ref) |
114 | 13 |
:base delta-base))) |
115 | 14 |
|
116 |
-(defun pack-offset-for-object (index-file obj-number) |
|
117 |
- (let ((offset-offset (getf index-file |
|
118 |
- :4-byte-offsets))) |
|
119 |
- (+ offset-offset |
|
120 |
- (* 4 obj-number)))) |
|
121 |
- |
|
122 |
-(defun extract-object-at-pos (pack pos ref) |
|
123 |
- (with-open-file (p (pack-file pack) :element-type '(unsigned-byte 8)) |
|
124 |
- (file-position p pos) |
|
125 |
- (read-object-from-pack p |
|
126 |
- (repository pack) |
|
127 |
- ref))) |
|
128 |
- |
|
129 |
-(defun read-4-byte-offset (pack obj-number) |
|
130 |
- (with-pack-streams (s _) pack |
|
131 |
- (file-position s |
|
132 |
- (pack-offset-for-object (idx-toc pack) |
|
133 |
- obj-number)) |
|
134 |
- (read-bytes 4 'fwoar.bin-parser:be->int s))) |
|
135 |
- |
|
136 |
-(defun extract-object-from-pack (pack obj-number ref) |
|
137 |
- (let ((object-offset-in-pack (read-4-byte-offset pack obj-number))) |
|
138 |
- (extract-object-at-pos pack |
|
139 |
- object-offset-in-pack |
|
140 |
- ref))) |
|
141 |
- |
|
142 | 15 |
(defun extract-loose-object (repo file ref) |
143 | 16 |
(with-open-file (s file :element-type '(unsigned-byte 8)) |
144 | 17 |
(alexandria:when-let ((result (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) |
... | ... |
@@ -154,18 +27,8 @@ |
154 | 27 |
ref |
155 | 28 |
nil))))) |
156 | 29 |
|
157 |
-(defparameter *want-delta* nil) |
|
158 | 30 |
(defgeneric extract-object (object) |
159 | 31 |
(:method ((object loose-ref)) |
160 | 32 |
(extract-loose-object (ref-repo object) |
161 | 33 |
(loose-ref-file object) |
162 |
- object)) |
|
163 |
- (:method ((object packed-ref)) |
|
164 |
- (let ((maybe-delta (data-lens.lenses:view *object-data-lens* |
|
165 |
- (extract-object-from-pack (packed-ref-pack object) |
|
166 |
- (packed-ref-offset object) |
|
167 |
- object)))) |
|
168 |
- (if *want-delta* |
|
169 |
- maybe-delta |
|
170 |
- (resolve-delta object |
|
171 |
- maybe-delta))))) |
|
34 |
+ object))) |
... | ... |
@@ -1,13 +1,5 @@ |
1 | 1 |
(in-package :fwoar.cl-git) |
2 | 2 |
|
3 |
-(defun seek-to-object-in-pack (pack idx-stream pack-stream obj-number) |
|
4 |
- (let* ((toc (idx-toc pack)) |
|
5 |
- (offset-offset (getf toc :4-byte-offsets))) |
|
6 |
- (file-position idx-stream (+ offset-offset (* 4 obj-number))) |
|
7 |
- (let ((object-offset-in-pack (read-bytes 4 'fwoar.bin-parser:be->int idx-stream))) |
|
8 |
- (values (file-position pack-stream object-offset-in-pack) |
|
9 |
- object-offset-in-pack)))) |
|
10 |
- |
|
11 | 3 |
(defun extract-object-metadata-from-pack (pack obj-number) |
12 | 4 |
(with-pack-streams (s p) pack |
13 | 5 |
(seek-to-object-in-pack pack s p obj-number) |
... | ... |
@@ -54,46 +46,11 @@ |
54 | 46 |
(defun object-offset (object-number s) |
55 | 47 |
(file-position s |
56 | 48 |
(+ (file-position s) |
57 |
- (* (1- object-number) |
|
58 |
- 4))) |
|
49 |
+ (* (1- object-number) |
|
50 |
+ 4))) |
|
59 | 51 |
(fwoar.bin-parser:extract '((offset 4 fwoar.bin-parser:be->int)) |
60 | 52 |
s)) |
61 | 53 |
|
62 |
-(defgeneric idx-toc (pack) |
|
63 |
- (:method ((pack pack)) |
|
64 |
- (with-pack-streams (idx-stream _) pack |
|
65 |
- (let* ((object-count (progn (file-position idx-stream 1028) |
|
66 |
- (let ((buf (make-array 4))) |
|
67 |
- (read-sequence buf idx-stream) |
|
68 |
- (fwoar.bin-parser:be->int buf)))) |
|
69 |
- (signature 0) |
|
70 |
- (version 4) |
|
71 |
- (fanout 8) |
|
72 |
- (shas (+ fanout |
|
73 |
- #.(* 4 256))) |
|
74 |
- (packed-crcs (+ shas |
|
75 |
- (* 20 object-count))) |
|
76 |
- (4-byte-offsets (+ packed-crcs |
|
77 |
- (* 4 object-count))) |
|
78 |
- (8-byte-offsets-pro (+ 4-byte-offsets |
|
79 |
- (* object-count 4))) |
|
80 |
- (pack-sha (- (file-length idx-stream) |
|
81 |
- 40)) |
|
82 |
- (8-byte-offsets (when (/= 8-byte-offsets-pro pack-sha) |
|
83 |
- 8-byte-offsets-pro)) |
|
84 |
- (idx-sha (- (file-length idx-stream) |
|
85 |
- 20))) |
|
86 |
- (values (sym->plist signature |
|
87 |
- version |
|
88 |
- fanout |
|
89 |
- shas |
|
90 |
- packed-crcs |
|
91 |
- 4-byte-offsets |
|
92 |
- 8-byte-offsets |
|
93 |
- pack-sha |
|
94 |
- idx-sha) |
|
95 |
- object-count))))) |
|
96 |
- |
|
97 | 54 |
(defun collect-data (idx-toc s num) |
98 | 55 |
(let ((sha-idx (getf idx-toc :shas)) |
99 | 56 |
(crc-idx (getf idx-toc :packed-crcs)) |
... | ... |
@@ -3,11 +3,6 @@ |
3 | 3 |
(defparameter *object-data-lens* |
4 | 4 |
(data-lens.lenses:make-alist-lens :object-data)) |
5 | 5 |
|
6 |
-(defclass pack () |
|
7 |
- ((%pack :initarg :pack :reader pack-file) |
|
8 |
- (%index :initarg :index :reader index-file) |
|
9 |
- (%repository :initarg :repository :reader repository))) |
|
10 |
- |
|
11 | 6 |
(defclass repository () |
12 | 7 |
((%root :initarg :root :reader root))) |
13 | 8 |
(defclass git-repository (repository) |
... | ... |
@@ -97,22 +92,13 @@ |
97 | 92 |
(let ((obj-path (fwoar.string-utils:insert-at 2 #\/ sha))) |
98 | 93 |
(merge-pathnames obj-path ".git/objects/"))) |
99 | 94 |
|
100 |
-(defun pack (index pack repository) |
|
101 |
- (fw.lu:new 'pack index pack repository)) |
|
102 |
- |
|
103 |
-(defmacro with-pack-streams ((idx-sym pack-sym) pack &body body) |
|
104 |
- (alexandria:once-only (pack) |
|
105 |
- `(with-open-file (,idx-sym (index-file ,pack) :element-type 'fwoar.cl-git.types:octet) |
|
106 |
- (with-open-file (,pack-sym (pack-file ,pack) :element-type 'fwoar.cl-git.types:octet) |
|
107 |
- ,@body)))) |
|
108 |
- |
|
109 | 95 |
(defgeneric pack-files (repo) |
110 | 96 |
(:method ((repo git-repository)) |
111 | 97 |
(mapcar (serapeum:op |
112 |
- (pack _1 |
|
113 |
- (merge-pathnames |
|
114 |
- (make-pathname :type "pack") _1) |
|
115 |
- repo)) |
|
98 |
+ (fwoar.cl-git.pack:pack _1 |
|
99 |
+ (merge-pathnames |
|
100 |
+ (make-pathname :type "pack") _1) |
|
101 |
+ repo)) |
|
116 | 102 |
(uiop:directory* |
117 | 103 |
(merge-pathnames ".git/objects/pack/*.idx" |
118 | 104 |
(root-of repo)))))) |
... | ... |
@@ -141,9 +127,6 @@ |
141 | 127 |
(%hash :initarg :hash :reader ref-hash))) |
142 | 128 |
(defclass loose-ref (git-ref) |
143 | 129 |
((%file :initarg :file :reader loose-ref-file))) |
144 |
-(defclass packed-ref (git-ref) |
|
145 |
- ((%pack :initarg :pack :reader packed-ref-pack) |
|
146 |
- (%offset :initarg :offset :reader packed-ref-offset))) |
|
147 | 130 |
|
148 | 131 |
(defmethod print-object ((obj git-ref) s) |
149 | 132 |
(print-unreadable-object (obj s :type t :identity t) |
150 | 133 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,212 @@ |
1 |
+(in-package :fwoar.cl-git.pack) |
|
2 |
+ |
|
3 |
+(defclass pack () |
|
4 |
+ ((%pack :initarg :pack :reader pack-file) |
|
5 |
+ (%index :initarg :index :reader index-file) |
|
6 |
+ (%repository :initarg :repository :reader fwoar.cl-git:repository))) |
|
7 |
+(defun pack (index pack repository) |
|
8 |
+ (fw.lu:new 'pack index pack repository)) |
|
9 |
+ |
|
10 |
+(defclass packed-ref (fwoar.cl-git::git-ref) |
|
11 |
+ ((%pack :initarg :pack :reader packed-ref-pack) |
|
12 |
+ (%offset :initarg :offset :reader packed-ref-offset))) |
|
13 |
+ |
|
14 |
+(defmacro with-pack-streams ((idx-sym pack-sym) pack &body body) |
|
15 |
+ (alexandria:once-only (pack) |
|
16 |
+ `(with-open-file (,idx-sym (index-file ,pack) :element-type 'fwoar.cl-git.types:octet) |
|
17 |
+ (with-open-file (,pack-sym (pack-file ,pack) :element-type 'fwoar.cl-git.types:octet) |
|
18 |
+ ,@body)))) |
|
19 |
+ |
|
20 |
+(defgeneric idx-toc (pack) |
|
21 |
+ (:method ((pack pack)) |
|
22 |
+ (with-pack-streams (idx-stream _) pack |
|
23 |
+ (let* ((object-count (progn (file-position idx-stream 1028) |
|
24 |
+ (let ((buf (make-array 4))) |
|
25 |
+ (read-sequence buf idx-stream) |
|
26 |
+ (fwoar.bin-parser:be->int buf)))) |
|
27 |
+ (signature 0) |
|
28 |
+ (version 4) |
|
29 |
+ (fanout 8) |
|
30 |
+ (shas (+ fanout |
|
31 |
+ #.(* 4 256))) |
|
32 |
+ (packed-crcs (+ shas |
|
33 |
+ (* 20 object-count))) |
|
34 |
+ (4-byte-offsets (+ packed-crcs |
|
35 |
+ (* 4 object-count))) |
|
36 |
+ (8-byte-offsets-pro (+ 4-byte-offsets |
|
37 |
+ (* object-count 4))) |
|
38 |
+ (pack-sha (- (file-length idx-stream) |
|
39 |
+ 40)) |
|
40 |
+ (8-byte-offsets (when (/= 8-byte-offsets-pro pack-sha) |
|
41 |
+ 8-byte-offsets-pro)) |
|
42 |
+ (idx-sha (- (file-length idx-stream) |
|
43 |
+ 20))) |
|
44 |
+ (values (fwoar.cl-git.utils:sym->plist signature |
|
45 |
+ version |
|
46 |
+ fanout |
|
47 |
+ shas |
|
48 |
+ packed-crcs |
|
49 |
+ 4-byte-offsets |
|
50 |
+ 8-byte-offsets |
|
51 |
+ pack-sha |
|
52 |
+ idx-sha) |
|
53 |
+ object-count))))) |
|
54 |
+ |
|
55 |
+(defun edges-in-fanout (toc s sha) |
|
56 |
+ (let* ((fanout-offset (getf toc :fanout))) |
|
57 |
+ (file-position s (+ fanout-offset (* 4 (1- (elt sha 0))))) |
|
58 |
+ (destructuring-bind ((_ . cur) (__ . next)) |
|
59 |
+ (fwoar.bin-parser:extract '((cur 4 fwoar.bin-parser:be->int) |
|
60 |
+ (next 4 fwoar.bin-parser:be->int)) |
|
61 |
+ s) |
|
62 |
+ (declare (ignore _ __)) |
|
63 |
+ (values cur next)))) |
|
64 |
+ |
|
65 |
+(defun extract-object-at-pos (pack pos ref) |
|
66 |
+ (with-open-file (p (fwoar.cl-git.pack:pack-file pack) :element-type '(unsigned-byte 8)) |
|
67 |
+ (file-position p pos) |
|
68 |
+ (read-object-from-pack p |
|
69 |
+ (fwoar.cl-git:repository pack) |
|
70 |
+ ref))) |
|
71 |
+ |
|
72 |
+(defun extract-object-from-pack (pack obj-number ref) |
|
73 |
+ (let ((object-offset-in-pack (read-4-byte-offset pack obj-number))) |
|
74 |
+ (extract-object-at-pos pack |
|
75 |
+ object-offset-in-pack |
|
76 |
+ ref))) |
|
77 |
+ |
|
78 |
+(defun find-object-in-pack-files (repo id) |
|
79 |
+ (dolist (pack-file (fwoar.cl-git::pack-files repo)) |
|
80 |
+ (multiple-value-bind (pack mid sha) (find-sha-in-pack pack-file id) |
|
81 |
+ (when pack |
|
82 |
+ (return-from find-object-in-pack-files |
|
83 |
+ (values pack mid sha)))))) |
|
84 |
+ |
|
85 |
+(defun find-sha-between-terms (toc s start end sha) |
|
86 |
+ (unless (>= start end) |
|
87 |
+ (let* ((sha-offset (getf toc :shas)) |
|
88 |
+ (mid (floor (+ start end) |
|
89 |
+ 2))) |
|
90 |
+ (file-position s (+ sha-offset (* 20 mid))) |
|
91 |
+ (let ((sha-at-mid (fwoar.cl-git.utils:read-bytes |
|
92 |
+ 20 'fwoar.bin-parser:byte-array-to-hex-string s))) |
|
93 |
+ (cond ((serapeum:string-prefix-p sha sha-at-mid) |
|
94 |
+ (values mid sha-at-mid)) |
|
95 |
+ ((string< sha sha-at-mid) |
|
96 |
+ (find-sha-between-terms toc s start mid sha)) |
|
97 |
+ ((string> sha sha-at-mid) |
|
98 |
+ (find-sha-between-terms toc s (1+ mid) end sha)) |
|
99 |
+ (t (values mid sha-at-mid))))))) |
|
100 |
+ |
|
101 |
+(defun find-sha-in-pack (pack-file id) |
|
102 |
+ (with-open-file (s (fwoar.cl-git.pack:index-file pack-file) |
|
103 |
+ :element-type '(unsigned-byte 8)) |
|
104 |
+ (let ((binary-sha (ironclad:hex-string-to-byte-array id)) |
|
105 |
+ (toc (fwoar.cl-git.pack:idx-toc pack-file))) |
|
106 |
+ (multiple-value-bind (_ end) (edges-in-fanout toc s binary-sha) |
|
107 |
+ (declare (ignore _)) |
|
108 |
+ (multiple-value-bind (midpoint sha) |
|
109 |
+ (find-sha-between-terms toc s 0 end id) |
|
110 |
+ (and midpoint |
|
111 |
+ (values pack-file |
|
112 |
+ midpoint |
|
113 |
+ sha))))))) |
|
114 |
+ |
|
115 |
+(defun get-object-from-pack (s) |
|
116 |
+ (let* ((metadata (fwoar.bin-parser:extract-high s)) |
|
117 |
+ (type (fwoar.cl-git::object-type->sym (fwoar.cl-git::get-object-type metadata))) |
|
118 |
+ (size (fwoar.cl-git::get-object-size metadata))) |
|
119 |
+ (case type |
|
120 |
+ (:ref-delta (error ":ref-delta not implemented yet")) |
|
121 |
+ (:ofs-delta (get-ofs-delta-offset-streaming s))) |
|
122 |
+ (let ((decompressed (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s))) |
|
123 |
+ (values (concatenate |
|
124 |
+ '(vector fwoar.cl-git.types:octet) |
|
125 |
+ (ecase type |
|
126 |
+ (:commit #.(babel:string-to-octets "commit" :encoding :ascii)) |
|
127 |
+ (:blob #.(babel:string-to-octets "blob" :encoding :ascii)) |
|
128 |
+ (:tree #.(babel:string-to-octets "tree" :encoding :ascii))) |
|
129 |
+ #(32) |
|
130 |
+ (babel:string-to-octets (prin1-to-string size ):encoding :ascii) |
|
131 |
+ #(0) |
|
132 |
+ decompressed) |
|
133 |
+ size |
|
134 |
+ (length decompressed))))) |
|
135 |
+ |
|
136 |
+(defun get-ofs-delta-offset-streaming (buf) |
|
137 |
+ (let* ((idx 0)) |
|
138 |
+ (flet ((advance () |
|
139 |
+ (read-byte buf))) |
|
140 |
+ (loop |
|
141 |
+ for c = (advance) |
|
142 |
+ for ofs = (logand c 127) then (+ (ash (1+ ofs) |
|
143 |
+ 7) |
|
144 |
+ (logand c 127)) |
|
145 |
+ while (> (logand c 128) 0) |
|
146 |
+ finally |
|
147 |
+ (return (values (- ofs) idx)))))) |
|
148 |
+ |
|
149 |
+(defun pack-offset-for-object (index-file obj-number) |
|
150 |
+ (let ((offset-offset (getf index-file |
|
151 |
+ :4-byte-offsets))) |
|
152 |
+ (+ offset-offset |
|
153 |
+ (* 4 obj-number)))) |
|
154 |
+ |
|
155 |
+(defun packed-ref (repo id) |
|
156 |
+ (multiple-value-bind (pack offset sha) (find-object-in-pack-files repo id) |
|
157 |
+ (when pack |
|
158 |
+ (make-instance 'packed-ref |
|
159 |
+ :hash sha |
|
160 |
+ :repo repo |
|
161 |
+ :offset offset |
|
162 |
+ :pack pack)))) |
|
163 |
+ |
|
164 |
+(defun raw-object-for-ref (packed-ref) |
|
165 |
+ (let ((pack (packed-ref-pack packed-ref))) |
|
166 |
+ (fwoar.cl-git.pack:with-pack-streams (i p) pack |
|
167 |
+ (file-position p (read-4-byte-offset pack |
|
168 |
+ (packed-ref-offset packed-ref))) |
|
169 |
+ (get-object-from-pack p)))) |
|
170 |
+ |
|
171 |
+(defun read-4-byte-offset (pack obj-number) |
|
172 |
+ (fwoar.cl-git.pack:with-pack-streams (s _) pack |
|
173 |
+ (file-position s |
|
174 |
+ (pack-offset-for-object (fwoar.cl-git.pack:idx-toc pack) |
|
175 |
+ obj-number)) |
|
176 |
+ (fwoar.cl-git.utils:read-bytes 4 'fwoar.bin-parser:be->int s))) |
|
177 |
+ |
|
178 |
+(defun read-object-from-pack (s repository ref) |
|
179 |
+ (let* ((pos (file-position s)) |
|
180 |
+ (metadata (fwoar.bin-parser:extract-high s)) |
|
181 |
+ (type (fwoar.cl-git::object-type->sym (fwoar.cl-git::get-object-type metadata))) |
|
182 |
+ (size (fwoar.cl-git::get-object-size metadata)) |
|
183 |
+ (delta-base (case type |
|
184 |
+ (:ref-delta (error ":ref-delta not implemented yet")) |
|
185 |
+ (:ofs-delta (fwoar.cl-git::get-ofs-delta-offset-streaming s)))) |
|
186 |
+ (decompressed (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)) |
|
187 |
+ (object-data (fwoar.cl-git::extract-object-of-type type decompressed repository pos (pathname s) ref delta-base))) |
|
188 |
+ (list (cons :type (fwoar.cl-git::object-type->sym type)) |
|
189 |
+ (cons :decompressed-size size) |
|
190 |
+ (cons :object-data object-data) |
|
191 |
+ (cons :raw-data decompressed)))) |
|
192 |
+ |
|
193 |
+(defun seek-to-object-in-pack (pack idx-stream pack-stream obj-number) |
|
194 |
+ (let* ((toc (idx-toc pack)) |
|
195 |
+ (offset-offset (getf toc :4-byte-offsets))) |
|
196 |
+ (file-position idx-stream (+ offset-offset (* 4 obj-number))) |
|
197 |
+ (let ((object-offset-in-pack (fwoar.cl-git.utils:read-bytes |
|
198 |
+ 4 'fwoar.bin-parser:be->int idx-stream))) |
|
199 |
+ (values (file-position pack-stream object-offset-in-pack) |
|
200 |
+ object-offset-in-pack)))) |
|
201 |
+ |
|
202 |
+(defparameter *want-delta* nil) |
|
203 |
+(defmethod fwoar.cl-git::extract-object ((object packed-ref)) |
|
204 |
+ (let ((maybe-delta (data-lens.lenses:view fwoar.cl-git::*object-data-lens* |
|
205 |
+ (extract-object-from-pack |
|
206 |
+ (fwoar.cl-git.pack::packed-ref-pack object) |
|
207 |
+ (fwoar.cl-git.pack::packed-ref-offset object) |
|
208 |
+ object)))) |
|
209 |
+ (if *want-delta* |
|
210 |
+ maybe-delta |
|
211 |
+ (fwoar.cl-git::resolve-delta object |
|
212 |
+ maybe-delta)))) |
... | ... |
@@ -6,15 +6,6 @@ |
6 | 6 |
((or pathname string) (namestring |
7 | 7 |
(truename repo))))) |
8 | 8 |
|
9 |
-(defun packed-ref (repo id) |
|
10 |
- (multiple-value-bind (pack offset sha) (find-object-in-pack-files repo id) |
|
11 |
- (when pack |
|
12 |
- (make-instance 'packed-ref |
|
13 |
- :hash sha |
|
14 |
- :repo repo |
|
15 |
- :offset offset |
|
16 |
- :pack pack)))) |
|
17 |
- |
|
18 | 9 |
(defgeneric ref (repo id) |
19 | 10 |
(:documentation "Given a REPOsitory and a ref ID return the ref-id object.") |
20 | 11 |
(:method ((repo git-repository) (id string)) |
... | ... |
@@ -73,13 +73,13 @@ |
73 | 73 |
(fake-ref repo hash)) |
74 | 74 |
(defmethod fwoar.cl-git::pack-files ((repo (eql *fake-repo*))) |
75 | 75 |
(list |
76 |
- (fwoar.cl-git::pack (asdf:system-relative-pathname |
|
77 |
- :co.fwoar.cl-git |
|
78 |
- "tests/sample-git-objects/hello-world-pack.idx") |
|
79 |
- (asdf:system-relative-pathname |
|
80 |
- :co.fwoar.cl-git |
|
81 |
- "tests/sample-git-objects/hello-world-pack.pack") |
|
82 |
- repo))) |
|
76 |
+ (fwoar.cl-git.pack::pack (asdf:system-relative-pathname |
|
77 |
+ :co.fwoar.cl-git |
|
78 |
+ "tests/sample-git-objects/hello-world-pack.idx") |
|
79 |
+ (asdf:system-relative-pathname |
|
80 |
+ :co.fwoar.cl-git |
|
81 |
+ "tests/sample-git-objects/hello-world-pack.pack") |
|
82 |
+ repo))) |
|
83 | 83 |
|
84 | 84 |
(fiveam:def-test pack-files-commit () |
85 | 85 |
(let* ((hash "7d7b56a6a64e090041f55293511f48aba6699f1a") |
... | ... |
@@ -162,20 +162,20 @@ |
162 | 162 |
()) |
163 | 163 |
(defun fake-ref-2 (repo hash) |
164 | 164 |
(fwoar.lisputils:new 'fake-ref-2 repo hash)) |
165 |
-(defmethod fwoar.cl-git::packed-ref-pack ((ref fake-ref-2)) |
|
165 |
+(defmethod fwoar.cl-git.pack::packed-ref-pack ((ref fake-ref-2)) |
|
166 | 166 |
(let* ((pack-file (asdf:system-relative-pathname |
167 | 167 |
:co.fwoar.cl-git/tests |
168 | 168 |
"tests/sample-git-objects/pack-a0533639fdee4493fdbfc1b701872ace63b95e5f.pack")) |
169 | 169 |
(index-file (asdf:system-relative-pathname |
170 | 170 |
:co.fwoar.cl-git/tests |
171 | 171 |
"tests/sample-git-objects/pack-a0533639fdee4493fdbfc1b701872ace63b95e5f.idx"))) |
172 |
- (make-instance 'fwoar.cl-git::pack |
|
172 |
+ (make-instance 'fwoar.cl-git.pack::pack |
|
173 | 173 |
:repository nil |
174 | 174 |
:index index-file |
175 | 175 |
:pack pack-file))) |
176 |
-(defmethod fwoar.cl-git::packed-ref-offset ((ref fake-ref-2)) |
|
177 |
- (nth-value 1 (fwoar.cl-git::find-sha-in-pack (fwoar.cl-git::packed-ref-pack ref) |
|
178 |
- (fwoar.cl-git::ref-hash ref)))) |
|
176 |
+(defmethod fwoar.cl-git.pack::packed-ref-offset ((ref fake-ref-2)) |
|
177 |
+ (nth-value 1 (fwoar.cl-git.pack::find-sha-in-pack (fwoar.cl-git.pack::packed-ref-pack ref) |
|
178 |
+ (fwoar.cl-git::ref-hash ref)))) |
|
179 | 179 |
(defmethod fwoar.cl-git::ref ((repo (eql *fake-repo-2*)) hash) |
180 | 180 |
(fake-ref-2 repo hash)) |
181 | 181 |
(defmethod fwoar.cl-git::pack-files ((repo (eql *fake-repo-2*))) |
... | ... |
@@ -186,13 +186,13 @@ |
186 | 186 |
(index-file (asdf:system-relative-pathname |
187 | 187 |
:co.fwoar.cl-git/tests |
188 | 188 |
"tests/sample-git-objects/pack-a0533639fdee4493fdbfc1b701872ace63b95e5f.idx"))) |
189 |
- (make-instance 'fwoar.cl-git::pack |
|
189 |
+ (make-instance 'fwoar.cl-git.pack::pack |
|
190 | 190 |
:repository nil |
191 | 191 |
:index index-file |
192 | 192 |
:pack pack-file)))) |
193 | 193 |
|
194 | 194 |
(fiveam:def-test pack-files-offsets () |
195 |
- (let* ((fwoar.cl-git:*want-delta* t) |
|
195 |
+ (let* ((fwoar.cl-git.pack::*want-delta* t) |
|
196 | 196 |
(expectations-file |
197 | 197 |
(asdf:system-relative-pathname |
198 | 198 |
:co.fwoar.cl-git/tests |
... | ... |
@@ -272,7 +272,7 @@ |
272 | 272 |
"cab7cafae3b61c5b101ee914cd4f5c8357e77fad" |
273 | 273 |
"f03a8d1b4cea085ee9555037d09bca2dbfb990cb"))) |
274 | 274 |
(loop for commit in shas |
275 |
- for obj = (fwoar.cl-git::raw-object-for-ref |
|
275 |
+ for obj = (fwoar.cl-git.pack::raw-object-for-ref |
|
276 | 276 |
(fwoar.cl-git::ref :fwoar.cl-git.git-objects.pack-2 commit)) |
277 | 277 |
do (5am:is (equal (crypto:byte-array-to-hex-string |
278 | 278 |
(crypto:digest-sequence :sha1 obj)) |
... | ... |
@@ -96,5 +96,5 @@ |
96 | 96 |
|
97 | 97 |
(defpackage :fwoar.cl-git.utils |
98 | 98 |
(:use :cl) |
99 |
- (:import-from :fwoar.cl-git #:partition-subseq) |
|
100 |
- (:export #:partition-subseq)) |
|
99 |
+ (:import-from :fwoar.cl-git #:partition-subseq #:sym->plist #:read-bytes) |
|
100 |
+ (:export #:partition-subseq #:sym->plist #:read-bytes)) |