X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=demo.lisp;h=c9e7e0f9125a67e69c4060758a4ee24558af3225;hb=cb60460c044d8e4c1270b30acd43853ef4ef8f94;hp=87c0aac00a473e58d67ce4d3e6afed2d144e1785;hpb=89ac090253571f870a5afd45559d7aa28ba1b152;p=cl-modlisp.git

diff --git a/demo.lisp b/demo.lisp
index 87c0aac..c9e7e0f 100644
--- a/demo.lisp
+++ b/demo.lisp
@@ -7,7 +7,7 @@
 ;;;; 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)
@@ -65,3 +65,38 @@
 
 
     
+;;; 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))