mac-win32.scm
(module mac-win32 mzscheme
        (require (lib "foreign.ss"))
        (provide get-mac-addresses-win32)
         
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; This library is very unsafe, lets get the needed function
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (unsafe!) 
        
        (define lib (with-handlers ((exn:fail? (lambda (exn) #f)))
                                    (ffi-lib "iphlpapi")))
        
        (define getadaptersinfo (with-handlers ((exn:fail? (lambda (exn) #f)))
                                  (get-ffi-obj "GetAdaptersInfo" lib
                                               (_fun (info : _pointer)
                                                     (buflen : (_ptr io _ulong))
                                                     -> (result : _ulong)
                                                     -> (values result buflen)))))

        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; MAC Address functions
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define ADR_OFFSET   (+ (ctype-sizeof _pointer)
                                (ctype-sizeof _ulong)
                                (+ 256 4) 
                                (+ 128 4) 
                                (ctype-sizeof _uint)))
        
        (define (make-hex x)
          (if (< x 16) 
              (format "0~x" x)
              (format "~x" x)))
        
        (define (make-mac-address . adrs)
          (apply string-append (cons (make-hex (car adrs))
                                     (map (lambda (a) (format ":~a" (make-hex a))) (cdr adrs)))))
        
        (define (get-mac-addresses-win32)
          (let* ((AI #f)
                 (bl  0))
            (call-with-values 
             (lambda () (getadaptersinfo AI bl))
             (lambda (result buflen)
               (let ((BUF (malloc buflen)))
                 (call-with-values
                  (lambda () (getadaptersinfo BUF buflen))
                  (lambda (result buflen)
                    (if (= result 0)
                        (letrec ((f (lambda (next)
                                      (if (eq? next #f)
                                          '()
                                          (let ((adr0 (ptr-ref next _ubyte 'abs ADR_OFFSET))
                                                (adr1 (ptr-ref next _ubyte 'abs (+ ADR_OFFSET 1)))
                                                (adr2 (ptr-ref next _ubyte 'abs (+ ADR_OFFSET 2)))
                                                (adr3 (ptr-ref next _ubyte 'abs (+ ADR_OFFSET 3)))
                                                (adr4 (ptr-ref next _ubyte 'abs (+ ADR_OFFSET 4)))
                                                (adr5 (ptr-ref next _ubyte 'abs (+ ADR_OFFSET 5))))
                                            (let ((_next (ptr-ref next _pointer 0)))
                                              (cons (make-mac-address adr0 adr1 adr2 adr3 adr4 adr5)
                                                    (f _next))))))))
                          (f BUF))
                        (error "Cannot get mac addresses")))))))))

        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
          )
        

;typedef struct _IP_ADAPTER_INFO {
;    struct _IP_ADAPTER_INFO* Next;
;    DWORD ComboIndex;
;    char AdapterName[MAX_ADAPTER_NAME_LENGTH + 4];
;    char Description[MAX_ADAPTER_DESCRIPTION_LENGTH + 4];
;    UINT AddressLength;
;    BYTE Address[MAX_ADAPTER_ADDRESS_LENGTH];
;    DWORD Index;
;    UINT Type;
;    UINT DhcpEnabled;
;    PIP_ADDR_STRING CurrentIpAddress;
;    IP_ADDR_STRING IpAddressList;
;    IP_ADDR_STRING GatewayList;
;    IP_ADDR_STRING DhcpServer;
;    BOOL HaveWins;
;    IP_ADDR_STRING PrimaryWinsServer;
;    IP_ADDR_STRING SecondaryWinsServer;
;    time_t LeaseObtained;
;    time_t LeaseExpires;
;} IP_ADAPTER_INFO, *PIP_ADAPTER_INFO;

;DWORD GetMACaddress(void)
;{
;  DWORD MACaddress = 0;
;  IP_ADAPTER_INFO AdapterInfo[16];       // Allocate information
;                                         // for up to 16 NICs
;  DWORD dwBufLen = sizeof(AdapterInfo);  // Save memory size of buffer

;  DWORD dwStatus = GetAdaptersInfo(      // Call GetAdapterInfo
;			AdapterInfo,                 // [out] buffer to receive data
;			&dwBufLen);                  // [in] size of receive data buffer
;  assert(dwStatus == ERROR_SUCCESS);  // Verify return value is
;                                      // valid, no buffer overflow

;  PIP_ADAPTER_INFO pAdapterInfo = AdapterInfo; // Contains pointer to
;                                               // current adapter info
;  do {
;	if (MACaddress == 0)
;		MACaddress = pAdapterInfo->Address [5] + pAdapterInfo->Address [4] * 256 +
;					pAdapterInfo->Address [3] * 256 * 256 +
;					pAdapterInfo->Address [2] * 256 * 256 * 256;
;    PrintMACaddress(pAdapterInfo->Address); // Print MAC address
;    pAdapterInfo = pAdapterInfo->Next;    // Progress through linked list
;  }
;  while(pAdapterInfo);                    // Terminate if last adapter
; 
;  return MACaddress;
;}       
;       
;       
;       
;