From: Kevin M. Rosenberg Date: Thu, 10 Jul 2003 18:52:39 +0000 (+0000) Subject: r5267: *** empty log message *** X-Git-Tag: v1.96~163 X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=commitdiff_plain;h=9c61ca103ddac473a3f91ac5baedd45335c369e3 r5267: *** empty log message *** --- diff --git a/README b/README index 9ecc16e..4c480a4 100644 --- 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/ + diff --git a/debian/changelog b/debian/changelog index 98ac156..33d53a8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-kmrcl (1.52-3) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Thu, 10 Jul 2003 12:52:04 -0600 + cl-kmrcl (1.51-1) unstable; urgency=low * New upstream with support of OpenMCL's MOP diff --git a/debian/copyright b/debian/copyright index cb26fba..e8ac01d 100644 --- a/debian/copyright +++ b/debian/copyright @@ -5,7 +5,7 @@ It was downloaded from ftp://ftp.b9.com/kmrcl Upstream Author: Kevin M. Rosenberg -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 diff --git a/listener.lisp b/listener.lisp index d37d72d..19fbdbe 100644 --- a/listener.lisp +++ b/listener.lisp @@ -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) @@ -80,16 +80,21 @@ (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) @@ -109,12 +114,22 @@ (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) @@ -162,3 +177,21 @@ (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)))))) diff --git a/sockets.lisp b/sockets.lisp index a0d4472..6af47d8 100644 --- a/sockets.lisp +++ b/sockets.lisp @@ -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) @@ -18,126 +18,6 @@ #+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") )