mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05:00
file-systems: Add NTFS support.
* gnu/system/uuid.scm (%ntfs-endianness): New macro, (ntfs-uuid->string): new procedure, (%ntfs-endianness): new variable, (string->ntfs-uuid): new exported procedure, (%uuid-parsers): add NTFS support, (%uuid-printers): add NTFS support. * gnu/build/file-systems.scm (%ntfs-endianness): New macro, (ntfs-superblock?, read-ntfs-superblock, ntfs-superblock-uuid, check-ntfs-file-system): new procedure, (%partition-uuid-readers): add NTFS support, (check-file-system): add NTFS support.
This commit is contained in:
parent
1f322c5eb3
commit
675e56221e
2 changed files with 76 additions and 2 deletions
|
@ -476,6 +476,42 @@ (define (luks-header-uuid header)
|
|||
(let ((uuid (sub-bytevector header 168 36)))
|
||||
(string->uuid (utf8->string uuid))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; NTFS file systems.
|
||||
;;;
|
||||
|
||||
;; Taken from <linux-libre>/fs/ntfs/layout.h
|
||||
|
||||
(define-syntax %ntfs-endianness
|
||||
;; Endianness of NTFS file systems.
|
||||
(identifier-syntax (endianness little)))
|
||||
|
||||
(define (ntfs-superblock? sblock)
|
||||
"Return #t when SBLOCK is a NTFS superblock."
|
||||
(bytevector=? (sub-bytevector sblock 3 8)
|
||||
(string->utf8 "NTFS ")))
|
||||
|
||||
(define (read-ntfs-superblock device)
|
||||
"Return the raw contents of DEVICE's NTFS superblock as a bytevector, or #f
|
||||
if DEVICE does not contain a NTFS file system."
|
||||
(read-superblock device 0 511 ntfs-superblock?))
|
||||
|
||||
(define (ntfs-superblock-uuid sblock)
|
||||
"Return the UUID of NTFS superblock SBLOCK as a 8-byte bytevector."
|
||||
(sub-bytevector sblock 72 8))
|
||||
|
||||
;; TODO: Add ntfs-superblock-volume-name. The partition label is not stored
|
||||
;; in the BOOT SECTOR like the UUID, but in the MASTER FILE TABLE, which seems
|
||||
;; way harder to access.
|
||||
|
||||
(define (check-ntfs-file-system device)
|
||||
"Return the health of a NTFS file system on DEVICE."
|
||||
(match (status:exit-val
|
||||
(system* "ntfsfix" device))
|
||||
(0 'pass)
|
||||
(_ 'fatal-error)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Partition lookup.
|
||||
|
@ -585,7 +621,9 @@ (define %partition-uuid-readers
|
|||
(partition-field-reader read-jfs-superblock
|
||||
jfs-superblock-uuid)
|
||||
(partition-field-reader read-f2fs-superblock
|
||||
f2fs-superblock-uuid)))
|
||||
f2fs-superblock-uuid)
|
||||
(partition-field-reader read-ntfs-superblock
|
||||
ntfs-superblock-uuid)))
|
||||
|
||||
(define read-partition-label
|
||||
(cut read-partition-field <> %partition-label-readers))
|
||||
|
@ -684,6 +722,7 @@ (define check-procedure
|
|||
((string-suffix? "fat" type) check-fat-file-system)
|
||||
((string-prefix? "jfs" type) check-jfs-file-system)
|
||||
((string-prefix? "f2fs" type) check-f2fs-file-system)
|
||||
((string-prefix? "ntfs" type) check-ntfs-file-system)
|
||||
((string-prefix? "nfs" type) (const 'pass))
|
||||
(else #f)))
|
||||
|
||||
|
|
|
@ -45,6 +45,7 @@ (define-module (gnu system uuid)
|
|||
string->btrfs-uuid
|
||||
string->fat-uuid
|
||||
string->jfs-uuid
|
||||
string->ntfs-uuid
|
||||
iso9660-uuid->string
|
||||
|
||||
;; XXX: For lack of a better place.
|
||||
|
@ -195,6 +196,38 @@ (define (string->fat-uuid str)
|
|||
%fat-endianness
|
||||
2))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; NTFS.
|
||||
;;;
|
||||
|
||||
(define-syntax %ntfs-endianness
|
||||
;; Endianness of NTFS file system.
|
||||
(identifier-syntax (endianness little)))
|
||||
|
||||
(define (ntfs-uuid->string uuid)
|
||||
"Convert NTFS UUID, a 8-byte bytevector, to its string representation."
|
||||
(format #f "~{~:@(~x~)~}" (reverse (bytevector->u8-list uuid))))
|
||||
|
||||
(define %ntfs-uuid-rx
|
||||
(make-regexp "^([[:xdigit:]]{16})$"))
|
||||
|
||||
(define (string->ntfs-uuid str)
|
||||
"Parse STR, which is in NTFS format, and return a bytevector or #f."
|
||||
(match (regexp-exec %ntfs-uuid-rx str)
|
||||
(#f
|
||||
#f)
|
||||
(rx-match
|
||||
(u8-list->bytevector
|
||||
(let loop ((str str)
|
||||
(res '()))
|
||||
(if (string=? str "")
|
||||
res
|
||||
(loop (string-drop str 2)
|
||||
(cons
|
||||
(string->number (string-take str 2) 16)
|
||||
res))))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Generic interface.
|
||||
|
@ -220,13 +253,15 @@ (define %uuid-parsers
|
|||
(vhashq
|
||||
('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => string->dce-uuid)
|
||||
('fat32 'fat16 'fat => string->fat-uuid)
|
||||
('ntfs => string->ntfs-uuid)
|
||||
('iso9660 => string->iso9660-uuid)))
|
||||
|
||||
(define %uuid-printers
|
||||
(vhashq
|
||||
('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => dce-uuid->string)
|
||||
('iso9660 => iso9660-uuid->string)
|
||||
('fat32 'fat16 'fat => fat-uuid->string)))
|
||||
('fat32 'fat16 'fat => fat-uuid->string)
|
||||
('ntfs => ntfs-uuid->string)))
|
||||
|
||||
(define* (string->uuid str #:optional (type 'dce))
|
||||
"Parse STR as a UUID of the given TYPE. On success, return the
|
||||
|
|
Loading…
Reference in a new issue