source: branches/home/psmith/restructure/src/protocol/http/http-response.lisp

Last change on this file was 23, checked in by psmith, 18 years ago

moved nio-server into nio package
narrowed nio external i/f
back to base working case after restructure

File size: 3.5 KB
Line 
1#|
2Copyright (c) 2006 Risto Laakso
3All rights reserved.
4
5Redistribution and use in source and binary forms, with or without
6modification, are permitted provided that the following conditions
7are met:
81. Redistributions of source code must retain the above copyright
9   notice, this list of conditions and the following disclaimer.
102. Redistributions in binary form must reproduce the above copyright
11   notice, this list of conditions and the following disclaimer in the
12   documentation and/or other materials provided with the distribution.
133. The name of the author may not be used to endorse or promote products
14   derived from this software without specific prior written permission.
15
16THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
17IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
18OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
19IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
20INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
21NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
22DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
23THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
24(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
25THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26|#
27(in-package :nio-http)
28
29
30;TODO move to utils
31
32(defun string-to-octets (string)
33  (map 'vector #'char-code string))
34
35
36(defun integer-to-octets (int)
37  (if (= int 0)
38      #(48)
39      (let* ((digits (floor (1+ (log int 10))))
40             (seq (make-sequence '(vector (unsigned-byte 8)) digits :initial-element 0))
41             (rem int))
42        (loop for idx from 0 below digits do
43             (multiple-value-bind (rest last) (truncate rem 10)
44               (setf (aref seq idx) (+ #.(char-code #\0) last)
45                     rem rest)))
46        (nreverse seq))))
47
48(defun file-to-octets (filename)
49  (with-open-file (stream filename :direction :input :element-type 'unsigned-byte)
50    (let* ((length (file-length stream))
51           (seq (make-sequence '(vector (unsigned-byte 8)) length :initial-element 0)))
52      (read-sequence seq stream)
53      seq)))
54           
55;end utils
56
57;TODO move to web-server
58(defparameter +page-hash+ (make-hash-table :test #'equalp))
59
60;end
61
62(defclass http-response (packet)
63  ((status :initarg :status)
64   (html :initarg :html))
65  )
66
67(defun http-response (&key status html)
68  (make-instance 'http-response :status status :html html))
69
70(defmethod get-bytes ((http-response http-response))
71 (with-slots (status html) http-response
72  (get-packet status "text/html" html)))
73
74
75
76(defparameter +status-lines+
77  (list (cons :ok
78              (concatenate 'vector (string-to-octets "HTTP/1.0 200 OK") #(13 10)))
79        (cons :not-found
80              (concatenate 'vector (string-to-octets "HTTP/1.0 404 Not found") #(13 10)))
81        (cons :method-not-implemented
82              (concatenate 'vector (string-to-octets "HTTP/1.0 501 Method not implemented") #(13 10)))
83        ))
84
85(defun make-status-line (status)
86  (cdr (assoc status +status-lines+)))
87
88
89(defun get-packet (status content-type html)
90#+nio-debug  (format t "serve-content ~%")
91  (let* ((content (string-to-octets html))
92         (status-line (make-status-line status))
93         (content-type 
94          (concatenate 'vector 
95                       (string-to-octets "Content-type: ") 
96                       (string-to-octets content-type) #(13 10)))
97         (content-len 
98          (concatenate 'vector 
99                       (string-to-octets "Content-length: ") 
100                       (integer-to-octets (length content)) #(13 10)))
101         )
102    (concatenate 'vector status-line content-type content-len #(13 10) content)))
103
Note: See TracBrowser for help on using the repository browser.