guix/build/debug-link.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix build debug-link)
  20   #:use-module (guix elf)
  21   #:use-module ((guix build utils)
  22                 #:select (find-files elf-file? make-file-writable))
  23   #:use-module (rnrs bytevectors)
  24   #:use-module (rnrs io ports)
  25   #:use-module (srfi srfi-1)
  26   #:use-module (system foreign)
  27   #:use-module (ice-9 match)
  28   #:export (debuglink-crc32
  29             elf-debuglink
  30             set-debuglink-crc
  31
  32             graft-debug-links))
  33
  34 ;;; Commentary:
  35 ;;;
  36 ;;; This module provides tools to deal with '.gnu_debuglink' sections in ELF
  37 ;;; files.  These sections are created by 'objcopy --add-gnu-debuglink' to
  38 ;;; create separate debug files (info "(gdb) Separate Debug Files").
  39 ;;;
  40 ;;; The main facility of this module is 'graft-debug-links', which allows us
  41 ;;; to update the CRC that appears in '.gnu_debuglink' sections when grafting,
  42 ;;; such that separate debug files remain usable after grafting.  Failing to
  43 ;;; do that, GDB would complain about CRC mismatch---see
  44 ;;; <https://bugs.gnu.org/19973>.
  45 ;;;
  46 ;;; Code:
  47
  48 (define %crc32-table
  49   ;; CRC table taken from "(gdb) Separate Debug Files".
  50   ;; TODO: Wouldn't it be nice to generate it "from source" with a macro?
  51   #(#x00000000 #x77073096 #xee0e612c #x990951ba #x076dc419
  52     #x706af48f #xe963a535 #x9e6495a3 #x0edb8832 #x79dcb8a4
  53     #xe0d5e91e #x97d2d988 #x09b64c2b #x7eb17cbd #xe7b82d07
  54     #x90bf1d91 #x1db71064 #x6ab020f2 #xf3b97148 #x84be41de
  55     #x1adad47d #x6ddde4eb #xf4d4b551 #x83d385c7 #x136c9856
  56     #x646ba8c0 #xfd62f97a #x8a65c9ec #x14015c4f #x63066cd9
  57     #xfa0f3d63 #x8d080df5 #x3b6e20c8 #x4c69105e #xd56041e4
  58     #xa2677172 #x3c03e4d1 #x4b04d447 #xd20d85fd #xa50ab56b
  59     #x35b5a8fa #x42b2986c #xdbbbc9d6 #xacbcf940 #x32d86ce3
  60     #x45df5c75 #xdcd60dcf #xabd13d59 #x26d930ac #x51de003a
  61     #xc8d75180 #xbfd06116 #x21b4f4b5 #x56b3c423 #xcfba9599
  62     #xb8bda50f #x2802b89e #x5f058808 #xc60cd9b2 #xb10be924
  63     #x2f6f7c87 #x58684c11 #xc1611dab #xb6662d3d #x76dc4190
  64     #x01db7106 #x98d220bc #xefd5102a #x71b18589 #x06b6b51f
  65     #x9fbfe4a5 #xe8b8d433 #x7807c9a2 #x0f00f934 #x9609a88e
  66     #xe10e9818 #x7f6a0dbb #x086d3d2d #x91646c97 #xe6635c01
  67     #x6b6b51f4 #x1c6c6162 #x856530d8 #xf262004e #x6c0695ed
  68     #x1b01a57b #x8208f4c1 #xf50fc457 #x65b0d9c6 #x12b7e950
  69     #x8bbeb8ea #xfcb9887c #x62dd1ddf #x15da2d49 #x8cd37cf3
  70     #xfbd44c65 #x4db26158 #x3ab551ce #xa3bc0074 #xd4bb30e2
  71     #x4adfa541 #x3dd895d7 #xa4d1c46d #xd3d6f4fb #x4369e96a
  72     #x346ed9fc #xad678846 #xda60b8d0 #x44042d73 #x33031de5
  73     #xaa0a4c5f #xdd0d7cc9 #x5005713c #x270241aa #xbe0b1010
  74     #xc90c2086 #x5768b525 #x206f85b3 #xb966d409 #xce61e49f
  75     #x5edef90e #x29d9c998 #xb0d09822 #xc7d7a8b4 #x59b33d17
  76     #x2eb40d81 #xb7bd5c3b #xc0ba6cad #xedb88320 #x9abfb3b6
  77     #x03b6e20c #x74b1d29a #xead54739 #x9dd277af #x04db2615
  78     #x73dc1683 #xe3630b12 #x94643b84 #x0d6d6a3e #x7a6a5aa8
  79     #xe40ecf0b #x9309ff9d #x0a00ae27 #x7d079eb1 #xf00f9344
  80     #x8708a3d2 #x1e01f268 #x6906c2fe #xf762575d #x806567cb
  81     #x196c3671 #x6e6b06e7 #xfed41b76 #x89d32be0 #x10da7a5a
  82     #x67dd4acc #xf9b9df6f #x8ebeeff9 #x17b7be43 #x60b08ed5
  83     #xd6d6a3e8 #xa1d1937e #x38d8c2c4 #x4fdff252 #xd1bb67f1
  84     #xa6bc5767 #x3fb506dd #x48b2364b #xd80d2bda #xaf0a1b4c
  85     #x36034af6 #x41047a60 #xdf60efc3 #xa867df55 #x316e8eef
  86     #x4669be79 #xcb61b38c #xbc66831a #x256fd2a0 #x5268e236
  87     #xcc0c7795 #xbb0b4703 #x220216b9 #x5505262f #xc5ba3bbe
  88     #xb2bd0b28 #x2bb45a92 #x5cb36a04 #xc2d7ffa7 #xb5d0cf31
  89     #x2cd99e8b #x5bdeae1d #x9b64c2b0 #xec63f226 #x756aa39c
  90     #x026d930a #x9c0906a9 #xeb0e363f #x72076785 #x05005713
  91     #x95bf4a82 #xe2b87a14 #x7bb12bae #x0cb61b38 #x92d28e9b
  92     #xe5d5be0d #x7cdcefb7 #x0bdbdf21 #x86d3d2d4 #xf1d4e242
  93     #x68ddb3f8 #x1fda836e #x81be16cd #xf6b9265b #x6fb077e1
  94     #x18b74777 #x88085ae6 #xff0f6a70 #x66063bca #x11010b5c
  95     #x8f659eff #xf862ae69 #x616bffd3 #x166ccf45 #xa00ae278
  96     #xd70dd2ee #x4e048354 #x3903b3c2 #xa7672661 #xd06016f7
  97     #x4969474d #x3e6e77db #xaed16a4a #xd9d65adc #x40df0b66
  98     #x37d83bf0 #xa9bcae53 #xdebb9ec5 #x47b2cf7f #x30b5ffe9
  99     #xbdbdf21c #xcabac28a #x53b39330 #x24b4a3a6 #xbad03605
 100     #xcdd70693 #x54de5729 #x23d967bf #xb3667a2e #xc4614ab8
 101     #x5d681b02 #x2a6f2b94 #xb40bbe37 #xc30c8ea1 #x5a05df1b
 102     #x2d02ef8d))
 103
 104 (define (debuglink-crc32 port)
 105   "Compute the 32-bit CRC used in in '.gnu_debuglink' over the data read from
 106 PORT and return it."                      ;(info "(gdb) Separate Debug Files")
 107   (let loop ((crc #xffffffff))
 108     (let ((byte (get-u8 port)))
 109       (if (eof-object? byte)
 110           (logand (lognot crc) #xffffffff)
 111           (let* ((index (logand (logxor crc byte) #xff))
 112                  (lhs   (vector-ref %crc32-table index)))
 113             (loop (logxor lhs (ash crc -8))))))))
 114
 115 (define (section-contents elf section)     ;XXX: copied from linux-modules.scm
 116   "Return the contents of SECTION in ELF as a bytevector."
 117   (let* ((contents (make-bytevector (elf-section-size section))))
 118     (bytevector-copy! (elf-bytes elf) (elf-section-offset section)
 119                       contents 0
 120                       (elf-section-size section))
 121     contents))
 122
 123 (define null-terminated-bytevector->string
 124   (compose pointer->string bytevector->pointer))
 125
 126 (define (elf-debuglink elf)
 127   "Return two values: the '.gnu_debuglink' file name of ELF and its CRC.
 128 Return #f for both if ELF lacks a '.gnu_debuglink' section."
 129   (let ((section (elf-section-by-name elf ".gnu_debuglink")))
 130     (if section
 131         (let ((size       (elf-section-size section))
 132               (bv         (section-contents elf section))
 133               (endianness (elf-byte-order elf)))
 134           (values (null-terminated-bytevector->string bv)
 135                   (bytevector-u32-ref bv (- size 4) endianness)))
 136         (values #f #f))))
 137
 138 (define (elf-debuglink-crc-offset elf)
 139   "Return the offset of the '.gnu_debuglink' 32-bit CRC, or #f if ELF lacks a
 140 '.gnu_debuglink' section."
 141   (let ((section (elf-section-by-name elf ".gnu_debuglink")))
 142     (and section
 143          (+ (elf-section-offset section)
 144             (elf-section-size section)
 145             -4))))
 146
 147 (define (set-debuglink-crc file debug-file)
 148   "Compute the CRC of DEBUG-FILE and set it as the '.gnu_debuglink' CRC in
 149 FILE."
 150   (let* ((elf    (parse-elf (call-with-input-file file get-bytevector-all)))
 151          (offset (elf-debuglink-crc-offset elf)))
 152     (and offset
 153          (let* ((crc (call-with-input-file debug-file debuglink-crc32))
 154                 (bv  (make-bytevector 4)))
 155            (bytevector-u32-set! bv 0 crc (elf-byte-order elf))
 156            (let ((port (open file O_RDWR)))
 157              (set-port-position! port offset)
 158              (put-bytevector port bv)
 159              (close-port port))))))
 160
 161 \f
 162 ;;;
 163 ;;; Updating debuglink CRC.
 164 ;;;
 165
 166 (define (find-elf-files outputs)
 167   "Return the list of ELF files found in OUTPUTS, a list of top-level store
 168 directories."
 169   (define directories
 170     (append-map (lambda (output)
 171                   (list (string-append output "/bin")
 172                         (string-append output "/sbin")
 173                         (string-append output "/lib")
 174                         (string-append output "/libexec")))
 175                 outputs))
 176
 177   (append-map (lambda (directory)
 178                 (filter elf-file?
 179                         (with-error-to-port (%make-void-port "w")
 180                           (lambda ()
 181                             (find-files directory)))))
 182               directories))
 183
 184 (define* (graft-debug-links old-outputs new-outputs mapping
 185                             #:key (log-port (current-error-port)))
 186   "Update the '.gnu_debuglink' CRCs found in ELF files of NEW-OUTPUTS,
 187 provided NEW-OUTPUTS contains a \"debug\" output, such that those CRCs match
 188 those of the corresponding '.debug' files found in the \"debug\" output.
 189
 190 This procedure is meant to be used as a \"grafting hook\" by (guix build
 191 graft)."
 192   (match (assoc-ref new-outputs "debug")
 193     (#f #t)                                       ;nothing to do
 194     (debug-directory
 195      (let ((files (find-elf-files (filter-map (match-lambda
 196                                                 (("debug" . _)
 197                                                  #f)
 198                                                 ((name . directory)
 199                                                  directory))
 200                                               new-outputs))))
 201        (for-each (lambda (file)
 202                    (let ((debug (string-append debug-directory
 203                                                "/lib/debug" file ".debug")))
 204                      (when (file-exists? debug)
 205                        (format log-port
 206                                "updating '.gnu_debuglink' CRC in '~a'~%"
 207                                file)
 208                        (make-file-writable file)
 209                        (set-debuglink-crc file debug))))
 210                  files)))))