/src/aserve-patch.lisp

 1(in-package :net.aserve)
 2
 3#| No longer loaded by default.
 4
 5Fixes a bug in portableaserve.  Modern browsers return headers like this:
 6 Content-type:  application/x-www-form-urlencoded; charset=utf-8
 7The patch below makes aserve ignore the semicolon and following text. 
 8
 9Kudos to David Sobeck for figuring this out.
10
11HAS BEEN FIXED in more recent versions of aserve (+++ conditionalize properly) |#
12
13(defun header-first-field (s)
14  (let ((sep (position #\; s)))
15    (if sep
16	(subseq s 0 sep)
17	s)))
18
19(defmethod request-query ((req http-request) &key (post t) (uri t)
20						  (external-format 
21						   *default-aserve-external-format*))
22  ;; decode if necessary and return the alist holding the
23  ;; args to this url.  In the alist items the value is the 
24  ;; cdr of the alist item.
25  ;;
26  ;; If uri is true then we look for query information in the uri
27  ;; (following a question mark)
28  ;; If post is true and this is a post request then we look for
29  ;; query information in the body of the query.
30  ;; If both are true (and this is a post) then we look both places.
31  ;;
32  ;;
33  (let ((alist (request-query-alist req))
34	(signature (cons post uri)))
35    
36    (if* (not (eq alist :empty))
37       then (let ((given-sig (getf (request-reply-plist req) 
38				   'request-query-sig)))
39	      (if* (equal given-sig signature)
40		 then ; same args as before, cached value is legit
41		      (return-from request-query alist))))
42    
43    (let (res)
44      (if* uri
45	 then (let ((arg (uri-query (request-uri req))))
46		(if* arg
47		   then (setq res (form-urlencoded-to-query
48				   arg
49				   :external-format external-format)))))
50	      
51      (if* post
52	 then (if* (and (eq (request-method req) :post)
53			(equal (header-first-field (header-slot-value req :content-type))
54			       "application/x-www-form-urlencoded")
55			)
56		 then (setf res
57			(append res
58				(form-urlencoded-to-query
59				 (get-request-body req)
60				 :external-format external-format)))))
61      (setf (getf (request-reply-plist req) 'request-query-sig)
62	signature)
63      (setf (request-query-alist req) res))))
64
65
66;;; The default value for this doesn't actually seem to work.
67;;;;  This doesn't effect anything in WuWei except unit tests.
68(setq net.aserve.client::cookie-separator "; ")