Commit | Line | Data |
---|---|---|
e2f4b305 | 1 | ;;; GNU Guix --- Functional package management for GNU |
11e19555 | 2 | ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> |
ab4e939c | 3 | ;;; Copyright © 2016, 2017 David Craven <david@craven.ch> |
a5e13c3b | 4 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> |
0dc5c856 | 5 | ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net> |
17425474 | 6 | ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr> |
7aa28eb3 | 7 | ;;; Copyright © 2019 David C. Trudgian <dave@trudgian.net> |
85a7466e | 8 | ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> |
e2f4b305 LC |
9 | ;;; |
10 | ;;; This file is part of GNU Guix. | |
11 | ;;; | |
12 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
13 | ;;; under the terms of the GNU General Public License as published by | |
14 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
15 | ;;; your option) any later version. | |
16 | ;;; | |
17 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
18 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;;; GNU General Public License for more details. | |
21 | ;;; | |
22 | ;;; You should have received a copy of the GNU General Public License | |
23 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
24 | ||
25 | (define-module (gnu build file-systems) | |
47cef4ec | 26 | #:use-module (gnu system uuid) |
1c65cca5 | 27 | #:use-module (gnu system file-systems) |
e2f4b305 | 28 | #:use-module (guix build utils) |
6eb43907 | 29 | #:use-module (guix build bournish) |
1c65cca5 LC |
30 | #:use-module ((guix build syscalls) |
31 | #:hide (file-system-type)) | |
e2f4b305 LC |
32 | #:use-module (rnrs io ports) |
33 | #:use-module (rnrs bytevectors) | |
34 | #:use-module (ice-9 match) | |
35 | #:use-module (ice-9 rdelim) | |
36 | #:use-module (system foreign) | |
37 | #:autoload (system repl repl) (start-repl) | |
38 | #:use-module (srfi srfi-1) | |
39 | #:use-module (srfi srfi-26) | |
40 | #:export (disk-partitions | |
41 | partition-label-predicate | |
0ec5ee94 | 42 | partition-uuid-predicate |
a1ccefaa | 43 | partition-luks-uuid-predicate |
e2f4b305 | 44 | find-partition-by-label |
0ec5ee94 | 45 | find-partition-by-uuid |
a1ccefaa | 46 | find-partition-by-luks-uuid |
e2f4b305 LC |
47 | canonicalize-device-spec |
48 | ||
983abd2c MO |
49 | read-partition-label |
50 | read-partition-uuid | |
8ae7044f | 51 | read-luks-partition-uuid |
983abd2c | 52 | |
e2f4b305 LC |
53 | bind-mount |
54 | ||
55 | mount-flags->bit-mask | |
56 | check-file-system | |
a5e13c3b | 57 | mount-file-system)) |
e2f4b305 LC |
58 | |
59 | ;;; Commentary: | |
60 | ;;; | |
61 | ;;; This modules provides tools to deal with disk partitions, and to mount and | |
62 | ;;; check file systems. | |
63 | ;;; | |
64 | ;;; Code: | |
65 | ||
e2f4b305 LC |
66 | (define (bind-mount source target) |
67 | "Bind-mount SOURCE at TARGET." | |
68 | (mount source target "" MS_BIND)) | |
69 | ||
2fe4ceee LC |
70 | (define (seek* fd/port offset whence) |
71 | "Like 'seek' but return -1 instead of throwing to 'system-error' upon | |
72 | EINVAL. This makes it easier to catch cases like OFFSET being too large for | |
73 | FD/PORT." | |
74 | (catch 'system-error | |
75 | (lambda () | |
76 | (seek fd/port offset whence)) | |
77 | (lambda args | |
78 | (if (= EINVAL (system-error-errno args)) | |
79 | -1 | |
80 | (apply throw args))))) | |
81 | ||
974e02da DC |
82 | (define (read-superblock device offset size magic?) |
83 | "Read a superblock of SIZE from OFFSET and DEVICE. Return the raw | |
84 | superblock on success, and #f if no valid superblock was found. MAGIC? | |
85 | takes a bytevector and returns #t when it's a valid superblock." | |
86 | (call-with-input-file device | |
87 | (lambda (port) | |
2fe4ceee LC |
88 | (and (= offset (seek* port offset SEEK_SET)) |
89 | (let ((block (make-bytevector size))) | |
90 | (match (get-bytevector-n! port block 0 (bytevector-length block)) | |
91 | ((? eof-object?) | |
92 | #f) | |
93 | ((? number? len) | |
94 | (and (= len (bytevector-length block)) | |
95 | (and (magic? block) | |
96 | block))))))))) | |
974e02da | 97 | |
b0377e58 DC |
98 | (define null-terminated-latin1->string |
99 | (cut latin1->string <> zero?)) | |
100 | ||
f73f4b3a DM |
101 | (define (bytevector-utf16-length bv) |
102 | "Given a bytevector BV containing a NUL-terminated UTF16-encoded string, | |
103 | determine where the NUL terminator is and return its index. If there's no | |
104 | NUL terminator, return the size of the bytevector." | |
105 | (let ((length (bytevector-length bv))) | |
106 | (let loop ((index 0)) | |
107 | (if (< index length) | |
108 | (if (zero? (bytevector-u16-ref bv index 'little)) | |
109 | index | |
110 | (loop (+ index 2))) | |
111 | length)))) | |
112 | ||
bb357c50 DM |
113 | (define* (bytevector->u16-list bv endianness #:optional (index 0)) |
114 | (if (< index (bytevector-length bv)) | |
115 | (cons (bytevector-u16-ref bv index endianness) | |
116 | (bytevector->u16-list bv endianness (+ index 2))) | |
117 | '())) | |
118 | ||
119 | ;; The initrd doesn't have iconv data, so do the conversion ourselves. | |
120 | (define (utf16->string bv endianness) | |
121 | (list->string | |
122 | (map integer->char | |
123 | (reverse | |
124 | (let loop ((remainder (bytevector->u16-list bv endianness)) | |
125 | (result '())) | |
126 | (match remainder | |
127 | (() result) | |
128 | ((a) (cons a result)) | |
129 | ((a b x ...) | |
130 | (if (and (>= a #xD800) (< a #xDC00) ; high surrogate | |
131 | (>= b #xDC00) (< b #xE000)) ; low surrogate | |
132 | (loop x (cons (+ #x10000 | |
133 | (* #x400 (- a #xD800)) | |
134 | (- b #xDC00)) | |
135 | result)) | |
136 | (loop (cons b x) (cons a result)))))))))) | |
137 | ||
f73f4b3a DM |
138 | (define (null-terminated-utf16->string bv endianness) |
139 | (utf16->string (sub-bytevector bv 0 (bytevector-utf16-length bv)) | |
140 | endianness)) | |
141 | ||
a1ccefaa LC |
142 | \f |
143 | ;;; | |
144 | ;;; Ext2 file systems. | |
145 | ;;; | |
146 | ||
974e02da DC |
147 | ;; <http://www.nongnu.org/ext2-doc/ext2.html#DEF-SUPERBLOCK>. |
148 | ;; TODO: Use "packed structs" from Guile-OpenGL or similar. | |
149 | ||
e2f4b305 LC |
150 | (define-syntax %ext2-endianness |
151 | ;; Endianness of ext2 file systems. | |
152 | (identifier-syntax (endianness little))) | |
153 | ||
974e02da DC |
154 | (define (ext2-superblock? sblock) |
155 | "Return #t when SBLOCK is an ext2 superblock." | |
156 | (let ((magic (bytevector-u16-ref sblock 56 %ext2-endianness))) | |
157 | (= magic #xef53))) | |
e2f4b305 LC |
158 | |
159 | (define (read-ext2-superblock device) | |
160 | "Return the raw contents of DEVICE's ext2 superblock as a bytevector, or #f | |
161 | if DEVICE does not contain an ext2 file system." | |
974e02da | 162 | (read-superblock device 1024 264 ext2-superblock?)) |
e2f4b305 LC |
163 | |
164 | (define (ext2-superblock-uuid sblock) | |
165 | "Return the UUID of ext2 superblock SBLOCK as a 16-byte bytevector." | |
974e02da | 166 | (sub-bytevector sblock 104 16)) |
e2f4b305 LC |
167 | |
168 | (define (ext2-superblock-volume-name sblock) | |
169 | "Return the volume name of SBLOCK as a string of at most 16 characters, or | |
170 | #f if SBLOCK has no volume name." | |
974e02da | 171 | (null-terminated-latin1->string (sub-bytevector sblock 120 16))) |
e2f4b305 | 172 | |
26905ec8 DC |
173 | (define (check-ext2-file-system device) |
174 | "Return the health of an ext2 file system on DEVICE." | |
175 | (match (status:exit-val | |
176 | (system* "e2fsck" "-v" "-p" "-C" "0" device)) | |
177 | (0 'pass) | |
178 | (1 'errors-corrected) | |
179 | (2 'reboot-required) | |
180 | (_ 'fatal-error))) | |
e2f4b305 | 181 | |
a1ccefaa | 182 | \f |
11e19555 LC |
183 | ;;; |
184 | ;;; Linux swap. | |
185 | ;;; | |
186 | ||
187 | ;; Linux "swap space" is not a file system but it has a UUID and volume name, | |
188 | ;; like actual file systems, and we want to be able to look up swap partitions | |
189 | ;; by UUID and by label. | |
190 | ||
191 | (define %linux-swap-magic | |
192 | (string->utf8 "SWAPSPACE2")) | |
193 | ||
194 | ;; Like 'PAGE_SIZE' in Linux, arch/x86/include/asm/page.h. | |
195 | ;; XXX: This is always 4K on x86_64, i386, and ARMv7. However, on AArch64, | |
196 | ;; this is determined by 'CONFIG_ARM64_PAGE_SHIFT' in the kernel, which is 12 | |
197 | ;; by default (4K) but can be 14 or 16. | |
198 | (define %page-size 4096) | |
199 | ||
200 | (define (linux-swap-superblock? sblock) | |
201 | "Return #t when SBLOCK is an linux-swap superblock." | |
202 | (and (= (bytevector-length sblock) %page-size) | |
203 | (bytevector=? (sub-bytevector sblock (- %page-size 10) 10) | |
204 | %linux-swap-magic))) | |
205 | ||
206 | (define (read-linux-swap-superblock device) | |
207 | "Return the raw contents of DEVICE's linux-swap superblock as a bytevector, or #f | |
208 | if DEVICE does not contain an linux-swap file system." | |
209 | (read-superblock device 0 %page-size linux-swap-superblock?)) | |
210 | ||
211 | ;; See 'union swap_header' in 'include/linux/swap.h'. | |
212 | ||
213 | (define (linux-swap-superblock-uuid sblock) | |
214 | "Return the UUID of Linux-swap superblock SBLOCK as a 16-byte bytevector." | |
215 | (sub-bytevector sblock (+ 1024 4 4 4) 16)) | |
216 | ||
217 | (define (linux-swap-superblock-volume-name sblock) | |
218 | "Return the label of Linux-swap superblock SBLOCK as a string." | |
219 | (null-terminated-latin1->string | |
220 | (sub-bytevector sblock (+ 1024 4 4 4 16) 16))) | |
17425474 TGR |
221 | \f |
222 | ||
223 | ;;; | |
224 | ;;; Bcachefs file systems. | |
225 | ;;; | |
226 | ||
227 | ;; <https://evilpiepirate.org/git/bcachefs-tools.git/tree/libbcachefs/bcachefs_format.h> | |
228 | ||
229 | (define-syntax %bcachefs-endianness | |
230 | ;; Endianness of bcachefs file systems. | |
231 | (identifier-syntax (endianness little))) | |
232 | ||
233 | (define (bcachefs-superblock? sblock) | |
234 | "Return #t when SBLOCK is an bcachefs superblock." | |
235 | (bytevector=? (sub-bytevector sblock 24 16) | |
236 | #vu8(#xc6 #x85 #x73 #xf6 #x4e #x1a #x45 #xca | |
237 | #x82 #x65 #xf5 #x7f #x48 #xba #x6d #x81))) | |
238 | ||
239 | (define (read-bcachefs-superblock device) | |
240 | "Return the raw contents of DEVICE's bcachefs superblock as a bytevector, or #f | |
241 | if DEVICE does not contain a bcachefs file system." | |
242 | ;; We completely ignore the back-up superblock & any checksum errors. | |
243 | ;; Superblock field names, with offset & length respectively, in bytes: | |
244 | ;; 0 16 bch_csum | |
245 | ;; 16 8 version | |
246 | ;; 24 16 magic | |
247 | ;; 40 16 uuid ← ‘internal UUID’, you probably don't want this | |
248 | ;; 56 16 user_uuid ← ‘external UUID’, the one by which to mount | |
249 | ;; 72 32 label | |
250 | ;; … there are more & the superblock is extensible, but we don't care yet. | |
251 | (read-superblock device 4096 104 bcachefs-superblock?)) | |
252 | ||
253 | (define (bcachefs-superblock-external-uuid sblock) | |
254 | "Return the external UUID of bcachefs superblock SBLOCK as a 16-byte | |
255 | bytevector." | |
256 | (sub-bytevector sblock 56 16)) | |
257 | ||
258 | (define (bcachefs-superblock-volume-name sblock) | |
259 | "Return the volume name of SBLOCK as a string of at most 32 characters, or | |
260 | #f if SBLOCK has no volume name." | |
261 | (null-terminated-latin1->string (sub-bytevector sblock 72 32))) | |
262 | ||
263 | (define (check-bcachefs-file-system device) | |
264 | "Return the health of a bcachefs file system on DEVICE." | |
265 | (match (status:exit-val | |
266 | (apply system* "bcachefs" "fsck" "-p" "-v" | |
267 | ;; Make each multi-device member a separate argument. | |
268 | (string-split device #\:))) | |
269 | (0 'pass) | |
270 | (1 'errors-corrected) | |
271 | (2 'reboot-required) | |
272 | (_ 'fatal-error))) | |
11e19555 LC |
273 | |
274 | \f | |
b1a505ba DC |
275 | ;;; |
276 | ;;; Btrfs file systems. | |
277 | ;;; | |
278 | ||
279 | ;; <https://btrfs.wiki.kernel.org/index.php/On-disk_Format#Superblock>. | |
280 | ||
281 | (define-syntax %btrfs-endianness | |
282 | ;; Endianness of btrfs file systems. | |
283 | (identifier-syntax (endianness little))) | |
284 | ||
285 | (define (btrfs-superblock? sblock) | |
286 | "Return #t when SBLOCK is a btrfs superblock." | |
287 | (bytevector=? (sub-bytevector sblock 64 8) | |
288 | (string->utf8 "_BHRfS_M"))) | |
289 | ||
290 | (define (read-btrfs-superblock device) | |
291 | "Return the raw contents of DEVICE's btrfs superblock as a bytevector, or #f | |
292 | if DEVICE does not contain a btrfs file system." | |
293 | (read-superblock device 65536 4096 btrfs-superblock?)) | |
294 | ||
295 | (define (btrfs-superblock-uuid sblock) | |
296 | "Return the UUID of a btrfs superblock SBLOCK as a 16-byte bytevector." | |
297 | (sub-bytevector sblock 32 16)) | |
298 | ||
299 | (define (btrfs-superblock-volume-name sblock) | |
300 | "Return the volume name of SBLOCK as a string of at most 256 characters, or | |
301 | #f if SBLOCK has no volume name." | |
302 | (null-terminated-latin1->string (sub-bytevector sblock 299 256))) | |
303 | ||
304 | (define (check-btrfs-file-system device) | |
305 | "Return the health of a btrfs file system on DEVICE." | |
306 | (match (status:exit-val | |
307 | (system* "btrfs" "device" "scan")) | |
308 | (0 'pass) | |
309 | (_ 'fatal-error))) | |
310 | ||
311 | \f | |
b0377e58 DC |
312 | ;;; |
313 | ;;; FAT32 file systems. | |
314 | ;;; | |
315 | ||
316 | ;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-107.pdf>. | |
317 | ||
b0377e58 DC |
318 | (define (fat32-superblock? sblock) |
319 | "Return #t when SBLOCK is a fat32 superblock." | |
320 | (bytevector=? (sub-bytevector sblock 82 8) | |
321 | (string->utf8 "FAT32 "))) | |
322 | ||
323 | (define (read-fat32-superblock device) | |
324 | "Return the raw contents of DEVICE's fat32 superblock as a bytevector, or | |
325 | #f if DEVICE does not contain a fat32 file system." | |
326 | (read-superblock device 0 90 fat32-superblock?)) | |
327 | ||
328 | (define (fat32-superblock-uuid sblock) | |
329 | "Return the Volume ID of a fat superblock SBLOCK as a 4-byte bytevector." | |
330 | (sub-bytevector sblock 67 4)) | |
331 | ||
b0377e58 DC |
332 | (define (fat32-superblock-volume-name sblock) |
333 | "Return the volume name of SBLOCK as a string of at most 11 characters, or | |
334 | #f if SBLOCK has no volume name. The volume name is a latin1 string. | |
335 | Trailing spaces are trimmed." | |
336 | (string-trim-right (latin1->string (sub-bytevector sblock 71 11) (lambda (c) #f)) #\space)) | |
337 | ||
88235675 | 338 | (define (check-fat-file-system device) |
b0377e58 DC |
339 | "Return the health of a fat file system on DEVICE." |
340 | (match (status:exit-val | |
341 | (system* "fsck.vfat" "-v" "-a" device)) | |
342 | (0 'pass) | |
343 | (1 'errors-corrected) | |
344 | (_ 'fatal-error))) | |
345 | ||
346 | \f | |
88235675 LC |
347 | ;;; |
348 | ;;; FAT16 file systems. | |
349 | ;;; | |
350 | ||
351 | (define (fat16-superblock? sblock) | |
352 | "Return #t when SBLOCK is a fat16 boot record." | |
353 | (bytevector=? (sub-bytevector sblock 54 8) | |
354 | (string->utf8 "FAT16 "))) | |
355 | ||
356 | (define (read-fat16-superblock device) | |
357 | "Return the raw contents of DEVICE's fat16 superblock as a bytevector, or | |
358 | #f if DEVICE does not contain a fat16 file system." | |
359 | (read-superblock device 0 62 fat16-superblock?)) | |
360 | ||
361 | (define (fat16-superblock-uuid sblock) | |
362 | "Return the Volume ID of a fat superblock SBLOCK as a 4-byte bytevector." | |
363 | (sub-bytevector sblock 39 4)) | |
364 | ||
365 | (define (fat16-superblock-volume-name sblock) | |
366 | "Return the volume name of SBLOCK as a string of at most 11 characters, or | |
367 | #f if SBLOCK has no volume name. The volume name is a latin1 string. | |
368 | Trailing spaces are trimmed." | |
369 | (string-trim-right (latin1->string (sub-bytevector sblock 43 11) | |
370 | (lambda (c) #f)) | |
371 | #\space)) | |
372 | ||
373 | \f | |
06110559 DM |
374 | ;;; |
375 | ;;; ISO9660 file systems. | |
376 | ;;; | |
377 | ||
378 | ;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-119.pdf>. | |
379 | ||
380 | (define (iso9660-superblock? sblock) | |
3dba9b37 | 381 | "Return #t when SBLOCK is an iso9660 volume descriptor." |
06110559 DM |
382 | (bytevector=? (sub-bytevector sblock 1 6) |
383 | ;; Note: "\x01" is the volume descriptor format version | |
384 | (string->utf8 "CD001\x01"))) | |
385 | ||
386 | (define (read-iso9660-primary-volume-descriptor device offset) | |
387 | "Find and read the first primary volume descriptor, starting at OFFSET. | |
388 | Return #f if not found." | |
389 | (let* ((sblock (read-superblock device offset 2048 iso9660-superblock?)) | |
203a9455 DM |
390 | (type-code (if sblock |
391 | (bytevector-u8-ref sblock 0) | |
392 | (error (format #f | |
393 | "Could not read ISO9660 primary | |
394 | volume descriptor from ~s" | |
395 | device))))) | |
06110559 DM |
396 | (match type-code |
397 | (255 #f) ; Volume Descriptor Set Terminator. | |
398 | (1 sblock) ; Primary Volume Descriptor | |
399 | (_ (read-iso9660-primary-volume-descriptor device (+ offset 2048)))))) | |
400 | ||
401 | (define (read-iso9660-superblock device) | |
3dba9b37 DM |
402 | "Return the raw contents of DEVICE's iso9660 primary volume descriptor |
403 | as a bytevector, or #f if DEVICE does not contain an iso9660 file system." | |
06110559 | 404 | ;; Start reading at sector 16. |
162a1374 | 405 | ;; Since we are not sure that the device contains an ISO9660 file system, |
fb03f44b DM |
406 | ;; we have to find that out first. |
407 | (if (read-superblock device (* 2048 16) 2048 iso9660-superblock?) | |
408 | (read-iso9660-primary-volume-descriptor device (* 2048 16)) | |
162a1374 | 409 | #f)) ; Device does not contain an iso9660 file system. |
06110559 DM |
410 | |
411 | (define (iso9660-superblock-uuid sblock) | |
3dba9b37 | 412 | "Return the modification time of an iso9660 primary volume descriptor |
c6aee77e | 413 | SBLOCK as a bytevector. If that's not set, returns the creation time." |
06110559 DM |
414 | ;; Drops GMT offset for compatibility with Grub, blkid and /dev/disk/by-uuid. |
415 | ;; Compare Grub: "2014-12-02-19-30-23-00". | |
416 | ;; Compare blkid result: "2014-12-02-19-30-23-00". | |
417 | ;; Compare /dev/disk/by-uuid entry: "2014-12-02-19-30-23-00". | |
c6aee77e DM |
418 | (let* ((creation-time (sub-bytevector sblock 813 17)) |
419 | (modification-time (sub-bytevector sblock 830 17)) | |
420 | (unset-time (make-bytevector 17 0)) | |
421 | (time (if (bytevector=? unset-time modification-time) | |
422 | creation-time | |
423 | modification-time))) | |
424 | (sub-bytevector time 0 16))) ; strips GMT offset. | |
06110559 | 425 | |
06110559 DM |
426 | (define (iso9660-superblock-volume-name sblock) |
427 | "Return the volume name of SBLOCK as a string. The volume name is an ASCII | |
428 | string. Trailing spaces are trimmed." | |
cdc701ea | 429 | ;; Note: Valid characters are of the set "[0-9][A-Z]_" (ECMA-119 Appendix A) |
06110559 DM |
430 | (string-trim-right (latin1->string (sub-bytevector sblock 40 32) |
431 | (lambda (c) #f)) #\space)) | |
432 | ||
433 | \f | |
1abbe7c6 TGR |
434 | ;;; |
435 | ;;; JFS file systems. | |
436 | ;;; | |
437 | ||
438 | ;; Taken from <linux-libre>/fs/jfs/jfs_superblock.h. | |
439 | ||
440 | (define-syntax %jfs-endianness | |
441 | ;; Endianness of JFS file systems. | |
442 | (identifier-syntax (endianness little))) | |
443 | ||
444 | (define (jfs-superblock? sblock) | |
445 | "Return #t when SBLOCK is a JFS superblock." | |
446 | (bytevector=? (sub-bytevector sblock 0 4) | |
447 | (string->utf8 "JFS1"))) | |
448 | ||
449 | (define (read-jfs-superblock device) | |
450 | "Return the raw contents of DEVICE's JFS superblock as a bytevector, or #f | |
451 | if DEVICE does not contain a JFS file system." | |
452 | (read-superblock device 32768 184 jfs-superblock?)) | |
453 | ||
454 | (define (jfs-superblock-uuid sblock) | |
455 | "Return the UUID of JFS superblock SBLOCK as a 16-byte bytevector." | |
456 | (sub-bytevector sblock 136 16)) | |
457 | ||
458 | (define (jfs-superblock-volume-name sblock) | |
459 | "Return the volume name of SBLOCK as a string of at most 16 characters, or | |
460 | #f if SBLOCK has no volume name." | |
461 | (null-terminated-latin1->string (sub-bytevector sblock 152 16))) | |
462 | ||
463 | (define (check-jfs-file-system device) | |
464 | "Return the health of a JFS file system on DEVICE." | |
465 | (match (status:exit-val | |
466 | (system* "jfs_fsck" "-p" "-v" device)) | |
467 | (0 'pass) | |
468 | (1 'errors-corrected) | |
469 | (2 'reboot-required) | |
470 | (_ 'fatal-error))) | |
471 | ||
472 | \f | |
23b37c3d | 473 | ;;; |
474 | ;;; F2FS (Flash-Friendly File System) | |
475 | ;;; | |
476 | ||
477 | ;;; https://git.kernel.org/pub/scm/linux/kernel/git/jaegeuk/f2fs.git/tree/include/linux/f2fs_fs.h | |
478 | ;;; (but using xxd proved to be simpler) | |
479 | ||
480 | (define-syntax %f2fs-endianness | |
481 | ;; Endianness of F2FS file systems | |
482 | (identifier-syntax (endianness little))) | |
483 | ||
484 | ;; F2FS actually stores two adjacent copies of the superblock. | |
485 | ;; should we read both? | |
486 | (define (f2fs-superblock? sblock) | |
487 | "Return #t when SBLOCK is an F2FS superblock." | |
488 | (let ((magic (bytevector-u32-ref sblock 0 %f2fs-endianness))) | |
489 | (= magic #xF2F52010))) | |
490 | ||
491 | (define (read-f2fs-superblock device) | |
492 | "Return the raw contents of DEVICE's F2FS superblock as a bytevector, or #f | |
493 | if DEVICE does not contain an F2FS file system." | |
494 | (read-superblock device | |
495 | ;; offset of magic in first copy | |
496 | #x400 | |
497 | ;; difference between magic of second | |
498 | ;; and first copies | |
499 | (- #x1400 #x400) | |
500 | f2fs-superblock?)) | |
501 | ||
502 | (define (f2fs-superblock-uuid sblock) | |
503 | "Return the UUID of F2FS superblock SBLOCK as a 16-byte bytevector." | |
504 | (sub-bytevector sblock | |
505 | (- (+ #x460 12) | |
506 | ;; subtract superblock offset | |
507 | #x400) | |
508 | 16)) | |
509 | ||
510 | (define (f2fs-superblock-volume-name sblock) | |
511 | "Return the volume name of SBLOCK as a string of at most 512 characters, or | |
512 | #f if SBLOCK has no volume name." | |
f73f4b3a DM |
513 | (null-terminated-utf16->string |
514 | (sub-bytevector sblock (- (+ #x470 12) #x400) 512) | |
515 | %f2fs-endianness)) | |
23b37c3d | 516 | |
517 | (define (check-f2fs-file-system device) | |
518 | "Return the health of a F2FS file system on DEVICE." | |
519 | (match (status:exit-val | |
520 | (system* "fsck.f2fs" "-p" device)) | |
521 | ;; 0 and -1 are the only two possibilities | |
522 | ;; (according to the manpage) | |
523 | (0 'pass) | |
524 | (_ 'fatal-error))) | |
525 | ||
526 | \f | |
a1ccefaa LC |
527 | ;;; |
528 | ;;; LUKS encrypted devices. | |
529 | ;;; | |
530 | ||
531 | ;; The LUKS header format is described in "LUKS On-Disk Format Specification": | |
de975de3 | 532 | ;; <https://gitlab.com/cryptsetup/cryptsetup/wikis/Specification>. We follow |
a1ccefaa LC |
533 | ;; version 1.2.1 of this document. |
534 | ||
7aa28eb3 DT |
535 | ;; The LUKS2 header format is described in "LUKS2 On-Disk Format Specification": |
536 | ;; <https://gitlab.com/cryptsetup/LUKS2-docs/blob/master/luks2_doc_wip.pdf>. | |
537 | ;; It is a WIP document. | |
538 | ||
a1ccefaa LC |
539 | (define-syntax %luks-endianness |
540 | ;; Endianness of LUKS headers. | |
541 | (identifier-syntax (endianness big))) | |
542 | ||
974e02da DC |
543 | (define (luks-superblock? sblock) |
544 | "Return #t when SBLOCK is a luks superblock." | |
545 | (define %luks-magic | |
546 | ;; The 'LUKS_MAGIC' constant. | |
547 | (u8-list->bytevector (append (map char->integer (string->list "LUKS")) | |
548 | (list #xba #xbe)))) | |
549 | (let ((magic (sub-bytevector sblock 0 6)) | |
550 | (version (bytevector-u16-ref sblock 6 %luks-endianness))) | |
551 | (and (bytevector=? magic %luks-magic) | |
7aa28eb3 | 552 | (or (= version 1) (= version 2))))) |
a1ccefaa LC |
553 | |
554 | (define (read-luks-header file) | |
555 | "Read a LUKS header from FILE. Return the raw header on success, and #f if | |
556 | not valid header was found." | |
7aa28eb3 DT |
557 | ;; Size in bytes of the LUKS binary header, which includes key slots in |
558 | ;; LUKS1. In LUKS2 the binary header is partially backward compatible, so | |
559 | ;; that UUID can be extracted as for LUKS1. Keyslots and other metadata are | |
560 | ;; not part of this header in LUKS2, but are included in the JSON metadata | |
561 | ;; area that follows. | |
974e02da | 562 | (read-superblock file 0 592 luks-superblock?)) |
a1ccefaa LC |
563 | |
564 | (define (luks-header-uuid header) | |
565 | "Return the LUKS UUID from HEADER, as a 16-byte bytevector." | |
566 | ;; 40 bytes are reserved for the UUID, but in practice, it contains the 36 | |
567 | ;; bytes of its ASCII representation. | |
568 | (let ((uuid (sub-bytevector header 168 36))) | |
569 | (string->uuid (utf8->string uuid)))) | |
570 | ||
571 | \f | |
675e5622 MO |
572 | ;;; |
573 | ;;; NTFS file systems. | |
574 | ;;; | |
575 | ||
576 | ;; Taken from <linux-libre>/fs/ntfs/layout.h | |
577 | ||
578 | (define-syntax %ntfs-endianness | |
579 | ;; Endianness of NTFS file systems. | |
580 | (identifier-syntax (endianness little))) | |
581 | ||
582 | (define (ntfs-superblock? sblock) | |
583 | "Return #t when SBLOCK is a NTFS superblock." | |
584 | (bytevector=? (sub-bytevector sblock 3 8) | |
585 | (string->utf8 "NTFS "))) | |
586 | ||
587 | (define (read-ntfs-superblock device) | |
588 | "Return the raw contents of DEVICE's NTFS superblock as a bytevector, or #f | |
589 | if DEVICE does not contain a NTFS file system." | |
590 | (read-superblock device 0 511 ntfs-superblock?)) | |
591 | ||
592 | (define (ntfs-superblock-uuid sblock) | |
593 | "Return the UUID of NTFS superblock SBLOCK as a 8-byte bytevector." | |
594 | (sub-bytevector sblock 72 8)) | |
595 | ||
596 | ;; TODO: Add ntfs-superblock-volume-name. The partition label is not stored | |
597 | ;; in the BOOT SECTOR like the UUID, but in the MASTER FILE TABLE, which seems | |
598 | ;; way harder to access. | |
599 | ||
600 | (define (check-ntfs-file-system device) | |
601 | "Return the health of a NTFS file system on DEVICE." | |
602 | (match (status:exit-val | |
603 | (system* "ntfsfix" device)) | |
604 | (0 'pass) | |
605 | (_ 'fatal-error))) | |
606 | ||
607 | \f | |
a1ccefaa LC |
608 | ;;; |
609 | ;;; Partition lookup. | |
610 | ;;; | |
611 | ||
e2f4b305 LC |
612 | (define (disk-partitions) |
613 | "Return the list of device names corresponding to valid disk partitions." | |
49baaff4 | 614 | (define (partition? name major minor) |
9833bcfc DM |
615 | ;; grub-mkrescue does some funny things for EFI support which |
616 | ;; makes it a lot more difficult than one would expect to support | |
617 | ;; booting an ISO-9660 image from an USB flash drive. | |
618 | ;; For example there's a buggy (too small) hidden partition in it | |
619 | ;; which Linux mounts and then proceeds to fail while trying to | |
620 | ;; fall off the edge. | |
621 | ;; In any case, partition tables are supposed to be optional so | |
622 | ;; here we allow checking entire disks for file systems, too. | |
623 | (> major 2)) ;ignore RAM disks and floppy disks | |
e2f4b305 LC |
624 | |
625 | (call-with-input-file "/proc/partitions" | |
626 | (lambda (port) | |
627 | ;; Skip the two header lines. | |
628 | (read-line port) | |
629 | (read-line port) | |
630 | ||
631 | ;; Read each subsequent line, and extract the last space-separated | |
632 | ;; field. | |
633 | (let loop ((parts '())) | |
634 | (let ((line (read-line port))) | |
635 | (if (eof-object? line) | |
636 | (reverse parts) | |
637 | (match (string-tokenize line) | |
638 | (((= string->number major) (= string->number minor) | |
639 | blocks name) | |
49baaff4 | 640 | (if (partition? name major minor) |
e2f4b305 LC |
641 | (loop (cons name parts)) |
642 | (loop parts)))))))))) | |
643 | ||
24473356 LC |
644 | (define (ENOENT-safe proc) |
645 | "Wrap the one-argument PROC such that ENOENT errors are caught and lead to a | |
646 | warning and #f as the result." | |
647 | (lambda (device) | |
648 | (catch 'system-error | |
649 | (lambda () | |
650 | (proc device)) | |
651 | (lambda args | |
652 | ;; When running on the hand-made /dev, | |
653 | ;; 'disk-partitions' could return partitions for which | |
654 | ;; we have no /dev node. Handle that gracefully. | |
49baaff4 LC |
655 | (let ((errno (system-error-errno args))) |
656 | (cond ((= ENOENT errno) | |
657 | (format (current-error-port) | |
658 | "warning: device '~a' not found~%" device) | |
659 | #f) | |
660 | ((= ENOMEDIUM errno) ;for removable media | |
661 | #f) | |
b53510e0 AVY |
662 | ((= EIO errno) ;unreadable hardware like audio CDs |
663 | (format (current-error-port) | |
664 | "warning: failed to read from device '~a'~%" device) | |
665 | #f) | |
49baaff4 LC |
666 | (else |
667 | (apply throw args)))))))) | |
24473356 | 668 | |
ab4e939c DC |
669 | (define (partition-field-reader read field) |
670 | "Return a procedure that takes a device and returns the value of a FIELD in | |
671 | the partition superblock or #f." | |
672 | (let ((read (ENOENT-safe read))) | |
673 | (lambda (device) | |
674 | (let ((sblock (read device))) | |
675 | (and sblock | |
676 | (field sblock)))))) | |
677 | ||
678 | (define (read-partition-field device partition-field-readers) | |
679 | "Returns the value of a FIELD in the partition superblock of DEVICE or #f. It | |
680 | takes a list of PARTITION-FIELD-READERS and returns the result of the first | |
681 | partition field reader that returned a value." | |
682 | (match (filter-map (cut apply <> (list device)) partition-field-readers) | |
683 | ((field . _) field) | |
684 | (_ #f))) | |
685 | ||
686 | (define %partition-label-readers | |
06110559 DM |
687 | (list (partition-field-reader read-iso9660-superblock |
688 | iso9660-superblock-volume-name) | |
689 | (partition-field-reader read-ext2-superblock | |
b1a505ba | 690 | ext2-superblock-volume-name) |
11e19555 LC |
691 | (partition-field-reader read-linux-swap-superblock |
692 | linux-swap-superblock-volume-name) | |
17425474 TGR |
693 | (partition-field-reader read-bcachefs-superblock |
694 | bcachefs-superblock-volume-name) | |
b1a505ba | 695 | (partition-field-reader read-btrfs-superblock |
b0377e58 DC |
696 | btrfs-superblock-volume-name) |
697 | (partition-field-reader read-fat32-superblock | |
88235675 LC |
698 | fat32-superblock-volume-name) |
699 | (partition-field-reader read-fat16-superblock | |
1abbe7c6 TGR |
700 | fat16-superblock-volume-name) |
701 | (partition-field-reader read-jfs-superblock | |
23b37c3d | 702 | jfs-superblock-volume-name) |
703 | (partition-field-reader read-f2fs-superblock | |
704 | f2fs-superblock-volume-name))) | |
ab4e939c DC |
705 | |
706 | (define %partition-uuid-readers | |
06110559 DM |
707 | (list (partition-field-reader read-iso9660-superblock |
708 | iso9660-superblock-uuid) | |
709 | (partition-field-reader read-ext2-superblock | |
b1a505ba | 710 | ext2-superblock-uuid) |
11e19555 LC |
711 | (partition-field-reader read-linux-swap-superblock |
712 | linux-swap-superblock-uuid) | |
17425474 TGR |
713 | (partition-field-reader read-bcachefs-superblock |
714 | bcachefs-superblock-external-uuid) | |
b1a505ba | 715 | (partition-field-reader read-btrfs-superblock |
b0377e58 DC |
716 | btrfs-superblock-uuid) |
717 | (partition-field-reader read-fat32-superblock | |
88235675 LC |
718 | fat32-superblock-uuid) |
719 | (partition-field-reader read-fat16-superblock | |
1abbe7c6 TGR |
720 | fat16-superblock-uuid) |
721 | (partition-field-reader read-jfs-superblock | |
23b37c3d | 722 | jfs-superblock-uuid) |
723 | (partition-field-reader read-f2fs-superblock | |
675e5622 MO |
724 | f2fs-superblock-uuid) |
725 | (partition-field-reader read-ntfs-superblock | |
726 | ntfs-superblock-uuid))) | |
ab4e939c DC |
727 | |
728 | (define read-partition-label | |
729 | (cut read-partition-field <> %partition-label-readers)) | |
730 | ||
731 | (define read-partition-uuid | |
732 | (cut read-partition-field <> %partition-uuid-readers)) | |
733 | ||
8ae7044f MO |
734 | (define luks-partition-field-reader |
735 | (partition-field-reader read-luks-header luks-header-uuid)) | |
736 | ||
737 | (define read-luks-partition-uuid | |
738 | (cut read-partition-field <> (list luks-partition-field-reader))) | |
739 | ||
ab4e939c | 740 | (define (partition-predicate reader =) |
a1ccefaa LC |
741 | "Return a predicate that returns true if the FIELD of partition header that |
742 | was READ is = to the given value." | |
ab4e939c DC |
743 | (lambda (expected) |
744 | (lambda (device) | |
745 | (let ((actual (reader device))) | |
746 | (and actual | |
747 | (= actual expected)))))) | |
0ec5ee94 LC |
748 | |
749 | (define partition-label-predicate | |
ab4e939c | 750 | (partition-predicate read-partition-label string=?)) |
0ec5ee94 LC |
751 | |
752 | (define partition-uuid-predicate | |
aed1f1b0 | 753 | (partition-predicate read-partition-uuid uuid=?)) |
a1ccefaa | 754 | |
974e02da | 755 | (define luks-partition-uuid-predicate |
8ae7044f | 756 | (partition-predicate luks-partition-field-reader uuid=?)) |
e2f4b305 | 757 | |
ab4e939c DC |
758 | (define (find-partition predicate) |
759 | "Return the first partition found that matches PREDICATE, or #f if none | |
e2f4b305 | 760 | were found." |
ab4e939c DC |
761 | (lambda (expected) |
762 | (find (predicate expected) | |
763 | (map (cut string-append "/dev/" <>) | |
764 | (disk-partitions))))) | |
765 | ||
766 | (define find-partition-by-label | |
767 | (find-partition partition-label-predicate)) | |
768 | ||
769 | (define find-partition-by-uuid | |
770 | (find-partition partition-uuid-predicate)) | |
771 | ||
772 | (define find-partition-by-luks-uuid | |
773 | (find-partition luks-partition-uuid-predicate)) | |
a1ccefaa | 774 | |
f8865db6 | 775 | \f |
a5acc17a LC |
776 | (define (canonicalize-device-spec spec) |
777 | "Return the device name corresponding to SPEC, which can be a <uuid>, a | |
1c3b709e S |
778 | <file-system-label>, or a string (typically a /dev file name or an nfs-root |
779 | containing ':/')." | |
e2f4b305 LC |
780 | (define max-trials |
781 | ;; Number of times we retry partition label resolution, 1 second per | |
782 | ;; trial. Note: somebody reported a delay of 16 seconds (!) before their | |
783 | ;; USB key would be detected by the kernel, so we must wait for at least | |
784 | ;; this long. | |
785 | 20) | |
786 | ||
0ec5ee94 LC |
787 | (define (resolve find-partition spec fmt) |
788 | (let loop ((count 0)) | |
789 | (let ((device (find-partition spec))) | |
790 | (or device | |
791 | ;; Some devices take a bit of time to appear, most notably USB | |
792 | ;; storage devices. Thus, wait for the device to appear. | |
793 | (if (> count max-trials) | |
794 | (error "failed to resolve partition" (fmt spec)) | |
795 | (begin | |
796 | (format #t "waiting for partition '~a' to appear...~%" | |
797 | (fmt spec)) | |
798 | (sleep 1) | |
799 | (loop (+ 1 count)))))))) | |
800 | ||
a5acc17a LC |
801 | (match spec |
802 | ((? string?) | |
281d80d8 MC |
803 | (if (string-contains spec ":/") |
804 | spec ; do not resolve NFS devices | |
805 | ;; Nothing to do, but wait until SPEC shows up. | |
806 | (resolve identity spec identity))) | |
a5acc17a | 807 | ((? file-system-label?) |
e2f4b305 | 808 | ;; Resolve the label. |
a5acc17a LC |
809 | (resolve find-partition-by-label |
810 | (file-system-label->string spec) | |
811 | identity)) | |
812 | ((? uuid?) | |
f453f637 | 813 | (resolve find-partition-by-uuid |
a5acc17a LC |
814 | (uuid-bytevector spec) |
815 | uuid->string)))) | |
e2f4b305 LC |
816 | |
817 | (define (check-file-system device type) | |
818 | "Run a file system check of TYPE on DEVICE." | |
26905ec8 DC |
819 | (define check-procedure |
820 | (cond | |
821 | ((string-prefix? "ext" type) check-ext2-file-system) | |
17425474 | 822 | ((string-prefix? "bcachefs" type) check-bcachefs-file-system) |
b1a505ba | 823 | ((string-prefix? "btrfs" type) check-btrfs-file-system) |
88235675 | 824 | ((string-suffix? "fat" type) check-fat-file-system) |
1abbe7c6 | 825 | ((string-prefix? "jfs" type) check-jfs-file-system) |
23b37c3d | 826 | ((string-prefix? "f2fs" type) check-f2fs-file-system) |
675e5622 | 827 | ((string-prefix? "ntfs" type) check-ntfs-file-system) |
85a7466e | 828 | ((string-prefix? "nfs" type) (const 'pass)) |
26905ec8 DC |
829 | (else #f))) |
830 | ||
831 | (if check-procedure | |
832 | (match (check-procedure device) | |
833 | ('pass | |
834 | #t) | |
835 | ('errors-corrected | |
836 | (format (current-error-port) | |
837 | "File system check corrected errors on ~a; continuing~%" | |
838 | device)) | |
839 | ('reboot-required | |
840 | (format (current-error-port) | |
841 | "File system check corrected errors on ~a; rebooting~%" | |
842 | device) | |
843 | (sleep 3) | |
844 | (reboot)) | |
845 | ('fatal-error | |
6ea6e147 | 846 | (format (current-error-port) "File system check on ~a failed~%" |
26905ec8 | 847 | device) |
6ea6e147 LC |
848 | |
849 | ;; Spawn a REPL only if someone would be able to interact with it. | |
850 | (when (isatty? (current-input-port)) | |
851 | (format (current-error-port) "Spawning Bourne-like REPL.~%") | |
5de5f818 LC |
852 | |
853 | ;; 'current-output-port' is typically connected to /dev/klog (in | |
854 | ;; PID 1), but here we want to make sure we talk directly to the | |
855 | ;; user. | |
856 | (with-output-to-file "/dev/console" | |
857 | (lambda () | |
858 | (start-repl %bournish-language)))))) | |
26905ec8 DC |
859 | (format (current-error-port) |
860 | "No file system check procedure for ~a; skipping~%" | |
861 | device))) | |
e2f4b305 LC |
862 | |
863 | (define (mount-flags->bit-mask flags) | |
864 | "Return the number suitable for the 'flags' argument of 'mount' that | |
865 | corresponds to the symbols listed in FLAGS." | |
866 | (let loop ((flags flags)) | |
867 | (match flags | |
868 | (('read-only rest ...) | |
869 | (logior MS_RDONLY (loop rest))) | |
870 | (('bind-mount rest ...) | |
871 | (logior MS_BIND (loop rest))) | |
872 | (('no-suid rest ...) | |
873 | (logior MS_NOSUID (loop rest))) | |
874 | (('no-dev rest ...) | |
875 | (logior MS_NODEV (loop rest))) | |
876 | (('no-exec rest ...) | |
877 | (logior MS_NOEXEC (loop rest))) | |
9d305381 | 878 | (('no-atime rest ...) |
879 | (logior MS_NOATIME (loop rest))) | |
0dc5c856 GLV |
880 | (('strict-atime rest ...) |
881 | (logior MS_STRICTATIME (loop rest))) | |
882 | (('lazy-time rest ...) | |
883 | (logior MS_LAZYTIME (loop rest))) | |
e2f4b305 LC |
884 | (() |
885 | 0)))) | |
886 | ||
1c65cca5 | 887 | (define* (mount-file-system fs #:key (root "/root")) |
d2ae8a25 | 888 | "Mount the file system described by FS, a <file-system> object, under ROOT." |
0c85db79 JD |
889 | |
890 | (define (mount-nfs source mount-point type flags options) | |
891 | (let* ((idx (string-rindex source #\:)) | |
892 | (host-part (string-take source idx)) | |
893 | ;; Strip [] from around host if present | |
894 | (host (match (string-split host-part (string->char-set "[]")) | |
895 | (("" h "") h) | |
896 | ((h) h))) | |
897 | (aa (match (getaddrinfo host "nfs") ((x . _) x))) | |
898 | (sa (addrinfo:addr aa)) | |
899 | (inet-addr (inet-ntop (sockaddr:fam sa) | |
900 | (sockaddr:addr sa)))) | |
901 | ||
902 | ;; Mounting an NFS file system requires passing the address | |
903 | ;; of the server in the addr= option | |
904 | (mount source mount-point type flags | |
905 | (string-append "addr=" | |
906 | inet-addr | |
907 | (if options | |
908 | (string-append "," options) | |
909 | ""))))) | |
1c65cca5 LC |
910 | (let ((type (file-system-type fs)) |
911 | (options (file-system-options fs)) | |
a5acc17a | 912 | (source (canonicalize-device-spec (file-system-device fs))) |
1c65cca5 LC |
913 | (mount-point (string-append root "/" |
914 | (file-system-mount-point fs))) | |
915 | (flags (mount-flags->bit-mask (file-system-flags fs)))) | |
916 | (when (file-system-check? fs) | |
917 | (check-file-system source type)) | |
918 | ||
7c27bd11 MO |
919 | (catch 'system-error |
920 | (lambda () | |
921 | ;; Create the mount point. Most of the time this is a directory, but | |
922 | ;; in the case of a bind mount, a regular file or socket may be | |
923 | ;; needed. | |
924 | (if (and (= MS_BIND (logand flags MS_BIND)) | |
925 | (not (file-is-directory? source))) | |
926 | (unless (file-exists? mount-point) | |
927 | (mkdir-p (dirname mount-point)) | |
928 | (call-with-output-file mount-point (const #t))) | |
929 | (mkdir-p mount-point)) | |
930 | ||
931 | (cond | |
932 | ((string-prefix? "nfs" type) | |
933 | (mount-nfs source mount-point type flags options)) | |
934 | (else | |
935 | (mount source mount-point type flags options))) | |
936 | ||
937 | ;; For read-only bind mounts, an extra remount is needed, as per | |
938 | ;; <http://lwn.net/Articles/281157/>, which still applies to Linux | |
939 | ;; 4.0. | |
940 | (when (and (= MS_BIND (logand flags MS_BIND)) | |
941 | (= MS_RDONLY (logand flags MS_RDONLY))) | |
942 | (let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY))) | |
943 | (mount source mount-point type flags #f)))) | |
944 | (lambda args | |
945 | (or (file-system-mount-may-fail? fs) | |
946 | (apply throw args)))))) | |
e2f4b305 LC |
947 | |
948 | ;;; file-systems.scm ends here |