diff --git a/collects/net/mime-util.ss b/collects/net/mime-util.ss new file mode 100644 index 0000000000..5f465cf19e --- /dev/null +++ b/collects/net/mime-util.ss @@ -0,0 +1,142 @@ +;;; +;;; ---- Extra utilities +;;; Time-stamp: <01/05/07 17:41:12 solsona> +;;; +;;; Copyright (C) 2001 by Francisco Solsona. +;;; +;;; This file is part of mime-plt. + +;;; mime-plt is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 2.1 of the License, or (at your option) any later version. + +;;; mime-plt 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 +;;; Lesser General Public License for more details. + +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with mime-plt; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;;; Author: Francisco Solsona +;; +;; +;; Commentary: + +(module mime-util mzscheme + (require (lib "etc.ss")) + + (provide string-tokenizer + trim-all-spaces + trim-spaces + trim-comments + lowercase + warning + cat) + + ;; string-index returns the leftmost index in string s + ;; that has character c + (define string-index + (lambda (s c) + (let ((n (string-length s))) + (let loop ((i 0)) + (cond ((>= i n) #f) + ((char=? (string-ref s i) c) i) + (else (loop (+ i 1)))))))) + + ;; string-tokenizer breaks string s into substrings separated by character c + (define string-tokenizer + (lambda (c s) + (let loop ((s s)) + (if (string=? s "") '() + (let ((i (string-index s c))) + (if i (cons (substring s 0 i) + (loop (substring s (+ i 1) + (string-length s)))) + (list s))))))) + + + ;; Trim all spaces, except those in quoted strings. + (define trim-all-spaces + (lambda (str) + (letrec ((eat-quoted-string (lambda (str) + (let* ((r (regexp "(\".*\")(.*)")) + (ans (regexp-match r str))) + (when (not ans) + ;; Uh oh, unterminated quoted string + ;; I will try to recover, but... + (values (substring str 0 1) + (substring str 1 (string-length str)))) + (values (regexp-replace r str "\\1") + (regexp-replace r str "\\2")))))) + (let loop ((out "") (str str)) + (cond ((string=? str "") out) + (else + (let ((c (string-ref str 0))) + (cond ((or (char=? c #\space) + (char=? c #\tab)) + (loop out (substring str 1 (string-length str)))) + ((char=? c #\");; Begin of quoted string + (let-values ([(quoted rest) + (eat-quoted-string str)]) + (loop (string-append out quoted) rest))) + (else + (loop (string-append out (string c)) + (substring str 1 (string-length str)))))))))))) + + ;; Only trims left and right spaces: + (define trim-spaces + (lambda (str) + (trim-right (trim-left str)))) + + (define trim-left + (lambda (str) + (let* ((r (regexp "^[ ]*(.*)")) + (ans (regexp-match r str))) + (and ans (regexp-replace r str "\\1"))))) + + (define trim-right + (lambda (str) + (let* ((r (regexp "[ ]*$")) + (pos (regexp-match-positions r str))) + (substring str 0 (caar pos))))) + + (define trim-comments + (lambda (str) + (let* ((reg (regexp "\\(.*\\)")) + (positions (regexp-match-positions reg str))) + (if (regexp-match reg str) + (string-append (substring str 0 (caar positions)) + (substring str (cdar positions) (string-length str))) + str)))) + + (define lowercase + (lambda (str) + (let loop ((out "") (rest str) (size (string-length str))) + (cond ((zero? size) out) + (else + (loop (string-append out (string + (char-downcase + (string-ref rest 0)))) + (substring rest 1 size) + (sub1 size))))))) + + (define warning + (lambda (msg . args) + (fprintf (current-error-port) + (apply format (cons msg args))) + (newline (current-error-port)))) + + ;; Copies its input `in' to its ouput port if given, it uses + ;; current-output-port if out is not provided. + (define cat + (opt-lambda (in (out (current-output-port))) + (let loop ((ln (read-line in))) + (unless (eof-object? ln) + (fprintf out "~a~n" ln) + (loop (read-line in)))))) + + ) +;;; mime-util.ss ends here diff --git a/collects/net/mime.ss b/collects/net/mime.ss new file mode 100644 index 0000000000..3c9bc3a814 --- /dev/null +++ b/collects/net/mime.ss @@ -0,0 +1,45 @@ +;;; +;;; ---- MIME support +;;; +;;; Copyright (C) 2001 by Wish Computing. +;;; +;;; This file is part of mime + +;;; mime 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 2, or (at your option) +;;; any later version. + +;;; mime 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 mime; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. + +;;; Author: Francisco Solsona +;; +;; +;; Commentary: + +(module mime mzscheme + (require (lib "unitsig.ss")) + + (require "mime-sig.ss" + "mime-unit.ss" + "qp-sig.ss" + "qp.ss" + "base64-sig.ss" + "base64.ss") + + (define-values/invoke-unit/sig net:mime^ + net:mime@ + #f + net:base64^ net:qp^) + + (provide-signature-elements net:mime^)) + +;;; mime.ss ends here \ No newline at end of file diff --git a/collects/net/qp.ss b/collects/net/qp.ss new file mode 100644 index 0000000000..15a9dcf5d0 --- /dev/null +++ b/collects/net/qp.ss @@ -0,0 +1,39 @@ +;;; +;;; ---- Quoted Printable Encoding/Decoding +;;; Time-stamp: <01/04/23 09:35:51 solsona> +;;; +;;; Copyright (C) 2001 by Francisco Solsona. +;;; +;;; This file is part of mime-plt. + +;;; mime-plt is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 2.1 of the License, or (at your option) any later version. + +;;; mime-plt 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 +;;; Lesser General Public License for more details. + +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with mime-plt; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;;; Author: Francisco Solsona +;; +;; +;; Commentary: + +(module qp mzscheme + (require (lib "unitsig.ss")) + + (require "qp-sig.ss") + (require "qp-unit.ss") + + (define-values/invoke-unit/sig net:qp^ + net:qp@) + + (provide-signature-elements net:qp^)) + +;;; qp.ss ends here \ No newline at end of file