scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Removed fqdn? and unqualified-hostname

This commit is contained in:
mainzelm 2003-02-10 13:13:26 +00:00
parent 35efb036af
commit 0b8c33af3f
1 changed files with 19 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
scheme/lib/dns.scm
View File

@ -1424,8 +1424,12 @@
(socket-address->internet-address addr) (socket-address->internet-address addr)
(apply dns-lookup-ip ip32 args))) (apply dns-lookup-ip ip32 args)))
(define (fqdn? name) ;; Some code to test the components of domain names
(regexp-search? (rx #\.) name)) ;;(define label-regexp
;; (rx (: alpha (? (* (| alphanumeric "-")) alphanumeric))))
;;(define (unqualified-hostname name)
;; (regexp-search? (rx (: ,label-regexp)) name))
(define (maybe-dns-lookup-name name . args) (define (maybe-dns-lookup-name name . args)
(call-with-current-continuation (call-with-current-continuation
@ -1435,7 +1439,7 @@
(k #f) (k #f)
(more))) (more)))
(lambda () (lambda ()
(dns-lookup-name name args)))))) (apply dns-lookup-name name args))))))
(define (maybe-dns-lookup-ip ip-addr . args) (define (maybe-dns-lookup-ip ip-addr . args)
(call-with-current-continuation (call-with-current-continuation
@ -1460,16 +1464,18 @@
(if (socket-address? name-or-socket-address) (if (socket-address? name-or-socket-address)
(apply socket-address->fqdn name-or-socket-address args) (apply socket-address->fqdn name-or-socket-address args)
(let ((name name-or-socket-address)) (let ((name name-or-socket-address))
(if (fqdn? name) (cond ((apply maybe-dns-lookup-name name args)
name => (lambda (ip)
(let lp ((domains (domains-for-search))) (apply dns-lookup-ip ip args)))
(if (null? domains) (else
#f (let lp ((domains (domains-for-search)))
(cond ((apply maybe-dns-lookup-name (if (null? domains)
(string-append name "." (car domains)) args) #f
=> (lambda (ip) (cond ((apply maybe-dns-lookup-name
(apply dns-lookup-ip ip args))) (string-append name "." (car domains)) args)
(else (lp (cdr domains)))))))))) => (lambda (ip)
(apply dns-lookup-ip ip args)))
(else (lp (cdr domains)))))))))))
(define (system-fqdn . args) (define (system-fqdn . args)
(apply host-fqdn (system-name) args)) (apply host-fqdn (system-name) args))