From 2bbc6db5e22b0361c166c89210c7a6fd9842db8c Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 22 Nov 2014 21:52:57 +0100
Subject: utils: Factorize magic bytes detection.

* guix/build/utils.scm (file-header-match): New procedure.
  (%elf-magic-bytes): New variable.
  (elf-file?, ar-file?): Define using 'file-header-match'.
---
 guix/build/utils.scm | 42 +++++++++++++++++++++++-------------------
 1 file changed, 23 insertions(+), 19 deletions(-)

(limited to 'guix/build/utils.scm')

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