sunet/scheme/dnsd/options.scm

215 lines
8.9 KiB
Scheme

; ---------------------
; --- DNSD-Options ---
; ---------------------
; 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 dnsd-options :dnsd-options
(really-make-dnsd-options
port dir nameservers use-axfr use-cache cleanup-interval retry-interval
use-db use-recursion rec-timeout socket-timeout socket-max-tries
max-connections blacklist-time blacklist-value use-pre/post debug-mode)
dnsd-options?
(port dnsd-options-port set-dnsd-options-port!)
(dir dnsd-options-dir set-dnsd-options-dir!)
(nameservers dnsd-options-nameservers set-dnsd-options-nameservers!)
(use-axfr dnsd-options-use-axfr? set-dnsd-options-use-axfr?!)
(use-cache dnsd-options-use-cache? set-dnsd-options-use-cache?!)
(cleanup-interval dnsd-options-cleanup-interval set-dnsd-options-cleanup-interval!)
(retry-interval dnsd-options-retry-interval set-dnsd-options-retry-interval!)
(use-db dnsd-options-use-db? set-dnsd-options-use-db?!)
(use-recursion dnsd-options-use-recursion? set-dnsd-options-use-recursion?!)
(rec-timeout dnsd-options-rec-timeout set-dnsd-options-rec-timeout!)
(socket-timeout dnsd-options-socket-timeout set-dnsd-options-socket-timeout!)
(socket-max-tries dnsd-options-socket-max-tries set-dnsd-options-socket-max-tries!)
(max-connections dnsd-options-max-connections set-dnsd-options-max-connections!)
(blacklist-time dnsd-options-blacklist-time set-dnsd-options-blacklist-time!)
(blacklist-value dnsd-options-blacklist-value set-dnsd-options-blacklist-value!)
(use-pre/post dnsd-options-use-pre/post set-dnsd-options-use-pre/post!)
(debug-mode dnsd-options-debug-mode set-dnsd-options-debug-mode!))
(define (make-default-dnsd-options)
(really-make-dnsd-options
53 ; Port to listen
"./" ; Path to the zone & option files.
'() ; Use the default SBELT-Servers
; Example-list: (list "192.168.2.1" "193.159.170.187" "192.36.148.17")
; or (dns-find-nameserver-list) ; SBELT-Nameserver(s) for recursion.
#t ; Toggles sending AXFR-responses
#t ; Toggles the use of the cache
(* 60 60) ; Cache garbage-collect interval in seconds
(* 60 60) ; Min. time-val (sec) to reload a zone
#t ; If #f don't use the db.
#t ; If #f don't use recursion.
10 ; Timeout (sec) for recursion.
2 ; Timeout (sec) for a query (resolver interface).
3 ; Max. tries on a socket (resolver interface).
25 ; Max. concurrent connections for UDP and TCP.
(* 60 30) ; How long will a blacklist entry be valid?
5 ; How often must a NS be bad to be ignored.
#f ; Don't use pre- and post-processing by default.
#f)) ; Print debug-options to syslog.
(define (copy-dnsd-options options)
(really-make-dnsd-options (dnsd-options-port options)
(dnsd-options-dir options)
(dnsd-options-nameservers options)
(dnsd-options-use-axfr? options)
(dnsd-options-use-cache? options)
(dnsd-options-cleanup-interval options)
(dnsd-options-retry-interval options)
(dnsd-options-use-db? options)
(dnsd-options-use-recursion? options)
(dnsd-options-rec-timeout options)
(dnsd-options-socket-timeout options)
(dnsd-options-socket-max-tries options)
(dnsd-options-max-connections options)
(dnsd-options-blacklist-time options)
(dnsd-options-blacklist-value options)
(dnsd-options-use-pre/post options)
(dnsd-options-debug-mode options)))
(define (make-dnsd-options-transformer set-option!)
(lambda (new-value . stuff)
(let ((new-options (if (not (null? stuff))
(copy-dnsd-options (car stuff))
(make-default-dnsd-options))))
(set-option! new-options new-value)
new-options)))
(define with-port
(make-dnsd-options-transformer set-dnsd-options-port!))
(define with-dir
(make-dnsd-options-transformer set-dnsd-options-dir!))
(define with-nameservers
(make-dnsd-options-transformer set-dnsd-options-nameservers!))
(define with-axfr
(make-dnsd-options-transformer set-dnsd-options-use-axfr?!))
(define with-cache
(make-dnsd-options-transformer set-dnsd-options-use-cache?!))
(define with-cleanup-interval
(make-dnsd-options-transformer set-dnsd-options-cleanup-interval!))
(define with-retry-interval
(make-dnsd-options-transformer set-dnsd-options-retry-interval!))
(define with-db
(make-dnsd-options-transformer set-dnsd-options-use-db?!))
(define with-recursion
(make-dnsd-options-transformer set-dnsd-options-use-recursion?!))
(define with-rec-timeout
(make-dnsd-options-transformer set-dnsd-options-rec-timeout!))
(define with-socket-timeout
(make-dnsd-options-transformer set-dnsd-options-socket-timeout!))
(define with-socket-max-tries
(make-dnsd-options-transformer set-dnsd-options-socket-max-tries!))
(define with-max-connections
(make-dnsd-options-transformer set-dnsd-options-max-connections!))
(define with-blacklist-time
(make-dnsd-options-transformer set-dnsd-options-blacklist-time!))
(define with-blacklist-value
(make-dnsd-options-transformer set-dnsd-options-blacklist-value!))
(define with-use-pre/post
(make-dnsd-options-transformer set-dnsd-options-use-pre/post!))
(define with-debug-mode
(make-dnsd-options-transformer set-dnsd-options-debug-mode!))
(define (make-dnsd-options . stuff)
(let loop ((options (make-default-dnsd-options))
(stuff stuff))
(if (null? stuff)
options
(let* ((transformer (car stuff))
(value (cadr stuff)))
(loop (transformer value options)
(cddr stuff))))))
(define (make-options-from-list o-list options)
(if (eq? (car o-list) 'options)
(begin
(for-each
(lambda (e)
(let ((id (car e))
(value (cadr e)))
(case id
((dir)
(if (string? value)
(set-dnsd-options-dir! options value)
(error "Bad option argument.")))
((nameservers)
(if (list? value)
(set-dnsd-options-nameservers! options value)
(error "Bad option argument.")))
((use-axfr)
(if (boolean? value)
(set-dnsd-options-use-axfr?! options value)
(error "Bad option argument.")))
((use-cache)
(if (boolean? value)
(set-dnsd-options-use-cache?! options value)
(error "Bad option argument.")))
((cleanup-interval)
(if (and (number? value) (<= 10 value))
(set-dnsd-options-cleanup-interval! options value)
(error "Bad option argument.")))
((retry-interval)
(if (and (number? value) (<= 10 value))
(set-dnsd-options-retry-interval! options value)
(error "Bad option argument.")))
((use-db)
(if (boolean? value)
(set-dnsd-options-use-db?! options value)
(error "Bad option argument.")))
((use-recursion)
(if (boolean? value)
(set-dnsd-options-use-recursion?! options value)
(error "Bad option argument.")))
((rec-timeout)
(if (and (number? value) (<= 1 value))
(set-dnsd-options-rec-timeout! options value)
(error "Bad options argument.")))
((socket-timeout)
(if (and (number? value) (<= 1 value) (> 13 value))
(set-dnsd-options-socket-timeout! options value)
(error "Bad options argument.")))
((socket-max-tries)
(if (and (number? value) (<= 1 value) (> 13 value))
(set-dnsd-options-socket-max-tries! options value)
(error "Bad options argument.")))
((max-connections)
(if (and (number? value) (<= 1 value))
(set-dnsd-options-max-connections! options value)
(error "Bad options argument.")))
((blacklist-time)
(if (and (number? value) (<= 60 value))
(set-dnsd-options-blacklist-time! options value)
(error "Bad options argument.")))
((blacklist-value)
(if (and (number? value) (<= 1 value))
(set-dnsd-options-blacklist-value! options value)
(error "Bad options argument.")))
((use-pre/post)
(if (boolean? value)
(set-dnsd-options-use-pre/post! options value)
(error "Bad options argument.")))
((debug-mode)
(if (boolean? value)
(set-dnsd-options-debug-mode! options value)
(error "Bad options argument.")))
(else (error "Bad option.")))))
(cdr o-list))
options)
(error "Not an option list.")))