Hello Erik,

Thank you for keeping the Scieneer CL in mind. The get-host-name implementation does work in the SCL. An implementation of wait-for-input-internal is attached.

Changing the wait-for-input-internal function to set a flag in the socket objects to indicate they are ready would avoid the need to cons up a list of ready sockets which can become very inefficient when managing a large number of connections.

Please consider also adding support for write waiting which is necessary when writing event loops for servers. This could be done by adding another flag to sockets to indication their waiting direction: :input, :output, :io, or nil.

Regards Douglas Crosher

Erik Huelsmann wrote:

Hi Douglas,

I recently added some functionality in usocket and even though I think I could have copy-pasted from the CMU backend, I want to verify with you if this is true.

The functions I added:

• get-host-name (as you can see in the commit mail below based on

copy-paste from CMU)

• wait-for-input-internal which I didn't copy-paste yet.

I would be especially gratefull if you could copy-paste and verify the latter for me and optionally even supply a patch.

For testing of the multiplexing code, I use this 'script':

(load "asdf.lisp") (asdf:oos 'asdf:load-op :usocket)

(defvar sockets nil) (defparameter crlf (format nil "~C~C" #\Return #\Linefeed)) (defparameter host "mirror.w3media.nl") (defparameter offset-path "/apache")

(dotimes (i 10) (let ((s (usocket:socket-connect host 80))) (format (usocket:socket-stream s) "GET http://~A~A/httpd/httpd-2.0.~A.tar.gz HTTP/1.0~%~%" host offset-path (+ 50 i)) (force-output (usocket:socket-stream s)) (push s sockets)))

(let ((buffer (make-array 8192 :element-type 'character))) (loop (let ((ready (usocket:wait-for-input sockets :timeout 15))) (unless ready (sleep 1) (format t "No ready sockets!~%")) (dolist (r ready) (format t "Reading from ~A~%" r) (read-sequence buffer (usocket:socket-stream r))))))

HTH and thanks for your reaction in advance!

bye,

Erik.

---------- Forwarded message ---------- From: ehuelsmann@common-lisp.net ehuelsmann@common-lisp.net Date: May 18, 2007 12:03 AM Subject: [usocket-cvs] r245 - usocket/trunk/backend To: usocket-cvs@common-lisp.net

Author: ehuelsmann Date: Thu May 17 18:03:55 2007 New Revision: 245

Modified: usocket/trunk/backend/scl.lisp Log: Add cl-smtp 'requirement': get-host-name (SCL backend); needs verification.

Modified: usocket/trunk/backend/scl.lisp

--- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Thu May 17 18:03:55 2007 @@ -129,3 +129,6 @@ (t (error 'ns-unknown-error :host-or-ip name :real-error errno))))))))

+(defun get-host-name ()

• (unix:unix-gethostname))

---

usocket-cvs mailing list usocket-cvs@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/usocket-cvs

Index: backend/scl.lisp =================================================================== --- backend/scl.lisp (revision 268) +++ backend/scl.lisp (working copy) @@ -132,3 +132,37 @@

(defun get-host-name () (unix:unix-gethostname)) + +(defun wait-for-input-internal (sockets &key timeout) + (let* ((pollfd-size (alien:alien-size (alien:struct unix::pollfd) :bytes)) + (nfds (length sockets)) + (bytes (* nfds pollfd-size))) + (alien:with-bytes (fds-sap bytes) + (do ((sockets sockets (rest sockets)) + (base 0 (+ base 8))) + ((endp sockets)) + (let ((fd (socket (first sockets)))) + (setf (sys:sap-ref-32 fds-sap base) fd) + (setf (sys:sap-ref-16 fds-sap (+ base 4)) unix::pollin))) + (multiple-value-bind (result errno) + (let ((thread:*thread-whostate* "Poll wait") + (timeout (if timeout + (truncate (* timeout 1000)) + -1))) + (declare (inline unix:unix-poll)) + (unix:unix-poll (alien:sap-alien fds-sap + (* (alien:struct unix::pollfd))) + nfds timeout)) + (cond ((not result) + (error "~@<Polling error: ~A~:@>" + (unix:get-unix-error-msg errno))) + (t + (do ((sockets sockets (rest sockets)) + (base 0 (+ base 8)) + (ready nil)) + ((endp sockets) + (nreverse ready)) + (let ((flags (sys:sap-ref-16 fds-sap (+ base 6)))) + (unless (zerop (logand flags unix::pollin)) + (push (first sockets) ready)))))))))) +