1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (guix base16)
21 #:use-module (srfi srfi-1)
22 #:use-module (srfi srfi-26)
23 #:use-module (srfi srfi-60)
24 #:use-module (rnrs bytevectors)
25 #:use-module (ice-9 vlist)
26 #:use-module (ice-9 format)
27 #:export (bytevector->base16-string
28 base16-string->bytevector))
34 (define (bytevector->base16-string bv)
35 "Return the hexadecimal representation of BV's contents."
36 (define len (bytevector-length bv))
37 (define utf8 (make-bytevector (* len 2)))
38 (let-syntax ((base16-octet-pairs
44 (unfold (cut > <> 255)
46 (format #f "~2,'0x" n))
49 (define octet-pairs base16-octet-pairs)
52 (bytevector-u16-native-set!
54 (bytevector-u16-native-ref octet-pairs
55 (* 2 (bytevector-u8-ref bv i))))
59 (define base16-string->bytevector
60 (let ((chars->value (fold (lambda (i r)
61 (vhash-consv (string-ref (number->string i 16)
67 "Return the bytevector whose hexadecimal representation is string S."
69 (make-bytevector (quotient (string-length s) 2) 0))
71 (string-fold (lambda (chr i)
72 (let ((j (quotient i 2))
73 (v (and=> (vhash-assv chr chars->value) cdr)))
75 (if (zero? (logand i 1))
76 (bytevector-u8-set! bv j
77 (arithmetic-shift v 4))
78 (let ((w (bytevector-u8-ref bv j)))
79 (bytevector-u8-set! bv j (logior v w))))
80 (error "invalid hexadecimal character" chr)))