Author: ehuelsmann Date: Fri Jan 27 17:05:41 2006 New Revision: 1
Added: public_html/ public_html/index.shtml public_html/project-name public_html/style.css usocket/ usocket/branches/ usocket/tags/ usocket/trunk/ (props changed) usocket/trunk/LICENSE usocket/trunk/Makefile usocket/trunk/README usocket/trunk/backend/ (props changed) usocket/trunk/backend/allegro.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/condition.lisp usocket/trunk/doc/ usocket/trunk/doc/allegro-socket.txt usocket/trunk/doc/clisp-sockets.txt usocket/trunk/doc/cmucl-sockets.txt usocket/trunk/doc/errors.txt usocket/trunk/doc/lw-sockets.txt usocket/trunk/doc/openmcl-sockets.txt usocket/trunk/doc/sb-bsd-sockets.txt usocket/trunk/doc/usock-sockets.txt usocket/trunk/package.lisp usocket/trunk/test/ (props changed) usocket/trunk/test/package.lisp usocket/trunk/test/test-usocket.lisp usocket/trunk/test/usocket-test.asd usocket/trunk/usocket.asd usocket/trunk/usocket.lisp Log: Initial import as copied off Erik Enge's home dir.
Added: public_html/index.shtml ============================================================================== --- (empty file) +++ public_html/index.shtml Fri Jan 27 17:05:41 2006 @@ -0,0 +1,25 @@ +<?xml version="1.0"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> +<head> + <title><!--#include virtual="project-name" --></title> + <link rel="stylesheet" type="text/css" href="style.css"/> + <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> +</head> + +<body> + <div class="header"> + <h1><!--#include virtual="project-name" --></h1> + </div> + + <p><em>This is an automatically generated placeholder page: this project + has not yet created a website.</em></p> + + <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p> + + <div class="check"> + <a href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a> + </div> +</body> +</html>
Added: public_html/project-name ============================================================================== --- (empty file) +++ public_html/project-name Fri Jan 27 17:05:41 2006 @@ -0,0 +1 @@ +usocket
Added: public_html/style.css ============================================================================== --- (empty file) +++ public_html/style.css Fri Jan 27 17:05:41 2006 @@ -0,0 +1,54 @@ + +.header { + font-size: medium; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 5px; + border-color:#002244; + padding: 1mm 1mm 1mm 5mm; +} + +.footer { + font-size: small; + font-style: italic; + text-align: right; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 2px; + border-color:#002244; + padding: 1mm 1mm 1mm 1mm; +} + +.footer a:link { + font-weight:bold; + color:#ffffff; + text-decoration:underline; +} + +.footer a:visited { + font-weight:bold; + color:#ffffff; + text-decoration:underline; +} + +.footer a:hover { + font-weight:bold; + color:#002244; + text-decoration:underline; } + +.check {font-size: x-small; + text-align:right;} + +.check a:link { font-weight:bold; + color:#a0a0ff; + text-decoration:underline; } + +.check a:visited { font-weight:bold; + color:#a0a0ff; + text-decoration:underline; } + +.check a:hover { font-weight:bold; + color:#000000; + text-decoration:underline; }
Added: usocket/trunk/LICENSE ============================================================================== --- (empty file) +++ usocket/trunk/LICENSE Fri Jan 27 17:05:41 2006 @@ -0,0 +1,23 @@ +(This is the MIT / X Consortium license as taken from + http://www.opensource.org/licenses/mit-license.html) + +Copyright (c) 2003 Erik Enge + +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.
Added: usocket/trunk/Makefile ============================================================================== --- (empty file) +++ usocket/trunk/Makefile Fri Jan 27 17:05:41 2006 @@ -0,0 +1,9 @@ +# $Id$ +# $Source$ + +clean: + find -name -o -name "*~" -o -name "*.err" -o -name "*.x86f" -o -name "*.lib" -o -name "*.fas" -o -name "*.fasl" -o -name "*.faslmt" -o -name "*.ufsl" | xargs rm + +commit: + make clean; cvs up; cvs ci +
Added: usocket/trunk/README ============================================================================== --- (empty file) +++ usocket/trunk/README Fri Jan 27 17:05:41 2006 @@ -0,0 +1,17 @@ + +;; the backends must implement +;; +;; - handle-condition +;; - open +;; - close +;; - listen +;; - accept +;; - read-line +;; - write-sequence +;; - get-host-by-address +;; - get-host-by-name +;; +;; the backend must wrap all calls to its socket functions in a +;; handler-case/bind to make sure handle-condition is called. + +;; open should take either the hostname or an vectorized ip \ No newline at end of file
Added: usocket/trunk/backend/allegro.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/allegro.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,34 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +(defun handle-condition (condition &optional (socket nil)) + "Dispatch correct usocket condition." + (typecase condition + (condition (error 'usocket-error + :real-condition condition + :socket socket)))) + +(defun open (host port &optional (type :stream)) + (declare (ignore type)) + (make-socket :socket (sock:make-socket :remote-host host + :remote-port port))) + +(defmethod close ((socket socket)) + "Close socket." + (sock:close (real-socket socket))) + +(defmethod read-line ((socket socket)) + (cl:read-line (real-socket socket))) + +(defmethod write-sequence ((socket socket) sequence) + (cl:write-sequence sequence (real-socket socket))) + +(defun get-host-by-address (address) + (sock:lookup-host address)) + +(defun get-host-by-name (name) + (sock:lookup-host name))
Added: usocket/trunk/backend/clisp.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/clisp.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,40 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +(defun handle-condition (condition &optional (socket nil)) + "Dispatch correct usocket condition." + (typecase condition + (condition (error 'usocket-error + :real-condition condition + :socket socket)))) + +(defun open (host port &optional (type :stream)) + (declare (ignore type)) + (make-socket :socket (socket:socket-connect port host) + :host host + :port port)) + +(defmethod close ((socket socket)) + "Close socket." + (socket:socket-server-close (real-socket socket))) + +(defmethod read-line ((socket socket)) + (cl:read-line (real-socket socket))) + +(defmethod write-sequence ((socket socket) sequence) + (cl:write-sequence sequence (real-socket socket))) + +(defun get-host-by-address (address) + (handler-case (posix:hostent-name + (posix:resolve-host-ipaddr (vector-quad-to-dotted-quad address))) + (condition (condition) (handle-condition condition)))) + +(defun get-host-by-name (name) + (handler-case (mapcar #'dotted-quad-to-vector-quad + (posix:hostent-addr-list (posix:resolve-host-ipaddr name))) + (condition (condition) (handle-condition condition)))) +
Added: usocket/trunk/backend/cmucl.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/cmucl.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,41 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +(defun handle-condition (condition &optional (socket nil)) + "Dispatch correct usocket condition." + (typecase condition + (condition (error 'usocket-error + :real-condition condition + :socket socket)))) + +(defun open (host port &optional (type :stream)) + (let* ((socket (ext:connect-to-inet-socket (host-byte-order host) port type)) + (stream (sys:make-fd-stream socket :input t :output t :element-type 'character)) + (usocket (make-socket :socket socket :host host :port port :stream stream))) + usocket)) + +(defmethod close ((socket socket)) + "Close socket." + (ext:close-socket (real-socket socket))) + +(defmethod read-line ((socket socket)) + (cl:read-line (real-stream socket))) + +(defmethod write-sequence ((socket socket) sequence) + (cl:write-sequence sequence (real-stream socket))) + +(defun get-host-by-address (address) + (handler-case (ext:host-entry-name + (ext::lookup-host-entry (host-byte-order address))) + (condition (condition) (handle-condition condition)))) + +(defun get-host-by-name (name) + (handler-case (mapcar #'hbo-to-vector-quad + (ext:host-entry-addr-list + (ext:lookup-host-entry name))) + (condition (condition) (handle-condition condition)))) +
Added: usocket/trunk/backend/lispworks.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/lispworks.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,37 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +(defun handle-condition (condition &optional (socket nil)) + "Dispatch correct usocket condition." + (typecase condition + (condition (error 'usocket-error + :real-condition condition + :socket socket)))) + +(defun open (host port &optional (type :stream)) + (declare (ignore type)) + (make-socket :socket (comm:open-tcp-stream host port) + :host host + :port port)) + +(defmethod close ((socket socket)) + "Close socket." + (cl:close (real-socket socket))) + +(defmethod read-line ((socket socket)) + (cl:read-line (real-socket socket))) + +(defmethod write-sequence ((socket socket) sequence) + (cl:write-sequence sequence (real-socket socket))) + +(defun get-host-by-address (address) + (comm:get-host-entry (vector-quad-to-dotted-quad address) + :fields '(:name))) + +(defun get-host-by-name (name) + (mapcar #'hbo-to-vector-quad + (comm:get-host-entry name :fields '(:addresses))))
Added: usocket/trunk/backend/sbcl.lisp ============================================================================== --- (empty file) +++ usocket/trunk/backend/sbcl.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,48 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +(defun handle-condition (condition &optional (socket nil)) + "Dispatch correct usocket condition." + (typecase condition + (condition (error 'usocket-error + :real-condition condition + :socket socket)))) + +(defun open (host port &optional (type :stream)) + "Connect to `host' on `port'. `host' is assumed to be a string of +an IP address represented in vector notation, such as #(192 168 1 1). +`port' is assumed to be an integer. + +Returns a socket object." + (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket :type type :protocol :tcp)) + (stream (sb-bsd-sockets:socket-make-stream socket)) + (usocket (make-socket :socket socket :host host :port port :stream stream))) + (handler-case (sb-bsd-sockets:socket-connect socket host port) + (condition (condition) (handle-condition condition usocket))) + usocket)) + +(defmethod close ((socket socket)) + "Close socket." + (handler-case (sb-bsd-sockets:socket-close (real-socket socket)) + (condition (condition) (handle-condition condition socket)))) + +(defmethod read-line ((socket socket)) + (cl:read-line (real-stream socket))) + +(defmethod write-sequence ((socket socket) sequence) + (cl:write-sequence sequence (real-stream socket))) + +(defun get-host-by-address (address) + (handler-case (sb-bsd-sockets::host-ent-name + (sb-bsd-sockets:get-host-by-address address)) + (condition (condition) (handle-condition condition)))) + +(defun get-host-by-name (name) + (handler-case (sb-bsd-sockets::host-ent-addresses + (sb-bsd-sockets:get-host-by-name name)) + (condition (condition) (handle-condition condition)))) +
Added: usocket/trunk/condition.lisp ============================================================================== --- (empty file) +++ usocket/trunk/condition.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,18 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +(define-condition usocket-error (error) + ((real-condition + :reader real-condition + :initarg :real-condition) + (socket + :reader socket + :initarg :socket)) + (:report (lambda (c stream) + (format stream "Error (~A) occured in socket: ~A." + (real-condition c) (socket c))))) +
Added: usocket/trunk/doc/allegro-socket.txt ============================================================================== --- (empty file) +++ usocket/trunk/doc/allegro-socket.txt Fri Jan 27 17:05:41 2006 @@ -0,0 +1,46 @@ + + +(require :sock) + +accept-connection (sock passive-socket) &key wait Generic function. +dotted-to-ipaddr dotted &key errorp Function. +ipaddr-to-dotted ipaddr &key values Function. +ipaddr-to-hostname ipaddr Function. +lookup-hostname hostname +lookup-port portname protocol Function. +make-socket &key type format address-family connect &allow-other-keys Function. +with-pending-connect &body body Macro. +receive-from (sock datagram-socket) size &key buffer extract Generic function. +send-to sock &key +shutdown sock &key direction +socket-control stream &key output-chunking output-chunking-eof input-chunking +socket-os-fd sock Generic function. + +remote-host socket Generic function. +local-host socket Generic function. +local-port socket + +remote-filename socket +local-filename socket +remote-port socket +socket-address-family socket +socket-connect socket +socket-format socket +socket-type socket + +errors + +:address-in-use Local socket address already in use +:address-not-available Local socket address not available +:network-down Network is down +:network-reset Network has been reset +:connection-aborted Connection aborted +:connection-reset Connection reset by peer +:no-buffer-space No buffer space +:shutdown Connection shut down +:connection-timed-out Connection timed out +:connection-refused Connection refused +:host-down Host is down +:host-unreachable Host is unreachable +:unknown Unknown error +
Added: usocket/trunk/doc/clisp-sockets.txt ============================================================================== --- (empty file) +++ usocket/trunk/doc/clisp-sockets.txt Fri Jan 27 17:05:41 2006 @@ -0,0 +1,16 @@ +http://clisp.cons.org/impnotes.html#socket + +(SOCKET:SOCKET-SERVER &OPTIONAL [port-or-socket]) +(SOCKET:SOCKET-SERVER-HOST socket-server) +(SOCKET:SOCKET-SERVER-PORT socket-server) +(SOCKET:SOCKET-WAIT socket-server &OPTIONAL [seconds [microseconds]]) +(SOCKET:SOCKET-ACCEPT socket-server &KEY :ELEMENT-TYPE :EXTERNAL-FORMAT :BUFFERED :TIMEOUT) +(SOCKET:SOCKET-CONNECT port &OPTIONAL [host] &KEY :ELEMENT-TYPE :EXTERNAL-FORMAT :BUFFERED :TIMEOUT) +(SOCKET:SOCKET-STATUS socket-stream-or-list &OPTIONAL [seconds [microseconds]]) +(SOCKET:SOCKET-STREAM-HOST socket-stream) +(SOCKET:SOCKET-STREAM-PORT socket-stream) +(SOCKET:SOCKET-SERVICE-PORT &OPTIONAL service-name (protocol "tcp")) +(SOCKET:SOCKET-STREAM-PEER socket-stream [do-not-resolve-p]) +(SOCKET:SOCKET-STREAM-LOCAL socket-stream [do-not-resolve-p]) +(SOCKET:SOCKET-STREAM-SHUTDOWN socket-stream direction) +(SOCKET:SOCKET-OPTIONS socket-server &REST {option}*)
Added: usocket/trunk/doc/cmucl-sockets.txt ============================================================================== --- (empty file) +++ usocket/trunk/doc/cmucl-sockets.txt Fri Jan 27 17:05:41 2006 @@ -0,0 +1,56 @@ +http://cvs2.cons.org/ftp-area/cmucl/doc/cmu-user/internet.html + +extensions:lookup-host-entry host + +[structure] +host-entry + + name aliases addr-type addr-list + +[Function] +extensions:ip-string addr + +[Function] +extensions:create-inet-listener port &optional kind &key :reuse-address :backlog :interface + +[Function] +extensions:create-unix-listener path &optional kind :reuse-address :backlog + +[Function] +extensions:accept-tcp-connection unconnected + +[Function] +extensions:accept-unix-connection unconnected + +[Function] +extensions:connect-to-inet-socket host port &optional kind + +[Function] +extensions:connect-to-unix-socket path &optional kind + +[Function] +extensions:add-oob-handler fd char handler + +[Function] +extensions:remove-oob-handler fd char + +[Function] +extensions:remove-all-oob-handlers fd + +[Function] +extensions:send-character-out-of-band fd char + +[Function] +extensions:create-unix-socket &optional type + +[Function] +extensions:create-inet-socket &optional type + +[Function] +extensions:get-socket-option socket level optname + +[Function] +extensions:set-socket-option socket level optname optval + +[Function] +extensions:close-socket socket
Added: usocket/trunk/doc/errors.txt ============================================================================== --- (empty file) +++ usocket/trunk/doc/errors.txt Fri Jan 27 17:05:41 2006 @@ -0,0 +1,13 @@ +EADDRINUSE address-in-use-error +EAGAIN interrupted-error +EBADF bad-file-descriptor-error +ECONNREFUSED connection-refused-error +EINTR interrupted-error +EINVAL invalid-argument-error +ENOBUFS no-buffers-error +ENOMEM out-of-memory-error +EOPNOTSUPP operation-not-supported-error +EPERM operation-not-permitted-error +EPROTONOSUPPORT protocol-not-supported-error +ESOCKTNOSUPPORT socket-type-not-supported-error +ENETUNREACH network-unreachable-error
Added: usocket/trunk/doc/lw-sockets.txt ============================================================================== --- (empty file) +++ usocket/trunk/doc/lw-sockets.txt Fri Jan 27 17:05:41 2006 @@ -0,0 +1,16 @@ +http://www.lispworks.com/reference/lwu41/lwref/LWRM_37.HTM + +Package: COMM + +get-host-entry +get-socket-address +get-socket-peer-address +ip-address-string +open-tcp-stream +socket-stream-address +socket-stream-peer-address +start-up-server +start-up-server-and-mp +socket-stream +string-ip-address +with-noticed-socket-stream
Added: usocket/trunk/doc/openmcl-sockets.txt ============================================================================== --- (empty file) +++ usocket/trunk/doc/openmcl-sockets.txt Fri Jan 27 17:05:41 2006 @@ -0,0 +1,27 @@ +http://openmcl.clozure.com/Doc/sockets.html + + make-socket [Function] + accept-connection [Function] + dotted-to-ipaddr [Function] + ipaddr-to-dotted [Function] + ipaddr-to-hostname [Function] + lookup-hostname [Function] + lookup-port [Function] + receive-from [Function] + send-to [Function] + shutdown [Function] + socket-os-fd [Function] + remote-port [Function] + local-host [Function] + local-port [Function] + + socket-address-family [Function] + + socket-connect [Function] + socket-format [Function] + socket-type [Function] + socket-error [Class] + socket-error-code [Function] + socket-error-identifier [Function] + socket-error-situation [Function] + close [method]
Added: usocket/trunk/doc/sb-bsd-sockets.txt ============================================================================== --- (empty file) +++ usocket/trunk/doc/sb-bsd-sockets.txt Fri Jan 27 17:05:41 2006 @@ -0,0 +1,86 @@ +http://www.xach.com/sbcl/sb-bsd-sockets.html + +package: sb-bsd-sockets + +class: socket + +slots: + + * file-descriptor : + * family : + * protocol : + * type : + * stream : + +operators: + + (socket-bind (s socket) &rest address) Generic Function + (socket-accept (socket socket)) Method + (socket-connect (s socket) &rest address) Generic Function + (socket-peername (socket socket)) Method + (socket-name (socket socket)) Method + (socket-receive (socket socket) buffer length &key oob peek waitall (element-type 'character)) Method + (socket-listen (socket socket) backlog) Method + (socket-close (socket socket)) Method + (socket-make-stream (socket socket) &rest args) Method + + (sockopt-reuse-address (socket socket) argument) Accessor + (sockopt-keep-alive (socket socket) argument) Accessor + (sockopt-oob-inline (socket socket) argument) Accessor + (sockopt-bsd-compatible (socket socket) argument) Accessor + (sockopt-pass-credentials (socket socket) argument) Accessor + (sockopt-debug (socket socket) argument) Accessor + (sockopt-dont-route (socket socket) argument) Accessor + (sockopt-broadcast (socket socket) argument) Accessor + (sockopt-tcp-nodelay (socket socket) argument) Accessor + +inet-domain sockets + +class: inet-socket + +slots: + + * family : + +operators: + + (make-inet-address dotted-quads) Function + (get-protocol-by-name name) Function + (make-inet-socket type protocol) Function + +file-domain sockets + +class: unix-socket + +slots: + + * family : + +class: host-ent + +Slots: + + * name : + * aliases : + * address-type : + * addresses : + + (host-ent-address (host-ent host-ent)) Method + (get-host-by-name host-name) Function + (get-host-by-address address) Function + (name-service-error where) Function + (non-blocking-mode (socket socket)) Method + +(define-socket-condition sockint::EADDRINUSE address-in-use-error) +(define-socket-condition sockint::EAGAIN interrupted-error) +(define-socket-condition sockint::EBADF bad-file-descriptor-error) +(define-socket-condition sockint::ECONNREFUSED connection-refused-error) +(define-socket-condition sockint::EINTR interrupted-error) +(define-socket-condition sockint::EINVAL invalid-argument-error) +(define-socket-condition sockint::ENOBUFS no-buffers-error) +(define-socket-condition sockint::ENOMEM out-of-memory-error) +(define-socket-condition sockint::EOPNOTSUPP operation-not-supported-error) +(define-socket-condition sockint::EPERM operation-not-permitted-error) +(define-socket-condition sockint::EPROTONOSUPPORT protocol-not-supported-error) +(define-socket-condition sockint::ESOCKTNOSUPPORT socket-type-not-supported-error) +(define-socket-condition sockint::ENETUNREACH network-unreachable-error)
Added: usocket/trunk/doc/usock-sockets.txt ============================================================================== --- (empty file) +++ usocket/trunk/doc/usock-sockets.txt Fri Jan 27 17:05:41 2006 @@ -0,0 +1,28 @@ +Package: + + clisp : socket + cmucl : extensions + sbcl : sb-bsd-sockets + lw : comm + openmcl: openmcl-socket + allegro: sock + +Connecting (TCP/inet only) + + clisp : socket-connect port &optional [host] &key :element-type :external-format :buffered :timeout = > socket-stream + cmucl : connect-to-inet-socket host port &optional kind => file descriptor + sbcl : sb-socket-connect socket &rest address => socket + lw : open-tcp-stream hostname service &key direction element-type buffered => stream-object + openmcl: socket-connect socket => :active, :passive or nil + allegro: make-socket (&rest args &key type format connect address-family eol) => socket + +Closing + + clisp : close socket + cmucl : close-socket socket + sbcl : socket-close socket + lw : close socket + openmcl: close socket + allegro: close socket + +Errors \ No newline at end of file
Added: usocket/trunk/package.lisp ============================================================================== --- (empty file) +++ usocket/trunk/package.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,31 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See the LICENSE file for licensing information. + +(in-package :cl-user) + +#+lispworks (require "comm") + +(eval-when (:execute :load-toplevel :compile-toplevel) + (defpackage :usocket + (:use :cl) + (:nicknames :usoc) + (:shadowing-import-from "COMMON-LISP" :close + :open + :read-line + :write-sequence) + (:export :open ; socket related operations + :make-socket + :close + :read-line + :write-sequence + :socket ; socket object and accessors + :host + :port + :get-host-by-address ; name services + :get-host-by-name + :host-byte-order ; utility operators + :usocket-error ; conditions + :no-route-to-host))) +
Added: usocket/trunk/test/package.lisp ============================================================================== --- (empty file) +++ usocket/trunk/test/package.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,13 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See the LICENSE file for licensing information. + +(in-package :cl-user) + +(eval-when (:execute :load-toplevel :compile-toplevel) + (defpackage :usocket-test + (:use :cl :rt) + (:nicknames :usoct) + (:export :do-tests))) +
Added: usocket/trunk/test/test-usocket.lisp ============================================================================== --- (empty file) +++ usocket/trunk/test/test-usocket.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,17 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket-test) + +(defvar *soc1* (usoc:make-socket :socket :stream + :host #(1 2 3 4) + :port 80 + :stream :my-stream)) + +(deftest make-socket.1 (usoc::real-socket usoct::*soc1*) :my-socket) +(deftest make-socket.2 (usoc::real-stream usoct::*soc1*) :my-stream) +(deftest make-socket.3 (usoc:host usoct::*soc1*) #(1 2 3 4)) +(deftest make-socket.4 (usoc:host usoct::*soc1*) 80) +
Added: usocket/trunk/test/usocket-test.asd ============================================================================== --- (empty file) +++ usocket/trunk/test/usocket-test.asd Fri Jan 27 17:05:41 2006 @@ -0,0 +1,22 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See the LICENSE file for licensing information. + +(in-package #:cl-user) + +(defpackage #:usocket-test-system + (:use #:cl #:asdf)) + +(in-package #:usocket-test-system) + +(defsystem usocket-test + :name "usocket-test" + :author "Erik Enge" + :version "0.1.0" + :licence "MIT" + :description "Tests for usocket" + :depends-on (:usocket :rt) + :components ((:file "package") + (:file "test-usocket" + :depends-on ("package"))))
Added: usocket/trunk/usocket.asd ============================================================================== --- (empty file) +++ usocket/trunk/usocket.asd Fri Jan 27 17:05:41 2006 @@ -0,0 +1,39 @@ + +;;;; $Id$ +;;;; $Source$ + +;;;; See the LICENSE file for licensing information. + +(in-package #:cl-user) + +(defpackage #:usocket-system + (:use #:cl #:asdf)) + +(in-package #:usocket-system) + +(defsystem usocket + :name "usocket" + :author "Erik Enge" + :version "0.1.0" + :licence "MIT" + :description "Universal socket library for Common Lisp" + :depends-on #+sbcl (:sb-bsd-sockets :split-sequence) + #-sbcl (:split-sequence) + :components ((:file "package") + (:file "usocket" + :depends-on ("package")) + (:file "condition" + :depends-on ("usocket")) + #+clisp (:file "clisp" :pathname "backend/clisp" + :depends-on ("condition")) + #+cmu (:file "cmucl" :pathname "backend/cmucl" + :depends-on ("condition")) + #+sbcl (:file "sbcl" :pathname "backend/sbcl" + :depends-on ("condition")) + #+lispworks (:file "lispworks" :pathname "backend/lispworks" + :depends-on ("condition")) + #+openmcl (:file "openmcl" :pathname "backend/openmcl" + :depends-on ("condition")) + #+allegro (:file "allegro" :pathname "backend/allegro" + :depends-on ("condition")) + ))
Added: usocket/trunk/usocket.lisp ============================================================================== --- (empty file) +++ usocket/trunk/usocket.lisp Fri Jan 27 17:05:41 2006 @@ -0,0 +1,79 @@ +;;;; $Id$ +;;;; $Source$ + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +(defclass socket () + ((real-socket + :initarg :real-socket + :accessor real-socket) + (real-stream + :initarg :real-stream + :accessor real-stream) + (host + :initarg :host + :accessor host) + (port + :initarg :port + :accessor port))) + +(defun make-socket (&key socket host port (stream nil)) + (make-instance 'socket + :real-socket socket + :host host + :port port + :real-stream stream)) + +;; +;; Utility +;; + +(defun list-of-strings-to-integers (list) + "Take a list of strings and return a new list of integers (from +parse-integer) on each of the string elements." + (let ((new-list nil)) + (dolist (element (reverse list)) + (push (parse-integer element) new-list)) + new-list)) + +(defun hbo-to-dotted-quad (integer) + "Host-byte-order integer to dotted-quad string conversion utility." + (let ((first (ldb (byte 8 24) integer)) + (second (ldb (byte 8 16) integer)) + (third (ldb (byte 8 8) integer)) + (fourth (ldb (byte 8 0) integer))) + (format nil "~A.~A.~A.~A" first second third fourth))) + +(defun hbo-to-vector-quad (integer) + "Host-byte-order integer to dotted-quad string conversion utility." + (let ((first (ldb (byte 8 24) integer)) + (second (ldb (byte 8 16) integer)) + (third (ldb (byte 8 8) integer)) + (fourth (ldb (byte 8 0) integer))) + (vector first second third fourth))) + +(defun vector-quad-to-dotted-quad (vector) + (format nil "~A.~A.~A.~A" + (aref vector 0) + (aref vector 1) + (aref vector 2) + (aref vector 3))) + +(defun dotted-quad-to-vector-quad (string) + (let ((list (list-of-strings-to-integers (split-sequence:split-sequence #. string)))) + (vector (first list) (second list) (third list) (fourth list)))) + +(defmethod host-byte-order ((string string)) + "Convert a string, such as 192.168.1.1, to host-byte-order, such as +3232235777." + (let ((list (list-of-strings-to-integers (split-sequence:split-sequence #. string)))) + (+ (* (first list) 256 256 256) (* (second list) 256 256) + (* (third list) 256) (fourth list)))) + +(defmethod host-byte-order ((vector vector)) + "Convert a vector, such as #(192 168 1 1), to host-byte-order, such as +3232235777." + (+ (* (aref vector 0) 256 256 256) (* (aref vector 1) 256 256) + (* (aref vector 2) 256) (aref vector 3)))