January 22, 2004
Rendezvous

I'm playing with OpenMCL's Objective C support and OS X's Rendezvous.

I can advertise services, but I think I need to figure out some things about Run Loops before I can get the rest of this to work.

(require :objc-support)

(defmacro with-nsstrs (init-forms &body body)
  "Establishes a lexical context with a bunch of stack allocated
   NSConstantStrings."
  (flet ((gen (s) #'(lambda (sym)
		      (declare (ignore sym))
		      (gensym s))))
    (let ((cstr-vars (mapcar (gen "CSTR") init-forms))
	  (string-vars (mapcar (gen "STRING") init-forms)))
      `(let ,(mapcar #'(lambda (init-form sv)
			 `(,sv ,(second init-form)))
	      init-forms string-vars)
	 (with-cstrs ,(mapcar #'(lambda (cv sv)
				  `(,cv ,sv))
			      cstr-vars string-vars)
	   (rlet
	    ,(mapcar
	      #'(lambda (init-form cstr-var string-var)
		  `(,(first init-form) :<NSC>onstant<S>tring
				       :isa ccl::*NSConstantString-class*
				       :bytes ,cstr-var
				       :num<B>ytes (length ,string-var)))
	      init-forms cstr-vars string-vars)
	    ,@body))))))

(defmacro @@ (string)
  "Creates a persistent, interned NSConstantString."
  `(ccl::objc-constant-string-nsstringptr
    (ccl::ns-constant-string ,string)))


(defun advertise-service (domain type name port &key properties)
  "Publishes the availability of a service via Rendezvous.

   The DOMAIN argument must be a string containing the domain name of
   the machine hosting the service (pass nil for localhost).  The TYPE
   argument is a string specifying the type of service being
   advertised (e.g., \"_http._tcp\" or \"_daap._tcp\").  NAME is a
   string naming the service.  PORT is the port associated with the
   service.  The PROPERTIES argument, if given, should be a property
   list containing additional service-specific information that will
   be part of the published information about the service. For
   example, ((\"path\" \"~/guest/\") (\"screenname\" \"clowny\")).

   This function returns a macptr that points to the Cocoa
   NetService instance representing the advertised service."
  (let ((net-service (ccl::make-objc-instance 'ns-net-service)))
    (with-nsstrs ((nsdomain (or domain ""))
		  (nstype type)
		  (nsname name))
      (ccl::send net-service
		 :init-with-domain nsdomain
		 :type nstype
		 :name nsname
		 :port port))

    #|  Something is going wrong here.
    
    (ccl::send net-service
	       :schedule-in-run-loop
	       (ccl::send (ccl::@class ns-run-loop) 'current-Run-Loop)
	       :for-mode (@@ "kCFRunLoopDefaultMode"))
    |#  
    
    (when properties
      ;; Hm, kind of odd that we have to use a constant NSString
      ;; here... (it fails if we use a stack-allocated one).
      (ccl::send net-service :set-protocol-specific-information
		 (@@ (build-text-record properties))))
    (ccl::send net-service :set-delegate
	       (ccl::make-objc-instance 'net-service-delegate))
    (ccl::send net-service 'publish)
    net-service))


;; Sadly, this doesn't seem to work.

(defun cancel-service (service)
  "Stops advertising a service.

   SERVICE must be a macptr returned by ADVERTISE-SERVICE."
  (ccl::send service 'stop))


(defparameter *record-separator* (code-char 1))

(defun build-text-record (properties)
  (reduce
   #'(lambda (p1 p2)
       (format nil "~A~A~A" p1 *record-separator* p2))
   (mapcar #'(lambda (property)
	       (format nil "~A=~A" (first property) (second property)))
	   properties)))


;; Here we define an Objective C class that acts as the callback
;; handler for NetService.

(ccl::def-objc-class net-service-delegate ns-object)

(ccl::define-objc-method ((:void :net-service sender
				 :did-not-publish error-dict)
			  net-service-delegate)
    (format T "~&Did not publish service."))

(ccl::define-objc-method ((:void :net-service-did-stop sender)
			  net-service-delegate)
    (format T "~&Did stop service."))

(ccl::define-objc-method ((:void :net-service-will-publish sender)
			  net-service-delegate)
    (format T "~&Will publish service."))
Posted by jjwiseman at January 22, 2004 07:29 AM
Comments
Post a comment
Name:


Email Address:


URL:




Unless you answer this question, your comment will be classified as spam and will not be posted.
(I'll give you a hint: the answer is “lisp”.)

Comments:


Remember info?