1 (in-package :bsd-sockets
)
2 #||
<a name
="name-service"><h2
>Name Service
</h2
></a
>
4 <p
>Presently name service is implemented by calling whatever
5 gethostbyname
(2) uses. This may be any or all of
/etc
/hosts
, NIS
, DNS
,
6 or something completely different. Typically it
's controlled by
9 <p
> Direct links to the asynchronous resolver
(3) routines would be nice to have
10 eventually
, so that we can do DNS lookups in parallel with other things
14 ((name :initarg
:name
:accessor host-ent-name
)
15 (aliases :initarg
:aliases
:accessor host-ent-aliases
)
16 (address-type :initarg
:type
:accessor host-ent-address-type
)
17 ; presently always AF_INET
18 (addresses :initarg
:addresses
:accessor host-ent-addresses
)))
20 (defmethod host-ent-address ((host-ent host-ent
))
21 (car (host-ent-addresses host-ent
)))
23 ;(define-condition host-not-found-error (socket-error)) ; host unknown
24 ;(define-condition no-address-error (socket-error)) ; valid name but no IP address
25 ;(define-condition no-recovery-error (socket-error)) ; name server error
26 ;(define-condition try-again-error (socket-error)) ; temporary
28 (defun get-host-by-name (host-name)
29 "Returns a HOST-ENT instance for HOST-NAME or throws some kind of condition.
30 HOST-NAME may also be an IP address in dotted quad notation or some other
31 weird stuff - see gethostbyname(3) for grisly details."
32 (let ((h (sockint::gethostbyname host-name
)))
35 (defun get-host-by-address (address)
36 "Returns a HOST-ENT instance for ADDRESS, which should be a vector of
37 (integer 0 255), or throws some kind of error. See gethostbyaddr(3) for
39 (let ((packed-addr (sockint::allocate-in-addr
)))
40 (loop for i from
0 to
3
41 do
(setf (sockint::in-addr-addr packed-addr i
) (elt address i
)))
44 (sockint::gethostbyaddr
(sockint::array-data-address packed-addr
)
48 (defun make-host-ent (h)
49 (if (sockint::foreign-nullp h
) (name-service-error "gethostbyname"))
50 (let* ((local-h (sockint::foreign-vector h
1 sockint
::size-of-hostent
))
51 (length (sockint::hostent-length local-h
))
53 (loop for i
= 0 then
(1+ i
)
54 for al
= (sb-sys:sap-ref-sap
55 (sb-sys:int-sap
(sockint::hostent-aliases local-h
))
57 until
(= (sb-sys:sap-int al
) 0)
58 collect
(sb-c-call::%naturalize-c-string al
)))
59 (address0 (sb-sys:sap-ref-sap
(sb-sys:int-sap
(sockint::hostent-addresses local-h
)) 0))
61 (loop for i
= 0 then
(+ length i
)
62 for ad
= (sb-sys:sap-ref-32 address0 i
)
65 (sockint::foreign-vector
(sb-sys:sap
+ address0 i
) 1 length
))))
66 (make-instance 'host-ent
67 :name
(sb-c-call::%naturalize-c-string
68 (sb-sys:int-sap
(sockint::hostent-name local-h
)))
69 :type
(sockint::hostent-type local-h
)
71 :addresses addresses
)))
73 ;;; The remainder is my fault - gw
75 (defvar *name-service-errno
* 0
76 "The value of h_errno, after it's been fetched from Unix-land by calling
77 GET-NAME-SERVICE-ERRNO")
79 (defun name-service-error (where)
80 (get-name-service-errno)
81 ;; Comment next to NETDB_INTERNAL in netdb.h says "See errno.".
82 ;; This special case treatment hasn't actually been tested yet.
83 (if (= *name-service-errno
* sockint
::NETDB-INTERNAL
)
86 (condition-for-name-service-errno *name-service-errno
*)))
87 (error condition
:errno
*name-service-errno
* :syscall where
))))
89 (define-condition name-service-error
(condition)
92 :reader name-service-error-errno
)
93 (symbol :initform nil
:initarg
:symbol
:reader name-service-error-symbol
)
94 (syscall :initform
"an unknown location" :initarg
:syscall
:reader name-service-error-syscall
))
95 (:report
(lambda (c s
)
96 (let ((num (name-service-error-errno c
)))
97 (format s
"Name service error in \"~A\": ~A (~A)"
98 (name-service-error-syscall c
)
99 (or (name-service-error-symbol c
)
100 (name-service-error-errno c
))
101 (get-name-service-error-message num
))))))
103 (defmacro define-name-service-condition
(symbol name
)
105 (define-condition ,name
(name-service-error)
106 ((symbol :reader name-service-error-symbol
:initform
(quote ,symbol
))))
107 (push (cons ,symbol
(quote ,name
)) *conditions-for-name-service-errno
*)))
109 (defparameter *conditions-for-name-service-errno
* nil
)
111 (define-name-service-condition sockint
::NETDB-INTERNAL netdb-internal-error
)
112 (define-name-service-condition sockint
::NETDB-SUCCESS netdb-success-error
)
113 (define-name-service-condition sockint
::HOST-NOT-FOUND host-not-found-error
)
114 (define-name-service-condition sockint
::TRY-AGAIN try-again-error
)
115 (define-name-service-condition sockint
::NO-RECOVERY no-recovery-error
)
116 ;; this is the same as the next one
117 ;;(define-name-service-condition sockint::NO-DATA no-data-error)
118 (define-name-service-condition sockint
::NO-ADDRESS no-address-error
)
120 (defun condition-for-name-service-errno (err)
121 (or (cdr (assoc err
*conditions-for-name-service-errno
* :test
#'eql
))
126 (defun get-name-service-errno ()
127 (setf *name-service-errno
*
128 (sb-alien:alien-funcall
129 (sb-alien:extern-alien
"get_h_errno" (function integer
)))))
134 (sb-alien:define-alien-routine
"hstrerror"
138 (alien:def-alien-routine
"hstrerror"
141 (defun get-name-service-error-message (num)