From 9182885c7fb310c4a7060f82be8fadc382409be0 Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Sun, 2 Dec 2007 01:23:18 +0100 Subject: [PATCH] LOOKUP-HOST now returns the host's truename as second value. Signed-off-by: Stelian Ionescu --- sockets/dns/lookup.lisp | 26 +++++++++++++++----------- sockets/namedb/hosts.lisp | 4 +++- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/sockets/dns/lookup.lisp b/sockets/dns/lookup.lisp index 814f90d..7542b55 100644 --- a/sockets/dns/lookup.lisp +++ b/sockets/dns/lookup.lisp @@ -49,7 +49,7 @@ (defun dns-lookup-host-by-address (address ipv6) (let ((reply (dns-query address :type :ptr))) - (check-reply-for-errors reply address) + (check-reply-for-errors reply address :ptr) (let ((hostname (remove-trailing-dot (dns-rr-data (aref (dns-message-answer reply) 0))))) (assert (eq :ptr (dns-record-type (aref (dns-message-answer reply) 0)))) @@ -57,35 +57,39 @@ (list (cons hostname address)))))) (defun lookup-host-by-address (address ipv6) - (multiple-value-bind (addresses aliases) + (multiple-value-bind (addresses truename aliases) (search-host-by-address address) - (cond (addresses (values addresses aliases)) + (cond (addresses (values addresses truename aliases)) (t (dns-lookup-host-by-address address ipv6))))) (defun process-one-reply (reply query-type) - (let (addresses aliases) + (let (truename addresses aliases) (loop :for rr :across (dns-message-answer reply) :do (switch ((dns-record-type rr) :test #'eq) - (:cname 'ok) + (:cname (setf truename (dns-rr-data rr))) (query-type (let ((address (ensure-address (dns-rr-data rr))) (name (remove-trailing-dot (dns-record-name rr)))) (push address addresses) (push (cons name address) aliases))) (t (warn "Invalid RR type: ~S" (dns-record-type rr))))) (values (nreverse addresses) + (remove-trailing-dot + (or truename + (dns-record-name (aref (dns-message-question reply) 0)))) (nreverse aliases)))) (defun dns-lookup-host-in-one-domain (host query-type) (let ((reply (dns-query host :type query-type))) - (check-reply-for-errors reply host) - (process-one-query reply query-type))) + (check-reply-for-errors reply host query-type) + (process-one-reply reply query-type))) (defun merge-a-and-aaaa-replies (4-reply 6-reply) - (multiple-value-bind (4-addresses 4-aliases) + (multiple-value-bind (4-addresses 4-truename 4-aliases) (process-one-reply 4-reply :a) - (multiple-value-bind (6-addresses 6-aliases) + (multiple-value-bind (6-addresses 6-truename 6-aliases) (process-one-reply 6-reply :aaaa) (values (nconc 4-addresses 6-addresses) + 4-truename (nconc 4-aliases 6-aliases))))) (defun dns-lookup-host-in-a-and-aaaa (host) @@ -111,9 +115,9 @@ ((t) (dns-lookup-host-in-a-and-aaaa host)))) (defun lookup-host-by-name (host ipv6) - (multiple-value-bind (addresses aliases) + (multiple-value-bind (addresses truename aliases) (search-host-by-name host ipv6) - (cond (addresses (values addresses aliases)) + (cond (addresses (values addresses truename aliases)) (t (dns-lookup-host-by-name host ipv6))))) ;; TODO: * implement address selection as per RFC 3484 diff --git a/sockets/namedb/hosts.lisp b/sockets/namedb/hosts.lisp index 8c97a67..a7cc420 100644 --- a/sockets/namedb/hosts.lisp +++ b/sockets/namedb/hosts.lisp @@ -114,6 +114,7 @@ (host-aliases host)))) hosts) (values (nreverse addresses) + name (nreverse aliases)))))) (defun search-host-by-address (address) @@ -123,7 +124,8 @@ address)) *hosts-cache*))) (when host - (values address + (values (list address) + (host-truename host) (list* (cons (host-truename host) address) (mapcar #'(lambda (alias) (cons alias address)) (host-aliases host))))))) -- 2.11.4.GIT