((category net)
 (synopsis "Network address information access")
 (license "BSD")
 (author "Thomas Chust")
 (doc-from-wiki)
 (needs)
 (test-depends test))

;; vim: set ai et ts=4 sts=2 sw=2 ft=scheme: ;;

(repo fossil "https://chust.org/repos/chicken-{egg-name}")

(uri targz "https://chust.org/repos/chicken-{egg-name}/tarball/{egg-name}.tar.gz?uuid=v{egg-release}")
(release "1.0.1")
(release "1.0.0")




;; vim: set ai et ts=4 sts=2 sw=2 ft=scheme: ;;

(module address-info
  (make-address-info address-info?
   address-info-family address-info-type address-info-host address-info-port
   address-infos)

(import


  scheme chicken foreign
  (only srfi-1 unfold) lolevel)

(require-library
  srfi-1 lolevel)

(declare
  (usual-integrations)
  (no-procedure-checks-for-usual-bindings))

#>
#include <errno.h>
#ifdef _WIN32
# ifdef _MSC_VER
#   include <winsock2.h>
# else
#   include <ws2tcpip.h>
# endif
#else
# include <sys/types.h>
# include <sys/socket.h>
# include <netdb.h>
# include <arpa/inet.h>

#endif
<#

(define-foreign-type addrinfo
  (c-pointer (struct "addrinfo")))

(define (type-error loc msg . args)

  (make-address-info family type host port)
  address-info?
  [family address-info-family]
  [type address-info-type]
  [host address-info-host]
  [port address-info-port])

(define-record-printer (address-info info out)

  (display "#<address-info" out)
  (cond
    [(address-info-type info)
     => (lambda (type)
          (let ([host (address-info-host info)]
                [port (address-info-port info)])
            (display #\space out)
            (display type out)
            (display "://" out)
            (if host
              (if (eq? (address-info-family info) 'ipv6)
                (begin
                  (display #\[ out)
                  (display host out)
                  (display #\] out))
                (display host out))
              (display #\* out))
            (when port
              (display #\: out)
              (display port out))))])
  (display #\> out))

(define (addrinfo->address-info info)
  (make-address-info
    (addrinfo-family info)
    (addrinfo-type info)
    (addrinfo-host info (make-string 64))
    (addrinfo-port info)))

(compile -s -O2 -d1 "address-info.scm" -j address-info
         ,@(cond-expand
            (windows
             '("-lws2_32"))
            (else
             '())))

(cond-expand
 (enable-static
  (compile -c -O2 -d1 "address-info.scm" -unit address-info))
 (else
  ))

(compile -s -O2 -d0 "address-info.import.scm")

(install-extension
 'address-info
 `("address-info.so"
   ,@(cond-expand
      (enable-static
       '("address-info.o"))
      (else
       '()))
   "address-info.import.so")
 `((version "1.0.0")
   ,@(cond-expand
      (enable-static
       `((static "address-info.o")
         ,@(cond-expand
            (windows
             '((static-options "-lws2_32")))
            (else
             '()))))
      (else
       '()))))

;; vim: set ai et ts=4 sts=2 sw=2 ft=scheme: ;;

<h1>Address Info API</h1>

This CHICKEN module exposes <tt>getaddrinfo(3)</tt> functionality to Scheme.

<verbatim>
  (require-extension address-info)
</verbatim>

<h2>Address Info Record</h2>

<verbatim>
  (define-record-type address-info
    (make-address-info family type host port)

;; This file is part of address-info for CHICKEN
;; Copyright (c) 2017 by Thomas Chust.  All rights reserved.
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the Software), to deal in the Software without restriction,
;; including without limitation the rights to use, copy, modify,
;; merge, publish, distribute, sublicense, and/or sell copies of the
;; Software, and to permit persons to whom the Software is furnished
;; to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

(require-extension
  address-info test)

(test-group "client mode"
  (test-assert "bad hostname" (not (address-infos "!foo/bar.invalid")))
  (test-assert "symbolic localhost" (list? (address-infos "localhost")))
  (test-assert "numeric ipv4 localhost" (member (make-address-info 'ipv4 'tcp "127.0.0.1" #f) (address-infos "127.0.0.1" type: 'stream numeric?: #t)))
  (test-assert "numeric ipv6 localhost" (member (make-address-info 'ipv6 'tcp "::1" #f) (address-infos "::1" type: 'stream numeric?: #t)))
  (test "port lookup" 80 (address-info-port (car (address-infos "example.com" port: "http")))))

(test-group "server mode"
  (test-assert "bad port" (not (address-infos #f port: "!foo/bar")))
  (test "port lookup" 80 (address-info-port (car (address-infos #f port: "http"))))
  (test "ipv4 wildcard lookup" "0.0.0.0" (address-info-host (car (address-infos #f port: "http" family: 'ipv4))))
  (test "ipv6 wildcard lookup" "::" (address-info-host (car (address-infos #f port: "http" family: 'ipv6)))))