From 4c0c4db0702048488a9712dbba7cad862c667d54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Mar 2017 21:54:34 +0100 Subject: utils: Move base16 procedures to (guix base16). * guix/utils.scm (bytevector->base16-string, base16-string->bytevector): Move to... * guix/base16.scm: ... here. New file. * tests/utils.scm ("bytevector->base16-string->bytevector"): Move to... * tests/base16.scm: ... here. New file. * Makefile.am (MODULES): Add guix/base16.scm. (SCM_TESTS): Add tests/base16.scm. * build-aux/download.scm, guix/derivations.scm, guix/docker.scm, guix/import/snix.scm, guix/pk-crypto.scm, guix/scripts/authenticate.scm, guix/scripts/download.scm, guix/scripts/hash.scm, guix/store.scm, tests/hash.scm, tests/pk-crypto.scm: Adjust imports accordingly. --- guix/base16.scm | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 guix/base16.scm (limited to 'guix/base16.scm') diff --git a/guix/base16.scm b/guix/base16.scm new file mode 100644 index 0000000000..6c15a9f588 --- /dev/null +++ b/guix/base16.scm @@ -0,0 +1,83 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2014, 2017 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix base16) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-60) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 vlist) + #:use-module (ice-9 format) + #:export (bytevector->base16-string + base16-string->bytevector)) + +;;; +;;; Base 16. +;;; + +(define (bytevector->base16-string bv) + "Return the hexadecimal representation of BV's contents." + (define len + (bytevector-length bv)) + + (let-syntax ((base16-chars (lambda (s) + (syntax-case s () + (_ + (let ((v (list->vector + (unfold (cut > <> 255) + (lambda (n) + (format #f "~2,'0x" n)) + 1+ + 0)))) + v)))))) + (define chars base16-chars) + (let loop ((i len) + (r '())) + (if (zero? i) + (string-concatenate r) + (let ((i (- i 1))) + (loop i + (cons (vector-ref chars (bytevector-u8-ref bv i)) r))))))) + +(define base16-string->bytevector + (let ((chars->value (fold (lambda (i r) + (vhash-consv (string-ref (number->string i 16) + 0) + i r)) + vlist-null + (iota 16)))) + (lambda (s) + "Return the bytevector whose hexadecimal representation is string S." + (define bv + (make-bytevector (quotient (string-length s) 2) 0)) + + (string-fold (lambda (chr i) + (let ((j (quotient i 2)) + (v (and=> (vhash-assv chr chars->value) cdr))) + (if v + (if (zero? (logand i 1)) + (bytevector-u8-set! bv j + (arithmetic-shift v 4)) + (let ((w (bytevector-u8-ref bv j))) + (bytevector-u8-set! bv j (logior v w)))) + (error "invalid hexadecimal character" chr))) + (+ i 1)) + 0 + s) + bv))) + -- cgit v1.2.3