;;  network: a library of network utilities.
;;  Copyright (C) 2006 Dave Herman
;; 
;;  Portions based on JUG (Java Uuid Generator)
;;  Copyright (c) 2002-2004 Tatu Saloranta, tatu.saloranta@iki.fi
;; 
;;  This library is free software; you can redistribute it and/or modify it
;;  under the terms of the GNU Lesser General Public License as published by
;;  the Free Software Foundation; either version 2.1 of the License, or (at
;;  your option) any later version.
;; 
;;  This library is distributed in the hope that it will be useful, but WITHOUT
;;  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;;  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;  License for more details.
;; 
;;  You should have received a copy of the GNU Lesser General Public License
;;  along with this library; if not, write to the Free Software Foundation,
;;  Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

(module windows mzscheme
  (require (lib "foreign.ss"))
  (unsafe!)

  (define ERROR_BUFFER_OVERFLOW 111)
  (define NO_ERROR 0)

  (define (bytes->string/zero-terminated bytes)
    (let loop ([i 0])
      (if (or (>= i (bytes-length bytes))
              (zero? (bytes-ref bytes i)))
          (bytes->string/latin-1 bytes #f 0 i)
          (loop (add1 i)))))

  ;; See <windows.txt> for the layout of IP_ADAPTER_INFO.

  (define sizeof-IP_ADAPTER_INFO 648)

  (define (adapter-info p)
    (let ([raw (make-sized-byte-string p sizeof-IP_ADAPTER_INFO)])
      (let ([AdapterName (bytes->string/zero-terminated (subbytes raw 8 268))]
            [Description (bytes->string/zero-terminated (subbytes raw 268 400))]
            [Address (bytes->list (subbytes raw 404 410))]
            [IpAddressList.IpAddress (bytes->string/zero-terminated (subbytes raw 432 448))]
            [IpAddressList.IpMask (bytes->string/zero-terminated (subbytes raw 448 464))])
        `((name        . ,AdapterName)
          (description . ,Description)
          (address     . ,Address)
          (ip          . ,IpAddressList.IpAddress)
          (mask        . ,IpAddressList.IpMask)))))

  (define (current-network-adapters)
    (let ([GetAdaptersInfo (get-ffi-obj 'GetAdaptersInfo "iphlpapi.dll"
                             (_fun _pointer _pointer -> _uint32))]
          [pSize (malloc 4)])
      (let loop ([size sizeof-IP_ADAPTER_INFO])
        (let ([pAdapterInfo (malloc size)])
          (ptr-set! pSize _uint32 size)
          (let ([result (GetAdaptersInfo pAdapterInfo pSize)])
            (cond
              [(= result ERROR_BUFFER_OVERFLOW)
               (free pAdapterInfo)
               (loop (ptr-ref pSize _uint32))]
              [(= result NO_ERROR)
               (dynamic-wind
                void
                (lambda ()
                  (let loop ([p pAdapterInfo] [accum null])
                    (let ([info1 (adapter-info p)])
                      (if (zero? (ptr-ref p _uint32))
                          (cons info1 accum)
                          (loop (ptr-ref p _pointer) (cons info1 accum))))))
                (lambda ()
                  (free pSize)
                  (free pAdapterInfo)))]
              [else
               (free pSize)
               (free pAdapterInfo)
               (error 'get-adapters-info (format "error number ~a" result))]))))))

  (provide current-network-adapters))