01/04: utils: Add 'ar-file?'.

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit 91ee959b03e9e45727761823a4fcc1046e0aa450
Author: Ludovic Courtès <address@hidden>
Date:   Sat Nov 22 21:44:59 2014 +0100

    utils: Add 'ar-file?'.
    
    * guix/build/utils.scm (%ar-magic-bytes): New variable.
      (ar-file?): New procedure.
---
 guix/build/utils.scm |   16 ++++++++++++++++
 1 files changed, 16 insertions(+), 0 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index fcf6dfc..0ea22ec 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -37,6 +37,7 @@
             executable-file?
             call-with-ascii-input-file
             elf-file?
+            ar-file?
             with-directory-excursion
             mkdir-p
             copy-recursively
@@ -118,6 +119,21 @@ return values of applying PROC to the port."
   (equal? (get-header)
           #vu8(#x7f #x45 #x4c #x46)))             ;"\177ELF"
 
+(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-syntax-rule (with-directory-excursion dir body ...)
   "Run BODY with DIR as the process's current directory."
   (let ((init (getcwd)))