me
/
guix
Archived
1
0
Fork 0
Code

base32: Use a custom error condition instead of 'misc-error'. 

Suggested by Christopher Allan Webber <cwebber@dustycloud.org>.

* guix/base32.scm (&invalid-base32-character): New error condition.
  (make-base32-string->bytevector): Use it instead of 'error'.
* tests/base32.scm ("&invalid-base32-character"): New test.
master
Ludovic Courtès 2015-05-31 21:59:43 +02:00
parent 23185ceadc
commit 1a706ff5cf
2 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
guix/base32.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,6 +18,8 @@
(define-module (guix base32) (define-module (guix base32)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-60) #:use-module (srfi srfi-60)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
@ -25,7 +27,11 @@
bytevector->base32-string bytevector->base32-string
bytevector->nix-base32-string bytevector->nix-base32-string
base32-string->bytevector base32-string->bytevector
nix-base32-string->bytevector)) nix-base32-string->bytevector
&invalid-base32-character
invalid-base32-character?
invalid-base32-character-value
invalid-base32-character-string))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -264,6 +270,12 @@ starting from the right of S."
s) s)
bv)) bv))
;; Invalid base32 character error condition when decoding base32.
(define-condition-type &invalid-base32-character &error
invalid-base32-character?
(character invalid-base32-character-value)
(string invalid-base32-character-string))
(define (make-base32-string->bytevector base32-string-unfold base32-chars) (define (make-base32-string->bytevector base32-string-unfold base32-chars)
(let ((char->value (let loop ((i 0) (let ((char->value (let loop ((i 0)
(v vlist-null)) (v vlist-null))
@ -276,7 +288,10 @@ starting from the right of S."
"Return the binary representation of base32 string S as a bytevector." "Return the binary representation of base32 string S as a bytevector."
(base32-string-unfold (lambda (chr) (base32-string-unfold (lambda (chr)
(or (and=> (vhash-assv chr char->value) cdr) (or (and=> (vhash-assv chr char->value) cdr)
(error "invalid base32 character" chr))) (raise (condition
(&invalid-base32-character
(character chr)
(string s))))))
s)))) s))))
(define base32-string->bytevector (define base32-string->bytevector

10
tests/base32.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,6 +21,7 @@
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
@ -77,6 +78,13 @@
;; Examples from RFC 4648. ;; Examples from RFC 4648.
(map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
(test-equal "&invalid-base32-character"
#\e
(guard (c ((invalid-base32-character? c)
(invalid-base32-character-value c)))
(nix-base32-string->bytevector
(string-append (make-string 51 #\a) "e"))))
;; The following test requires `nix-hash' in $PATH. ;; The following test requires `nix-hash' in $PATH.
(unless %have-nix-hash? (unless %have-nix-hash?
(test-skip 1)) (test-skip 1))