- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/headers.lisp
by BKNR Commits 29 Aug '11

29 Aug '11

Revision: 4674 Author: hans URL: http://bknr.net/trac/changeset/4674 Reject requests with non-ASCII characters in request line. U trunk/thirdparty/hunchentoot/headers.lisp Modified: trunk/thirdparty/hunchentoot/headers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/headers.lisp 2011-08-29 07:42:59 UTC (rev 4673) +++ trunk/thirdparty/hunchentoot/headers.lisp 2011-08-29 08:48:51 UTC (rev 4674) @@ -224,13 +224,16 @@ (read-line* stream))) ((or end-of-file #-:lispworks usocket:timeout-error) ()))) -(defun send-bad-request-response (stream) +(defun send-bad-request-response (stream &optional additional-info) "Send a ``Bad Request'' response to the client." (write-sequence (flex:string-to-octets - (format nil "HTTP/1.0 ~D ~A~C~CConnection: close~C~C~C~CYour request could not be interpreted by this HTTP server~C~C" + (format nil "HTTP/1.0 ~D ~A~C~CConnection: close~C~C~C~CYour request could not be interpreted by this HTTP server~C~C~@[~A~]~C~C" +http-bad-request+ (reason-phrase +http-bad-request+) #\Return #\Linefeed - #\Return #\Linefeed #\Return #\Linefeed #\Return #\Linefeed)) + #\Return #\Linefeed #\Return #\Linefeed #\Return #\Linefeed additional-info #\Return #\Linefeed)) stream)) + +(defun printable-ascii-char-p (char) + (<= 32 (char-code char) 126)) (defun get-request-data (stream) "Reads incoming headers from the client via STREAM. Returns as @@ -239,6 +242,9 @@ (with-character-stream-semantics (let ((first-line (read-initial-request-line stream))) (when first-line + (unless (every #'printable-ascii-char-p first-line) + (send-bad-request-response stream "Non-ASCII character in request line") + (return-from get-request-data nil)) (destructuring-bind (&optional method url-string protocol) (split "\\s+" first-line :limit 3) (unless url-string

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/test/script.lisp
by BKNR Commits 29 Aug '11

29 Aug '11

Revision: 4673 Author: hans URL: http://bknr.net/trac/changeset/4673 fix range response tests U trunk/thirdparty/hunchentoot/test/script.lisp Modified: trunk/thirdparty/hunchentoot/test/script.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/script.lisp 2011-08-29 07:42:22 UTC (rev 4672) +++ trunk/thirdparty/hunchentoot/test/script.lisp 2011-08-29 07:42:59 UTC (rev 4673) @@ -136,7 +136,7 @@ (let* ((range-test-file-size (* 256 1024)) ; large enough to have hunchentoot use multiple buffers when reading back data, should be aligned to 1024 (range-test-buffer (make-array range-test-file-size :element-type '(unsigned-byte 8))) (uploaded-file-url "files/?path=user-stream") ; The uploaded file will appear under the name "user-stream" in hunchentoot - (expected-content-range (format nil "bytes 0-~D/*" range-test-file-size))) + (expected-content-range (format nil "bytes 0-~D/*" (1- range-test-file-size)))) (dotimes (i range-test-file-size) (setf (aref range-test-buffer i) (random 256))) @@ -156,7 +156,7 @@ (http-request uploaded-file-url :range '(0 0)) (http-assert 'status-code 206) (http-assert 'body 'equalp (subseq range-test-buffer 0 1)) - (http-assert-header :content-range expected-content-range) + (http-assert-header :content-range (format nil "bytes 0-0")) (say " End out of range") (http-request uploaded-file-url :range (list 0 range-test-file-size)) @@ -175,7 +175,7 @@ (http-request uploaded-file-url :range (list start-offset (1- length))) (http-assert 'status-code 206) (http-assert 'body 'equalp (subseq range-test-buffer start-offset length)) - (http-assert-header :content-range expected-content-range))) + (http-assert-header :content-range (format nil "bytes ~D-~D" start-offset (1- length))))) (values)))

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/misc.lisp
by BKNR Commits 29 Aug '11

29 Aug '11

Revision: 4672 Author: hans URL: http://bknr.net/trac/changeset/4672 report acceptable ranges in 416 response U trunk/thirdparty/hunchentoot/misc.lisp Modified: trunk/thirdparty/hunchentoot/misc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/misc.lisp 2011-08-29 07:11:05 UTC (rev 4671) +++ trunk/thirdparty/hunchentoot/misc.lisp 2011-08-29 07:42:22 UTC (rev 4672) @@ -136,7 +136,8 @@ end (parse-integer end)) (when (or (< start 0) (>= end (file-length file))) - (setf (return-code*) +http-requested-range-not-satisfiable+) + (setf (return-code*) +http-requested-range-not-satisfiable+ + (header-out :content-range) (format nil "bytes 0-~D/*" (1- (file-length file)))) (throw 'handler-done (format nil "invalid request range (requested ~D-~D, accepted 0-~D)" start end (1- (file-length file)))))

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/misc.lisp
by BKNR Commits 29 Aug '11

29 Aug '11

Revision: 4671 Author: hans URL: http://bknr.net/trac/changeset/4671 Range handling fixes: Add "Accept-Ranges" header to static file responses, report range only in partial responses, Fix off-by-one errors (ranges are inclusive). Thanks to Wukix Inc. for reporting. U trunk/thirdparty/hunchentoot/misc.lisp Modified: trunk/thirdparty/hunchentoot/misc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/misc.lisp 2011-08-29 05:42:50 UTC (rev 4670) +++ trunk/thirdparty/hunchentoot/misc.lisp 2011-08-29 07:11:05 UTC (rev 4671) @@ -139,10 +139,11 @@ (setf (return-code*) +http-requested-range-not-satisfiable+) (throw 'handler-done (format nil "invalid request range (requested ~D-~D, accepted 0-~D)" - start end (file-length file)))) + start end (1- (file-length file))))) (file-position file start) (setf (return-code*) +http-partial-content+ - bytes-to-send (1+ (- end start)))) + bytes-to-send (1+ (- end start)) + (header-out :content-range) (format nil "bytes ~D-~D/*" start end))) bytes-to-send)) (defun handle-static-file (pathname &optional content-type) @@ -162,14 +163,14 @@ (setf (content-type*) (or content-type (mime-type pathname) "application/octet-stream") - (header-out :last-modified) (rfc-1123-date time)) + (header-out :last-modified) (rfc-1123-date time) + (header-out :accept-ranges) "bytes") (handle-if-modified-since time) (with-open-file (file pathname :direction :input :element-type 'octet :if-does-not-exist nil) - (setf (header-out :content-range) (format nil "bytes 0-~D/*" (1- (file-length file))) - bytes-to-send (maybe-handle-range-header file) + (setf bytes-to-send (maybe-handle-range-header file) (content-length*) bytes-to-send) (let ((out (send-headers)) (buf (make-array +buffer-length+ :element-type 'octet)))

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/misc.lisp
by BKNR Commits 29 Aug '11

29 Aug '11

Revision: 4670 Author: hans URL: http://bknr.net/trac/changeset/4670 Set content-type and last-modified headers of served static files before handling if-modified-since, thanks to Wukix Inc. for reporting. U trunk/thirdparty/hunchentoot/misc.lisp Modified: trunk/thirdparty/hunchentoot/misc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/misc.lisp 2011-08-16 07:47:58 UTC (rev 4669) +++ trunk/thirdparty/hunchentoot/misc.lisp 2011-08-29 05:42:50 UTC (rev 4670) @@ -159,16 +159,16 @@ (let ((time (or (file-write-date pathname) (get-universal-time))) bytes-to-send) + (setf (content-type*) (or content-type + (mime-type pathname) + "application/octet-stream") + (header-out :last-modified) (rfc-1123-date time)) (handle-if-modified-since time) (with-open-file (file pathname :direction :input :element-type 'octet :if-does-not-exist nil) - (setf (content-type*) (or content-type - (mime-type pathname) - "application/octet-stream") - (header-out :content-range) (format nil "bytes 0-~D/*" (file-length file)) - (header-out :last-modified) (rfc-1123-date time) + (setf (header-out :content-range) (format nil "bytes 0-~D/*" (1- (file-length file))) bytes-to-send (maybe-handle-range-header file) (content-length*) bytes-to-send) (let ((out (send-headers))

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
by BKNR Commits 16 Aug '11

16 Aug '11

Revision: 4669 Author: hans URL: http://bknr.net/trac/changeset/4669 ACL modern mode fixes U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/test/packages.lisp Change set too large, please see URL above

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-fad/fad.lisp
by BKNR Commits 30 May '11

30 May '11

Revision: 4668 Author: edi URL: http://bknr.net/trac/changeset/4668 Make argument ignorable U trunk/thirdparty/cl-fad/fad.lisp Modified: trunk/thirdparty/cl-fad/fad.lisp =================================================================== --- trunk/thirdparty/cl-fad/fad.lisp 2011-05-25 14:40:41 UTC (rev 4667) +++ trunk/thirdparty/cl-fad/fad.lisp 2011-05-30 12:15:18 UTC (rev 4668) @@ -94,6 +94,7 @@ When FOLLOW-SYMLINKS is NIL, it should return the actual directory contents, which might include symlinks. Currently this works on SBCL and CCL." + (declare (ignorable follow-symlinks)) (when (wild-pathname-p dirname) (error "Can only list concrete directory names.")) #+:ecl

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-fad/
by BKNR Commits 25 May '11

25 May '11

Revision: 4667 Author: edi URL: http://bknr.net/trac/changeset/4667 Symlink behavior U trunk/thirdparty/cl-fad/CHANGELOG U trunk/thirdparty/cl-fad/doc/index.html U trunk/thirdparty/cl-fad/fad.lisp U trunk/thirdparty/cl-fad/openmcl.lisp Modified: trunk/thirdparty/cl-fad/CHANGELOG =================================================================== --- trunk/thirdparty/cl-fad/CHANGELOG 2011-05-01 07:30:43 UTC (rev 4666) +++ trunk/thirdparty/cl-fad/CHANGELOG 2011-05-25 14:40:41 UTC (rev 4667) @@ -1,3 +1,7 @@ +Version 0.6.5 +xxx +Fix symlink behaviour for some platforms (Mihai Bazon and Janis Dzerins) + Version 0.6.4 2010-11-18 Adapt to newer ClozureCL version (patch from Zach Beane, thanks to Chun Tian and Ralph Moritz as well) Modified: trunk/thirdparty/cl-fad/doc/index.html =================================================================== --- trunk/thirdparty/cl-fad/doc/index.html 2011-05-01 07:30:43 UTC (rev 4666) +++ trunk/thirdparty/cl-fad/doc/index.html 2011-05-25 14:40:41 UTC (rev 4667) @@ -164,18 +164,31 @@ </blockquote> [Function] - <a class=none name="list-directory">list-directory dirname => list</a> + <a class=none name="list-directory">list-directory dirname <tt>&key</tt> follow-symlinks => list</a> <blockquote> -Returns a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_f.htm#fresh">fresh</a> list of pathnames corresponding to the truenames of + +Returns a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_f.htm#fresh">fresh</a> list of pathnames corresponding to all files within the directory named by the non-wild <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname…">pathname designator</a> <code>dirname</code>. The pathnames of sub-directories are returned in directory form - see <a href="#pathname-as-directory"><code>PATHNAME-AS-DIRECTORY</code></a>. + + + If <code>follow-symlinks</code> is true (which is the + default), then the returned list contains truenames (symlinks will + be resolved) which essentially means that it might also return files + from outside the directory. This works on all platforms. + + + When <code>follow-symlinks</code> is <code>NIL</code>, it should return the actual directory + contents, which might include symlinks. (This is currently implemented only on SBCL and CCL.) + </blockquote> [Function] - <a class=none name="walk-directory">walk-directory dirname fn <tt>&key</tt> directories if-does-not-exist test => |</a> + <a class=none name="walk-directory">walk-directory dirname fn <tt>&key</tt> directories if-does-not-exist test follow-symlinks => |</a> <blockquote> + Recursively applies the function designated by the <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_f.htm#function…">function designator</a> <code>fn</code> to all files within the directory named by the non-wild <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname…">pathname @@ -190,17 +203,33 @@ directory's content will be skipped. <code>if-does-not-exist</code> must be one of <code>:ERROR</code> or <code>:IGNORE</code> where <code>:ERROR</code> (the default) means that an error will be signaled if the directory <code>dirname</code> - does not exist. </blockquote> + does not exist. + + + If <code>follow-symlinks</code> is true (which is + the default), then your callback will receive truenames. Otherwise + you should get the actual directory contents, which might include + symlinks. This might not be supported on all platforms. See + <a href="#list-directory"><code>LIST-DIRECTORY</code></a>. + +</blockquote> [Function] <a class=none name="delete-directory-and-files">delete-directory-and-files dirname<tt>&key</tt> if-does-not-exist => |</a> <blockquote> + Recursively deletes all files and directories within the directory designated by the non-wild <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname…">pathname designator</a> <code>dirname</code> including <code>dirname</code> itself. <code>if-does-not-exist</code> must be one of <code>:ERROR</code> or <code>:IGNORE</code> where <code>:ERROR</code> (the default) means that an error will be signaled if the directory <code>dirname</code> does not exist. + + + Warning: this function might remove files from outside the + directory, if the directory that you are deleting contains links to + external files. This is currently fixed for SBCL and CCL. + </blockquote> [Function] Modified: trunk/thirdparty/cl-fad/fad.lisp =================================================================== --- trunk/thirdparty/cl-fad/fad.lisp 2011-05-01 07:30:43 UTC (rev 4666) +++ trunk/thirdparty/cl-fad/fad.lisp 2011-05-25 14:40:41 UTC (rev 4667) @@ -39,7 +39,7 @@ "Returns NIL if PATHSPEC \(a pathname designator) does not designate a directory, PATHSPEC otherwise. It is irrelevant whether file or directory designated by PATHSPEC does actually exist." - (and + (and (not (component-present-p (pathname-name pathspec))) (not (component-present-p (pathname-type pathspec))) pathspec)) @@ -80,23 +80,33 @@ :type nil :defaults wildcard)) -(defun list-directory (dirname) - "Returns a fresh list of pathnames corresponding to the truenames of -all files within the directory named by the non-wild pathname -designator DIRNAME. The pathnames of sub-directories are returned in -directory form - see PATHNAME-AS-DIRECTORY." +(defun list-directory (dirname &key (follow-symlinks t)) + "Returns a fresh list of pathnames corresponding to all files within +the directory named by the non-wild pathname designator DIRNAME. The +pathnames of sub-directories are returned in directory form - see +PATHNAME-AS-DIRECTORY. + +If FOLLOW-SYMLINKS is true, then the returned list contains +truenames (symlinks will be resolved) which essentially means that it +might also return files from *outside* the directory. This works on +all platforms. + +When FOLLOW-SYMLINKS is NIL, it should return the actual directory +contents, which might include symlinks. Currently this works on SBCL +and CCL." (when (wild-pathname-p dirname) (error "Can only list concrete directory names.")) - #+:ecl + #+:ecl (let ((dir (pathname-as-directory dirname))) (concatenate 'list (directory (merge-pathnames (pathname "*/") dir)) (directory (merge-pathnames (pathname "*.*") dir)))) - #-:ecl + #-:ecl (let ((wildcard (directory-wildcard dirname))) #+:abcl (system::list-directory dirname) - #+(or :sbcl :cmu :scl :lispworks) (directory wildcard) - #+(or :openmcl :digitool) (directory wildcard :directories t) + #+:sbcl (directory wildcard :resolve-symlinks follow-symlinks) + #+(or :cmu :scl :lispworks) (directory wildcard) + #+(or :openmcl :digitool) (directory wildcard :directories t :follow-links follow-symlinks) #+:allegro (directory wildcard :directories-are-files nil) #+:clisp (nconc (directory wildcard :if-does-not-exist :keep) (directory (clisp-subdirectories-wildcard wildcard))) @@ -160,32 +170,36 @@ (defun walk-directory (dirname fn &key directories (if-does-not-exist :error) - (test (constantly t))) + (test (constantly t)) + (follow-symlinks t)) "Recursively applies the function FN to all files within the directory named by the non-wild pathname designator DIRNAME and all of its sub-directories. FN will only be applied to files for which the function TEST returns a true value. If DIRECTORIES is not NIL, FN and -TEST are applied to directories as well. If DIRECTORIES is :DEPTH-FIRST, -FN will be applied to the directory's contents first. If -DIRECTORIES is :BREADTH-FIRST and TEST returns NIL, the -directory's content will be skipped. IF-DOES-NOT-EXIST must be -one of :ERROR or :IGNORE where :ERROR means that an error will be -signaled if the directory DIRNAME does not exist." +TEST are applied to directories as well. If DIRECTORIES +is :DEPTH-FIRST, FN will be applied to the directory's contents first. +If DIRECTORIES is :BREADTH-FIRST and TEST returns NIL, the directory's +content will be skipped. IF-DOES-NOT-EXIST must be one of :ERROR +or :IGNORE where :ERROR means that an error will be signaled if the +directory DIRNAME does not exist. If FOLLOW-SYMLINKS is T, then your +callback will receive truenames. Otherwise you should get the actual +directory contents, which might include symlinks. This might not be +supported on all platforms. See LIST-DIRECTORY." (labels ((walk (name) (cond ((directory-pathname-p name) ;; the code is written in a slightly awkward way for ;; backward compatibility (cond ((not directories) - (dolist (file (list-directory name)) + (dolist (file (list-directory name :follow-symlinks follow-symlinks)) (walk file))) ((eql directories :breadth-first) (when (funcall test name) (funcall fn name) - (dolist (file (list-directory name)) + (dolist (file (list-directory name :follow-symlinks follow-symlinks)) (walk file)))) ;; :DEPTH-FIRST is implicit - (t (dolist (file (list-directory name)) + (t (dolist (file (list-directory name :follow-symlinks follow-symlinks)) (walk file)) (when (funcall test name) (funcall fn name))))) @@ -253,32 +267,53 @@ designated by the non-wild pathname designator DIRNAME including DIRNAME itself. IF-DOES-NOT-EXIST must be one of :ERROR or :IGNORE where :ERROR means that an error will be signaled if the directory -DIRNAME does not exist." +DIRNAME does not exist. + +NOTE: this function is dangerous if the directory that you are +removing contains symlinks to files outside of it - the target files +might be removed instead! This is currently fixed for SBCL and CCL." + #+:allegro (excl.osi:delete-directory-and-files dirname :if-does-not-exist if-does-not-exist) - #-:allegro (walk-directory dirname - (lambda (file) - (cond ((directory-pathname-p file) - #+:lispworks (lw:delete-directory file) - #+:cmu (multiple-value-bind (ok err-number) - (unix:unix-rmdir (namestring (truename file))) - (unless ok - (error "Error number ~A when trying to delete ~A" - err-number file))) - #+:scl (multiple-value-bind (ok errno) - (unix:unix-rmdir (ext:unix-namestring (truename file))) - (unless ok - (error "~@<Error deleting ~S: ~A~@:>" - file (unix:get-unix-error-msg errno)))) - #+:sbcl (sb-posix:rmdir file) - #+:clisp (ext:delete-dir file) - #+:openmcl (cl-fad-ccl:delete-directory file) - #+:cormanlisp (win32:delete-directory file) - #+:ecl (si:rmdir file) - #+(or :abcl :digitool) (delete-file file)) - (t (delete-file file)))) - :directories t - :if-does-not-exist if-does-not-exist) + + #+:sbcl + (if (directory-exists-p dirname) + (sb-ext:delete-directory dirname :recursive t) + (ecase if-does-not-exist + (:error (error "~S is not a directory" dirname)) + (:ignore nil))) + + #+:ccl-has-delete-directory + (if (directory-exists-p dirname) + (ccl:delete-directory dirname) + (ecase if-does-not-exist + (:error (error "~S is not a directory" dirname)) + (:ignore nil))) + + #-(or :allegro :sbcl :ccl-has-delete-directory) + (walk-directory dirname + (lambda (file) + (cond ((directory-pathname-p file) + #+:lispworks (lw:delete-directory file) + #+:cmu (multiple-value-bind (ok err-number) + (unix:unix-rmdir (namestring (truename file))) + (unless ok + (error "Error number ~A when trying to delete ~A" + err-number file))) + #+:scl (multiple-value-bind (ok errno) + (unix:unix-rmdir (ext:unix-namestring (truename file))) + (unless ok + (error "~@<Error deleting ~S: ~A~@:>" + file (unix:get-unix-error-msg errno)))) + #+:clisp (ext:delete-dir file) + #+:openmcl (cl-fad-ccl:delete-directory file) + #+:cormanlisp (win32:delete-directory file) + #+:ecl (si:rmdir file) + #+(or :abcl :digitool) (delete-file file)) + (t (delete-file file)))) + :follow-symlinks nil + :directories t + :if-does-not-exist if-does-not-exist) (values)) (pushnew :cl-fad *features*) Modified: trunk/thirdparty/cl-fad/openmcl.lisp =================================================================== --- trunk/thirdparty/cl-fad/openmcl.lisp 2011-05-01 07:30:43 UTC (rev 4666) +++ trunk/thirdparty/cl-fad/openmcl.lisp 2011-05-25 14:40:41 UTC (rev 4667) @@ -59,6 +59,9 @@ ;;; ClozureCL 1.6 introduced ccl:delete-directory with semantics that ;;; are acceptably similar to this "legacy" definition. +;;; +;;; Except this legacy definition is not recursive, hence this function is +;;; used only if there is no :CCL-HAS-DELETE-DIRECTORY feature. #-ccl-has-delete-directory (defun delete-directory (path)

1 0

[bknr-cvs] hans changed deployed/bos/projects/bos/payment-website/
by BKNR Commits 01 May '11

01 May '11

Revision: 4666 Author: hans URL: http://bknr.net/trac/changeset/4666 commit files from test system A deployed/bos/projects/bos/payment-website/ge A deployed/bos/projects/bos/payment-website/images/blueten.jpg Added: deployed/bos/projects/bos/payment-website/ge =================================================================== --- deployed/bos/projects/bos/payment-website/ge (rev 0) +++ deployed/bos/projects/bos/payment-website/ge 2011-05-01 07:30:43 UTC (rev 4666) @@ -0,0 +1 @@ +link /home/bknr/ge \ No newline at end of file Property changes on: deployed/bos/projects/bos/payment-website/ge ___________________________________________________________________ Added: svn:special + * Added: deployed/bos/projects/bos/payment-website/images/blueten.jpg =================================================================== (Binary files differ) Property changes on: deployed/bos/projects/bos/payment-website/images/blueten.jpg ___________________________________________________________________ Added: svn:mime-type + application/octet-stream

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/acceptor.lisp
by BKNR Commits 03 Apr '11

03 Apr '11

Revision: 4665 Author: hans URL: http://bknr.net/trac/changeset/4665 Use force-output instead of finish-output to appease SBCL, thanks to Andrey Moskvitin for reporting. U trunk/thirdparty/hunchentoot/acceptor.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2011-04-01 17:18:25 UTC (rev 4664) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2011-04-03 13:24:36 UTC (rev 4665) @@ -383,7 +383,7 @@ :method method :uri url-string :server-protocol protocol))))) - (finish-output *hunchentoot-stream*) + (force-output *hunchentoot-stream*) (setq *hunchentoot-stream* (reset-connection-stream *acceptor* *hunchentoot-stream*)) (when *close-hunchentoot-stream* (return))))) @@ -392,7 +392,7 @@ ;; errors that may occur while flushing and/or closing the ;; stream. (ignore-errors* - (finish-output *hunchentoot-stream*)) + (force-output *hunchentoot-stream*)) (ignore-errors* (close *hunchentoot-stream* :abort t))))))

1 0