(module mac mzscheme (require (lib "pregexp.ss")) (require (lib "list.ss")) (require "mac-win32.scm") (require "mac-unix.scm") (provide get-mac-address mac-address-of-this-host? available-mac-addresses good-mac-address? mac-address->vector possible-mac-addresses ) (define get-mac-addresses (if (eq? (system-type 'os) 'windows) get-mac-addresses-win32 get-mac-addresses-unix)) (define (hex->dec d) (cond ((eq? d #\0) 0) ((eq? d #\1) 1) ((eq? d #\2) 2) ((eq? d #\3) 3) ((eq? d #\4) 4) ((eq? d #\5) 5) ((eq? d #\6) 6) ((eq? d #\7) 7) ((eq? d #\8) 8) ((eq? d #\9) 9) ((eq? d #\a) 10) ((eq? d #\b) 11) ((eq? d #\c) 12) ((eq? d #\d) 13) ((eq? d #\e) 14) ((eq? d #\f) 15))) (define (mac-address->vector A) (list->vector (map (lambda (part) (let ((u (string-ref part 0)) (l (string-ref part 1))) (+ (* (hex->dec u) 16) (hex->dec l)))) (pregexp-split "[-:]" (string-downcase A))))) (define (good-mac-address? A) (let ((re (pregexp (format "~a~a~a" "^" (re-mac) "$")))) (if (pregexp-match re A) (let ((adr (mac-address->vector A))) (if (or (= (vector-ref adr 1) 0) (= (vector-ref adr 1) 255)) #f #t))))) (define (get-mac-address) (letrec ((f (lambda (adrs) (if (null? adrs) #f (if (good-mac-address? (car adrs)) (car adrs) (f (cdr adrs))))))) (f (sort (get-mac-addresses) string-ci<?)))) (define (available-mac-addresses) (get-mac-addresses)) (define (possible-mac-addresses) (sort (filter good-mac-address? (available-mac-addresses)) string-ci<?)) (define (mac-address-of-this-host? A) (letrec ((f (lambda (adrs) (if (null? adrs) #f (if (string-ci=? A (car adrs)) #t (f (cdr adrs))))))) (f (available-mac-addresses)))) )