;;; guile-email --- Guile email parser ;;; Copyright © 2018 Arun Isaac ;;; ;;; This file is part of guile-email. ;;; ;;; guile-email is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU Affero General Public License as ;;; published by the Free Software Foundation; either version 3 of the ;;; License, or (at your option) any later version. ;;; ;;; guile-email 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 ;;; Affero General Public License for more details. ;;; ;;; You should have received a copy of the GNU Affero General Public ;;; License along with guile-email. If not, see ;;; . (define-module (email quoted-printable) #:use-module (rnrs) #:use-module (ice-9 match) #:export (quoted-printable-decode q-encoding-decode)) ;; TODO: Error out on invalid quoted-printable input (define quoted-printable-decode (match-lambda* (((? string? str)) (call-with-input-string str quoted-printable-decode)) (((? port? in)) (let-values (((out get-bytevector) (open-bytevector-output-port))) (quoted-printable-decode in out) (get-bytevector))) (((? port? in) (? port? out)) (let ((c (read-char in))) (cond ((eof-object? c) out) ((char=? c #\=) ;; TODO: Support "\r\n" line ending (let ((c1 (read-char in))) (unless (char=? c1 #\Newline) (let ((c2 (read-char in))) (put-u8 out (string->number (string c1 c2) 16))))) (quoted-printable-decode in out)) (#t (put-u8 out (char->integer c)) (quoted-printable-decode in out))))))) (define (q-encoding-decode str) (quoted-printable-decode (string-map (lambda (c) (if (char=? c #\_) #\Space c)) str)))