(module netutils mzscheme
(require "define-utils.ss"
"ffi-utils.ss"
(lib "include.ss")
(all-except (lib "contract.ss") ->)
(rename (lib "contract.ss") => ->)
(lib "foreign.ss")) (unsafe!)
(provide
inet-ntoa
(rename inet-addr inet-aton)
ntohl
ntohs
htonl
htons)
(default-_string-type _string*/utf-8)
(define libc (ffi-lib
(case (system-type)
[(unix) #f]
[(windows) "Ws2_32"])))
(define HOST-SIZE 1025)
(define PORT-SIZE 32)
(define SOCKLEN 16)
(define host-buf (make-parameter (make-bytes HOST-SIZE)))
(define port-buf (make-parameter (make-bytes PORT-SIZE)))
(define _getnameinfo-flags
(_bitmask
'(NI-NONE = 0
NI-NOFQDN = 1
NI-NUMERICHOST = 2
NI-NAMEREQD = 4
NI-NUMERICSERV = 8
NI-DGRAM = 16)))
(define-struct/provide/contract sockaddr ([host string?]
[port string?])
(make-inspector))
(define/provide _sockaddr
(make-ctype _pointer #f
(lambda (ptr)
(if ptr
(getnameinfo ptr '(NI-NOFQDN
NI-NUMERICHOST
NI-NUMERICSERV))
#f))))
(define/provide _ip-addr
(make-ctype _int32
(lambda (ip-addr) (inet-addr ip-addr))
(lambda (int)
(inet-ntoa int))))
(ffi-func/contract libc
(("-" "_"))
([getnameinfo
(cpointer? (union symbol? (listof symbol?)) . => . (union false/c sockaddr?))
(_fun _pointer (_uint = SOCKLEN) (host : _bytes = (host-buf)) (_int = HOST-SIZE) (port : _bytes = (port-buf)) (_int = PORT-SIZE) _getnameinfo-flags -> (ret : _int)
-> (if (= ret 0)
(make-sockaddr (cstring->string host)
(cstring->string port))
#f))]
[inet-ntoa
(integer? . => . string?)
(_fun _int32 -> (ret : _string)
-> (if ret
ret
(raise (make-exn:fail:network "inet-ntoa invalid address" (current-continuation-marks)))))]
[inet-addr
(string? . => . integer?)
(_fun (in : _string) -> (ret : _int)
-> (cond
[(= #xFFFFFFFF ret)
(if (equal? in "255.255.255.255") ret
(raise (make-exn:fail:network "inet-addr invalid address" (current-continuation-marks))))]
[else ret]))]
[ntohl
(integer? . => . integer?)
(_fun _uint32 -> _uint32)]
[ntohs
(integer? . => . integer?)
(_fun _uint16 -> _uint16)]
[htonl
(integer? . => . integer?)
(_fun _uint32 -> _uint32)]
[htons
(integer? . => . integer?)
(_fun _uint16 -> _uint16)]))
)