me/guix
Archived
1
0
Fork 0
Code Activity

utils: Factorize magic bytes detection.

Browse source 
* guix/build/utils.scm (file-header-match): New procedure.
  (%elf-magic-bytes): New variable.
  (elf-file?, ar-file?): Define using 'file-header-match'.
This commit is contained in:
Ludovic Courtès 2014-11-22 21:52:57 +01:00
parent 91ee959b03
commit 2bbc6db5e2
1 changed files with 23 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
guix/build/utils.scm
View file

@ -108,31 +108,35 @@ return values of applying PROC to the port."
(lambda () (lambda ()
(close-input-port port))))) (close-input-port port)))))
(define (elf-file? file) (define (file-header-match header)
"Return true if FILE starts with the ELF magic bytes." "Return a procedure that returns true when its argument is a file starting
(define (get-header) with the bytes in HEADER, a bytevector."
(call-with-input-file file (define len
(lambda (port) (bytevector-length header))
(get-bytevector-n port 4))
#:binary #t #:guess-encoding #f))
(equal? (get-header) (lambda (file)
#vu8(#x7f #x45 #x4c #x46))) ;"\177ELF" "Return true if FILE starts with the right magic bytes."
(define (get-header)
(call-with-input-file file
(lambda (port)
(get-bytevector-n port len))
#:binary #t #:guess-encoding #f))
(equal? (get-header) header)))
(define %elf-magic-bytes
;; Magic bytes of ELF files. See <elf.h>.
(u8-list->bytevector (map char->integer (string->list "\x7FELF"))))
(define elf-file?
(file-header-match %elf-magic-bytes))
(define %ar-magic-bytes (define %ar-magic-bytes
;; Magic bytes of archives created by 'ar'. See <ar.h>. ;; Magic bytes of archives created by 'ar'. See <ar.h>.
(u8-list->bytevector (map char->integer (string->list "!<arch>\n")))) (u8-list->bytevector (map char->integer (string->list "!<arch>\n"))))
(define (ar-file? file) (define ar-file?
"Return true if FILE starts with the magic bytes of archives as created by (file-header-match %ar-magic-bytes))
'ar'."
(define (get-header)
(call-with-input-file file
(lambda (port)
(get-bytevector-n port 8))
#:binary #t #:guess-encoding #f))
(equal? (get-header) %ar-magic-bytes))
(define-syntax-rule (with-directory-excursion dir body ...) (define-syntax-rule (with-directory-excursion dir body ...)
"Run BODY with DIR as the process's current directory." "Run BODY with DIR as the process's current directory."