r5267: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Thu, 10 Jul 2003 18:52:39 +0000 (18:52 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Thu, 10 Jul 2003 18:52:39 +0000 (18:52 +0000)
README
debian/changelog
debian/copyright
listener.lisp
sockets.lisp

diff --git a/README b/README
index 9ecc16e..4c480a4 100644 (file)
--- a/README
+++ b/README
@@ -1,5 +1,6 @@
 KMRCL is a collection of utility functions. It is used as a base for
 some of Kevin M. Rosenberg's Common Lisp packages.
 
-The web site for KMRCL is http://lisp.b9.com/
+The web site for KMRCL is http://files.b9.com/kmrcl/
+
 
index 98ac156..33d53a8 100644 (file)
@@ -1,3 +1,9 @@
+cl-kmrcl (1.52-3) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Thu, 10 Jul 2003 12:52:04 -0600
+
 cl-kmrcl (1.51-1) unstable; urgency=low
 
   * New upstream with support of OpenMCL's MOP
index cb26fba..e8ac01d 100644 (file)
@@ -5,7 +5,7 @@ It was downloaded from ftp://ftp.b9.com/kmrcl
 
 Upstream Author: Kevin M. Rosenberg <kevin@rosenberg.net>
 
-Copyright (C) 2000-2002 by Kevin M. Rosenberg.
+Copyright (C) 2000-2003 by Kevin M. Rosenberg.
 
 This code is free software; you can redistribute it and/or modify it
 under the terms of the version 2.1 of the GNU Lesser General Public
index d37d72d..19fbdbe 100644 (file)
@@ -5,9 +5,9 @@
 ;;;; Name:          listener.lisp
 ;;;; Purpose:       Listener and worker processes
 ;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Dec 2002
+;;;; Date Started:  Jun 2003
 ;;;;
-;;;; $Id: listener.lisp,v 1.2 2003/07/09 22:12:52 kevin Exp $
+;;;; $Id: listener.lisp,v 1.3 2003/07/10 18:52:10 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
@@ -29,8 +29,8 @@
             :initform nil)
    (function-args :initarg :function-args :accessor function-args
                  :initform nil)
-   (process :initarg :process :accessor process)
-   (socket :initarg :socket :accessor socket)
+   (process :initarg :process :accessor process :initform nil)
+   (socket :initarg :socket :accessor socket :initform nil)
    (workers :initform nil :accessor workers
            :documentation "list of worker threads")
    (name :initform "" :accessor name :initarg :name)
        (warn "~&listener is not in active list")
        (return-from init/listener listener))
      (dolist (worker (workers listener))
-       (close-active-socket (connection worker))
-       (destroy-process (process worker))
-       (setf (connection worker) nil)
-       (setf (process worker) nil))
+       (with-slots (connection process) worker
+        (when connection
+          (errorset (close-active-socket connection) nil)
+          (setf connection nil))
+        (when process
+          (errorset (destroy-process process) nil)
+          (setf process nil))))
      (setf (workers listener) nil)
      (with-slots (process socket) listener
-       (errorset (close-passive-socket socket) t)
-       (errorset (destroy-process process) t)
-       (setf process nil)
-       (setf socket nil))
+       (when socket
+        (errorset (close-passive-socket socket) nil)
+        (setf socket nil))
+       (when process
+        (errorset (destroy-process process) nil)
+        (setf process nil)))
      (setq *active-listeners* (remove listener *active-listeners*)))
     (:restart
      (init/listener listener :stop)
   (format nil "~A-worker-~D" base-name (incf *worker-count*)))
 
 (defun make-socket-server (listener)
-  (setf (socket listener) (create-inet-listener
-                          (port listener)
-                          :format (listener-format listener)))
-  (setf (process listener) (make-process
-                           (name listener)
-                           #'(lambda () (start-socket-server listener))))
+  #+lispworks
+  (progn
+    (setf (process listener)
+      (comm:start-up-server :process-name (name listener)
+                           :service (port listener) 
+                           :function
+                           #'(lambda (handle) 
+                               (lw-worker handle listener)))))
+  #-lispworks
+  (progn
+    (setf (socket listener) (create-inet-listener
+                            (port listener)
+                            :format (listener-format listener)))
+    (setf (process listener) (make-process
+                             (name listener)
+                             #'(lambda () (start-socket-server listener)))))
   listener)
 
 
                (make-process (name worker) (thread-fun worker)))
              (push worker (workers listener))))))
     (errorset (close-passive-socket (socket listener)) nil)))
+
+#+lispworks
+(defun lw-worker (handle listener)
+  (let ((connection (make-instance 'comm:socket-stream
+                     :socket handle
+                     :direction :io
+                     :element-type 'base-char)))
+    (if (wait listener)
+       (apply (listener-function listener)
+              connection
+              (function-args listener))
+      (let ((worker (make-instance 'worker :listener listener
+                                  :connection connection
+                                  :name (next-worker-name
+                                                 (base-name listener)))))
+       (setf (process worker)
+         (make-process (name worker) (thread-fun worker)))
+       (push worker (workers listener))))))
index a0d4472..6af47d8 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg with excerpts from portableaserve
 ;;;; Date Started:  Jun 2003
 ;;;;
-;;;; $Id: sockets.lisp,v 1.2 2003/07/09 22:12:52 kevin Exp $
+;;;; $Id: sockets.lisp,v 1.3 2003/07/10 18:52:10 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
   #+allegro (require :socket))
 
 
-#+lispworks
-(progn
-  
-(define-condition lw-stream-error (error)
-  ((stream :initarg :stream
-           :reader stream-error-stream)
-   (action :initarg :action
-           :reader stream-error-action)
-   (code :initarg :code
-         :reader stream-error-code)
-   (identifier :initarg :identifier
-               :reader stream-error-identifier))
-  (:report (lambda (condition stream)
-             (format stream "A stream error occured (action=~A identifier=~A code=~A stream=~S)."
-                     (stream-error-action condition)
-                     (stream-error-identifier condition)
-                     (stream-error-code condition)
-                     (stream-error-stream condition)))))
-
-(define-condition socket-error (lw-stream-error)
-  ()
-  (:report (lambda (condition stream)
-             (format stream "A socket error occured (action=~A identifier=~A code=~A stream=~S)."
-                     (stream-error-action condition)
-                     (stream-error-identifier condition)
-                     (stream-error-code condition)
-                     (stream-error-stream condition)))))
-
-(defclass socket ()
-    ((passive-socket :type fixnum
-                    :initarg :passive-socket
-                    :reader socket-os-fd)))
-  
-  (defclass passive-socket (socket)
-    ((element-type :type (member signed-byte unsigned-byte base-char)
-                  :initarg :element-type
-                  :reader element-type)
-     (port :type fixnum
-          :initarg :port
-          :reader local-port)))
-
-  (defmethod print-object ((passive-socket passive-socket) stream)
-    (print-unreadable-object (passive-socket stream :type t :identity nil)
-      (format stream "@~d on port ~d" (socket-os-fd passive-socket) (local-port passive-socket))))
-
-  (defclass binary-socket-stream (comm:socket-stream) ())
-(defclass input-binary-socket-stream (binary-socket-stream)())
-(defclass output-binary-socket-stream (binary-socket-stream)())
-(defclass bidirectional-binary-socket-stream (input-binary-socket-stream output-binary-socket-stream)())
-
-#+unix
-(defun %socket-error-identifier (code)
-  (case code
-    (32 :x-broken-pipe)
-    (98 :address-in-use)
-    (99 :address-not-available)
-    (100 :network-down)
-    (102 :network-reset)
-    (103 :connection-aborted)
-    (104 :connection-reset)
-    (105 :no-buffer-space)
-    (108 :shutdown)
-    (110 :connection-timed-out)
-    (111 :connection-refused)
-    (112 :host-down)
-    (113 :host-unreachable)
-    (otherwise :unknown)))
-
-#+win32
-(defun %socket-error-identifier (code)
-  (case code
-    (10048 :address-in-use)
-    (10049 :address-not-available)
-    (10050 :network-down)
-    (10052 :network-reset)
-    (10053 :connection-aborted)
-    (10054 :connection-reset)
-    (10055 :no-buffer-space)
-    (10058 :shutdown)
-    (10060 :connection-timed-out)
-    (10061 :connection-refused)
-    (10064 :host-down)
-    (10065 :host-unreachable)
-    (otherwise :unknown)))
-
-(defun socket-error (stream error-code action format-string &rest format-args)
-  (let ((code (if (numberp error-code) error-code #+unix(lw:errno-value))))
-    (error 'socket-error :stream stream :code code
-           :identifier (if (keywordp error-code)
-                           error-code
-                         (%socket-error-identifier error-code))
-           :action action
-           :format-control "~A occured while doing socket IO (~?)"
-           :format-arguments (list 'socket-error format-string format-args))))
-
-
-(defmethod comm::socket-error ((stream binary-socket-stream) error-code format-string &rest format-args)
-  (apply #'socket-error stream error-code :IO format-string format-args))
-
-(defmethod stream-input-available ((fd fixnum))
-  (comm::socket-listen fd))
-
-(defmethod stream-input-available ((stream stream::os-file-handle-stream))
-  (stream-input-available (stream::os-file-handle-stream-file-handle stream)))
-
-(defmethod stream-input-available ((stream comm:socket-stream))
-  (or (comm::socket-listen (comm:socket-stream-socket stream))
-      (listen stream)))
-
-(defmethod stream-input-available ((stream passive-socket))
-  (comm::socket-listen (socket-os-fd stream)))
-
-(defun %new-passive-socket (local-port)
-  (multiple-value-bind (socket error-location error-code)
-      (comm::create-tcp-socket-for-service local-port)
-    (cond (socket socket)
-         (t (error 'socket-error :action error-location :code error-code :identifier :unknown)))))
-
-) ;; lispworks
-
 #+sbcl
 (defun listen-to-inet-port (&key (port 0) (kind :stream) (reuse nil))
   "Create, bind and listen to an inet socket on *:PORT.
@@ -166,13 +46,8 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
   #+sbcl
   (listen-to-inet-port :port port :reuse reuse-address)
   #+clisp (ext:socket-server port)
-  #+lispworks
-  (let ((comm::*use_so_reuseaddr* reuse-address))
-    (make-instance 'passive-socket
-                  :port port
-                  :passive-socket (%new-passive-socket port)
-                  :element-type (case format
-                                  (:text 'base-char))))
+  #-(or allegro clisp cmu sbcl)
+  (warn "create-inet-listener not supported on this implementation")
   )
 
 (defun make-fd-stream (socket &key input output element-type)
@@ -188,6 +63,10 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
 
 
 (defun accept-tcp-connection (listener)
+  #+allegro
+  (socket:accept-connection listener)
+  #+clisp
+  (ext:socket-accept listener)
   #+cmu
   (progn
     (mp:process-wait-until-fd-usable listener :input)
@@ -201,20 +80,8 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
      (sb-bsd-sockets:socket-accept listener)
      :element-type 'base-char
      :input t :output t))
-  #+allegro
-  (socket:accept-connection listener)
-  #+clisp
-  (ext:socket-accept listener)
-  #+lispworks
-  (progn
-    (loop while (not (stream-input-available listener))
-         do (sleep 1))
-    (make-instance 'bidirectional-binary-socket-stream
-                  :socket (comm::get-fd-from-socket
-                           (socket-os-fd listener))
-                  :direction :io
-                  :element-type (element-type listener)))
-    
+  #-(or allegro clisp cmu sbcl)
+  (warn "accept-tcp-connection not supported on this implementation")
   )
 
 
@@ -228,11 +95,12 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
 
 (defun close-passive-socket (socket)
   #+allegro (close socket)
+  #+clisp (close socket)
   #+cmu (unix:unix-close socket)
   #+sbcl (sb-unix:unix-close
          (sb-bsd-sockets:socket-file-descriptor socket))
-  #+clisp (close socket)
-  #+lispworks (comm::close-socket (socket-os-fd socket))
+  #-(or allegro clisp cmu sbcl)
+  (warn "close-passive-socket not supported on this implementation")
   )