;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
-;;;; $Id: demo.lisp,v 1.1 2003/07/05 00:59:49 kevin Exp $
+;;;; $Id: demo.lisp,v 1.2 2003/07/08 06:40:00 kevin Exp $
;;;; *************************************************************************
(in-package #:modlisp)
+;;; A small test bench used to test and time the client/server protocol
+;;; From Marc Battyani
+
+(defun fetch-mod-lisp-url (server url &key (num-fetch 1) (port 20123)
+ close-socket)
+ (loop with server-socket and reply
+ repeat num-fetch
+ do (unless server-socket
+ (setf server-socket (make-active-socket server port)))
+ (write-string "url" server-socket)
+ (write-char #\NewLine server-socket)
+ (write-string url server-socket)
+ (write-char #\NewLine server-socket)
+ (write-string "end" server-socket)
+ (write-char #\NewLine server-socket)
+ (force-output server-socket)
+ (setf reply (read-reply server-socket))
+ (when close-socket
+ (close server-socket)
+ (setf server-socket nil))
+ finally
+ (unless close-socket (close server-socket))
+ (return reply)))
+
+(defun read-reply (socket)
+ (let* ((header (loop for key = (read-line socket nil nil)
+ while (and key (string-not-equal key "end"))
+ for value = (read-line socket nil nil)
+ collect (cons key value)))
+ (content-length (cdr (assoc "Content-Length" header :test #'string=)))
+ (content (when content-length (make-string (parse-integer content-length :junk-allowed t)))))
+ (when content
+ (read-sequence content socket)
+ (push (cons "reply-content" content) header))
+ header))