(defun http-char (c1 c2 &optional (default #\space))(let ((code (parse-integer (coerce (list c1 c2) ‘string):radix 16:junk-allowed t)))(if code(code-char code)default)))(defun decode-param (s)(labels ((f (lst)(when lst(case (car lst)(#\% (cons (http-char (cadr lst) (caddr lst))(f (cdddr lst))))(#\+ (cons #\space (f (cdr lst))))(otherwise (cons (car lst) (f (cdr lst))))))))(coerce (f (coerce s ‘list )) ‘string)))(defun parse-params (s)(let* ((i1 (position #\= s))(i2 (position #\& s)))(cond (i1 (cons (cons (intern (string-upcase (subseq s 0 i1)))(decode-param (subseq s (1+ i1) i2)))(and i2 (parse-params (subseq s (1+ i2))))))((equal s "") nil)(t s))))(defun parse-url (s)(let* ((url (subseq s(+ 2 (position #\space s))(position #\space s :from-end t) ))(x (position #\? url)) )(if x(cons (subseq url 0 x) (parse-params (subseq url (1+ x))))(cons url ‘()))))(defun get-header (stream)(let* ((s (read-line stream)) ??(h (let ((i (position #\: s))) ??(when i ??(cons (intern (string-upcase (subseq s 0 i))) ????(subseq s (+ 2 i)))))))(when h(cons h (get-header stream)))))(defun get-content-params (stream header)(let ((length (cdr (assoc ‘content-header header)))) (when length(let ((content (make-string (parse-integer length))))(read-sequence content stream)(parse-params content)))))(defun serve (request-handler)(let ((socket (socket-server 8080)))(unwind-protect (loop (with-open-stream (stream (socket-accept socket))(let* ((url (parse-url (read-line stream))) ??(path (car url)) ??(header (get-header stream)) ??(params (append (cdr url) ?????(get-content-params stream header))) ??(*standard-output* stream))(funcall request-handler path header params))))(socket-server-close socket))))(defun hello-request-handler (path header params)(if (equal path "greeting")(let ((name (assoc ‘name params )))(if (not name)(princ "<html><form>What is your name? <input name=‘name‘/> </form><html>")(format t "<html>Nice to meet you,~a! </html>" (cdr name))))(princ "Sorry I don‘t know the page.")))
最后的显示似乎有点问题
webserver
原文地址：http://www.cnblogs.com/tclan126/p/7502673.html