.
original commit: ebe32a3daa3d375c8b6e89ec9ac14a476fa713e9
This commit is contained in:
Matthew Flatt
parent
3b96f6069f
commit
37a0969025
142
collects/net/mime-util.ss
Normal file
142
collects/net/mime-util.ss
Normal file
|
|
@ -0,0 +1,142 @@
|
||||||
|
;;;
|
||||||
|
;;; <mime-util.ss> ---- 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 <solsona@acm.org>
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;; 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
|
||||||
45
collects/net/mime.ss
Normal file
45
collects/net/mime.ss
Normal file
|
|
@ -0,0 +1,45 @@
|
||||||
|
;;;
|
||||||
|
;;; <mime.ss> ---- 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 <solsona@acm.org>
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;; 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
|
||||||
39
collects/net/qp.ss
Normal file
39
collects/net/qp.ss
Normal file
|
|
@ -0,0 +1,39 @@
|
||||||
|
;;;
|
||||||
|
;;; <qp.ss> ---- 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 <solsona@acm.org>
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;; 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
|
||||||
Loading…
Reference in New Issue
Block a user