[Bese-devel] Bug in aserve backend

[Janis Dzerins]

Antonio Menezes Leitao wrote:

> To solve this problem, I suggest that the methods:
> 
> (defmethod get-header ((response aserve-response) header-name)
>   (net.aserve:reply-header-slot-value (request response) header-name))
> 
> (defmethod (setf get-header) (value (response aserve-response) header-name)
>   (setf (net.aserve:reply-header-slot-value (request response) header-name)
>         value))
> 
> should be replaced by something like:
> 
> (defmethod get-header ((response aserve-response) header-name)
>   (switch (header-name :test #'string-equal)
>     ("Date"             (net.aserve:reply-header-slot-value (request response) :date))
>     ("Content-Type"     (net.aserve:reply-header-slot-value (request response) :content-type))
>     ("Content-Length"   (net.aserve:reply-header-slot-value (request response) :content-length))
>     (t (net.aserve:reply-header-slot-value
> 	(request response)
> 	(read-from-string (format nil ":~A" header-name))))))
> 
> (defmethod (setf get-header) (value (response aserve-response) header-name)
>   (switch (header-name :test #'string-equal)
>     ("Date"             (error "Can't update header Date"))
>     ("Content-Type"     (setf (net.aserve:reply-header-slot-value (request response) :content-type)   value))
>     ("Content-Length"   (setf (net.aserve:reply-header-slot-value (request response) :content-length) value))
>     (t (setf (net.aserve:reply-header-slot-value
> 	      (request response)
> 	      (read-from-string (format nil ":~A" header-name)))
> 	     value))))

Why not like this:


(defmethod get-header ((response aserver-response) header-name)
  (net.aserve:reply-header-slot-value
   (request response)
   (intern (string-upcase header-name) :keyword)))

(defmethod (setf get-header) (value (response aserver-response) header-name)
  (let ((header (intern (string-upcase header-name) :keyword)))
    (if (eq :date header)
        (error "Can't update Date header.")
        (setf (net.aserve:reply-header-slot-value (request response)
                                                  header)
              value))))

?

(Ok, there most probably is a problem with Allegro's "modern" mode, but your
version is not really better in this respect.)

--
Janis Dzerins