forked from froggey/Mezzano
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathpartition.lisp
299 lines (280 loc) · 13.8 KB
/
partition.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
;;;; Copyright (c) 2015-2016 Henry Harrington <[email protected]>
;;;; This code is licensed under the MIT license.
(in-package :mezzano.supervisor)
(declaim (inline memref-ub16/le memref-ub16/be))
(defun memref-ub16/le (base &optional (index 0))
(sys.int::memref-unsigned-byte-16 base index))
(defun memref-ub16/be (base)
(logior (ash (sys.int::memref-unsigned-byte-8 base) 8)
(sys.int::memref-unsigned-byte-8 (+ base 1))))
(declaim (inline memref-ub32/le memref-ub32/be))
(defun memref-ub32/le (base &optional (index 0))
(sys.int::memref-unsigned-byte-32 base index))
(defun memref-ub32/be (base)
(logior (ash (sys.int::memref-unsigned-byte-8 base) 24)
(ash (sys.int::memref-unsigned-byte-8 (+ base 1)) 16)
(ash (sys.int::memref-unsigned-byte-8 (+ base 2)) 8)
(sys.int::memref-unsigned-byte-8 (+ base 3))))
(declaim (inline memref-ub64/le memref-ub64/be))
(defun memref-ub64/le (base &optional (index 0))
(sys.int::memref-unsigned-byte-64 base index))
(defun memref-ub64/be (base)
(logior (ash (sys.int::memref-unsigned-byte-8 base) 56)
(ash (sys.int::memref-unsigned-byte-8 (+ base 1)) 48)
(ash (sys.int::memref-unsigned-byte-8 (+ base 2)) 40)
(ash (sys.int::memref-unsigned-byte-8 (+ base 3)) 32)
(ash (sys.int::memref-unsigned-byte-8 (+ base 4)) 24)
(ash (sys.int::memref-unsigned-byte-8 (+ base 5)) 16)
(ash (sys.int::memref-unsigned-byte-8 (+ base 6)) 8)
(sys.int::memref-unsigned-byte-8 (+ base 7))))
(defmacro with-pages ((virtual-address n-pages &rest options) &body body)
(let ((n-pages-sym (gensym "N-PAGES"))
(page (gensym "PAGE")))
`(let* ((,n-pages-sym ,n-pages)
(,page (allocate-physical-pages ,n-pages-sym ,@options))
(,virtual-address (when ,page
(convert-to-pmap-address (* ,page +4k-page-size+)))))
(unwind-protect
(progn ,@body)
(when ,page
(release-physical-pages ,page ,n-pages-sym))))))
(defun read-disk-partition (device lba n-sectors buffer)
(funcall (disk-read-fn (partition-disk device))
(disk-device (partition-disk device))
(+ (partition-offset device) lba)
n-sectors
buffer))
(defun write-disk-partition (device lba n-sectors buffer)
(funcall (disk-write-fn (partition-disk device))
(disk-device (partition-disk device))
(+ (partition-offset device) lba)
n-sectors
buffer))
(defun flush-disk-partition (device)
(funcall (disk-flush-fn (partition-disk device))
(disk-device (partition-disk device))))
(defun detect-disk-partitions ()
(dolist (disk (all-disks))
;; Search for a GPT, then a PC MBR.
(or (detect-gpt-partition-table disk)
(detect-mbr-partition-table disk)
(detect-iso9660-partition-table disk))))
(defun check-gpt-header-signature (page-addr)
(loop
for i from 0
for m in '(#x45 #x46 #x49 #x20 #x50 #x41 #x52 #x54)
when (not (eql (sys.int::memref-unsigned-byte-8 (+ page-addr i) 0) m))
do (return nil)
finally (return t)))
(defun process-gpt-partition-table-entry (disk offset i entry-size sector-buffer)
(let ((sector-size (disk-sector-size disk)))
(multiple-value-bind (sector-index byte-offset)
(truncate (* i entry-size) sector-size)
(when (not (disk-read disk (+ offset sector-index) 1 sector-buffer))
(panic "Unable to read GPT entry block " (+ offset sector-index) " on disk " disk))
(let* ((base (+ sector-buffer byte-offset))
(first-lba (memref-ub64/le (+ base #x20) 0))
(last-lba (memref-ub64/le (+ base #x28) 0))
(size (- (1+ last-lba) first-lba))
(the-system-id nil))
(when (loop
for i from 0 below 16
for system-id = (sys.int::memref-unsigned-byte-8 (+ base i) 0)
then (sys.int::memref-unsigned-byte-8 (+ base i) 0)
when (not (eql system-id 0))
do
(setf the-system-id system-id)
(return t)
finally (return nil))
(debug-print-line "Detected partition " i " on disk " disk ". Start: " first-lba " size: " size)
(register-disk (make-partition :disk disk
:offset first-lba
:id i
:type the-system-id)
(disk-writable-p disk)
size
sector-size
(disk-max-transfer disk)
'read-disk-partition
'write-disk-partition
'flush-disk-partition
nil))))))
(defun detect-gpt-partition-table (disk)
(let* ((sector-size (disk-sector-size disk))
(pages-per-sector (ceiling sector-size +4k-page-size+))
(found-table-p nil))
(with-pages (page-addr pages-per-sector
:mandatory-p "DETECT-DISK disk buffer")
;; GPT is stored on LBA 1, protective MBR on LBA 0.
(when (not (disk-read disk 1 1 page-addr))
(panic "Unable to read second block on disk " disk))
(when (and (>= sector-size 512)
(check-gpt-header-signature page-addr))
;; Found, scan partitions.
;; FIXME: Deal with GPT tables that exceed the sector size.
;; FIXME: Little-endian reads.
;; FIXME: Verify the CRC & other fields.
(setf found-table-p t)
(debug-print-line "Detected GPT on disk " disk)
(let ((offset (memref-ub64/le (+ page-addr #x48)))
(num-entries (memref-ub32/le (+ page-addr #x50)))
(entry-size (memref-ub32/le (+ page-addr #x54))))
(dotimes (i num-entries)
(process-gpt-partition-table-entry
disk offset i entry-size page-addr))))
found-table-p)))
(defun decode-ebr (page-addr)
(if (and (eql (sys.int::memref-unsigned-byte-8 page-addr #x1FE) #x55)
(eql (sys.int::memref-unsigned-byte-8 page-addr #x1FF) #xAA))
(values (sys.int::memref-unsigned-byte-8 (+ page-addr #x1BE) 4)
(memref-ub32/le (+ page-addr #x1BE 8))
(memref-ub32/le (+ page-addr #x1BE 12))
(memref-ub32/le (+ page-addr #x1CE 8)))
(values 0 0 0 0)))
(defun detect-mbr-partition-table (disk)
(let* ((sector-size (disk-sector-size disk))
(pages-per-sector (ceiling sector-size +4k-page-size+))
(found-table-p nil)
(ebr-lba nil))
(with-pages (page-addr pages-per-sector
:mandatory-p "DETECT-DISK disk buffer")
(when (not (disk-read disk 0 1 page-addr))
(panic "Unable to read first block on disk " disk))
(when (and (>= sector-size 512)
(eql (sys.int::memref-unsigned-byte-8 page-addr #x1FE) #x55)
(eql (sys.int::memref-unsigned-byte-8 page-addr #x1FF) #xAA))
;; Found, scan partitions.
(setf found-table-p t)
(debug-print-line "Detected MBR style parition table on disk " disk)
(dotimes (i 4)
(let ((part-type (sys.int::memref-unsigned-byte-8 (+ page-addr #x1BE (* 16 i) 4)))
(start-lba (memref-ub32/le (+ page-addr #x1BE (* 16 i) 8)))
(size (memref-ub32/le (+ page-addr #x1BE (* 16 i) 12))))
(when (and (not (eql part-type 0))
(not (eql size 0)))
(debug-print-line "Detected partition " i " on disk " disk ". Start: " start-lba " size: " size)
(register-disk (make-partition :disk disk
:offset start-lba
:id i
:type part-type)
(disk-writable-p disk)
size
sector-size
(disk-max-transfer disk)
'read-disk-partition
'write-disk-partition
'flush-disk-partition
nil)
(when (or (eql part-type #x05) (eql part-type #x0F))
(setf ebr-lba start-lba)))))
;; Handle extended partition documentation at:
;; https://thestarman.pcministry.com/asm/mbr/PartTables.htm
(when ebr-lba
(when (not (disk-read disk ebr-lba 1 page-addr))
;; What do to with this error?
)
(loop with part-type and data-offset and size and ebr-offset
with part-num = 4
do (setf (values part-type data-offset size ebr-offset)
(decode-ebr page-addr))
unless (or (eql data-offset 0)
(eql size 0))
do
(progn
(debug-print-line "Extended partition " part-num
" on disk " disk
". Type: " part-type
" start: " (+ ebr-lba data-offset)
" size: " size)
(register-disk (make-partition :disk disk
:offset (+ ebr-lba data-offset)
:id part-num
:type part-type)
(disk-writable-p disk)
size
sector-size
(disk-max-transfer disk)
'read-disk-partition
'write-disk-partition
'flush-disk-partition
nil)
(incf part-num))
if (eql ebr-offset 0)
do (return nil)
else do
(progn
(setf ebr-lba (+ ebr-lba ebr-offset))
(when (not (disk-read disk ebr-lba 1 page-addr))
;; what to do with this error?
)))))
found-table-p)))
(defun find-iso9660-primary-volume-descriptor (disk buffer)
(loop
;; The Volume Descriptor Set starts on sector 16/offset 32kb.
;; Limit to searching the first 128 entries.
for sector from #x10 below (+ #x10 128)
do
(when (not (disk-read disk sector 1 buffer))
(return nil))
;; Check identifier 'CD001' and version
(when (not (and (eql (sys.int::memref-unsigned-byte-8 buffer 1) #x43)
(eql (sys.int::memref-unsigned-byte-8 buffer 2) #x44)
(eql (sys.int::memref-unsigned-byte-8 buffer 3) #x30)
(eql (sys.int::memref-unsigned-byte-8 buffer 4) #x30)
(eql (sys.int::memref-unsigned-byte-8 buffer 5) #x31)
(eql (sys.int::memref-unsigned-byte-8 buffer 6) #x01)))
(return nil))
;; Check type.
(case (sys.int::memref-unsigned-byte-8 buffer 0)
(#x01 ; Primary Volume Descriptor.
(return sector))
(#xFF ; Volume Descriptor Set Terminator.
(return nil)))))
(defun detect-iso9660-partition-table (disk)
(let* ((sector-size (disk-sector-size disk))
(pages-per-sector (ceiling sector-size +4k-page-size+))
(found-table-p nil))
(when (not (eql sector-size 2048))
(return-from detect-iso9660-partition-table nil))
(with-pages (page-addr pages-per-sector
:mandatory-p "DETECT-DISK disk buffer")
;; Search for a primary volume descriptor.
(let ((primary-volume (find-iso9660-primary-volume-descriptor disk page-addr)))
(when (not primary-volume)
(return-from detect-iso9660-partition-table nil))
(debug-print-line "Detected ISO9660 primary volume descriptor at sector " primary-volume " on disk " disk)
;; Treat every file in the root directory as a partition.
(let ((root-extent (memref-ub32/le (+ page-addr 156 2)))
(root-length (memref-ub32/le (+ page-addr 156 10)))
(n-entries 0))
(debug-print-line "Root directory at " root-extent "/" root-length)
(loop
for sector from 0 below (ceiling root-length 2048)
do
(when (not (disk-read disk (+ root-extent sector) 1 page-addr))
(return nil))
(do ((offset 0))
((>= offset 2048))
(let ((rec-len (sys.int::memref-unsigned-byte-8 (+ page-addr offset 0)))
(extent (memref-ub32/le (+ page-addr offset 2)))
(length (memref-ub32/le (+ page-addr offset 10)))
(flags (sys.int::memref-unsigned-byte-8 (+ page-addr offset 25))))
(when (zerop rec-len)
;; Reached last record.
(return))
(debug-print-line "Root entry at " extent "/" length " flags: " flags)
(when (eql (logand flags #b11101111) #b00000000) ; Ignore the protection bit.
;; Valid file.
(register-disk (make-partition :disk disk
:offset extent
:id (incf n-entries)
:type nil)
nil
(ceiling length 2048)
2048
(disk-max-transfer disk)
'read-disk-partition
'write-disk-partition
'flush-disk-partition
nil))
(incf offset rec-len)))))))))