(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)
  
  ;; use utf-8 strings
  (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)))
  
  ;; Flag values for getnameinfo
  (define _getnameinfo-flags
    (_bitmask 
     '(NI-NONE = 0
               NI-NOFQDN = 1
               NI-NUMERICHOST = 2
               NI-NAMEREQD = 4
               NI-NUMERICSERV = 8
               NI-DGRAM  = 16)))
  
  
  ;; Define the sockaddr and _sockaddr structures
  (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 the _ip-addr structure
  (define/provide _ip-addr
    (make-ctype _int32 
                (lambda (ip-addr) (inet-addr ip-addr))
                (lambda (int)
                  (inet-ntoa int))))
  
  (ffi-func/contract libc
                     (("-" "_"))
                     ;; getnameinfo Takes a sockaddr pointer and NI- flags and returns a sockaddr
                     ([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)))))]
                      ;; We're using inet-addr instead of inet-aton for compatibility with windows
                      ;; We should use a more elegant solution
                      [inet-addr
                       (string? . => . integer?)
                       (_fun (in : _string) -> (ret : _int)
                             -> (cond
                                  [(= #xFFFFFFFF ret) 
                                   (if (equal? in "255.255.255.255") ; This is technically invalid as the octets can be in octal or hex
                                       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)]))
  
  )