- usocket-cvs@common-lisp.net - mailman3.common-lisp.net

[usocket-cvs] r365 - trivial-sockets
by ehuelsmann＠common-lisp.net 13 Jul '08

13 Jul '08

Author: ehuelsmann Date: Sun Jul 13 14:19:33 2008 New Revision: 365 Modified: trivial-sockets/README Log: Update trivial-sockets/README. Modified: trivial-sockets/README ============================================================================== --- trivial-sockets/README (original) +++ trivial-sockets/README Sun Jul 13 14:19:33 2008 @@ -1,19 +1,31 @@ -Trivial-sockets: + +* +* NOTE NOTE ***** IMPORTANT ***** +* +* +* This package is no longer maintained. If you're looking for a sockets +* library which does receive maintenance, check out usocket. +* +* You can find usocket at http://common-lisp.net/project/usocket/ +* + + +Trivial-sockets: server and client stream sockets for undemanding network applications Usage examples: -(with-open-stream (s (trivial-sockets:open-stream "www.google.com" 80)) - (format s "HEAD / HTTP/1.0~%Host: www.google.com~%~%") - (force-output s) - (loop - (let ((l (read-line s nil nil))) - (unless l (return)) +(with-open-stream (s (trivial-sockets:open-stream "www.google.com" 80)) + (format s "HEAD / HTTP/1.0~%Host: www.google.com~%~%") + (force-output s) + (loop + (let ((l (read-line s nil nil))) + (unless l (return)) (princ l) (terpri)))) (trivial-sockets:with-server (s (:port 8913 :reuse-address t)) (loop - (with-open-stream (c (trivial-sockets:accept-connection s)) + (with-open-stream (c (trivial-sockets:accept-connection s)) (read-line c) (format c "Hi there!~%")))) @@ -26,7 +38,7 @@ Installation: -Use asdf-install. +Use asdf-install. * (asdf:operate 'asdf:load-op 'asdf-install) * (asdf-install:install 'trivial-sockets)

1 0

[usocket-cvs] r364 - trivial-sockets
by ehuelsmann＠common-lisp.net 13 Jul '08

13 Jul '08

Author: ehuelsmann Date: Sun Jul 13 14:16:19 2008 New Revision: 364 Added: trivial-sockets/ trivial-sockets/README trivial-sockets/abcl.lisp trivial-sockets/allegro.lisp trivial-sockets/clisp.lisp trivial-sockets/cmucl.lisp trivial-sockets/defpackage.lisp trivial-sockets/errors.lisp trivial-sockets/lispworks.lisp trivial-sockets/openmcl.lisp trivial-sockets/sbcl.lisp trivial-sockets/server.lisp trivial-sockets/trivial-sockets.asd trivial-sockets/trivial-sockets.texi Log: Trivial sockets imported as gotten from the clbuild project mirror. Added: trivial-sockets/README ============================================================================== --- (empty file) +++ trivial-sockets/README Sun Jul 13 14:16:19 2008 @@ -0,0 +1,58 @@ +Trivial-sockets: + server and client stream sockets for undemanding network applications + +Usage examples: + +(with-open-stream (s (trivial-sockets:open-stream "www.google.com" 80)) + (format s "HEAD / HTTP/1.0~%Host: www.google.com~%~%") + (force-output s) + (loop + (let ((l (read-line s nil nil))) + (unless l (return)) + (princ l) (terpri)))) + +(trivial-sockets:with-server (s (:port 8913 :reuse-address t)) + (loop + (with-open-stream (c (trivial-sockets:accept-connection s)) + (read-line c) + (format c "Hi there!~%")))) + + +Proper documentation is in trivial-sockets.texi. If you have Texinfo +installed you can convert this to DVI or PDF using texi2dvi or +texi2pdf, or use makeinfo to create an Info file for use with Emacs or +the standalone info reader. + + +Installation: + +Use asdf-install. + + * (asdf:operate 'asdf:load-op 'asdf-install) + * (asdf-install:install 'trivial-sockets) + +Or if you don't have asdf-install but you do have asdf, create a +symlink from a directory in your asdf:*central-registry* and run + + * (asdf:operate 'asdf:load-op 'trivial-sockets) + +Or if you don't have asdf, either (a) get it, or (b) compile the files by +hand in an order that satisfies the dependencies in trivial-sockets.asd + + +References: + +http://www.cliki.net/asdf-install +http://www.cliki.net/asdf + + +Thanks to: (alphabetical order) + +- Andras Simon for Armed Bear CL support +- Edi Weitz, by whose asdf-install work some of the code was inspired +- Oliver Markovic, for OpenMCL support +- Rudi Schlatte, for a ton of stuff including OpenMCL and CMUCL server + support, work on the manual, and also the Stevens justification I + needed to make SO_REUSEADDR default +- Sven Van Caekenberghe provided Lispworks support + Added: trivial-sockets/abcl.lisp ============================================================================== --- (empty file) +++ trivial-sockets/abcl.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,60 @@ + +(in-package :trivial-sockets) + +(defun resolve-hostname (name) + (cond + ((eql name :any) "0.0.0.0") + ((typep name '(vector * 4)) (format nil "~{~A~^.~}" (coerce name 'list))) + (t name))) + +(defun open-stream (peer-host peer-port + &key (local-host :any) (local-port 0) + (external-format :default) + (element-type 'character) + (protocol :tcp)) + (unless (and (eql local-host :any) (eql local-port 0)) + (error 'unsupported :feature :bind)) + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (ext:get-socket-stream + (ext:make-socket (resolve-hostname peer-host) peer-port) + :element-type element-type))) + + +(defun open-server (&key (host :any) (port 0) + (reuse-address t) + (backlog 50) + (protocol :tcp)) + "Returns a SERVER object and the port that was bound, as multiple values" + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (unless (equal (resolve-hostname host) "0.0.0.0") + (error 'unsupported :feature :bind)) + (unless (= backlog 50) + ;; the default, as of jdk 1.4.2 + (error 'unsupported :feature :backlog)) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (let ((sock (ext:make-server-socket port))) + (java:jcall (java:jmethod "java.net.ServerSocket" "setReuseAddress" "boolean") + sock + (java:make-immediate-object reuse-address :boolean)) + (values sock + (java:jcall (java:jmethod "java.net.ServerSocket" "getLocalPort") + sock))))) + +(defun close-server (server) + (ext:server-socket-close server)) + +(defun accept-connection (socket + &key + (external-format :default) + (element-type 'character)) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (ext:get-socket-stream (ext:socket-accept socket) + :element-type element-type))) + Added: trivial-sockets/allegro.lisp ============================================================================== --- (empty file) +++ trivial-sockets/allegro.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,60 @@ +(in-package :trivial-sockets) + +(defun resolve-hostname (name) + (cond + ((eql name :any) "0.0.0.0") + ((typep name '(vector * 4)) (format nil "~{~A~^.~}" (coerce name 'list))) + (t name))) + +(defun open-stream (peer-host peer-port + &key (local-host :any) (local-port 0) + (external-format :default) + (element-type 'character) + (protocol :tcp)) + (declare (ignore element-type)) + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (socket:make-socket :address-family :internet + :connect :active + :type :stream + :remote-host (resolve-hostname peer-host) + :remote-port peer-port + :local-host (resolve-hostname local-host) + :local-port local-port))) + + +(defun open-server (&key (host :any) (port 0) + (reuse-address t) + (backlog 1) + (protocol :tcp)) + "Returns a SERVER object and the port that was bound, as multiple values" + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (handler-bind ((error + (lambda (c) (error 'socket-error :nested-error c)))) + (let* ((host (if (eql host :any) nil host)) + (socket (socket:make-socket :address-family :internet + :type :stream + :connect :passive + :local-host host + :local-port port + :reuse-address reuse-address + :backlog backlog))) + (values socket (socket:local-port socket))))) + +(defun close-server (server) + (close server)) + +(defun accept-connection (socket + &key + (external-format :default) + (element-type 'character)) + (declare (ignore element-type)) ; bivalent streams + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (handler-bind ((error + (lambda (c) (error 'socket-error :nested-error c)))) + (socket:accept-connection socket :wait t))) Added: trivial-sockets/clisp.lisp ============================================================================== --- (empty file) +++ trivial-sockets/clisp.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,56 @@ +(in-package :trivial-sockets) + +(defun resolve-hostname (name) + (cond + ((eql name :any) "0.0.0.0") + ((typep name '(vector * 4)) (format nil "~{~A~^.~}" (coerce name 'list))) + (t name))) + +(defun open-stream (peer-host peer-port + &key (local-host :any) (local-port 0) + (external-format :default) + (element-type 'character) + (protocol :tcp)) + (unless (and (eql local-host :any) (eql local-port 0)) + (error 'unsupported :feature :bind)) + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + ;; FIXME I wish there were a smarter way to detect only the errors + ;; we're interested in, but CLISP impnotes don't say what to look for + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (socket:socket-connect peer-port (resolve-hostname peer-host) + :element-type element-type + :external-format external-format + :buffered nil + ))) + + +(defun open-server (&key (host :any) (port 0) + (reuse-address t) + (backlog 1) + (protocol :tcp)) + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (unless (equal (resolve-hostname host) "0.0.0.0") + (error 'unsupported :feature :bind)) + (unless (= backlog 1) + ;; we established that the default backlog is 1 by stracing clisp + ;; 2.33.2 (2004-06-02) (built 3304881526) + (error 'unsupported :feature :backlog)) + (unless reuse-address + (error 'unsupported :feature :nil-reuse-address)) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (let ((s (socket:socket-server port))) + (values s (socket:socket-server-port s))))) + +(defun close-server (server) + (socket:socket-server-close server)) + +(defun accept-connection (socket + &key + (external-format :default) + (element-type 'character)) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (socket:socket-accept socket :external-format external-format + :element-type element-type + :buffered nil))) Added: trivial-sockets/cmucl.lisp ============================================================================== --- (empty file) +++ trivial-sockets/cmucl.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,72 @@ +(in-package :trivial-sockets) + +(defun resolve-hostname (name) + (cond + ((eql name :any) "0.0.0.0") + ((typep name '(vector * 4)) (format nil "~{~A~^.~}" (coerce name 'list))) + (t name))) + +(defun pretty-stream-name (host port) + (format nil "~A:~A" (resolve-hostname host) port)) + +(defun open-stream (peer-host peer-port + &key (local-host :any) (local-port 0) + (external-format :default) + (element-type 'character) + (protocol :tcp)) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (unless (and (eql local-host :any) (eql local-port 0)) + (error 'unsupported :feature :bind)) + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + ;; connect-to-inet-socket signals simple-erors. not great + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (let ((s (ext:connect-to-inet-socket + (resolve-hostname peer-host) peer-port))) + (sys:make-fd-stream s :input t :output t :element-type element-type + :buffering :full + :name (pretty-stream-name peer-host peer-port))))) + +(defun open-server (&key (host :any) (port 0) + (reuse-address t) + (backlog 1) + (protocol :tcp)) + "Returns a SERVER object and the port that was bound, as multiple values" + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (let ((socket (if (equal (resolve-hostname host) "0.0.0.0") + ;; create-inet-listener barfs on `:host nil' + (ext:create-inet-listener port :stream + :reuse-address reuse-address + :backlog backlog) + (ext:create-inet-listener port :stream + :reuse-address reuse-address + :backlog backlog + :host host)))) + (multiple-value-bind (host port) + (ext:get-socket-host-and-port socket) + (declare (ignore host)) + (values socket port))))) + +(defun close-server (server) + (unix:unix-close server)) + +(defun accept-connection (socket + &key + (external-format :default) + (element-type 'character)) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (let ((fd (ext:accept-tcp-connection socket))) + (multiple-value-bind (peer-host peer-port) + (ext:get-peer-host-and-port fd) + (sys:make-fd-stream fd + :input t :output t + :element-type element-type + :auto-close t + :buffering :full + :name (pretty-stream-name peer-host peer-port)))))) + Added: trivial-sockets/defpackage.lisp ============================================================================== --- (empty file) +++ trivial-sockets/defpackage.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,8 @@ +(in-package :cl-user) +(defpackage trivial-sockets + (:use :CL) + (:export #:open-stream #:socket-error #:socket-nested-error + #:unsupported #:unsupported-feature + #:open-server #:close-server #:accept-connection + #:with-server)) + Added: trivial-sockets/errors.lisp ============================================================================== --- (empty file) +++ trivial-sockets/errors.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,11 @@ +(in-package :trivial-sockets) + +;; you're using a part of the interface that the implementation doesn't do +(define-condition unsupported (error) + ((feature :initarg :feature :reader unsupported-feature))) + +;; all-purpose error: host not found, host not responding, +;; no service on that port, etc +(define-condition socket-error (error) + ((nested-error :initarg :nested-error :reader socket-nested-error))) + Added: trivial-sockets/lispworks.lisp ============================================================================== --- (empty file) +++ trivial-sockets/lispworks.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,114 @@ +(in-package :trivial-sockets) + +(defun resolve-hostname (name) + (cond + ((eql name :any) "0.0.0.0") + ((typep name '(vector * 4)) (format nil "~{~A~^.~}" (coerce name 'list))) + (t name))) + +(defun open-stream (peer-host peer-port + &key (local-host :any) (local-port 0) + (external-format :default) + (element-type 'base-char) + (protocol :tcp)) + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (unless (eql external-format :default) + (error 'unsupported :feature `(:external-format ,external-format))) + (unless (eql local-host :any) + (error 'unsupported :feature `(:local-host ,local-host))) + (unless (eql local-port 0) + (error 'unsupported :feature `(:local-port ,local-port))) + (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c)))) + (comm:open-tcp-stream (resolve-hostname peer-host) + peer-port + :element-type element-type + :errorp t))) + +;; there is no (published) way to make a server socket in lispworks +;; this server implementation is a hack around the otherwise elegant +;; lispworks #'comm:start-up-server functionality + +(defun make-queue () + (cons nil nil)) + +(defun queue-empty-p (queue) + (null (car queue))) + +(defun enqueue (x queue) + (if (null (car queue)) + (setf (cdr queue) (setf (car queue) (list x))) + (setf (cdr (cdr queue)) (list x) + (cdr queue) (cdr (cdr queue)))) + (car queue)) + +(defun dequeue (queue) + (pop (car queue))) + +(defclass server () + ((process :reader get-process) + (lock :initform (mp:make-lock)) + (clients :initform (make-queue)))) + +(defun open-server (&key (host :any) (port 0) + (reuse-address t) + (backlog 5) + (protocol :tcp)) + "Returns a SERVER object and the port that was bound, as multiple values" + (unless (eql host :any) + ;; not in the manual, appears in arglist, maybe not on all platforms + (error 'unsupported :feature `(:host ,host))) + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (unless (eql backlog 5) + ;; not in the manual, appears in arglist, maybe not on all platforms + (error 'unsupported :feature `(:backlog ,backlog))) + (let ((server (make-instance 'server))) + (with-slots (process lock clients) + server + (multiple-value-bind (new-process condition) + ;; we enqueue all incoming connections until #'accept-connection retrieves them + (let ((comm::*use_so_reuseaddr* reuse-address)) + (comm:start-up-server :function #'(lambda (socket) + (mp:with-lock (lock) + (enqueue socket clients))) + :service port + :wait t)) + (when condition + (error 'socket-error :nested-error condition)) + (setf process new-process))) + (values server port))) ;; we do not return the actual port when port was 0 + +(defun close-server (server) + (with-slots (process) + server + (mp:process-kill process) + (setf process nil))) + +(defun accept-connection (server + &key + (external-format :default) + (element-type 'base-char)) + (unless (eql external-format :default) + (error 'unsupported :feature `(:external-format, external-format))) + (let (client-socket) + (with-slots (process lock clients) + server + (unless process + (error 'socket-error :nested-error (make-instance 'simple-error :format-string "Server closed"))) + (loop + (mp:with-lock (lock) + (unless (queue-empty-p clients) + (setf client-socket (dequeue clients)) + (return))) + (mp:process-wait "Waiting for incoming connections" + #'(lambda (server) + (with-slots (lock clients) + server + (mp:with-lock (lock) + (not (queue-empty-p clients))))) + server))) + (make-instance 'comm:socket-stream + :socket client-socket + :direction :io + :element-type element-type))) Added: trivial-sockets/openmcl.lisp ============================================================================== --- (empty file) +++ trivial-sockets/openmcl.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,60 @@ +(in-package :trivial-sockets) + +(defun resolve-hostname (name) + (cond + ((eql name :any) "0.0.0.0") + ((typep name '(vector * 4)) (format nil "~{~A~^.~}" (coerce name 'list))) + (t name))) + +(defun open-stream (peer-host peer-port + &key (local-host :any) (local-port 0) + (external-format :default) + (element-type 'character) + (protocol :tcp)) + (declare (ignore element-type)) + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (handler-bind ((ccl::socket-creation-error + (lambda (c) (error 'socket-error :nested-error c)))) + (ccl:make-socket :address-family :internet + :connect :active + :type :stream + :remote-host (resolve-hostname peer-host) + :remote-port peer-port + :local-host (resolve-hostname local-host) + :local-port local-port))) + +(defun open-server (&key (host :any) (port 0) + (reuse-address t) + (backlog 1) + (protocol :tcp)) + "Returns a SERVER object and the port that was bound, as multiple values" + (unless (eql protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (handler-bind ((ccl::socket-creation-error + (lambda (c) (error 'socket-error :nested-error c)))) + (let* ((host (if (eql host :any) nil host)) + (socket (ccl:make-socket :address-family :internet + :type :stream + :connect :passive + :local-host host + :local-port port + :reuse-address reuse-address + :backlog backlog))) + (values socket (ccl:local-port socket))))) + +(defun close-server (server) + (close server)) + +(defun accept-connection (socket + &key + (external-format :default) + (element-type 'character)) + (declare (ignore element-type)) ; openmcl streams are bivalent. + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (handler-bind ((ccl:socket-error + (lambda (c) (error 'socket-error :nested-error c)))) + (ccl:accept-connection socket :wait t))) \ No newline at end of file Added: trivial-sockets/sbcl.lisp ============================================================================== --- (empty file) +++ trivial-sockets/sbcl.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,63 @@ +(in-package :trivial-sockets) + +(defun resolve-hostname (name) + (cond + ((eql name :any) #(0 0 0 0)) + ((typep name '(vector * 4)) name) + (t (car (sb-bsd-sockets:host-ent-addresses + (sb-bsd-sockets:get-host-by-name name)))))) + +(defun open-stream (peer-host peer-port + &key (local-host :any) (local-port 0) + (external-format :default) + (element-type 'character) + (protocol :tcp)) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (handler-bind ((sb-bsd-sockets:socket-error + (lambda (c) (error 'socket-error :nested-error c))) + (sb-bsd-sockets:name-service-error + (lambda (c) (error 'socket-error :nested-error c)))) + (let ((s (make-instance 'sb-bsd-sockets:inet-socket + :type :stream + :protocol protocol)) + (me (resolve-hostname local-host))) + (unless (and (equal me #(0 0 0 0)) (eql local-port 0)) + (sb-bsd-sockets:socket-bind s me local-port)) + (sb-bsd-sockets:socket-connect + s (resolve-hostname peer-host) peer-port) + (sb-bsd-sockets:socket-make-stream s :input t :output t + :element-type element-type + :buffering :full)))) + +(defun open-server (&key (host :any) (port 0) + (reuse-address t) + (backlog 1) + (protocol :tcp)) + "Returns a SERVER object and the port that was bound, as multiple values" + (let ((sock (make-instance 'sb-bsd-sockets:inet-socket + :type :stream + :protocol protocol))) + (when reuse-address + (setf (sb-bsd-sockets:sockopt-reuse-address sock) t)) + (sb-bsd-sockets:socket-bind sock (resolve-hostname host) port) + (sb-bsd-sockets:socket-listen sock backlog) + (multiple-value-bind (h p) (sb-bsd-sockets:socket-name sock) + (declare (ignore h)) + (values sock p)))) + +(defun close-server (server) + (sb-bsd-sockets:socket-close server)) + +(defun accept-connection (socket + &key + (external-format :default) + (element-type 'character)) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (let ((s (sb-bsd-sockets:socket-accept socket))) + (sb-bsd-sockets:socket-make-stream s + :input t :output t + :element-type element-type + :buffering :full))) + Added: trivial-sockets/server.lisp ============================================================================== --- (empty file) +++ trivial-sockets/server.lisp Sun Jul 13 14:16:19 2008 @@ -0,0 +1,10 @@ +(in-package :trivial-sockets) + +(defmacro with-server ((name arguments) &body forms) + `(let (,name) + (unwind-protect + (progn + (setf ,name (open-server ,@arguments)) + (locally + ,@forms)) + (when ,name (close-server ,name))))) Added: trivial-sockets/trivial-sockets.asd ============================================================================== --- (empty file) +++ trivial-sockets/trivial-sockets.asd Sun Jul 13 14:16:19 2008 @@ -0,0 +1,21 @@ +;;; -*- Lisp -*- +(defpackage #:trivial-sockets-system (:use #:asdf #:cl)) +(in-package #:trivial-sockets-system ) + +(defsystem trivial-sockets + :version "0.3" + :depends-on (#+sbcl sb-bsd-sockets) + :components ((:file "defpackage") + (:file "errors" :depends-on ("defpackage")) + (:file + #+sbcl "sbcl" + #+cmu "cmucl" + #+clisp "clisp" + #+acl-socket "allegro" + #+openmcl "openmcl" + #+lispworks "lispworks" + #+armedbear "abcl" + :depends-on ("defpackage")) + (:file "server" :depends-on ("defpackage")) + )) + Added: trivial-sockets/trivial-sockets.texi ============================================================================== --- (empty file) +++ trivial-sockets/trivial-sockets.texi Sun Jul 13 14:16:19 2008 @@ -0,0 +1,444 @@ +\input texinfo @c -*- texinfo -*- +@c %**start of header +@setfilename trivial-sockets.info +@settitle TRIVIAL-SOCKETS Manual +@c %**end of header + +@c merge type index into function index +@syncodeindex tp fn +@c ... and concept index, too. +@synindex cp fn + +@c for install-info +@dircategory Software development +@direntry +* trivial-sockets: (trivial-sockets). CL socket interface for scripting/interactive use +@end direntry + +@copying +This manual describes TRIVIAL-SOCKETS, a simple socket interface for Common +Lisp programs and libraries. + +Copyright @copyright{} 2004 Daniel Barlow and contributors + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +``Software''), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +@end copying + + + +@titlepage +@title TRIVIAL-SOCKETS + +@c The following two commands start the copyright page. +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@c Output the table of contents at the beginning. +@contents + +@c ------------------- + +@ifnottex + +@node Top +@top TRIVIAL-SOCKETS: a socket interface for scripting and interactive use + +@insertcopying + +@menu +* Introduction:: Design goals and target audience +* Installation:: How to download and install +* API:: +* Index:: +@end menu + +@end ifnottex + +@c ------------------- + +@node Introduction +@chapter Introduction + +TRIVIAL-SOCKETS is a portable socket interface that allows CL programs +to open connected (client) stream sockets to network services +(e.g. HTTP, FTP, SMTP servers) and communicate with them. It's +intended mostly for use by small ``script'' programs and for +interactive use where the effort involved in writing one's own +portable wrapper layer for several Lisp implementations would outweigh +that spent on the actual application. + +In the interests of simplicity and ease of porting, the functionality +available through TRIVIAL-SOCKETS has been deliberately restricted. +For a more general sockets interface which may allow access to more +functionality, the reader is encouraged to consult his Lisp +implementation's documentation. + +@node Installation +@chapter Installation +@cindex{Installation} + +TRIVIAL-SOCKETS is distributed via asdf-install. If you are on the +Internet and your Lisp implementation has asdf-install available, you +may download and compile this package with an invocation like + +@lisp +(asdf-install:install 'trivial-sockets) +@end lisp + +The trivial-sockets package has been PGP-signed by Daniel Barlow, and +asdf-install will by default check that the signature is good and that +a trust path exists between you and him. If not, you will be prompted +for a decision on whether to install anyway. See asdf-install +documentation for more details on how this works. + +Once you have installed trivial-sockets, the next time you wish to +load it you need only evaluate + +@lisp +(asdf:operate 'asdf:load-op 'trivial-sockets) +@end lisp + +or if you have an asdf system that uses it, add +@code{trivial-sockets} to the @code{:depends-on} clause of that system +and it will be loaded whenever your system is. + +@chapter API +@node API + +@section Types +@cindex{Host designator} +@cindex{IP address} +@cindex{Address} +@cindex{Protocol} + +A @emph{host designator} is one of the following: + +@enumerate +@item A string, which is resolved as a hostname by the system resolver, +typically using DNS or YP or some other implementation-defined +mechanism. For example, @code{"www.google.com"} + +@item An IPv4 address in "dotted quad" notation: e.g. @code{"127.0.0.1"} + +@item (Implementation-defined): An IPv4 address in whatever ``native'' +format the implementation uses to represent same, if applicable. +For example, @code{#(127 0 0 1)} or @code{2130706433} + +@item The keyword @code{:ANY}, which corresponds to INADDR_ANY or "0.0.0.0" +@end enumerate + +A @emph{protocol specifier} is a keyword naming an +@uref{http://www.iana.org/assignments/protocol-numbers,,IANA protocol +number} (as typically found in @file{/etc/protocols} on Unix-like +systems) or the corresponding number. Implementations must support +@code{:TCP} at a minimum. + +@section Functions + +@anchor{Function open-stream} +@defun open-stream peer-host peer-port &key local-host local-port external-format element-type protocol +@result{} stream + +@strong{Arguments and Values:} + +@var{peer-host}--a host designator. + +@var{peer-port}--an integer. + +@var{local-host}--a host designator. The default is @code{:any}. + +@var{local-port}--an integer. The default is @code{0}. + +@var{external-format}--an external file format designator. The default +is @code{:default}. + +@var{element-type}--a type specifier; see the Common Lisp function +@code{open} for valid values. The default is @code{'character}. + +@var{protocol}--a protocol specifier. The default is @code{:tcp}. + +@strong{Description:} + +Return a stream to the named service, open for both reading and writing. +The stream is usually buffered, so be sure to use @code{force-output} +where necessary. + +If the stream cannot be created for any reason, an error of type +@code{socket-error} is signaled. + +The stream should be closed in the usual way when no longer needed: +see the Common Lisp functions @code{close}, @code{with-open-stream} +@end defun + +@anchor{Function open-server} +@defun open-server &key host port reuse-address backlog protocol +@result{} server socket + +@strong{Arguments and Values:} + +@var{host}--a host designator. The default is @code{:any}. + +@var{port}--an integer. The default is @code{0}. + +@var{reuse-address}--@code{t} or @code{nil}. The default is @code{t}. + +@var{backlog}--an integer. The default is @code{1}. + +@var{protocol}--a protocol specifier. The default is @code{:tcp}. + +@strong{Description:} + +Create a listening server socket. If @var{port} is 0, an unused port +will be chosen by the implementation/operating system. @var{Host} +may be set to the address of any local network interface to restrict +the socket to that interface. + +If @var{reuse-address} is true (the default, as recommended by Stevens) +then the @code{SO_REUSEADDR} socket option will be set, which allows the +the port to be reused immediately after it has been closed, without +waiting for a timeout (``2*MSL'') to expire. + +@var{Backlog} sets how many pending connections are queued by the +operating system. + +If the socket cannot be created for any reason, an error of type +@code{socket-error} is signaled. + +The nature of the object returned is implementation-dependent. When +the socket is no longer needed it should be closed with +@code{close-server}. + +@xref{Macro with-server}. +@end defun + +@c <3dqes6$e49(a)bosnia.pop.psu.edu> or see 242-246 of +@c "TCP/IP Illustrated, Volume 1" + +@anchor{Function close-server} +@defun close-server server +@result{} result + +@strong{Arguments and Values:} + +@var{server}--a server socket. + +@var{result}--implementation-dependent. + +@strong{Description:} + +Close @var{server} and release all resources associated with it. +Note that opening a new server on the same address/port will not be +immediately possible unless the earlier server was created with the +@code{:reuse-address} argument. +@end defun + +@anchor{Macro with-server} +@defmac with-server (server args) declaration* form* +@result{} results + +@strong{Arguments and Values:} + +@var{server}--a variable. + +@var{args}--a list of arguments. + +@var{declaration}--a declare expression. + +@var{forms}--an implicit @code{progn}. + +@var{results}--the values returned by the @var{forms}. + +@strong{Description:} + +@code{with-server} uses @code{open-server} to create a server socket +named by @var{server}. @var{Args} are used as keyword arguments to +@code{open-server}. + +@code{with-server} evaluates the @var{forms} as an implicit progn with +@var{server} bound to the value returned by @code{open-server}. + +When control leaves the body, either normally or abnormally (such as by +use of @code{throw}), the server socket is automatically closed. + +The consequences are undefined if an attempt is made to assign to +the variable @var{server} within the body forms. +@end defmac + +@anchor{Function accept-connection} +@defun accept-connection server &key external-format element-type +@result{} stream + +@strong{Arguments and Values:} + +@var{server}--a server socket. + +@var{external-format}--an external file format designator. The default +is @code{:default}. + +@var{element-type}--a type specifier; see the Common Lisp function +@code{open} for valid values. The default is @code{'character}. + +@strong{Description:} + +Accept a connection to @var{server}, returning a stream connected to +the client which is open for both reading and writing. The stream is +usually buffered, so be sure to use @code{force-output} where +necessary. + +If no connection is pending, @code{accept-connection} waits until one +arrives. + +If anything goes wrong, an error of type @code{socket-error} is +signaled. +@end defun + +@section Examples + +@subsection Simple client + +@lisp +;; this is not HTTP compliant, really. But it's good enough +;; for a demonstration +(with-open-stream (s (trivial-sockets:open-stream "www.google.com" 80)) + (format s "HEAD / HTTP/1.0~%Host: www.google.com~%~%") + (force-output s) + (loop + (let ((l (read-line s nil nil))) + (unless l (return)) + (princ l) (terpri)))) +@end lisp + +@subsection Simple (single-threaded) server + +@lisp +(trivial-sockets:with-server (s (:port 8913 :reuse-address t)) + (loop + (with-open-stream (c (trivial-sockets:accept-connection s)) + (read-line c) + (format c "This is a compliant though pointless implementation ~ +of the finger protocol~%")))) +@end lisp + + +@section Errors + +@anchor{Condition unsupported} +@deftp {Condition} unsupported +Class precedence list: @w{error} + +This exists so that partial implementations of this interface may be +created for environments which are incapable of supporting the full +API. An @code{unsupported} error is signaled if the user requests +functionality that is not implemented for the Lisp environment in use. +@end deftp + +@anchor{Condition socket-error} +@deftp {Condition} socket-error +Class precedence list: @w{error} + +A @code{socket-error} error is signaled when an error situation occurs +during opening of the stream. If you need more detail, this is +probably a sign that you have outgrown this interface and will have to +resort to unportable code (error codes vary between systems:were you +expecting @code{HOST_UNREACH} or @code{NET_UNREACH}?). With that in +mind, you can access the implementation-specific error using + +@lisp +(socket-nested-error condition) +@end lisp + +@end deftp + +@chapter Implementation-dependent +@node Implementation-dependent + +Not all features in this interface are supported on all platforms, +owing to deficiencies in the underlying socket layers that it uses. + +Many implementations signal socket-related errors using non-specific +error classes such as ERROR or SIMPLE-ERROR. (Some others, perhaps, +signal more specific errors but the code in trivial-sockets does not +know that. Patches welcome). Where we don't know of a specific +error, we catch the general ones and resignal @code{SOCKET-ERROR}, so +it's possible sometimes that errors shich are nothing at all to do +with sockets (e.g. keyboard interrupts or external signals) also get +presented as SOCKET-ERRORs. This applies in all implementations +listed except where noted. + +@itemize + +@item Armed Bear CL currently supports only client sockets, and only +for TCP, with unspecified local endpoint, and with the default +external-format. + +@item Allegro CL (tested in Allegro 6.2. trial) has no support for +protocols other than @code{:tcp} or non-default external-formats. +Allegro sockets are multivalent, so it ignores the +@code{:element-type}. + +@item CLISP has no support for protocols that are not @code{:tcp}, or for +binding the local address/port. Its streams are unbuffered, as CLISP +buffered streams do not return any data at all on reads until the +buffer is full - making them no use for any protocol in which one side +sends less than 4k at a time. (CLISP ``interactively buffered'' +streams are likely to fix this, but as of October 2004 have not yet +been implemented). + +@item CMUCL has no support for external-formats other than +@code{:default}, for protocols that are not @code{:tcp}, or for +binding the local address/port. + +@item Lispworks supports TCP only, It doesn't do +non-default local address in server sockets, or listen backlog length. +It doesn't do non-default external-formats. If the local port is 0, +@code{open-server} doesn't return the real port number. It also uses +an odd construction involving multiple threads for server sockets +which in principle should be transparent but don't say we didn't warn +you. + +@item OpenMCL socket support is very similar to that of Allegro: all +implementation notes applicable to Allegro also hold for OpenMCL. +Additionally, errors signaled by instances of @code{ccl:socket-error} +are caught and resignaled as @code{socket-error}. + +@item SBCL has no support for external-formats other than @code{:default}. +Errors signaled by @code{sb-bsd-sockets:socket-error} and @code +{sb-bsd-sockets:name-service-error} are caught and resignaled as +@code{socket-error}. + +@end itemize + +Patches to improve per-implementation support for this interface are +welcome. Patches which include an appropriate update for the manual +are doubly if not sevenfoldly so. + +@c ------------------- + + +@node Index, +@unnumbered Index + +@printindex fn + +@bye +

1 0

[usocket-cvs] r363 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 13 Jul '08

13 Jul '08

Author: ehuelsmann Date: Sun Jul 13 07:05:40 2008 New Revision: 363 Modified: usocket/trunk/backend/sbcl.lisp Log: Commit change to trunk which should have been there all the time, but got committed to the 0.3.x branch only, for some reason. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Sun Jul 13 07:05:40 2008 @@ -67,7 +67,7 @@ (defun get-host-name () (ffi:c-inline () () :object - "{ char *buf = GC_malloc(256); + "{ char *buf = cl_alloc_atomic(257); if (gethostname(buf,256) == 0) @(return) = make_simple_base_string(buf);

1 0

[usocket-cvs] r362 - usocket/branches/new-wfi/backend
by ehuelsmann＠common-lisp.net 04 Jul '08

04 Jul '08

Author: ehuelsmann Date: Fri Jul 4 19:19:05 2008 New Revision: 362 Modified: usocket/branches/new-wfi/backend/clisp.lisp Log: Fix CLISP backend. Modified: usocket/branches/new-wfi/backend/clisp.lisp ============================================================================== --- usocket/branches/new-wfi/backend/clisp.lisp (original) +++ usocket/branches/new-wfi/backend/clisp.lisp Fri Jul 4 19:19:05 2008 @@ -144,14 +144,15 @@ (split-timeout (or timeout 1)) (dolist (x (wait-list-%wait wait-list)) (setf (cdr x) :INPUT)) - (let* ((status-list (if timeout + (let* ((request-list (wait-list-%wait wait-list)) + (status-list (if timeout (socket:socket-status request-list secs musecs) (socket:socket-status request-list))) (sockets (wait-list-waiters wait-list))) (do* ((x (pop sockets) (pop sockets)) (y (pop status-list) (pop status-list))) - ((or (null sockets) (null status-list))) - (when y + ((null x)) + (when (eq y :INPUT) (setf (state x) :READ))) wait-list))))

1 0

[usocket-cvs] r361 - usocket/branches/new-wfi/backend
by ehuelsmann＠common-lisp.net 03 Jul '08

03 Jul '08

Author: ehuelsmann Date: Thu Jul 3 18:33:36 2008 New Revision: 361 Modified: usocket/branches/new-wfi/backend/sbcl.lisp Log: Fix SBCL backend (non Win32). Modified: usocket/branches/new-wfi/backend/sbcl.lisp ============================================================================== --- usocket/branches/new-wfi/backend/sbcl.lisp (original) +++ usocket/branches/new-wfi/backend/sbcl.lisp Thu Jul 3 18:33:36 2008 @@ -268,13 +268,26 @@ #+sbcl (progn #-win32 +(defun %setup-wait-list (wait-list) + (declare (ignore wait-list))) + +(defun %add-waiter (wait-list waiter) + (push (socket waiter) (wait-list-%wait wait-list))) + +(defun %remove-waiter (wait-list waiter) + ;;;### not removing from the waiters list?! + (setf (wait-list-%wait wait-list) + (remove (socket waiter) (wait-list-%wait wait-list)))) + + + (defun wait-for-input-internal (sockets &key timeout) (with-mapped-conditions () (sb-alien:with-alien ((rfds (sb-alien:struct sb-unix:fd-set))) (sb-unix:fd-zero rfds) - (dolist (socket sockets) + (dolist (socket (wait-list-%wait sockets)) (sb-unix:fd-set - (sb-bsd-sockets:socket-file-descriptor (socket socket)) + (sb-bsd-sockets:socket-file-descriptor socket) rfds)) (multiple-value-bind (secs musecs) @@ -282,7 +295,7 @@ (multiple-value-bind (count err) (sb-unix:unix-fast-select - (1+ (reduce #'max (mapcar #'socket sockets) + (1+ (reduce #'max (mapcar #'socket (wait-list-waiters sockets)) :key #'sb-bsd-sockets:socket-file-descriptor)) (sb-alien:addr rfds) nil nil (when timeout secs) musecs) @@ -291,12 +304,11 @@ (error (map-errno-error err))) (when (< 0 count) ;; process the result... - (remove-if - #'(lambda (x) - (not (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor (socket x)) - rfds))) - sockets)))))))) + (dolist (x (wait-list-waiters sockets)) + (when (not (sb-unix:fd-isset + (sb-bsd-sockets:socket-file-descriptor (socket x)) + rfds)) + (setf (state x) :READ)))))))))) #+win32 (warn "wait-for-input not (yet!) supported...")

1 0

[usocket-cvs] r360 - usocket/branches/new-wfi
by ehuelsmann＠common-lisp.net 03 Jul '08

03 Jul '08

Author: ehuelsmann Date: Thu Jul 3 17:29:44 2008 New Revision: 360 Modified: usocket/branches/new-wfi/usocket.lisp Log: Fix new-wfi code (generic part). Modified: usocket/branches/new-wfi/usocket.lisp ============================================================================== --- usocket/branches/new-wfi/usocket.lisp (original) +++ usocket/branches/new-wfi/usocket.lisp Thu Jul 3 17:29:44 2008 @@ -275,7 +275,7 @@ (values (if ready-only socks socket-or-sockets) to))))) (let* ((start (get-internal-real-time)) (sockets-ready 0)) - (dolist (x (wait-list-waiters sockets)) + (dolist (x (wait-list-waiters socket-or-sockets)) (when (setf (state x) (if (and (stream-usocket-p x) (listen (socket-stream x)))

1 0

[usocket-cvs] r359 - public_html/releases
by ehuelsmann＠common-lisp.net 28 Jun '08

28 Jun '08

Author: ehuelsmann Date: Sat Jun 28 08:30:31 2008 New Revision: 359 Added: public_html/releases/usocket-0.3.6.tar.gz.asc public_html/releases/usocket-0.3.7.tar.gz.asc Log: Add signature files. Added: public_html/releases/usocket-0.3.6.tar.gz.asc ============================================================================== --- (empty file) +++ public_html/releases/usocket-0.3.6.tar.gz.asc Sat Jun 28 08:30:31 2008 @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.6 (GNU/Linux) + +iD8DBQBIZi7yi5O0Epaz9TkRAulwAJ9g2dVsqbYf7f6FdOyR1iUkq9J2yACeIjyl +CDeMaYezgHhOpRFWWXoWeMM= +=Qa9v +-----END PGP SIGNATURE----- Added: public_html/releases/usocket-0.3.7.tar.gz.asc ============================================================================== --- (empty file) +++ public_html/releases/usocket-0.3.7.tar.gz.asc Sat Jun 28 08:30:31 2008 @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.6 (GNU/Linux) + +iD8DBQBIZi8Hi5O0Epaz9TkRAsBRAJ9bLlrhPfjmolHIFwevuDQt+lOpdwCfVmfl +oDpQpvdjRQhraZfB88TrgS0= +=/Swp +-----END PGP SIGNATURE-----

1 0

[usocket-cvs] r358 - usocket/branches/0.3.x
by ehuelsmann＠common-lisp.net 28 Jun '08

28 Jun '08

Author: ehuelsmann Date: Sat Jun 28 06:18:15 2008 New Revision: 358 Modified: usocket/branches/0.3.x/usocket.asd Log: Bump version number. Modified: usocket/branches/0.3.x/usocket.asd ============================================================================== --- usocket/branches/0.3.x/usocket.asd (original) +++ usocket/branches/0.3.x/usocket.asd Sat Jun 28 06:18:15 2008 @@ -14,7 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" - :version "0.3.5-dev" + :version "0.3.8-dev" :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence

1 0

[usocket-cvs] r357 - in public_html: . releases
by ehuelsmann＠common-lisp.net 28 Jun '08

28 Jun '08

Author: ehuelsmann Date: Sat Jun 28 06:17:28 2008 New Revision: 357 Added: public_html/releases/usocket-0.3.7.tar.gz (contents, props changed) Modified: public_html/index.shtml Log: Add 0.3.7 release. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Sat Jun 28 06:17:28 2008 @@ -391,6 +391,9 @@ <table> <caption>Release history</caption> <tr><th>Date</th><th>Release</th><th>Summary</th></tr> +<tr><td>Jun 28, 2008</td> + <td>0.3.7</td> + <td>Fix of OpenMCL (Closure CL) backend. </td></tr> <tr><td>Jun 21, 2008</td> <td>0.3.6</td> <td>Code fixups based on advice from the ECL and OpenMCL maintainers. Added: public_html/releases/usocket-0.3.7.tar.gz ============================================================================== Binary file. No diff available.

1 0

[usocket-cvs] r356 - usocket/tags/0.3.7
by ehuelsmann＠common-lisp.net 28 Jun '08

28 Jun '08

Author: ehuelsmann Date: Sat Jun 28 06:12:13 2008 New Revision: 356 Added: usocket/tags/0.3.7/ - copied from r355, usocket/branches/0.3.x/ Modified: usocket/tags/0.3.7/usocket.asd Log: Create 0.3.7 tag. Modified: usocket/tags/0.3.7/usocket.asd ============================================================================== --- usocket/branches/0.3.x/usocket.asd (original) +++ usocket/tags/0.3.7/usocket.asd Sat Jun 28 06:12:13 2008 @@ -14,7 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" - :version "0.3.5-dev" + :version "0.3.7" :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence

1 0