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