Skip to content

Commit

Permalink
0.8.10.56:
Browse files Browse the repository at this point in the history 
        MORE ALIENS! sb-grovel now defines alien structures.

        Affected:
        ... sb-grovel, obviously. Reworked the def-to-lisp mechanism a bit
            and then hacked foreign-glue.
        .... array-data.lisp isn't needed by sb-grovel any more, and any
             code that uses it will probably break anyway; removed it.
        .... The Manual: Now there's a section on sb-grovel usage.
             sb-grovel's README is no more.

        ... sb-bsd-sockets: It had to learn to use aliens instead of
            non-typechecked lisp arrays. I hope there are no memory leaks.
        ... ditto for sb-posix.

        Thanks to vja for patches & patiently testing my changes on
        x86 and SPARC.
  • Loading branch information
@antifuchs
antifuchs committed May 27, 2004
1 parent 235c8f1 commit d4c7ab0
Show file tree
Hide file tree
Showing 16 changed files with 994 additions and 583 deletions.
34 changes: 19 additions & 15 deletions contrib/sb-bsd-sockets/constants.lisp
View file
Expand Up @@ -104,23 +104,27 @@
(buf (* t))))
|#
(:structure protoent ("struct protoent"
((* t) name "char *" "p_name")
(c-string-pointer name "char *" "p_name")
((* (* t)) aliases "char **" "p_aliases")
(integer proto "int" "p_proto")))
(:function getprotobyname ("getprotobyname" (* t)
(name c-string)))
(:integer inaddr-any "INADDR_ANY")
(:structure in-addr ("struct in_addr"
((array (unsigned 8) 4) addr "u_int32_t" "s_addr")))
((array (unsigned 8)) addr "u_int32_t" "s_addr")))
(:structure sockaddr-in ("struct sockaddr_in"
(integer family "sa_family_t" "sin_family")
((array (unsigned 8) 2) port "u_int16_t" "sin_port")
((array (unsigned 8) 4) addr "struct in_addr" "sin_addr")))
;; These two could be in-port-t and
;; in-addr-t, but then we'd throw away the
;; convenience (and byte-order agnosticism)
;; of the old sb-grovel scheme.
((array (unsigned 8)) port "u_int16_t" "sin_port")
((array (unsigned 8)) addr "struct in_addr" "sin_addr")))
(:structure sockaddr-un ("struct sockaddr_un"
(integer family "sa_family_t" "sun_family")
((array (unsigned 8) 108) path "char" "sun_path")))
(c-string path "char" "sun_path")))
(:structure hostent ("struct hostent"
((* t) name "char *" "h_name")
(c-string-pointer name "char *" "h_name")
((* c-string) aliases "char **" "h_aliases")
(integer type "int" "h_addrtype")
(integer length "int" "h_length")
Expand All @@ -131,26 +135,26 @@
(protocol integer)))
(:function bind ("bind" integer
(sockfd integer)
(my-addr (* t))
(my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
(addrlen integer)))
(:function listen ("listen" integer
(socket integer)
(backlog integer)))
(:function accept ("accept" integer
(socket integer)
(my-addr (* t))
(my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
(addrlen integer :in-out)))
(:function getpeername ("getpeername" integer
(socket integer)
(her-addr (* t))
(her-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
(addrlen integer :in-out)))
(:function getsockname ("getsockname" integer
(socket integer)
(my-addr (* t))
(my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
(addrlen integer :in-out)))
(:function connect ("connect" integer
(socket integer)
(his-addr (* t))
(his-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
(addrlen integer )))

(:function close ("close" integer
Expand All @@ -160,10 +164,10 @@
(buf (* t))
(len integer)
(flags integer)
(sockaddr (* t))
(sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
(socklen (* integer))))
(:function gethostbyname ("gethostbyname" (* t ) (name c-string)))
(:function gethostbyaddr ("gethostbyaddr" (* t )
(:function gethostbyname ("gethostbyname" (* hostent) (name c-string)))
(:function gethostbyaddr ("gethostbyaddr" (* hostent)
(addr (* t))
(len integer)
(af integer)))
Expand All @@ -182,5 +186,5 @@
(level integer)
(optname integer)
(optval (* t))
(optlen integer :in-out))))
(optlen (* integer)))))
)
48 changes: 22 additions & 26 deletions contrib/sb-bsd-sockets/inet.lisp
View file
Expand Up @@ -26,10 +26,9 @@
(defun make-inet-address (dotted-quads)
"Return a vector of octets given a string DOTTED-QUADS in the format
\"127.0.0.1\""
(coerce
(mapcar #'parse-integer
(split dotted-quads nil '(#\.)))
'vector))
(map 'vector
#'parse-integer
(split dotted-quads nil '(#\.))))

;;; getprotobyname only works in the internet domain, which is why this
;;; is here
Expand All @@ -38,52 +37,49 @@
using getprotobyname(2) which typically looks in NIS or /etc/protocols"
;; for extra brownie points, could return canonical protocol name
;; and aliases as extra values
(let ((ent (sb-grovel::foreign-vector (sockint::getprotobyname name) 1
sockint::size-of-protoent)))
(let ((ent (sockint::getprotobyname name)))
(sockint::protoent-proto ent)))


;;; sockaddr protocol
;;; (1) sockaddrs are represented as the semi-foreign array-of-octets
;;; thing
;;; (2) a protocol provides make-sockaddr-for, size-of-sockaddr,
;;; our protocol provides make-sockaddr-for, size-of-sockaddr,
;;; bits-of-sockaddr

(defmethod make-sockaddr-for ((socket inet-socket) &optional sockaddr &rest address &aux (host (first address)) (port (second address)))
(let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-in))))
(when (and host port)
(setf host (coerce host '(simple-array (unsigned-byte 8) (4))))
;; port and host are represented in C as "network-endian" unsigned
;; integers of various lengths. This is stupid. The value of the
;; integer doesn't matter (and will change depending on your
;; machine's endianness); what the bind(2) call is interested in
;; is the pattern of bytes within that integer.

;; We have no truck with such dreadful type punning. Octets to
;; octets, dust to dust.

(setf (sockint::sockaddr-in-family sockaddr) sockint::af-inet)
(setf (sockint::sockaddr-in-port sockaddr 0) (ldb (byte 8 8) port))
(setf (sockint::sockaddr-in-port sockaddr 1) (ldb (byte 8 0) port))
(setf (sockint::sockaddr-in-addr sockaddr 0) (elt host 0))
(setf (sockint::sockaddr-in-addr sockaddr 1) (elt host 1))
(setf (sockint::sockaddr-in-addr sockaddr 2) (elt host 2))
(setf (sockint::sockaddr-in-addr sockaddr 3) (elt host 3)))
(setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0) (ldb (byte 8 8) port))
(setf (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1) (ldb (byte 8 0) port))

(setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 0) (elt host 0))
(setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 1) (elt host 1))
(setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 2) (elt host 2))
(setf (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) 3) (elt host 3)))
sockaddr))

(defmethod free-sockaddr-for ((socket inet-socket) sockaddr)
(sockint::free-sockaddr-in sockaddr))

(defmethod size-of-sockaddr ((socket inet-socket))
sockint::size-of-sockaddr-in)

(defmethod bits-of-sockaddr ((socket inet-socket) sockaddr)
"Returns address and port of SOCKADDR as multiple values"
(values
(vector
(sockint::sockaddr-in-addr sockaddr 0)
(sockint::sockaddr-in-addr sockaddr 1)
(sockint::sockaddr-in-addr sockaddr 2)
(sockint::sockaddr-in-addr sockaddr 3))
(+ (* 256 (sockint::sockaddr-in-port sockaddr 0))
(sockint::sockaddr-in-port sockaddr 1))))
(coerce (loop for i from 0 below 4
collect (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i))
'(vector (unsigned-byte 8) 4))
(+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0))
(sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1))))

(defun make-inet-socket (type protocol)
"Make an INET socket. Deprecated in favour of make-instance"
Expand Down
15 changes: 5 additions & 10 deletions contrib/sb-bsd-sockets/local.lisp
View file
Expand Up @@ -19,22 +19,17 @@ a network.
(let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un))))
(setf (sockint::sockaddr-un-family sockaddr) sockint::af-local)
(when filename
(loop for c across filename
;; XXX magic constant ew ew ew. should grovel this from
;; system headers
for i from 0 to (min 107 (1- (length filename)))
do (setf (sockint::sockaddr-un-path sockaddr i) (char-code c))
finally
(setf (sockint::sockaddr-un-path sockaddr (1+ i)) 0)))
(setf (sockint::sockaddr-un-path sockaddr) filename))
sockaddr))

(defmethod free-sockaddr-for ((socket local-socket) sockaddr)
(sockint::free-sockaddr-un sockaddr))

(defmethod size-of-sockaddr ((socket local-socket))
sockint::size-of-sockaddr-un)

(defmethod bits-of-sockaddr ((socket local-socket) sockaddr)
"Return the file name of the local socket address SOCKADDR."
(let ((name (sb-c-call::%naturalize-c-string
(sb-sys:sap+ (sb-grovel::array-data-address sockaddr)
sockint::offset-of-sockaddr-un-path))))
(let ((name (sockint::sockaddr-un-path sockaddr)))
(if (zerop (length name)) nil name)))

57 changes: 27 additions & 30 deletions contrib/sb-bsd-sockets/name-service.lisp
View file
Expand Up @@ -31,44 +31,42 @@ eventually, so that we can do DNS lookups in parallel with other things
"Returns a HOST-ENT instance for HOST-NAME or throws some kind of condition.
HOST-NAME may also be an IP address in dotted quad notation or some other
weird stuff - see gethostbyname(3) for grisly details."
(let ((h (sockint::gethostbyname host-name)))
(make-host-ent h)))
(make-host-ent (sockint::gethostbyname host-name)))

(defun get-host-by-address (address)
"Returns a HOST-ENT instance for ADDRESS, which should be a vector of
(integer 0 255), or throws some kind of error. See gethostbyaddr(3) for
(integer 0 255), or throws some kind of error. See gethostbyaddr(3) for
grisly details."
(let ((packed-addr (sockint::allocate-in-addr)))
(loop for i from 0 to 3
do (setf (sockint::in-addr-addr packed-addr i) (elt address i)))
(make-host-ent
(sb-sys:with-pinned-objects (packed-addr)
(sockint::gethostbyaddr (sb-grovel::array-data-address packed-addr)
4
sockint::af-inet)))))
(sockint::with-in-addr packed-addr ()
(let ((addr-vector (coerce address 'vector)))
(loop for i from 0 below (length addr-vector)
do (setf (sb-alien:deref (sockint::in-addr-addr packed-addr) i)
(elt addr-vector i)))
(make-host-ent (sockint::gethostbyaddr packed-addr
4
sockint::af-inet)))))

(defun make-host-ent (h)
(if (sb-grovel::foreign-nullp h) (name-service-error "gethostbyname"))
(let* ((local-h (sb-grovel::foreign-vector h 1 sockint::size-of-hostent))
(length (sockint::hostent-length local-h))
(aliases
(loop for i = 0 then (1+ i)
for al = (sb-sys:sap-ref-sap
(sb-sys:int-sap (sockint::hostent-aliases local-h))
(* i 4))
until (= (sb-sys:sap-int al) 0)
collect (sb-c-call::%naturalize-c-string al)))
(address0 (sb-sys:sap-ref-sap (sb-sys:int-sap (sockint::hostent-addresses local-h)) 0))
(let* ((length (sockint::hostent-length h))
(aliases (loop for i = 0 then (1+ i)
for al = (sb-alien:deref (sockint::hostent-aliases h) i)
while al
collect al))
(address0 (sockint::hostent-addresses h))
(addresses
(loop for i = 0 then (+ length i)
for ad = (sb-sys:sap-ref-32 address0 i)
while (> ad 0)
collect
(sb-grovel::foreign-vector (sb-sys:sap+ address0 i) 1 length))))
(loop for i = 0 then (1+ i)
for ad = (sb-alien:deref address0 i)
until (sb-alien:null-alien ad)
collect (ecase (sockint::hostent-type h)
(#.sockint::af-inet
(loop for i from 0 below length
collect (sb-alien:deref ad i)))
(#.sockint::af-local
(sb-alien:cast ad sb-alien:c-string))))))
(make-instance 'host-ent
:name (sb-c-call::%naturalize-c-string
(sb-sys:int-sap (sockint::hostent-name local-h)))
:type (sockint::hostent-type local-h)
:name (sockint::hostent-name h)
:type (sockint::hostent-type h)
:aliases aliases
:addresses addresses)))

Expand Down Expand Up @@ -143,4 +141,3 @@ GET-NAME-SERVICE-ERRNO")
(defun get-name-service-error-message (num)
(hstrerror num))
)

0 comments on commit d4c7ab0

Please sign in to comment.