(eval-when (:compile-toplevel :load-toplevel :execute)
           (require "wrapptrs"))
(defpackage "INTERNET" (:use "XLISP" "WRAPPTRS") (:nicknames "INET"))
(in-package "INET")
(export '(inet-aton
          inet-ntoa
          gethostbyname gethostbyaddr))
(wrap:c-lines "#include <netinet/in.h>")
(wrap:c-lines "#include <arpa/inet.h>")
(wrap:c-lines "
#define HAVE_INET_ATON 0 /**** configure should do this */
#if ! HAVE_INET_ATON
int inet_aton(const char *strptr, struct in_addr *addrptr)
{
  unsigned long a = inet_addr(strptr); /**** not portable */
  if (a == INADDR_NONE)
    return 0;
  memcpy(addrptr, &a, 4);
  return 1;
}
#endif")
(wrap:c-function base-inet-aton "inet_aton" (:string (:cptr "void")) :integer)
(defun inet-aton (string)
  (let* ((i (make-array 4 :element-type 'c-char))
         (vi (cast-c-void (array-data-address i))))
    (if (= (base-inet-aton string vi) 0)
        nil
      i)))
(wrap:c-lines "
static char *my_inet_ntoa(struct in_addr *a)
{
  return inet_ntoa(*a);
}")
(wrap:c-function base-inet-ntoa "my_inet_ntoa" ((:cptr "void")) :string)
(defun inet-ntoa (addr)
  (unless (typep addr '(vector c-char 4))
          (error "~s is not a valid internet address" addr))
  (base-inet-ntoa (cast-c-void (array-data-address addr))))
(wrap:c-lines "#include <netdb.h>"
              "#include <sys/socket.h>")
(wrap:c-constant HOST_NOT_FOUND "HOST_NOT_FOUND" :integer)
(wrap:c-constant TRY_AGAIN "TRY_AGAIN" :integer)
(wrap:c-constant NO_RECOVERY "NO_RECOVERY" :integer)
(wrap:c-constant NO_DATA "NO_DATA" :integer)
(wrap:c-constant AF_INET "AF_INET" :integer)
(wrap:c-pointer (:struct "hostent")
                (:get hent-name "h_name" :string)
                (:get hent-aliases "h_aliases" (:cptr (:cptr "char")))
                (:get hent-addrtype "h_addrtype" :integer)
                (:get hent-length "h_length" :integer)
                (:get hent-addr-list "h_addr_list" (:cptr (:cptr "void"))))
(wrap:c-function base-gethostbyname "gethostbyname"
                 (:string) (:cptr (:struct "hostent")))
(wrap:c-function base-gethostbyaddr "gethostbyaddr"
                 ((:cptr "void") :integer :integer) (:cptr (:struct "hostent")))
(wrap:c-lines "extern int h_errno;")
(wrap:c-variable "h_errno" :integer (:get get-h-errno))
(defun hent-values (h)
  (if h
      (values (hent-name h)
              (map-cptr-list #'get-c-string (hent-aliases h))
              (hent-addrtype h)
              (hent-length h)
              (flet ((inet-addr (p)
                       (let* ((n (hent-length h))
                              (a (make-array n :element-type 'c-char)))
                         (dotimes (i n a)
                           (setf (elt a i) (get-c-uchar p i))))))
                (mapcar #'inet-addr
                        (map-cptr-list #'get-c-void-p (hent-addr-list h)))))
    (values nil
            (let ((e (get-h-errno)))
              (cond
               ((= e HOST_NOT_FOUND) 'HOST_NOT_FOUND)
               ((= e TRY_AGAIN) 'TRY_AGAIN)
               ((= e NO_RECOVERY) 'NO_RECOVERY)
               ((= e NO_DATA) 'NO_DATA)
               (t e))))))
(defun map-cptr-list (fun ptr)
  (do* ((val nil)
        (count 0 (+ count 1))
        (v (funcall fun ptr count) (funcall fun ptr count)))
       ((null v) (nreverse val))
       (push v val)))
(defun gethostbyname (hostname)
  (hent-values (base-gethostbyname hostname)))

(defun gethostbyaddr (addr)
  (unless (typep addr '(vector c-char 4))
          (error "~s is not a valid internet address" addr))
  (let ((p (cast-c-void (array-data-address addr))))
    (hent-values (base-gethostbyaddr p 4 AF_INET))))