PageRenderTime 49ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

/src/mdns-ffi.lisp

http://cl-dns-sd.googlecode.com/
Lisp | 193 lines | 147 code | 29 blank | 17 comment | 1 complexity | 3c06bb8c2f29ae6efe75d89c1ec899fc MD5 | raw file
  1. #| This file is part of DNS-SD, a Common Lisp library for
  2. Zeroconf service discovery.
  3. This file contains the CFFI definitions for Apple's
  4. DNSServiceDiscovery API |#
  5. (in-package #:dns-sd)
  6. ;; Load the host system's DNS-SD library
  7. #-(or darwin-target darwin)
  8. (handler-case
  9. (progn
  10. (cffi:define-foreign-library dns-sd
  11. (:unix (:default "libdns_sd")))
  12. (cffi:use-foreign-library dns-sd))
  13. (error (c)
  14. (warn "Couldn't load mDNSResponder client library; ~@
  15. DNS-SD functionality won't be available"))
  16. (:no-error (result)
  17. (when result
  18. (pushnew :dns-sd *features*))))
  19. #+(or darwin-target darwin)
  20. (pushnew :dns-sd *features*) ; mDNSResponder is included in Mac OS X
  21. ;; ----------
  22. ;; CFFI definitions and utilities
  23. ;; ----------
  24. ;; Some convenience macros.
  25. (defmacro def-dnssd-type (type foreign-type)
  26. "Defines a foreign (CFFI) type TYPE and defines a Lisp type
  27. corresponding to the foreign type."
  28. `(cffi:defctype ,type ,foreign-type))
  29. (defmacro def-dnssd-function (name args external-name)
  30. "Declares a foreign (CFFI) function that returns a value of
  31. type DNSServiceErrorType and defines a wrapper around the
  32. foreign function that raises an error of type
  33. DNS-SD-RESULT-ERROR if the foreign function returns a value
  34. indicating that an error occurred."
  35. (let ((arg-names (mapcar #'car args))
  36. (result-var (gensym "RESULT")))
  37. `(let ((cfun (symbol-function (cffi:defcfun ,external-name dns-service-error-type ,@args))))
  38. (defun ,name ,arg-names
  39. (let ((,result-var (funcall cfun ,@arg-names)))
  40. (if (= ,result-var 0)
  41. ,result-var
  42. (handle-dns-sd-error ,result-var)))))))
  43. (defun handle-dns-sd-error (code)
  44. (dns-sd-error code))
  45. ;; Types (see dns_sd.h)
  46. (def-dnssd-type dns-service-ref :pointer)
  47. (def-dnssd-type dns-record-ref :pointer)
  48. (def-dnssd-type dns-service-flags :uint32)
  49. (def-dnssd-type dns-service-protocol :uint32)
  50. (def-dnssd-type dns-service-error-type :int32)
  51. (def-dnssd-type dns-service-register-reply :pointer)
  52. (def-dnssd-type dns-service-browse-reply :pointer)
  53. (def-dnssd-type dns-service-resolve-reply :pointer)
  54. (def-dnssd-type dns-service-query-record-reply :pointer)
  55. ;; Functions
  56. (cffi:defcfun ("DNSServiceRefSockFD"
  57. %dns-service-ref-sock-fd) :int
  58. (sd-ref dns-service-ref))
  59. ;; A wrapper around DNSServiceRefSockFD that raises a SOCKET-FD-ERROR
  60. ;; if the returned value is -1. It seems that if the mDNS daemon
  61. ;; isn't running, the only indication we get is a -1 when we call
  62. ;; DNSServiceRefSockFD.
  63. (defun dns-service-ref-sock-fd (ref)
  64. (let ((sock (%dns-service-ref-sock-fd ref)))
  65. (if (eql sock -1)
  66. (error 'socket-fd-error :oid ref)
  67. sock)))
  68. (cffi:defcfun ("DNSServiceRefDeallocate"
  69. dns-service-ref-deallocate) :void
  70. (sd-ref dns-service-ref))
  71. (def-dnssd-function dns-service-process-result ((sd-ref dns-service-ref))
  72. "DNSServiceProcessResult")
  73. (def-dnssd-function dns-service-browse
  74. ((sd-ref-ptr :pointer)
  75. (flags dns-service-flags)
  76. (interface-index :uint32)
  77. (reg-type :string)
  78. (domain :string)
  79. (callback dns-service-browse-reply)
  80. (context :pointer))
  81. "DNSServiceBrowse")
  82. (def-dnssd-function dns-service-resolve
  83. ((sd-ref-ptr :pointer)
  84. (flags dns-service-flags)
  85. (interface-index :uint32)
  86. (name :string)
  87. (reg-type :string)
  88. (domain :string)
  89. (callback dns-service-resolve-reply)
  90. (context :pointer))
  91. "DNSServiceResolve")
  92. (def-dnssd-function dns-service-query-record
  93. ((sd-ref-ptr :pointer)
  94. (flags dns-service-flags)
  95. (interface-index :uint32)
  96. (full-name :string)
  97. (rrtype :uint16)
  98. (rrclass :uint16)
  99. (callback dns-service-query-record-reply)
  100. (context :pointer))
  101. "DNSServiceQueryRecord")
  102. (def-dnssd-function %dns-service-register
  103. ((sd-ref-ptr :pointer)
  104. (flags dns-service-flags)
  105. (interface-index :uint32)
  106. (name :string)
  107. (reg-type :string)
  108. (domain :string)
  109. (host :string)
  110. (port :uint16)
  111. (txt-len :uint16)
  112. (txt-record :pointer)
  113. (callback dns-service-register-reply)
  114. (context :pointer))
  115. "DNSServiceRegister")
  116. #+(or little-endian x86)
  117. (defun uint16/network-byte-order (value)
  118. "big-endian-uint16"
  119. (let ((result 0))
  120. (declare (type (unsigned-byte 16) value result))
  121. (setf (ldb (byte 8 8) result) (ldb (byte 8 0) value)
  122. (ldb (byte 8 0) result) (ldb (byte 8 8) value))
  123. result))
  124. #-(or little-endian x86)
  125. (defmacro uint16/network-byte-order (value)
  126. value)
  127. (defun dns-service-register
  128. (sd-ref-ptr flags interface-index name
  129. reg-type domain host port txt-len
  130. txt-record dns-service-register-reply
  131. context)
  132. (%dns-service-register
  133. sd-ref-ptr flags interface-index name reg-type domain host
  134. (uint16/network-byte-order port)
  135. txt-len txt-record dns-service-register-reply context))
  136. ;; Constants
  137. (eval-when (:compile-toplevel :load-toplevel :execute)
  138. (defconstant +dns-service-err-no-err+ 0)
  139. (defconstant +dns-service-err-unknown+ -65537)
  140. (defconstant +dns-service-err-no-such-name+ -65538)
  141. (defconstant +dns-service-err-no-memory+ -65539)
  142. (defconstant +dns-service-err-bad-param+ -65540)
  143. (defconstant +dns-service-err-bad-reference+ -65541)
  144. (defconstant +dns-service-err-bad-state+ -65542)
  145. (defconstant +dns-service-err-bad-flags+ -65543)
  146. (defconstant +dns-service-err-unsupported+ -65544)
  147. (defconstant +dns-service-err-not-initialized+ -65545)
  148. (defconstant +dns-service-err-already-registered+ -65547)
  149. (defconstant +dns-service-err-name-conflict+ -65548)
  150. (defconstant +dns-service-err-invalid+ -65549)
  151. (defconstant +dns-service-err-incompatible+ -65551)
  152. (defconstant +dns-service-err-bad-interface-index+ -65552)
  153. (defconstant +dns-service-flags-more-coming+ 1)
  154. (defconstant +dns-service-flags-finished+ 0)
  155. (defconstant +dns-service-flags-add+ 2)
  156. (defconstant +dns-service-flags-default+ 4)
  157. (defconstant +dns-service-flags-remove+ 0)
  158. (defconstant +dns-service-flags-no-auto-rename+ 8)
  159. (defconstant +dns-service-flags-auto-rename+ 0)
  160. (defconstant +dns-service-flags-shared+ 16)
  161. (defconstant +dns-service-flags-unique+ 32)
  162. (defconstant +dns-service-flags-browse-domains+ 64)
  163. (defconstant +dns-service-flags-registration-domains+ 128))