From jdzerins at common-lisp.net Mon Jul 19 07:25:05 2010 From: jdzerins at common-lisp.net (jdzerins) Date: Mon, 19 Jul 2010 03:25:05 -0400 Subject: [rfc2388-cvs] CVS rfc2388 Message-ID: Update of /project/rfc2388/cvsroot/rfc2388 In directory cl-net:/tmp/cvs-serv13304 Modified Files: rfc2388.lisp Log Message: Specify output file external-format for ClosureCL --- /project/rfc2388/cvsroot/rfc2388/rfc2388.lisp 2010/06/29 10:49:02 1.12 +++ /project/rfc2388/cvsroot/rfc2388/rfc2388.lisp 2010/07/19 07:25:05 1.13 @@ -437,11 +437,13 @@ :direction :output ;; external format for faithful I/O ;; see - #+(or :sbcl :lispworks :allegro) + #+(or :sbcl :lispworks :allegro :openmcl) :external-format #+sbcl :latin-1 #+:lispworks '(:latin-1 :eol-style :lf) - #+:allegro (excl:crlf-base-ef :latin1)) + #+:allegro (excl:crlf-base-ef :latin1) + #+:openmcl '(:character-encoding :iso-8859-1 + :line-termination :unix)) (read-until-next-boundary input boundary nil out-file)) (declare (ignore text)) (when (and (stringp file-name) From jdzerins at common-lisp.net Mon Jul 19 07:30:20 2010 From: jdzerins at common-lisp.net (jdzerins) Date: Mon, 19 Jul 2010 03:30:20 -0400 Subject: [rfc2388-cvs] CVS rfc2388 Message-ID: Update of /project/rfc2388/cvsroot/rfc2388 In directory cl-net:/tmp/cvs-serv14603 Modified Files: rfc2388.lisp Log Message: Removed unused variable (since rev. 1.12) --- /project/rfc2388/cvsroot/rfc2388/rfc2388.lisp 2010/07/19 07:25:05 1.13 +++ /project/rfc2388/cvsroot/rfc2388/rfc2388.lisp 2010/07/19 07:30:19 1.14 @@ -418,15 +418,13 @@ (unless (nth-value 1 (read-until-next-boundary input boundary t)) (return-from parse-mime nil)) - (let ((result ()) - content-type-header) + (let ((result ())) (loop (let ((headers (loop for header = (parse-header input) while header when (string-equal "CONTENT-TYPE" (header-name header)) - do (setf content-type-header header - (header-value header) (parse-content-type (header-value header))) + do (setf (header-value header) (parse-content-type (header-value header))) collect header))) (let ((file-name (get-file-name headers))) (cond ((and write-content-to-file From jdzerins at common-lisp.net Mon Jul 19 07:33:20 2010 From: jdzerins at common-lisp.net (jdzerins) Date: Mon, 19 Jul 2010 03:33:20 -0400 Subject: [rfc2388-cvs] CVS rfc2388 Message-ID: Update of /project/rfc2388/cvsroot/rfc2388 In directory cl-net:/tmp/cvs-serv15235 Modified Files: packages.lisp rfc2388.asd rfc2388.lisp test.lisp Log Message: Removed trailing whitespace --- /project/rfc2388/cvsroot/rfc2388/packages.lisp 2009/10/23 06:35:20 1.4 +++ /project/rfc2388/cvsroot/rfc2388/packages.lisp 2010/07/19 07:33:20 1.5 @@ -1,6 +1,6 @@ ;;;; -*- mode: LISP; package: RFC2388 -*- ;;;; Copyright (c) 2003 Janis Dzerins -;;;; +;;;; ;;;; Redistribution and use in source and binary forms, with or without ;;;; modification, are permitted provided that the following conditions ;;;; are met: --- /project/rfc2388/cvsroot/rfc2388/rfc2388.asd 2005/04/05 08:45:21 1.1 +++ /project/rfc2388/cvsroot/rfc2388/rfc2388.asd 2010/07/19 07:33:20 1.2 @@ -1,6 +1,6 @@ ;;;; -*- mode: LISP; package: RFC2388 -*- ;;;; Copyright (c) 2003 Janis Dzerins -;;;; +;;;; ;;;; Redistribution and use in source and binary forms, with or without ;;;; modification, are permitted provided that the following conditions ;;;; are met: --- /project/rfc2388/cvsroot/rfc2388/rfc2388.lisp 2010/07/19 07:30:19 1.14 +++ /project/rfc2388/cvsroot/rfc2388/rfc2388.lisp 2010/07/19 07:33:20 1.15 @@ -1,7 +1,7 @@ ;;;; -*- mode: LISP; package: RFC2388 -*- ;;;; Copyright (c) 2003 Janis Dzerins ;;;; Modifications for TBNL Copyright (c) 2004 Michael Weber and Dr. Edmund Weitz -;;;; +;;;; ;;;; Redistribution and use in source and binary forms, with or without ;;;; modification, are permitted provided that the following conditions ;;;; are met: @@ -38,7 +38,7 @@ ;;; *** This actually belongs to RFC2046 -;;; +;;; (defun read-until-next-boundary (stream boundary &optional discard out-stream) "Reads from STREAM up to the next boundary. Returns two values: read data (nil if DISCARD is true), and true if the boundary is not last @@ -48,13 +48,13 @@ ;; ;; *** This will WARN like crazy on some bad input -- should only do each ;; warning once. - + (let ((length (length boundary))) (unless (<= 1 length 70) (warn "Boundary has invalid length -- must be between 1 and 70, but is: ~S" length)) (when (lwsp-char-p (schar boundary (1- length))) (warn "Boundary has trailing whitespace: ~S" boundary))) - + (flet ((run (result) "This one writes everything up to a boundary to RESULT stream, and returns false if the closing delimiter has been read, and @@ -67,22 +67,22 @@ (queue-index 0) char (leave-char nil)) - + (flet ((write-queued-chars () (dotimes (i queue-index) (write-char (schar queued-chars i) result)) (setf queue-index 0)) - + (enqueue-char () (setf (schar queued-chars queue-index) char) (incf queue-index))) - + (loop - + (if leave-char (setq leave-char nil) (setq char (read-char stream nil nil))) - + (unless char (setq closed t) (return)) @@ -230,7 +230,7 @@ ;;; *** I don't like this parser -- it will have to be rewritten when I ;;; make my state-machine parser-generator macro! -;;; +;;; (defmethod parse-header ((stream stream) &optional (start-state :name)) "Returns a MIME part header, or NIL, if there is no header. Header is terminated by CRLF." @@ -245,7 +245,7 @@ value parameter-name parameters) - + (labels ((skip-lwsp (next-state) (loop do (setq char (read-char stream nil nil)) @@ -265,15 +265,15 @@ (lwsp-char-p char)))) (loop - + (if leave-char (setq leave-char nil) (setq char (read-char stream nil nil))) - + ;; end of stream (unless char (return)) - + (when (char= #\return char) (setq char (read-char stream nil nil)) (cond ((or (null char) @@ -284,11 +284,11 @@ (warn "LINEFEED without RETURN in header.") (write-char #\return result) (setq leave-char t)))) - + #-(and) (format t "~&S:~,'0D CH:~:[~;*~]~S~%" state leave-char char) - + (ecase state (1 ;; NAME (cond ((char= char #\:) @@ -297,28 +297,28 @@ (skip-lwsp 2)) (t (write-char char result)))) - + (2 ;; VALUE (cond ((token-end-char-p char) (setq value (get-output-stream-string result)) (skip-lwsp 3)) (t (write-char char result)))) - + (3 ;; PARAMETER name (cond ((char= #\= char) (setq parameter-name (get-output-stream-string result) state 4)) (t (write-char char result)))) - + (4 ;; PARAMETER value start (cond ((char= #\" char) (setq state 5)) (t (setq leave-char t state 7)))) - + (5 ;; Quoted PARAMETER value (cond ((char= #\" char) (setq state 6)) @@ -332,7 +332,7 @@ ;; no space or semicolon after quoted parameter value (setq leave-char t state 3)))) - + (7 ;; Unquoted PARAMETER value (cond ((token-end-char-p char) (collect-parameter)) @@ -386,7 +386,7 @@ (make-content-type (make-array sep-offset :element-type type :displaced-to string) - (make-array (- (length string) (incf sep-offset)) + (make-array (- (length string) (incf sep-offset)) :element-type type :displaced-to string :displaced-index-offset sep-offset)) @@ -417,7 +417,7 @@ ;; one. (unless (nth-value 1 (read-until-next-boundary input boundary t)) (return-from parse-mime nil)) - + (let ((result ())) (loop (let ((headers (loop @@ -479,10 +479,10 @@ (defun find-content-disposition-header (headers) - (find-if (lambda (header) - (and (string-equal "CONTENT-DISPOSITION" + (find-if (lambda (header) + (and (string-equal "CONTENT-DISPOSITION" (rfc2388:header-name header)) - (string-equal "FORM-DATA" + (string-equal "FORM-DATA" (rfc2388:header-value header)))) headers)) --- /project/rfc2388/cvsroot/rfc2388/test.lisp 2005/08/02 08:46:00 1.1 +++ /project/rfc2388/cvsroot/rfc2388/test.lisp 2010/07/19 07:33:20 1.2 @@ -67,7 +67,7 @@ (sanitize-test-string result) more-p) (finish-output t))))) - + (dolist (string *strings*) (dolist (boundary *boundaries*) (dolist (trailing-separator '("--" ""))