135 lines
4.4 KiB
Scheme
135 lines
4.4 KiB
Scheme
;; ------------------------
|
|
;; --- Database-Options ---
|
|
;; ------------------------
|
|
|
|
; Database-Options for DNS-Server based on the RFCs: 1034 / 1035
|
|
|
|
; This file is part of the Scheme Untergrund Networking package
|
|
|
|
; Copyright (c) 2005/2006 by Norbert Freudemann
|
|
; <nofreude@informatik.uni-tuebingen.de>
|
|
; For copyright information, see the file COPYING which comes with
|
|
; the distribution.
|
|
|
|
; The format and style of the option procedures is the same as seen
|
|
; in the SUNet HTTPD & FTPD - Files
|
|
|
|
|
|
(define-record-type dnsddb-options :dnsddb-options
|
|
(really-make-dnsddb-options name class type primary? file filetype master-name master-ip)
|
|
dnsddb-options?
|
|
(name dnsddb-options-name set-dnsddb-options-name!)
|
|
(class dnsddb-options-class set-dnsddb-options-class!)
|
|
(type dnsddb-options-type set-dnsddb-options-type!)
|
|
(primary? dnsddb-options-primary? set-dnsddb-options-primary?!) ;;depreaced
|
|
(file dnsddb-options-file set-dnsddb-options-file!)
|
|
(filetype dnsddb-options-filetype set-dnsddb-options-filetype!)
|
|
(master-name dnsddb-options-master-name set-dnsddb-options-master-name!)
|
|
(master-ip dnsddb-options-master-ip set-dnsddb-options-master-ip!))
|
|
|
|
|
|
(define (make-default-dnsddb-options)
|
|
(really-make-dnsddb-options
|
|
"" ;; the name of the zone
|
|
(message-class in)
|
|
"primary" ;;
|
|
#t ;; is primary?
|
|
"" ;; a filename
|
|
"dnsd" ;; "dnsd" or "rfc"
|
|
#f ;; Has to be set by dnsd-zones.scm, e.g. "dns01.my.example."
|
|
#f)) ;; e.g. "192.168.2.1" or #f
|
|
|
|
|
|
(define (copy-dnsddb-options options)
|
|
(really-make-dnsddb-options
|
|
(dnsddb-options-name options)
|
|
(dnsddb-options-class options)
|
|
(dnsddb-options-type options)
|
|
(dnsddb-options-primary? options)
|
|
(dnsddb-options-file options)
|
|
(dnsddb-options-filetype options)
|
|
(dnsddb-options-master-name options)
|
|
(dnsddb-options-master-ip options)))
|
|
|
|
|
|
(define (make-dnsddb-options-transformer set-option!)
|
|
(lambda (new-value . stuff)
|
|
(let ((new-options (if (not (null? stuff))
|
|
(copy-dnsddb-options (car stuff))
|
|
(make-default-dnsddb-options))))
|
|
(set-option! new-options new-value)
|
|
new-options)))
|
|
|
|
|
|
(define with-name
|
|
(make-dnsddb-options-transformer set-dnsddb-options-name!))
|
|
(define with-class
|
|
(make-dnsddb-options-transformer set-dnsddb-options-class!))
|
|
(define with-type
|
|
(make-dnsddb-options-transformer set-dnsddb-options-type!))
|
|
(define with-primary?
|
|
(make-dnsddb-options-transformer set-dnsddb-options-primary?!))
|
|
(define with-file
|
|
(make-dnsddb-options-transformer set-dnsddb-options-file!))
|
|
(define with-filetype
|
|
(make-dnsddb-options-transformer set-dnsddb-options-filetype!))
|
|
(define with-master-name
|
|
(make-dnsddb-options-transformer set-dnsddb-options-master-name!))
|
|
(define with-master-ip
|
|
(make-dnsddb-options-transformer set-dnsddb-options-master-ip!))
|
|
|
|
|
|
(define (make-dnsddb-options . stuff)
|
|
(let loop ((options (make-default-dnsddb-options))
|
|
(stuff stuff))
|
|
(if (null? stuff)
|
|
options
|
|
(let* ((transformer (car stuff))
|
|
(value (cadr stuff)))
|
|
(loop (transformer value options)
|
|
(cddr stuff))))))
|
|
|
|
|
|
(define (make-db-options-from-list o-list)
|
|
(let ((options (make-default-dnsddb-options)))
|
|
(if (eq? (car o-list) 'zone)
|
|
(begin
|
|
(for-each
|
|
(lambda (e)
|
|
(let ((id (car e))
|
|
(value (cadr e)))
|
|
(case id
|
|
((name)
|
|
(if (string? value)
|
|
(set-dnsddb-options-name!
|
|
options (make-fqdn-name value))
|
|
(error "Bad option argument.")))
|
|
((type)
|
|
(if (or (string-ci=? "primary" value)
|
|
(string-ci=? "secondary" value)
|
|
(string-ci=? "master" value)
|
|
(string-ci=? "slave" value))
|
|
(set-dnsddb-options-type! options value)
|
|
(error "Bad option argument.")))
|
|
((file)
|
|
(if (and (string? value) (file-name-non-directory? value))
|
|
(set-dnsddb-options-file! options value)
|
|
(error "Bad option argument.")))
|
|
((filetype)
|
|
(if (or (string-ci=? "dnsd" value)
|
|
(string-ci=? "rfc" value))
|
|
(set-dnsddb-options-filetype! options value)
|
|
(error "Bad option argument.")))
|
|
((master-name)
|
|
(if (string? value)
|
|
(set-dnsddb-options-master-name! options value)
|
|
(error "Bad option argument.")))
|
|
((master-ip)
|
|
(if (string? value)
|
|
(set-dnsddb-options-master-ip! options value)
|
|
(error "Bad option argument.")))
|
|
(else (error "Bad option.")))))
|
|
(cdr o-list))
|
|
options)
|
|
(error "Not an option list."))))
|