From 277a836aa2e9fca708b8860533ef68227a4c9308 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sat, 8 Sep 2018 17:40:37 +0530 Subject: Initial commit. --- email/quoted-printable.scm | 57 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 email/quoted-printable.scm (limited to 'email/quoted-printable.scm') diff --git a/email/quoted-printable.scm b/email/quoted-printable.scm new file mode 100644 index 0000000..f6e3605 --- /dev/null +++ b/email/quoted-printable.scm @@ -0,0 +1,57 @@ +;;; 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))) -- cgit v1.2.3