enum.scm

(define-module (dns enum)
  :export (rr-types
           int->rr rr->int
           class-types
           int->class class->int
           rcode-types
           int->rcode rcode->int
           opcode-types
           int->opcode opcode->int))

(define (flip-cons c)
  (cons (cdr c) (car c)))

(define (make-mappings name table)
  (values
   (lambda (i)
     (cond ((assv i (map flip-cons table)) => cdr)
           ((integer? i) (inexact->exact i))
           (else (scm-error 'wrong-type-arg (format #f "int->~a" name)
                            "Unknown value ~s, expected known integer or one of ~a"
                            (list i (map car table)) (list (map car table))))))

   (lambda (value)
     (cond ((integer? value) (inexact->exact value))
           ((assv value table) => cdr)
           (else (scm-error 'wrong-type-arg (format #f "~a->int" name)
                            "Unknown value ~s"
                            (list value) #f)))  )))

;; All number are documented at
;; https://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml

(define rr-types
  '(; 0 reserved
    (A     . 1)
    (NS    . 2)
    (MD    . 3)
    (MF    . 4)
    (CNAME . 5)
    (SOA   . 6)
    (MB    . 7)
    (MG    . 8)
    (MR    . 9)
    (NULL  . 10)
    (WKS   . 11)
    (PTR   . 12)
    (HINFO . 13)
    (MINFO . 14)
    (MX    . 15)
    (TXT   . 16)
    (RP    . 17)
    (AFSDB . 18)
    (X25   . 19)
    (ISDN  . 20)
    (RT    . 21)
    (NSAP  . 22)
    (NSAP-PTR . 23)
    (SIG   . 24)
    (KEY   . 25)
    (PX    . 26)
    (GPOS  . 27)
    (AAAA  . 28)
    (LOC   . 29)
    (NXT   . 30)
    (EID   . 30)
    (NIMLOC . 32)
    (SRV   . 33)
    (ATMA  . 34)
    (NAPTR . 35)
    (KX    . 36)
    (CERT  . 37)
    (A6    . 38)
    (DNAME . 39)
    (SINK  . 40)
    (OPT   . 41)
    (APL   . 42)
    (DS    . 43)
    (SSHFP . 44)
    (IPSECKEY . 45)
    (RRSIG  . 46)
    (NSEC   . 47)
    (DNSKEY . 48)
    (DHCID  . 49)
    (NSEC3  . 50)
    (NSEC3PARAM . 51)
    (TLSA   . 52)
    (SMIMEA . 53)
    ;; 54 unasigned
    (HIP    . 55)
    (NINFO  . 56)
    (RKEY   . 57)
    (TALINK . 58)
    (CDS    . 59)
    (CDNSKEY . 60)
    (OPENPGPKEY . 61)
    (CSYNC  . 62)
    (ZONEMD . 63)
    (SVCB   . 64)
    (HTTPS  . 65)
    ;; 66-98 unasigned
    (SPF    . 99)
    (UINFO  . 100)
    (UID    . 101)
    (GID    . 102)
    (UNSPEC . 103)
    (NID    . 104)
    (L32    . 105)
    (L64    . 106)
    (LP     . 107)
    (EUI48  . 108)
    (EUI64  . 109)
    ;; 110-248 unasigned
    (TKEY   . 249)
    (TSIG   . 250)
    (IXFR   . 251)
    (AXFR   . 252)
    (MAILB  . 253)
    (MAILA  . 254)
    (*      . 255)
    (URI    . 256)
    (CAA    . 257)
    (AVC    . 258)
    (DOA    . 290)
    (AMTRELAY . 260)
    ;; 261-32767 unasigned
    (TA     . 32765)
    (DLV    . 32769)
    ;; 32770-65279 unasigned
    ;; 65280-65534 private use
    ;; 65535 reserved
    ))

(define-values (int->rr rr->int)
  (make-mappings "rr" rr-types))

(define class-types
  '((IN . 1)
    (CS . 2)
    (CH . 3)
    (HS . 4)))

(define-values (int->class class->int)
  (make-mappings "class" class-types))

(define rcode-types
  '((NOERROR   . 0) ; no error condition
    (FORMERR   . 1) ; format error - name server can't interpret
    (SERVFAIL  . 2) ; server failure
    (NXDOMAIN  . 3) ; non-exisent domain
    (NOTIMP    . 4) ; Not implemented
    (REFUSED   . 5)
    (YXDOMAIN  . 6)
    (YXRRSET   . 7)
    (NXRRSET   . 8)
    (NOTAUTH   . 9) ; Two different means exists for NotAuth
    (NOTZONE   . 10)
    (DSOTYPENI . 11)
    ;; 12-15 unasigned
    (BADSIG    . 16) ; BADSIG and BADVERS share code 16, BADSIG being before
    (BADVERS   . 16) ; means it gets choosen by int->rcode.
    (BADKEY    . 17)
    (BADTIME   . 18)
    (BADMODE   . 19)
    (BADNAME   . 20)
    (BADALG    . 21)
    (BADTRUNC  . 22)
    (BADCOOKIE . 23)
    ;; 24-3840 unasigned
    ;; 3841-4095 private use
    ;; 4096-65534 unasigned
    ;; 65535 reserved
    ))

(define-values (int->rcode rcode->int)
               (make-mappings "rcode" rcode-types))


(define opcode-types
  '((QUERY  . 0)
    (IQUERY . 1)
    (STATUS . 2)
    ;; 3 unasigned
    (NOTIFY . 4)
    (UPDATE . 5)
    (DSA    . 6) ; DNS Stateful Operations
    ;; 7-15 unasigned
    ))

(define-values (int->opcode opcode->int)
               (make-mappings "opcode" opcode-types))