56 lines
2.0 KiB
Racket
56 lines
2.0 KiB
Racket
#lang racket/base
|
|
;; Untyped struct definitions required to interoperate with marketplace's struct-map
|
|
;; See also Racket PR 13593.
|
|
;;
|
|
;;; Copyright 2010, 2011, 2012, 2013 Tony Garnock-Jones <tonyg@ccs.neu.edu>
|
|
;;;
|
|
;;; This file is part of marketplace-dns.
|
|
;;;
|
|
;;; marketplace-dns is free software: you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU General Public License as
|
|
;;; published by the Free Software Foundation, either version 3 of the
|
|
;;; License, or (at your option) any later version.
|
|
;;;
|
|
;;; marketplace-dns 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
|
|
;;; General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; along with marketplace-dns. If not, see
|
|
;;; <http://www.gnu.org/licenses/>.
|
|
|
|
(provide (struct-out domain)
|
|
downcase-labels
|
|
make-domain)
|
|
|
|
;; (These utilities need to be defined ahead of the domain struct
|
|
;; definition.)
|
|
(define (domain=? a b recursive-equal?)
|
|
(recursive-equal? (domain-downcased-labels a)
|
|
(domain-downcased-labels b)))
|
|
|
|
(define (domain-hash-1/2 d recursive-hash)
|
|
(recursive-hash (domain-downcased-labels d)))
|
|
|
|
(struct domain (labels downcased-labels)
|
|
#:transparent
|
|
#:property prop:equal+hash (list domain=? domain-hash-1/2 domain-hash-1/2))
|
|
|
|
;; ListOf<Bytes> -> ListOf<Bytes>
|
|
;; Converts the 7-bit ASCII bytes in the argument to lower-case
|
|
;; equivalents. Used to normalize case for domain-name comparisons.
|
|
(define (downcase-labels labels)
|
|
(for/list ([label labels])
|
|
(define b (make-bytes (bytes-length label)))
|
|
(for ([i (bytes-length label)])
|
|
(define v (bytes-ref label i))
|
|
(bytes-set! b i (if (<= 65 v 90) (+ 32 v) v)))
|
|
b))
|
|
|
|
;; ListOf<Bytes> -> DomainName
|
|
;; Replacement constructor for domain structs. Automatically downcases
|
|
;; labels appropriately.
|
|
(define (make-domain labels)
|
|
(domain labels (downcase-labels labels)))
|