Revision: 4664
Author: edi
URL: http://bknr.net/trac/changeset/4664
Oops...
U trunk/thirdparty/hunchentoot/doc/index.xml
Modified: trunk/thirdparty/hunchentoot/doc/index.xml
===================================================================
--- trunk/thirdparty/hunchentoot/doc/index.xml 2011-03-29 11:08:10 UTC (rev 4663)
+++ trunk/thirdparty/hunchentoot/doc/index.xml 2011-04-01 17:18:25 UTC (rev 4664)
@@ -300,8 +300,6 @@
Here is some software which extends Hunchentoot or is based on it:
</p>
<ul>
- <li>Andrey Moskvitin's <a href="http://restas.lisper.ru/en/">RESTAS</a> framework.
- </li>
<li>Tomo Matsumoto's web application
framework <a href="http://web4r.org/en/">web4r</a>.
</li>
Revision: 4663
Author: edi
URL: http://bknr.net/trac/changeset/4663
Link to RESTAS
U trunk/thirdparty/hunchentoot/doc/index.xml
Modified: trunk/thirdparty/hunchentoot/doc/index.xml
===================================================================
--- trunk/thirdparty/hunchentoot/doc/index.xml 2011-03-21 05:17:30 UTC (rev 4662)
+++ trunk/thirdparty/hunchentoot/doc/index.xml 2011-03-29 11:08:10 UTC (rev 4663)
@@ -300,6 +300,8 @@
Here is some software which extends Hunchentoot or is based on it:
</p>
<ul>
+ <li>Andrey Moskvitin's <a href="http://restas.lisper.ru/en/">RESTAS</a> framework.
+ </li>
<li>Tomo Matsumoto's web application
framework <a href="http://web4r.org/en/">web4r</a>.
</li>
Revision: 4662
Author: hans
URL: http://bknr.net/trac/changeset/4662
Patch to allow restarting an acceptor after it has been stopped, by Desmond O. Chang.
U trunk/thirdparty/hunchentoot/acceptor.lisp
Modified: trunk/thirdparty/hunchentoot/acceptor.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/acceptor.lisp 2011-03-15 05:44:16 UTC (rev 4661)
+++ trunk/thirdparty/hunchentoot/acceptor.lisp 2011-03-21 05:17:30 UTC (rev 4662)
@@ -120,7 +120,7 @@
:documentation "Number of pending connections
allowed in the listen socket before the kernel rejects
further incoming connections.")
- (acceptor-shutdown-p :initform nil
+ (acceptor-shutdown-p :initform t
:accessor acceptor-shutdown-p
:documentation "A flag that makes the acceptor
shutdown itself when set to something other than NIL.")
@@ -266,6 +266,7 @@
;; general implementation
(defmethod start ((acceptor acceptor))
+ (setf (acceptor-shutdown-p acceptor) nil)
(start-listening acceptor)
(let ((taskmaster (acceptor-taskmaster acceptor)))
(setf (taskmaster-acceptor taskmaster) acceptor)
Revision: 4660
Author: hans
URL: http://bknr.net/trac/changeset/4660
Improve standard logging facility by allowing log destinations to be
set to a pathname, an open stream or to NIL to suppress logging.
U trunk/thirdparty/hunchentoot/acceptor.lisp
U trunk/thirdparty/hunchentoot/doc/index.xml
U trunk/thirdparty/hunchentoot/log.lisp
U trunk/thirdparty/hunchentoot/packages.lisp
Modified: trunk/thirdparty/hunchentoot/acceptor.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/acceptor.lisp 2011-03-09 18:15:44 UTC (rev 4659)
+++ trunk/thirdparty/hunchentoot/acceptor.lisp 2011-03-15 05:36:46 UTC (rev 4660)
@@ -131,17 +131,20 @@
:accessor acceptor-shutdown-lock
:documentation "The lock protecting the shutdown-queue
condition variable and the requests-in-progress counter.")
- (access-log-pathname :initarg :access-log-pathname
- :accessor acceptor-access-log-pathname
- :documentation "Pathname of the access log
-file which contains one log entry per request handled in a format
- similar to Apache's access.log.")
- (message-log-pathname :initarg :message-log-pathname
- :accessor acceptor-message-log-pathname
- :documentation "Pathname of the server error
-log file which is used to log informational,
-warning and error messages in a free-text
-format intended for human inspection")
+ (access-log-destination :initarg :access-log-destination
+ :accessor acceptor-access-log-destination
+ :documentation "Destination of the access log
+which contains one log entry per request handled in a format similar
+to Apache's access.log. Can be set to a pathname or string
+designating the log file, to a open output stream or to NIL to
+suppress logging.")
+ (message-log-destination :initarg :message-log-destination
+ :accessor acceptor-message-log-destination
+ :documentation "Destination of the server
+error log which is used to log informational, warning and error
+messages in a free-text format intended for human inspection. Can be
+set to a pathname or string designating the log file, to a open output
+stream or to NIL to suppress logging.")
(error-template-directory :initarg :error-template-directory
:accessor acceptor-error-template-directory
:documentation "Directory pathname that
@@ -168,8 +171,8 @@
:persistent-connections-p t
:read-timeout *default-connection-timeout*
:write-timeout *default-connection-timeout*
- :access-log-pathname nil
- :message-log-pathname nil
+ :access-log-destination *error-output*
+ :message-log-destination *error-output*
:document-root (load-time-value (default-document-directory))
:error-template-directory (load-time-value (default-document-directory "errors/")))
(:documentation "To create a Hunchentoot webserver, you make an
@@ -399,11 +402,11 @@
(defmethod acceptor-log-access ((acceptor acceptor) &key return-code)
"Default method for access logging. It logs the information to the
-file determined by (ACCEPTOR-ACCESS-LOG-PATHNAME ACCEPTOR) \(unless
-that value is NIL) in a format that can be parsed by most Apache log
-analysis tools.)"
+destination determined by (ACCEPTOR-ACCESS-LOG-DESTINATION ACCEPTOR)
+\(unless that value is NIL) in a format that can be parsed by most
+Apache log analysis tools.)"
- (with-open-file-or-console (stream (acceptor-access-log-pathname acceptor) *access-log-lock*)
+ (with-log-stream (stream (acceptor-access-log-destination acceptor) *access-log-lock*)
(format stream "~:[-~@[ (~A)~]~;~:*~A~@[ (~A)~]~] ~:[-~;~:*~A~] [~A] \"~A ~A~@[?~A~] ~
~A\" ~D ~:[-~;~:*~D~] \"~:[-~;~:*~A~]\" \"~:[-~;~:*~A~]\"~%"
(remote-addr*)
@@ -428,10 +431,10 @@
(defmethod acceptor-log-message ((acceptor acceptor) log-level format-string &rest format-arguments)
"Default function to log server messages. Sends a formatted message
- to the file denoted by (ACCEPTOR-MESSAGE-LOG-PATHNAME ACCEPTOR). FORMAT and
- ARGS are as in FORMAT. LOG-LEVEL is a keyword denoting the log
- level or NIL in which case it is ignored."
- (with-open-file-or-console (stream (acceptor-message-log-pathname acceptor) *message-log-lock*)
+ to the destination denoted by (ACCEPTOR-MESSAGE-LOG-DESTINATION
+ ACCEPTOR). FORMAT and ARGS are as in FORMAT. LOG-LEVEL is a
+ keyword denoting the log level or NIL in which case it is ignored."
+ (with-log-stream (stream (acceptor-message-log-destination acceptor) *message-log-lock*)
(format stream "[~A~@[ [~A]~]] ~?~%"
(iso-time) log-level
format-string format-arguments)))
Modified: trunk/thirdparty/hunchentoot/doc/index.xml
===================================================================
--- trunk/thirdparty/hunchentoot/doc/index.xml 2011-03-09 18:15:44 UTC (rev 4659)
+++ trunk/thirdparty/hunchentoot/doc/index.xml 2011-03-15 05:36:46 UTC (rev 4660)
@@ -476,7 +476,7 @@
</clix:readers>
<clix:accessors generic='true'>
- <clix:listed-accessor generic='true' name='acceptor-access-log-pathname'>
+ <clix:listed-accessor generic='true' name='acceptor-access-log-destination'>
<clix:lambda-list>acceptor
</clix:lambda-list>
<clix:returns>(or pathname null)
@@ -497,7 +497,7 @@
</clix:returns>
</clix:listed-accessor>
- <clix:listed-accessor generic='true' name='acceptor-message-log-pathname'>
+ <clix:listed-accessor generic='true' name='acceptor-message-log-destination'>
<clix:lambda-list>acceptor
</clix:lambda-list>
<clix:returns>(or pathname null)
@@ -2767,19 +2767,22 @@
</clix:subchapter>
<clix:subchapter name="logging" title="Logging">
- Hunchentoot can log accesses and diagnostic messages to two separate
- files in the file system. Logging to files is enabled and disabled by
- setting the <clix:code>ACCESS-LOG-PATHNAME</clix:code> and
- <clix:code>MESSAGE-LOG-PATHNAME</clix:code> slots in the
- <clix:ref>ACCEPTOR</clix:ref> instance of the running server, either
- by providing the :ACCESS-LOG-PATHNAME and :MESSAGE-LOG-PATHNAME
- initialization arguments when creating the acceptor or by setting the
- slots through its <clix:ref>ACCEPTOR-MESSAGE-LOG-PATHNAME</clix:ref>
- and <clix:ref>ACCEPTOR-ACCESS-LOG-PATHNAME</clix:ref> accessors.
+ Hunchentoot can log accesses and diagnostic messages to two
+ separate destinations, which can be either files in the file
+ system or streams. Logging can also be disabled by setting the
+ <clix:code>ACCESS-LOG-DESTINATION</clix:code> and
+ <clix:code>MESSAGE-LOG-DESTINATION</clix:code> slots in the
+ <clix:ref>ACCEPTOR</clix:ref> instance of the running server,
+ either by providing the :ACCESS-LOG-DESTINATION and
+ :MESSAGE-LOG-DESTINATION initialization arguments when creating the
+ acceptor or by setting the slots through its
+ <clix:ref>ACCEPTOR-MESSAGE-LOG-DESTINATION</clix:ref> and
+ <clix:ref>ACCEPTOR-ACCESS-LOG-DESTINATION</clix:ref> accessors.
<p>
- When the path for the message or accept log is set to NIL,
- hunchentoots writes corresponding log entries to the *ERROR-OUTPUT* of
- the running Lisp. This is the default.
+ When the path for the message or accept log is set to a
+ variable holding an output stream, hunchentoots writes
+ corresponding log entries to that stream. By default,
+ Hunchentoot logs to *STANDARD-ERROR*.
</p>
<p>
Access logging is done in a format similar to what
@@ -2798,9 +2801,10 @@
file format.
</p>
<p>
- Errors happening within a <a href="#handlers">handler</a> which are
- not caught by the handler itself are handled by Hunchentoot by logging
- them to the log file.
+ Errors happening within a <a href="#handlers">handler</a>
+ which are not caught by the handler itself are handled by
+ Hunchentoot by logging them to the established
+ <clix:ref>ACCEPTOR-MESSAGE-LOG-DESTINATION</clix:ref>.
</p>
<clix:function name='log-message*'>
Modified: trunk/thirdparty/hunchentoot/log.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/log.lisp 2011-03-09 18:15:44 UTC (rev 4659)
+++ trunk/thirdparty/hunchentoot/log.lisp 2011-03-15 05:36:46 UTC (rev 4660)
@@ -29,30 +29,40 @@
(in-package :hunchentoot)
-(defmacro with-open-file-or-console ((stream-var pathname lock) &body body)
+(defmacro with-log-stream ((stream-var destination lock) &body body)
"Helper macro to write log entries. STREAM-VAR is a symbol that
will be bound to the logging stream during the execution of BODY.
-PATHNAME is the pathname designator of the log file or NIL if logging
-should be done to *ERROR-OUTPUT*. LOCK refers to the lock that should
-be held during the logging operation. If PATHNAME is not NIL, a flexi
-stream with UTF-8 encoding will be created and bound to STREAM-VAR.
-If an error occurs while writing to the log file, that error will be
-logged to *ERROR-OUTPUT*."
+DESTINATION is the logging destination, which can be either a pathname
+designator of the log file, a symbol designating an open stream or NIL
+if logging should be done to *ERROR-OUTPUT*. LOCK refers to the lock
+that should be held during the logging operation. If DESTINATION is a
+pathname, a flexi stream with UTF-8 encoding will be created and
+bound to STREAM-VAR. If an error occurs while writing to the log
+file, that error will be logged to *ERROR-OUTPUT*.
+
+Note that logging to a file involves opening and closing the log file
+for every logging operation, which is overall costly. Web servers
+with high throughput demands should make use of a specialized logging
+function rather than relying on Hunchentoot's default logging
+facility."
(with-unique-names (binary-stream)
- (with-rebinding (pathname)
+ (with-rebinding (destination)
(let ((body body))
- `(if ,pathname
- (with-lock-held (,lock)
- (with-open-file (,binary-stream ,pathname
- :direction :output
- :element-type 'octet
- :if-does-not-exist :create
- :if-exists :append
- #+:openmcl #+:openmcl
- :sharing :lock)
- (let ((,stream-var (make-flexi-stream ,binary-stream :external-format +utf-8+)))
- ,@body)))
- (let ((,stream-var *error-output*))
- (prog1 (progn ,@body)
- (finish-output *error-output*))))))))
+ `(when ,destination
+ (with-lock-held (,lock)
+ (etypecase ,destination
+ ((or string pathname)
+ (with-open-file (,binary-stream ,destination
+ :direction :output
+ :element-type 'octet
+ :if-does-not-exist :create
+ :if-exists :append
+ #+:openmcl #+:openmcl
+ :sharing :lock)
+ (let ((,stream-var (make-flexi-stream ,binary-stream :external-format +utf-8+)))
+ ,@body)))
+ (stream
+ (let ((,stream-var ,destination))
+ (prog1 (progn ,@body)
+ (finish-output *error-output*)))))))))))
Modified: trunk/thirdparty/hunchentoot/packages.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/packages.lisp 2011-03-09 18:15:44 UTC (rev 4659)
+++ trunk/thirdparty/hunchentoot/packages.lisp 2011-03-15 05:36:46 UTC (rev 4660)
@@ -39,7 +39,6 @@
#+:lispworks
(:import-from :lw #:WITH-UNIQUE-NAMES #:WHEN-LET)
(:export #:*ACCEPTOR*
- #:*ACCESS-LOG-PATHNAME*
#:*APPROVED-RETURN-CODES*
#:*CATCH-ERRORS-P*
#+:lispworks
@@ -61,7 +60,6 @@
#:*LOG-LISP-BACKTRACES-P*
#:*LOG-LISP-ERRORS-P*
#:*LOG-LISP-WARNINGS-P*
- #:*MESSAGE-LOG-PATHNAME*
#:*METHODS-FOR-POST-PARAMETERS*
#:*REPLY*
#:*REQUEST*
@@ -121,14 +119,14 @@
#:ABORT-REQUEST-HANDLER
#:ACCEPT-CONNECTIONS
#:ACCEPTOR
- #:ACCEPTOR-ACCESS-LOG-PATHNAME
+ #:ACCEPTOR-ACCESS-LOG-DESTINATION
#:ACCEPTOR-ADDRESS
#:ACCEPTOR-DISPATCH-REQUEST
#:ACCEPTOR-ERROR-TEMPLATE-DIRECTORY
#:ACCEPTOR-INPUT-CHUNKING-P
#:ACCEPTOR-LOG-ACCESS
#:ACCEPTOR-LOG-MESSAGE
- #:ACCEPTOR-MESSAGE-LOG-PATHNAME
+ #:ACCEPTOR-MESSAGE-LOG-DESTINATION
#:ACCEPTOR-NAME
#:ACCEPTOR-OUTPUT-CHUNKING-P
#:ACCEPTOR-PERSISTENT-CONNECTIONS-P
Revision: 4659
Author: hans
URL: http://bknr.net/trac/changeset/4659
documentation update from Scott McKay and Dan Weinreb to document the
resource usage limitation changes.
U trunk/thirdparty/hunchentoot/doc/index.xml
Modified: trunk/thirdparty/hunchentoot/doc/index.xml
===================================================================
--- trunk/thirdparty/hunchentoot/doc/index.xml 2011-03-03 07:21:56 UTC (rev 4658)
+++ trunk/thirdparty/hunchentoot/doc/index.xml 2011-03-09 18:15:44 UTC (rev 4659)
@@ -214,7 +214,7 @@
<clix:chapter name="start" title="Your own webserver (the easy teen-age New York version)">
Starting your own web server is pretty easy. Do something like this:
-<pre>(hunchentoot:<a class="noborder" href="#start">start</a> (make-instance 'hunchentoot:<a class="noborder" href="#acceptor">acceptor</a> :port 4242))</pre>
+<pre>(hunchentoot:<a class="noborder" href="#start">start</a> (make-instance 'hunchentoot:<a class="noborder" href="#acceptor">easy-acceptor</a> :port 4242))</pre>
That's it. Now you should be able to enter the address
"<a href='http://127.0.0.1:4242/'><code>http://127.0.0.1:4242/</code></a>" in
your browser and see something, albeit nothing very interesting
@@ -591,8 +591,9 @@
responsible for settings things up to wait for clients to
connect. For each connection which comes in,
<clix:ref>HANDLE-INCOMING-CONNECTION</clix:ref> is applied to
- the taskmaster which will call
- <clix:ref>PROCESS-CONNECTION</clix:ref>.
+ the taskmaster which will either call
+ <clix:ref>PROCESS-CONNECTION</clix:ref> directly,
+ or will create a thread to call it.
<clix:ref>PROCESS-CONNECTION</clix:ref> calls
<clix:ref>INITIALIZE-CONNECTION-STREAM</clix:ref> before it does
anything else, then it selects and calls a function which
@@ -756,11 +757,48 @@
straightforward to create a taskmaster which allocates threads
from a fixed pool instead of creating a new one for each
connection.
+
<p>
- If you want to implement your own taskmasters, you should
- subclass <clix:ref>TASKMASTER</clix:ref> and specialize the
- generic functions in this section.
+ You can control the resources consumed by a threaded taskmaster via
+ two initargs. <code>:max-thread-count</code> lets you set the maximum
+ number of request threads that can be processes simultaneously. If
+ this is <code>nil</code>, the is no thread limit imposed.
+
+ <code>:max-accept-count</code> lets you set the maximum number of requests
+ that can be outstanding (i.e. being processed or queued for processing).
+
+ If <code>:max-thread-count</code> is supplied and <code>:max-accept-count</code>
+ is <code>NIL</code>, then a <clix:ref>+HTTP-SERVICE-UNAVAILABLE+</clix:ref>
+ error will be generated if there are more than the max-thread-count
+ threads processing requests. If both <code>:max-thread-count</code>
+ and <code>:max-accept-count</code> are supplied, then max-thread-count
+ must be less than max-accept-count; if more than max-thread-count
+ requests are being processed, then requests up to max-accept-count
+ will be queued until a thread becomes available. If more than
+ max-accept-count requests are outstanding, then a <clix:ref>+HTTP-SERVICE-UNAVAILABLE+</clix:ref>
+ error will be generated.
+
+ In a load-balanced environment with multiple Hunchentoot servers, it's
+ reasonable to provide <code>:max-thread-count</code> but leave
+ <code>:max-accept-count</code> null. This will immediately result
+ in <clix:ref>+HTTP-SERVICE-UNAVAILABLE+</clix:ref> when one server is
+ out of resources, so the load balancer can try to find another server.
+
+ In an environment with a single Hunchentoot server, it's reasonable
+ to provide both <code>:max-thread-count</code> and a somewhat larger value
+ for <code>:max-accept-count</code>. This will cause a server that's almost
+ out of resources to wait a bit; if the server is completely out of resources,
+ then the reply will be <clix:ref>+HTTP-SERVICE-UNAVAILABLE+</clix:ref>.
+ The default for these values is 100 and 120, respectively.
</p>
+
+ <p>
+ If you want to implement your own taskmasters, you should subclass
+ <clix:ref>TASKMASTER</clix:ref> or one of its subclasses,
+ <clix:ref>SINGLE-THREADED-TASKMASTER</clix:ref> or
+ <clix:ref>ONE-THREAD-PER-CONNECTION-TASKMASTER</clix:ref>, and
+ specialize the generic functions in this section.
+ </p>
<clix:class name='taskmaster'>
<clix:description>
@@ -822,6 +860,43 @@
the incoming connection by calling the <clix:ref>PROCESS-CONNECTION</clix:ref>
method of the acceptor instance. The <clix:arg>socket</clix:arg> argument is passed to
<clix:ref>PROCESS-CONNECTION</clix:ref> as an argument.
+
+ If the taskmaster is a multi-threaded taskmaster, <clix:ref>HANDLE-INCOMING-THREAD</clix:ref>
+ will call <clix:ref>CREATE-TASKMASTER-THREAD</clix:ref>, which will call
+ <clix:ref>PROCESS-CONNECTION</clix:ref> in a new thread.
+ <clix:ref>HANDLE-INCOMING-THREAD</clix:ref> might issue a
+ <clix:ref>+HTTP-SERVICE-UNAVAILABLE+</clix:ref> error
+ if there are too many request threads or it might block waiting for a
+ request thread to finish.
+ </clix:description>
+ </clix:function>
+
+ <clix:function generic='true' name='create-taskmaster-thread'>
+ <clix:lambda-list>taskmaster socket
+ </clix:lambda-list>
+ <clix:returns>thread
+ </clix:returns>
+ <clix:description>This function is called by <clix:ref>HANDLE-INCOMING-THREAD</clix:ref>
+ to create a new thread which calls <clix:ref>PROCESS-CONNECTION</clix:ref>.
+ If you specialize this function, you must be careful to have the thread
+ call <clix:ref>DECREMENT-TASKMASTER-REQUEST-COUNT</clix:ref> before
+ it exits. A typical method will look like this:
+
+ <pre>(defmethod create-taskmaster-thread ((taskmaster monitor-taskmaster) socket)
+ (bt:make-thread
+ (lambda ()
+ (with-monitor-error-handlers
+ (unwind-protect
+ (with-monitor-variable-bindings
+ (process-connection (taskmaster-acceptor taskmaster) socket))
+ (decrement-taskmaster-request-count taskmaster))))))</pre>
+
+
+
+
+
+
+
</clix:description>
</clix:function>
Revision: 4658
Author: edi
URL: http://bknr.net/trac/changeset/4658
CMU fix
U trunk/thirdparty/flexi-streams/CHANGELOG
U trunk/thirdparty/flexi-streams/mapping.lisp
Modified: trunk/thirdparty/flexi-streams/CHANGELOG
===================================================================
--- trunk/thirdparty/flexi-streams/CHANGELOG 2011-02-16 12:24:35 UTC (rev 4657)
+++ trunk/thirdparty/flexi-streams/CHANGELOG 2011-03-03 07:21:56 UTC (rev 4658)
@@ -1,3 +1,5 @@
+Fix for CMUCL (Raymond Toy, Xu Jingtao)
+
Version 1.0.7
2008-08-26
Don't read a second time if the first READ-SEQUENCE already reached EOF (Drakma bug report by Stas Boukarev)
Modified: trunk/thirdparty/flexi-streams/mapping.lisp
===================================================================
--- trunk/thirdparty/flexi-streams/mapping.lisp 2011-02-16 12:24:35 UTC (rev 4657)
+++ trunk/thirdparty/flexi-streams/mapping.lisp 2011-03-03 07:21:56 UTC (rev 4658)
@@ -47,7 +47,8 @@
(deftype char-code-integer ()
"The subtype of integers which can be returned by the function CHAR-CODE."
- '(integer 0 #.(1- char-code-limit)))
+ #-:cmu '(integer 0 #.(1- char-code-limit))
+ #+:cmu '(integer 0 65533))
(deftype code-point ()
"The subtype of integers that's just big enough to hold all Unicode
Revision: 4655
Author: hans
URL: http://bknr.net/trac/changeset/4655
Automatically set the charset= attribute in the Content-Type: header
when a string has been returned by the handler. With this change, it
is sufficient to change *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT* to the
desired default charset used for responses.
U trunk/thirdparty/hunchentoot/headers.lisp
U trunk/thirdparty/hunchentoot/specials.lisp
Modified: trunk/thirdparty/hunchentoot/headers.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/headers.lisp 2011-02-15 21:45:25 UTC (rev 4654)
+++ trunk/thirdparty/hunchentoot/headers.lisp 2011-02-16 11:47:44 UTC (rev 4655)
@@ -53,6 +53,16 @@
(:method (key value stream)
(write-header-line key (princ-to-string value) stream)))
+(defun maybe-add-charset-to-content-type-header (content-type external-format)
+ "Given the contents of a CONTENT-TYPE header, add a charset=
+ attribute describing the given EXTERNAL-FORMAT if no charset=
+ attribute is already present and the content type is a text content
+ type. Returns the augmented content type."
+ (if (and (cl-ppcre:scan "(?i)^text" content-type)
+ (not (cl-ppcre:scan "(?i);\\s*charset=" content-type)))
+ (format nil "~A; charset=~(~A~)" content-type (flex:external-format-name external-format))
+ content-type))
+
(defun start-output (return-code &optional (content nil content-provided-p))
"Sends all headers and maybe the content body to
*HUNCHENTOOT-STREAM*. Returns immediately and does nothing if called
@@ -115,7 +125,9 @@
(setq content (maybe-rewrite-urls-for-session content)))
(when (stringp content)
;; if the content is a string, convert it to the proper external format
- (setf content (string-to-octets content :external-format (reply-external-format*))))
+ (setf content (string-to-octets content :external-format (reply-external-format*))
+ (content-type*) (maybe-add-charset-to-content-type-header (content-type*)
+ (reply-external-format*))))
(when content
;; whenever we know what we're going to send out as content, set
;; the Content-Length header properly; maybe the user specified
Modified: trunk/thirdparty/hunchentoot/specials.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/specials.lisp 2011-02-15 21:45:25 UTC (rev 4654)
+++ trunk/thirdparty/hunchentoot/specials.lisp 2011-02-16 11:47:44 UTC (rev 4655)
@@ -114,11 +114,11 @@
"The three-character names of the twelve months - needed for cookie
date format.")
-(defvar *rewrite-for-session-urls* t
+(defparameter *rewrite-for-session-urls* t
"Whether HTML pages should possibly be rewritten for cookie-less
session-management.")
-(defvar *content-types-for-url-rewrite*
+(defparameter *content-types-for-url-rewrite*
'("text/html" "application/xhtml+xml")
"The content types for which url-rewriting is OK. See
*REWRITE-FOR-SESSION-URLS*.")
@@ -154,20 +154,20 @@
(defvar *session-db* nil
"The default \(global) session database.")
-(defvar *session-max-time* #.(* 30 60)
+(defparameter *session-max-time* #.(* 30 60)
"The default time \(in seconds) after which a session times out.")
-(defvar *session-gc-frequency* 50
+(defparameter *session-gc-frequency* 50
"A session GC \(see function SESSION-GC) will happen every
*SESSION-GC-FREQUENCY* requests \(counting only requests which create
a new session) if this variable is not NIL. See SESSION-CREATED.")
-(defvar *use-user-agent-for-sessions* t
+(defparameter *use-user-agent-for-sessions* t
"Whether the 'User-Agent' header should be encoded into the session
string. If this value is true, a session will cease to be accessible
if the client sends a different 'User-Agent' header.")
-(defvar *use-remote-addr-for-sessions* nil
+(defparameter *use-remote-addr-for-sessions* nil
"Whether the client's remote IP \(as returned by REAL-REMOTE-ADDR)
should be encoded into the session string. If this value is true, a
session will cease to be accessible if the client's remote IP changes.
@@ -175,39 +175,42 @@
This might for example be an issue if the client uses a proxy server
which doesn't send correct 'X_FORWARDED_FOR' headers.")
-(defvar *default-content-type* "text/html; charset=iso-8859-1"
- "The default content-type header which is returned to the client.")
+(defparameter *default-content-type* "text/html"
+ "The default content-type header which is returned to the client.
+If this is text content type, the character set used for encoding the
+response will automatically be added to the content type in a
+``charset'' attribute.")
-(defvar *methods-for-post-parameters* '(:post)
+(defparameter *methods-for-post-parameters* '(:post)
"A list of the request method types \(as keywords) for which
Hunchentoot will try to compute POST-PARAMETERS.")
-(defvar *header-stream* nil
+(defparameter *header-stream* nil
"If this variable is not NIL, it should be bound to a stream to
which incoming and outgoing headers will be written for debugging
purposes.")
-(defvar *show-lisp-errors-p* nil
+(defparameter *show-lisp-errors-p* nil
"Whether Lisp errors in request handlers should be shown in HTML output.")
-(defvar *show-lisp-backtraces-p* t
+(defparameter *show-lisp-backtraces-p* t
"Whether Lisp errors shown in HTML output should contain backtrace information.")
-(defvar *log-lisp-errors-p* t
+(defparameter *log-lisp-errors-p* t
"Whether Lisp errors in request handlers should be logged.")
-(defvar *log-lisp-backtraces-p* t
+(defparameter *log-lisp-backtraces-p* t
"Whether Lisp backtraces should be logged. Only has an effect if
*LOG-LISP-ERRORS-P* is true as well.")
-(defvar *log-lisp-warnings-p* t
+(defparameter *log-lisp-warnings-p* t
"Whether Lisp warnings in request handlers should be logged.")
-(defvar *lisp-errors-log-level* :error
+(defparameter *lisp-errors-log-level* :error
"Log level for Lisp errors. Should be one of :ERROR \(the default),
:WARNING, or :INFO.")
-(defvar *lisp-warnings-log-level* :warning
+(defparameter *lisp-warnings-log-level* :warning
"Log level for Lisp warnings. Should be one of :ERROR, :WARNING
\(the default), or :INFO.")
@@ -219,7 +222,7 @@
"A global lock to prevent concurrent access to the log file used by
the ACCEPTOR-LOG-ACCESS function.")
-(defvar *catch-errors-p* t
+(defparameter *catch-errors-p* t
"Whether Hunchentoot should catch and log errors \(or rather invoke
the debugger).")
@@ -243,7 +246,7 @@
#+:openmcl "http://openmcl.clozure.com/"
"A link to the website of the underlying Lisp implementation.")
-(defvar *tmp-directory*
+(defparameter *tmp-directory*
#+(or :win32 :mswindows) "c:\\hunchentoot-temp\\"
#-(or :win32 :mswindows) "/tmp/hunchentoot/"
"Directory for temporary files created by MAKE-TMP-FILE-NAME.")
@@ -261,13 +264,13 @@
"A FLEXI-STREAMS external format used internally for logging and to
encode cookie values.")
-(defvar *hunchentoot-default-external-format* +latin-1+
+(defparameter *hunchentoot-default-external-format* +utf-8+
"The external format used to compute the REQUEST object.")
(defconstant +buffer-length+ 8192
"Length of buffers used for internal purposes.")
-(defvar *default-connection-timeout* 20
+(defparameter *default-connection-timeout* 20
"The default connection timeout used when an acceptor is reading
from and writing to a socket stream.")
@@ -292,7 +295,7 @@
;; see <http://common-lisp.net/project/hyperdoc/>
;; and <http://www.cliki.net/hyperdoc>
-(defvar *hyperdoc-base-uri* "http://weitz.de/hunchentoot/")
+(defparameter *hyperdoc-base-uri* "http://weitz.de/hunchentoot/")
(let ((exported-symbols-alist
(loop for symbol being the external-symbols of :hunchentoot