;; export a tcp-connect that does not block other srfi-18 threads
;; while it's doing its DNS resolving.
(use posix srfi-18)

(foreign-declare "#include <netdb.h>")
(foreign-declare "#include <arpa/inet.h>")

;; does a dns-resolve using the gethostaddr C function. note that this
;; procedure will block all other srfi-18 threads.
(define (dns-resolve* host)
  ((foreign-lambda*
    c-string ((c-string host))
    "struct hostent *he = gethostbyname(host);"
    "if(he == NULL) C_return(0);"
    "C_return(inet_ntoa(*(struct in_addr *)he->h_addr));")
   host))

;; we need to fork because dns-resolve* blocks other srfi-18
;; threads. the child-process will reply with the resolved hostname's
;; IP address as string. thread-wait-for-i/o! is the magic that makes
;; the other threads not block.
(define (dns-resolve host)
  (let-values (( (in out) (create-pipe) ))
    (let ((pid
           (process-fork
            (lambda ()
              (file-close in)
              (file-write out (dns-resolve* host))
              (file-close out))
            #t)))
      (file-close out)
      ;; in will be quiet until we have everything we need.
      (thread-wait-for-i/o! in)
      (let ((response (file-read in 128)))
        (file-close in)
        (process-wait pid)
        (substring (car response) 0 (cadr response))))))

(define tcp-connect% tcp-connect)
(define (tcp-connect host port)
  (tcp-connect% (dns-resolve host) port))

(print "async result: " (dns-resolve "klm.com"))