trivial-sockets is a trivial networking library for undemanding Internet applications (for example "scripting" and interactive use). In version 0.2 it has support for Armed Bear Lisp (client only), Allegro CL, CLISP, CMUCL, Xanalys Lispworks, OpenMCL and SBCL
@deffn {Function} open-stream peer-host peer-port &key (local-host :any) (local-port 0) (external-format :default) (element-type 'character) (protocol :tcp)
@deffn {Function} open-server &key (host :any) (port 0) (reuse-address t) (backlog 1) (protocol :tcp)
@deffn {Function} close-server server
@deffn {Macro} with-server server args &body forms
@deffn {Function} accept-connection server &key (external-format :default) (element-type 'character)
Download ASDF package from http://common-lisp.net/project/usocket/releases/old/trivial-sockets.tar.gz
I had to (setf asdf-install:*cclan-mirror* "http://www-jcsu.jesus.cam.ac.uk/ftp/pub/cclan/") to install trivial-sockets. -- Lars Brinkhoff
You can also get the latest from darcs
:; darcs get http://verisons.telent.net/trivial-sockets/or browse to http://verisons.telent.net/cgi-bin/darcs.cgi
There's a bug in the SBCL implementation (at least) - you can't connect to hosts which have four character hostnames, since (typep "abcd" '(vector * 4)) is true, so resolve-hostname assumes the hostname is an ip address :S
CMUCL diff to allow buffering choice in accept-connection
--- cmucl.lisp.~1~ 2005-06-13 08:20:31.000000000 -0700
+++ cmucl.lisp 2005-07-06 14:07:23.000000000 -0700
@@ -56,7 +56,8 @@
(defun accept-connection (socket
&key
(external-format :default)
- (element-type 'character))
+ (element-type 'character)
+ (buffering :full)) ; (member :full :line :none)
(unless (eql external-format :default)
(error 'unsupported :feature :external-format))
(handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
@@ -67,6 +68,6 @@
:input t :output t
:element-type element-type
:auto-close t
- :buffering :full
+ :buffering buffering
:name (pretty-stream-name peer-host peer-port))))))
And another for UDP
--- cmucl.lisp.ORIG 2005-08-11 22:55:12.418061000 +0200
+++ cmucl.lisp 2005-08-11 22:48:11.295204000 +0200
@@ -19,12 +19,15 @@
(error 'unsupported :feature :external-format))
(unless (and (eql local-host :any) (eql local-port 0))
(error 'unsupported :feature :bind))
- (unless (eql protocol :tcp)
+ (unless (member protocol '(:tcp :udp))
(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)))
+ (resolve-hostname peer-host) peer-port
+ (case protocol
+ (:tcp :stream)
+ (:udp :datagram)))))
(sys:make-fd-stream s :input t :output t :element-type element-type
:buffering buffering
:name (pretty-stream-name peer-host peer-port)))))
@@ -34,15 +37,19 @@
(backlog 1)
(protocol :tcp))
"Returns a SERVER object and the port that was bound, as multiple values"
- (unless (eql protocol :tcp)
+ (unless (member protocol '(:tcp :udp))
(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
+ (ext:create-inet-listener port (case protocol
+ (:tcp :stream)
+ (:udp :datagram))
:reuse-address reuse-address
:backlog backlog)
- (ext:create-inet-listener port :stream
+ (ext:create-inet-listener port (case protocol
+ (:tcp :stream)
+ (:udp :datagram))
:reuse-address reuse-address
:backlog backlog
:host host))))
Unfortunately I didn't see that it was unmaintained until I already started on a port to MCL. So here it is. -- Lennart Staflin
[port to MCL
lenst@lysator.liu.se**20070427075328
This is a port to MCL 5.0 using the opentransport library.
Unfortunately opentransport has a different way of dealing with
passive (server) side. The semantics of open-server and
accept-connection is therefor not quite right. It won't actually start
listening until the first accept-connection.
] {
addfile ./mcl.lisp
hunk ./mcl.lisp 1
+(in-package :trivial-sockets)
+
+
+(require "OPENTRANSPORT")
+
+
+(defclass MCL-LISTENER-SOCKET ()
+ ((port :initarg :port :accessor mcl-listener-port)
+ (stream :initform nil :accessor listener-stream)
+ (reuse-address :initarg :reuse-address :accessor reuse-address)))
+
+
+(defun open-stream (peer-host peer-port
+ &key (local-host :any) (local-port 0)
+ (external-format :default)
+ (element-type 'base-character)
+ (protocol :tcp))
+ (unless (eql protocol :tcp)
+ (error 'unsupported :feature `(:protocol ,protocol)))
+ (unless (eql external-format :default)
+ (error 'unsupported :feature :external-format))
+ (unless (eql local-host :any)
+ (error 'unsupported :feature :local-host))
+ (unless (eql local-port 0)
+ (error 'unsupported :feature :local-port))
+ (handler-bind ((error
+ (lambda (c) (error 'socket-error :nested-error c))))
+ (ccl::open-tcp-stream peer-host peer-port :element-type element-type
+ :connect-timeout 60)))
+
+
+(defun open-server (&key (host :any) (port 0)
+ (reuse-address t)
+ (backlog 1)
+ (protocol :tcp))
+ "Returns a SERVER object"
+ (declare (ignore backlog))
+ (unless (eql protocol :tcp)
+ (error 'unsupported :feature `(:protocol ,protocol)))
+ (unless (eql host :any)
+ (error 'unsupported :feature :host))
+ (when (eql port 0)
+ (error 'unsupported :feature `(:port 0)))
+ (let ((listener (make-instance 'mcl-listener-socket :port port :reuse-address reuse-address)))
+ ;;(accept-connection listener)
+ listener))
+
+
+(defun close-server (server)
+ (when (listener-stream server)
+ (close (listener-stream server))))
+
+
+(defun accept-connection (server
+ &key
+ (external-format :default)
+ (element-type 'base-character))
+ (unless (eql external-format :default)
+ (error 'unsupported :feature :external-format))
+ (do ((s (listener-stream server))
+ (new nil))
+ (new new)
+ (when s
+ (flet ((ready-p (s)
+ (not (eql (ccl::opentransport-stream-connection-state s) :unbnd))))
+ (unless (ready-p s)
+ (ccl:process-wait "waiting" #'ready-p s))))
+
+ (let ((state (and s (ccl::opentransport-stream-connection-state s))))
+ (when (member state '(:incon :dataxfer))
+ (setq new s
+ state nil))
+ (when (member state '(nil :uninit :closed))
+ (or (mcl-listener-port server)
+ (error "MCL OpenTransport needs explicit port number for listener stream"))
+ (setq s (setf (listener-stream server)
+ (ccl::open-tcp-stream nil (mcl-listener-port server)
+ :element-type element-type
+ :reuse-local-port-p (reuse-address server))))))))
+
hunk ./trivial-sockets.asd 16
+ #+Digitool "mcl"
}
This page is linked from: Categorized Libraries Current recommended libraries Steeldump trivial trivial-usocket USOCKET
CLiki pages can be edited by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively