From: Vladimir V. Zolotych
Subject: CMUCL Sockets
Date: 
Message-ID: <3B388619.B392E5F2@eurocom.od.ua>
"Pierre R. Mai" wrote:
> 
> (use-package :MP)
> 
> (defun silly-listener (port)
>   (let ((socket (ext:create-inet-listener port)))
>     (unwind-protect
>         (loop
>           ;; Wait for a new connection:
>           (process-wait-until-fd-usable socket :input)
>           (multiple-value-bind (new-fd remote-host)
>               (ext:accept-tcp-connection socket)
>             (let ((stream (sys:make-fd-stream new-fd :input t :output t)))
>               (make-process #'(lambda () (process-connection stream))))))
>       (unix:unix-close socket))))
> 
> (defun start-silly-listener (port)
>   (make-process #'(lambda () (silly-listener port))))

Being slightly familiar with such things in C (SOCKET, BIND, LISTEN,
ACCEPT) may I ask which role MP:PROCESS-WAIT-UNTIL-USABLE plays here ?
EXT:CREATE-INET-LISTENER does SOCKET, BIND, LISTEN; 
EXT:ACCEPT-TCP-CONNECTION does ACCEPT. So, which job remains to
MP:PROCESS-WAIT-UNTIL-FD-USABLE ?

Where can I find any information about MP:functions 
in CMUCL (or standard if it exists) ?

Is it possible to do something with anonymous processes
created via (mp:make-process #'(lambda () (...))), e.g.
view their status or kill it ?

To study subject better I've write simple CL code that
follows (just to see things working). Which way 
it should be improved to become more or less real client/server 
(except those parts, which deals with specific job, 
e.g. do_something, write-line etc. of course). 

===================================================================
(use-package :MP)

;; Just the same as "silly-listener".

(defun my-listener (port)
  (let ((socket (ext:create-inet-listener port)))
    (unwind-protect
	 (loop
	  (process-wait-until-fd-usable socket :input)
	  (multiple-value-bind (new-fd remote-host)
	      (ext:accept-tcp-connection socket)
	    (let ((stream (sys:make-fd-stream new-fd :input t :output t)))
	      (make-process #'(lambda () (do-something stream))))))
      (unix:unix-close socket))))

(defun start-my-listener (port)
  (make-process #'(lambda () (my-listener port))))

(defun do-something (stream)
  (loop for line = (read-line stream nil nil) while line
	do (format t "~&socket --> '~A'~%" line)))

(start-my-listener 50000)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun client (host portnum)
  (let ((socket (ext:connect-to-inet-socket host portnum)))
    (unwind-protect
	 (let ((stream (sys:make-fd-stream socket :output t)))
	   (loop for line = (read-line *standard-input* nil nil) while line
		 do (write-line line stream)
		    (finish-output stream)))
      (unix:unix-close socket))))

-- 
Vladimir Zolotych                         ······@eurocom.od.ua

From: Daniel Barlow
Subject: Re: CMUCL Sockets
Date: 
Message-ID: <878zifqr0l.fsf@noetbook.telent.net>
"Vladimir V. Zolotych" <······@eurocom.od.ua> writes:

> Being slightly familiar with such things in C (SOCKET, BIND, LISTEN,
> ACCEPT) may I ask which role MP:PROCESS-WAIT-UNTIL-USABLE plays here ?

select(), more or less.  CMUCL has a builtin select() loop:
process-wait-until-usable registers our new socket with that loop so
that other things (e.g the top-level listener) can continue to happen
while we wait for a connection to be made.


-dan

-- 

  http://ww.telent.net/cliki/ - Link farm for free CL-on-Unix resources 
From: Pierre R. Mai
Subject: Re: CMUCL Sockets
Date: 
Message-ID: <87wv5nzpbi.fsf@orion.bln.pmsf.de>
"Vladimir V. Zolotych" <······@eurocom.od.ua> writes:

> "Pierre R. Mai" wrote:
> > 
> > (use-package :MP)
> > 
> > (defun silly-listener (port)
> >   (let ((socket (ext:create-inet-listener port)))
> >     (unwind-protect
> >         (loop
> >           ;; Wait for a new connection:
> >           (process-wait-until-fd-usable socket :input)
> >           (multiple-value-bind (new-fd remote-host)
> >               (ext:accept-tcp-connection socket)
> >             (let ((stream (sys:make-fd-stream new-fd :input t :output t)))
> >               (make-process #'(lambda () (process-connection stream))))))
> >       (unix:unix-close socket))))
> > 
> > (defun start-silly-listener (port)
> >   (make-process #'(lambda () (silly-listener port))))
> 
> Being slightly familiar with such things in C (SOCKET, BIND, LISTEN,
> ACCEPT) may I ask which role MP:PROCESS-WAIT-UNTIL-USABLE plays here ?
> EXT:CREATE-INET-LISTENER does SOCKET, BIND, LISTEN; 
> EXT:ACCEPT-TCP-CONNECTION does ACCEPT. So, which job remains to
> MP:PROCESS-WAIT-UNTIL-FD-USABLE ?

Sorry for the delayed response, but I was away in another world, and
hence didn't have time to read c.l.l.  Anyhow, your direct question
has already been answered by someone else: MP:P-W-U-F-U will do the
job of select, in that it makes the current process unrunnable until
one or more connections are ready to be accepted from the socket.

In that way other processes can run without undue influence from this
one.

> Where can I find any information about MP:functions 
> in CMUCL (or standard if it exists) ?

There is currently little in the way of documentation, besides the
code in multi-proc.lisp itself.  The MP stuff is somewhat similar in
concept to the MP stuff on Symbolics' Lisp Machines, but there are
numerous differences.

> Is it possible to do something with anonymous processes
> created via (mp:make-process #'(lambda () (...))), e.g.
> view their status or kill it ?

The list of all current processes can be obtained via
mp:all-processes, so you can iterate on that, calling functions like
mp:process-whostate etc on the process to get more information.  The
function mp:show-processes will give you a nicely formatted overview.
You can destroy processes via mp:destroy-process, etc.

Most of the functions can be found quite easily in the later parts of
multi-proc.lisp (those that are of public interest are marked "Public"
in a comment preceeding them.

> To study subject better I've write simple CL code that
> follows (just to see things working). Which way 
> it should be improved to become more or less real client/server 
> (except those parts, which deals with specific job, 
> e.g. do_something, write-line etc. of course). 

Your example seems quite adequate for the job at hand.  To give you an
impression on "real-world" server-side code, here is the CMU CL driver
code of our in-house HTTP server.  The code below works both on non-MP
CMU CL cores (using the serve-event facility), as well as MP CMU CL
cores, using processes, etc.  As you can see there is not much
difference between the code in here and your code.  One important
thing to watch out for is to assign some suitable process to
mp:*idle-process* (like initialize-clash does), because otherwise you
might encounter delays of up to a second between connection attempt
and connection acceptance (reasons for this elided).

;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
;;;; This is copyrighted software.  See documentation for terms.
;;;; 
;;;; simple-cmu.cl --- Simple HTTP-Server driver for CMU CL
;;;; 
;;;; Checkout Tag: $Name:  $
;;;; $Id: simple-cmu.cl,v 1.4 2001/03/20 23:40:33 dent Exp $

(in-package :CLASH)

;;;; %File Description:
;;;; 
;;;; Simple MP and EVENT-driven drivers for CMU CL
;;;; 


;;; Connection handling

(defun ip-address-string (address)
  (format nil "~D.~D.~D.~D"
	  (ldb (byte 8 24) address)
	  (ldb (byte 8 16) address)
	  (ldb (byte 8 8)  address)
	  (ldb (byte 8 0)  address)))

(defclass cmucl-connection (connection)
  ((binary-address :initarg :binary-address)
   (stream :initarg :stream :reader connection-stream)))

(defmethod initialize-instance :after
    ((instance cmucl-connection) &rest initargs &key socket)
  (declare (ignore initargs))
  (setf (slot-value instance 'stream)
	(sys:make-fd-stream socket :input t :output t
			    #-MP :buffering #-MP :none)))

(defmethod connection-address ((connection cmucl-connection))
  (ip-address-string (slot-value connection 'binary-address)))

(defmethod connection-hostname ((connection cmucl-connection))
  (let* ((address (slot-value connection 'binary-address))
	 (host-entry (ext:lookup-host-entry address)))
    (if host-entry
	(ext:host-entry-name host-entry)
	(ip-address-string address))))

(defmethod close-connection ((connection cmucl-connection))
  (ignore-errors
    (let ((stream (connection-stream connection)))
      (finish-output stream)
      (close stream))))

;;; Event-driven handler

#-MP
(defvar *fd-handlers* (make-hash-table))

#-MP
(defvar *fd-addresses* (make-hash-table))

#-MP
(defun start-http-listener (port server &key reuse-address)
  (labels ((read-handler (socket)
	     (let ((address (gethash socket *fd-addresses*)))
	       (system:remove-fd-handler (gethash socket *fd-handlers*))
	       (remhash socket *fd-handlers*)
	       (remhash socket *fd-addresses*)
	       (serve-connection server
				 (make-instance 'cmucl-connection
						:socket socket
						:binary-address address))))
	   (accept-handler (listener)
	     (multiple-value-bind (socket remote-host)
		 (ext:accept-tcp-connection listener)
	       (setf (gethash socket *fd-addresses*) remote-host
		     (gethash socket *fd-handlers*)
		     (system:add-fd-handler socket :input #'read-handler)))))
    (let ((fd (ext:create-inet-listener port :stream
					:reuse-address reuse-address)))
      (setf (gethash fd *fd-handlers*)
	    (system:add-fd-handler fd :input #'accept-handler)))))

#-MP
(defun initialize-clash (&optional idle-process)
  (declare (ignore idle-process))
  t)

;;; MP handler

#+MP
(defun http-listener (port server reuse-address)
  (let ((fd (ext:create-inet-listener port :stream
				      :reuse-address reuse-address)))
    (unwind-protect
	 (progn
	   (setf (process-name *current-process*)
		 (format nil
			 "HTTP connection listener on port ~D with server ~A"
			 port server))
	   #+CLASH-DEBUG
	   (format t "~&;;; Started lisp connection listener on ~
                port ~d for server ~A~%" port server)
	   (loop
	       ;; Wait for new connection
	       (process-wait-until-fd-usable fd :input)
	       #+CLASH-DEBUG
	       (format t "~&;;; At ~D Got Connection...~%"
		       (get-internal-real-time))
	       (multiple-value-bind (new-fd remote-host)
		   (ext:accept-tcp-connection fd)
		 #+CLASH-DEBUG
		 (format t "~&;;; At ~D Have Connection...~%"
			 (get-internal-real-time))
		 (let ((connection
			(make-instance 'cmucl-connection
				       :socket new-fd
				       :binary-address remote-host)))
		   #+CLASH-DEBUG
		   (format t "~&;;; At ~D Established Connection...~%"
			   (get-internal-real-time))
		   (make-process
		    #'(lambda ()
			(serve-connection server connection))
		    :name (format nil "HTTP connection from ~A"
				  (connection-hostname connection)))))))
      (when fd (unix:unix-close fd)))))

#+MP
(defun start-http-listener (port server &key reuse-address)
  (make-process #'(lambda () (http-listener port server reuse-address))))

#+MP
(defun initialize-clash (&optional (idle-process mp::*initial-process*))
  (setf mp::*idle-process* idle-process))

;;; Update Herald

(setf (getf ext:*herald-items* :clash)
      (list "    CLASH HTTP Server Toolkit "
	    #'(lambda (stream)
		(write-string (clash-version-string) stream))))

Regs, Pierre.

-- 
Pierre R. Mai <····@acm.org>                    http://www.pmsf.de/pmai/
 The most likely way for the world to be destroyed, most experts agree,
 is by accident. That's where we come in; we're computer professionals.
 We cause accidents.                           -- Nathaniel Borenstein