usocket-cvs May 2007

usocket-cvs@common-lisp.net

1 participants
29 discussions

[usocket-cvs] r247 - in usocket/trunk: . backend test
by ehuelsmann＠common-lisp.net 20 May '07

20 May '07

Author: ehuelsmann Date: Sun May 20 06:51:58 2007 New Revision: 247 Modified: usocket/trunk/ (props changed) usocket/trunk/backend/ (props changed) usocket/trunk/test/ (props changed) Log: Add ignore value for LispWorks 5.0 ufasls.

1 0

[usocket-cvs] r246 - usocket/trunk
by ehuelsmann＠common-lisp.net 18 May '07

18 May '07

Author: ehuelsmann Date: Fri May 18 16:18:59 2007 New Revision: 246 Modified: usocket/trunk/package.lisp Log: Prefix package construction with Common Lisp package designator. Add 2 missing external symbols. Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Fri May 18 16:18:59 2007 @@ -3,14 +3,15 @@ ;;;; See the LICENSE file for licensing information. -(in-package :cl-user) +#+lispworks (cl:require "comm") -#+lispworks (require "comm") - -(eval-when (:execute :load-toplevel :compile-toplevel) - (defpackage :usocket +(cl:eval-when (:execute :load-toplevel :compile-toplevel) + (cl:defpackage :usocket (:use :cl) - (:export #:socket-connect ; socket constructors and methods + (:export #:*wildcard-host* + #:*auto-port* + + #:socket-connect ; socket constructors and methods #:socket-listen #:socket-accept #:socket-close

1 0

[usocket-cvs] r245 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 17 May '07

17 May '07

Author: ehuelsmann Date: Thu May 17 18:03:55 2007 New Revision: 245 Modified: usocket/trunk/backend/scl.lisp Log: Add cl-smtp 'requirement': get-host-name (SCL backend); needs verification. Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Thu May 17 18:03:55 2007 @@ -129,3 +129,6 @@ (t (error 'ns-unknown-error :host-or-ip name :real-error errno)))))))) + +(defun get-host-name () + (unix:unix-gethostname))

1 0

[usocket-cvs] r244 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 17 May '07

17 May '07

Author: ehuelsmann Date: Thu May 17 18:00:04 2007 New Revision: 244 Modified: usocket/trunk/backend/openmcl.lisp Log: Add cl-smtp 'requirement': get-host-name (OpenMCL backend). Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Thu May 17 18:00:04 2007 @@ -5,7 +5,10 @@ (in-package :usocket) - +(defun get-host-name () + (ccl::%stack-block ((resultbuf 256)) + (when (zerop (#_gethostname resultbuf 256)) + (ccl::%get-cstring resultbuf)))) (defparameter +openmcl-error-map+ '((:address-in-use . address-in-use-error) @@ -23,6 +26,35 @@ (:access-denied . operation-not-permitted-error))) +;; we need something which the openmcl implementors 'forgot' to do: +;; wait for more than one socket-or-fd + +(defun input-available-p (sockets &optional ticks-to-wait) + (ccl::rletZ ((tv :timeval)) + (ccl::ticks-to-timeval ticks-to-wait tv) + (ccl::%stack-block ((infds ccl::*fd-set-size*) + (errfds ccl::*fd-set-size*)) + (ccl::fd-zero infds) + (ccl::fd-zero errfds) + (dolist (sock sockets) + (ccl::fd-set (socket-os-fd sock infds)) + (ccl::fd-set (socket-os-fd sock errfds))) + (let* ((res (ccl::syscall syscalls::select + (1+ (apply #'max fds)) + infds (ccl::%null-ptr) errfds + (if ticks-to-wait tv (ccl::%null-ptr))))) + (when (> res 0) + (remove-if #'(lambda (x) + (not (ccl::fd-is-set (socket-os-fd x) infds))) + sockets)))))) + +(defun wait-for-input (sockets &optional ticks-to-wait) + (let ((wait-end (when ticks-to-wait (+ ticks-to-wait (ccl::get-tick-count))))) + (do ((res (input-available-p sockets ticks-to-wait) + (input-available-p sockets ticks-to-wait))) + ((or res (< wait-end (ccl::get-tick-count))) + res)))) + (defun raise-error-from-id (condition-id socket real-condition) (let ((usock-err (cdr (assoc condition-id +openmcl-error-map+)))) (if usock-err

1 0

[usocket-cvs] r243 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 17 May '07

17 May '07

Author: ehuelsmann Date: Thu May 17 17:21:11 2007 New Revision: 243 Modified: usocket/trunk/backend/armedbear.lisp Log: Add cl-smtp 'requirement': get-host-name (ArmedBear backend). Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Thu May 17 17:21:11 2007 @@ -17,6 +17,14 @@ `(java:jnew (java:jconstructor ,class ,@arg-spec) ,@args)) +(defun get-host-name () + (let ((localAddress (java:jstatic + (java:jmethod "java.net.InetAddress" + "getLocalHost") + (java:jclass "java.net.InetAddress")))) + (java:jcall (java:jmethod "java.net.InetAddress" "getHostName") + localAddress))) + (defun handle-condition (condition &optional socket) (typecase condition (error (error 'unknown-error :socket socket :real-error condition))))

1 0

[usocket-cvs] r242 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 17 May '07

17 May '07

Author: ehuelsmann Date: Thu May 17 16:54:47 2007 New Revision: 242 Modified: usocket/trunk/backend/allegro.lisp Log: Add cl-smtp 'requirement': get-host-name (Allegro backend). Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Thu May 17 16:54:47 2007 @@ -6,7 +6,13 @@ (in-package :usocket) (eval-when (:compile-toplevel :load-toplevel :execute) - (require :sock)) + (require :sock) + ;; note: the line below requires ACL 6.2+ + (require :osi)) + +(defun get-host-name () + ;; note: the line below requires ACL 7.0+ to actually *work* on windows + (excl.osi:gethostname)) (defparameter +allegro-identifier-error-map+ '((:address-in-use . address-in-use-error)

1 0

[usocket-cvs] r241 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 17 May '07

17 May '07

Author: ehuelsmann Date: Thu May 17 03:27:16 2007 New Revision: 241 Modified: usocket/trunk/backend/clisp.lisp Log: Add cl-smtp 'requirement': get-host-name (clisp backend). Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Thu May 17 03:27:16 2007 @@ -6,6 +6,23 @@ (in-package :usocket) +;; utility routine for looking up the current host name +(FFI:DEF-CALL-OUT get-host-name-internal + (:name "gethostname") + (:arguments (name (FFI:C-PTR (FFI:C-ARRAY-MAX ffi:character 256)) + :OUT :ALLOCA) + (len ffi:int)) + #+win32 (:library "WS2_32") + (:return-type ffi:int)) + + +(defun get-host-name () + (multiple-value-bind (retcode name) + (get-host-name-internal) + (when (= retcode 0) + name))) + + #+win32 (defun remap-maybe-for-win32 (z) (mapcar #'(lambda (x)

1 0

[usocket-cvs] r240 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 May '07

16 May '07

Author: ehuelsmann Date: Wed May 16 19:06:09 2007 New Revision: 240 Modified: usocket/trunk/backend/sbcl.lisp Log: Add cl-smtp 'requirement': get-host-name (ECL backend). Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Wed May 16 19:06:09 2007 @@ -35,6 +35,26 @@ (cast buf sb-alien:c-string)))))) +#+ecl +(progn + (ffi:clines + #-:wsock + "#include <sys/socket.h>" + #+:wsock + "#include <winsock2.h>" + ) + + (defun get-host-name () + (ffi:c-inline + () () t + "{ char buf[256]; + int r = gethostname(&buf,256); + + if (r == 0) + @(return) = make_simple_base_string(&buf); + else + @(return) = Cnil; + }"))) (defun map-socket-error (sock-err) (map-errno-error (sb-bsd-sockets::socket-error-errno sock-err)))

1 0

[usocket-cvs] r239 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 May '07

16 May '07

Author: ehuelsmann Date: Wed May 16 18:15:45 2007 New Revision: 239 Modified: usocket/trunk/backend/sbcl.lisp Log: Add cl-smtp 'requirement': get-host-name (SBCL backend). Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Wed May 16 18:15:45 2007 @@ -13,6 +13,29 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require :sockets)) +#+sbcl +(progn + #-win32 + (defun get-host-name () + (sb-unix:unix-gethostname)) + + ;; we assume winsock has already been loaded, after all, + ;; we already loaded sb-bsd-sockets and sb-alien + #+win32 + (defun get-host-name () + (sb-alien:with-alien ((buf (sb-alien:array sb-alien:char 256))) + (let ((result (sb-alien:alien-funcall + (sb-alien:extern-alien "gethostname" + (sb-alien:function sb-alien:int + (* sb-alien:char) + sb-alien:int)) + (sb-alien:cast buf (* sb-alien:char)) + 256))) + (when (= result 0) + (cast buf sb-alien:c-string)))))) + + + (defun map-socket-error (sock-err) (map-errno-error (sb-bsd-sockets::socket-error-errno sock-err)))

1 0

[usocket-cvs] r238 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 16 May '07

16 May '07

Author: ehuelsmann Date: Wed May 16 02:49:25 2007 New Revision: 238 Modified: usocket/trunk/backend/cmucl.lisp Log: Add cl-smtp 'requirement': get-host-name (CMUCL backend). Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Wed May 16 02:49:25 2007 @@ -160,3 +160,5 @@ (lookup-host-entry name))) (condition (condition) (handle-condition condition)))) +(defun get-host-name () + (unix:unix-gethostname))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

usocket-cvs May 2007