[usocket-cvs] r364 - trivial-sockets
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sun Jul 13 18:16:20 UTC 2008
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 , at arguments))
+ (locally
+ , at 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 -*-
+ at c %**start of header
+ at setfilename trivial-sockets.info
+ at settitle TRIVIAL-SOCKETS Manual
+ at c %**end of header
+
+ at c merge type index into function index
+ at syncodeindex tp fn
+ at c ... and concept index, too.
+ at synindex cp fn
+
+ at c for install-info
+ at dircategory Software development
+ at direntry
+* trivial-sockets: (trivial-sockets). CL socket interface for scripting/interactive use
+ at end direntry
+
+ at 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.
+
+ at end copying
+
+
+
+ at titlepage
+ at title TRIVIAL-SOCKETS
+
+ at c The following two commands start the copyright page.
+ at page
+ at vskip 0pt plus 1filll
+ at insertcopying
+ at end titlepage
+
+ at c Output the table of contents at the beginning.
+ at contents
+
+ at c -------------------
+
+ at ifnottex
+
+ at node Top
+ at top TRIVIAL-SOCKETS: a socket interface for scripting and interactive use
+
+ at insertcopying
+
+ at menu
+* Introduction:: Design goals and target audience
+* Installation:: How to download and install
+* API::
+* Index::
+ at end menu
+
+ at end ifnottex
+
+ at c -------------------
+
+ at node Introduction
+ at 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.
+
+ at node Installation
+ at chapter Installation
+ at 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
+
+ at lisp
+(asdf-install:install 'trivial-sockets)
+ at 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
+
+ at lisp
+(asdf:operate 'asdf:load-op 'trivial-sockets)
+ at end lisp
+
+or if you have an asdf system that uses it, add
+ at code{trivial-sockets} to the @code{:depends-on} clause of that system
+and it will be loaded whenever your system is.
+
+ at chapter API
+ at node API
+
+ at section Types
+ at cindex{Host designator}
+ at cindex{IP address}
+ at cindex{Address}
+ at cindex{Protocol}
+
+A @emph{host designator} is one of the following:
+
+ at enumerate
+ at 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"}
+
+ at item An IPv4 address in "dotted quad" notation: e.g. @code{"127.0.0.1"}
+
+ at 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}
+
+ at item The keyword @code{:ANY}, which corresponds to INADDR_ANY or "0.0.0.0"
+ at end enumerate
+
+A @emph{protocol specifier} is a keyword naming an
+ at 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
+ at code{:TCP} at a minimum.
+
+ at section Functions
+
+ at anchor{Function open-stream}
+ at defun open-stream peer-host peer-port &key local-host local-port external-format element-type protocol
+ at result{} stream
+
+ at strong{Arguments and Values:}
+
+ at var{peer-host}--a host designator.
+
+ at var{peer-port}--an integer.
+
+ at var{local-host}--a host designator. The default is @code{:any}.
+
+ at var{local-port}--an integer. The default is @code{0}.
+
+ at var{external-format}--an external file format designator. The default
+is @code{:default}.
+
+ at var{element-type}--a type specifier; see the Common Lisp function
+ at code{open} for valid values. The default is @code{'character}.
+
+ at var{protocol}--a protocol specifier. The default is @code{:tcp}.
+
+ at 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
+ at 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}
+ at end defun
+
+ at anchor{Function open-server}
+ at defun open-server &key host port reuse-address backlog protocol
+ at result{} server socket
+
+ at strong{Arguments and Values:}
+
+ at var{host}--a host designator. The default is @code{:any}.
+
+ at var{port}--an integer. The default is @code{0}.
+
+ at var{reuse-address}-- at code{t} or @code{nil}. The default is @code{t}.
+
+ at var{backlog}--an integer. The default is @code{1}.
+
+ at var{protocol}--a protocol specifier. The default is @code{:tcp}.
+
+ at 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.
+
+ at 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
+ at 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
+ at code{close-server}.
+
+ at xref{Macro with-server}.
+ at end defun
+
+ at c <3dqes6$e49 at bosnia.pop.psu.edu> or see 242-246 of
+ at c "TCP/IP Illustrated, Volume 1"
+
+ at anchor{Function close-server}
+ at defun close-server server
+ at result{} result
+
+ at strong{Arguments and Values:}
+
+ at var{server}--a server socket.
+
+ at var{result}--implementation-dependent.
+
+ at 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
+ at code{:reuse-address} argument.
+ at end defun
+
+ at anchor{Macro with-server}
+ at defmac with-server (server args) declaration* form*
+ at result{} results
+
+ at strong{Arguments and Values:}
+
+ at var{server}--a variable.
+
+ at var{args}--a list of arguments.
+
+ at var{declaration}--a declare expression.
+
+ at var{forms}--an implicit @code{progn}.
+
+ at var{results}--the values returned by the @var{forms}.
+
+ at strong{Description:}
+
+ at code{with-server} uses @code{open-server} to create a server socket
+named by @var{server}. @var{Args} are used as keyword arguments to
+ at code{open-server}.
+
+ at code{with-server} evaluates the @var{forms} as an implicit progn with
+ at 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.
+ at end defmac
+
+ at anchor{Function accept-connection}
+ at defun accept-connection server &key external-format element-type
+ at result{} stream
+
+ at strong{Arguments and Values:}
+
+ at var{server}--a server socket.
+
+ at var{external-format}--an external file format designator. The default
+is @code{:default}.
+
+ at var{element-type}--a type specifier; see the Common Lisp function
+ at code{open} for valid values. The default is @code{'character}.
+
+ at 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.
+ at end defun
+
+ at section Examples
+
+ at subsection Simple client
+
+ at 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))))
+ at end lisp
+
+ at subsection Simple (single-threaded) server
+
+ at 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~%"))))
+ at end lisp
+
+
+ at section Errors
+
+ at anchor{Condition unsupported}
+ at 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.
+ at end deftp
+
+ at anchor{Condition socket-error}
+ at 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
+
+ at lisp
+(socket-nested-error condition)
+ at end lisp
+
+ at end deftp
+
+ at chapter Implementation-dependent
+ at 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.
+
+ at itemize
+
+ at item Armed Bear CL currently supports only client sockets, and only
+for TCP, with unspecified local endpoint, and with the default
+external-format.
+
+ at 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
+ at code{:element-type}.
+
+ at 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).
+
+ at item CMUCL has no support for external-formats other than
+ at code{:default}, for protocols that are not @code{:tcp}, or for
+binding the local address/port.
+
+ at 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,
+ at 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.
+
+ at 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}.
+
+ at 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
+ at code{socket-error}.
+
+ at 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.
+
+ at c -------------------
+
+
+ at node Index,
+ at unnumbered Index
+
+ at printindex fn
+
+ at bye
+
More information about the usocket-cvs
mailing list