From d81c8fbd7f2239b4e26a08fdea7f6e411333b891 Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Fri, 4 Jan 2008 23:22:15 +0100 Subject: [PATCH] Cleanup: remove unused functions, use WITH-ACCESSORS instead of WITH-SLOTS in a few places. Signed-off-by: Stelian Ionescu --- sockets/conditions.lisp | 11 ------ sockets/dns/dynamic-buffer.lisp | 8 +++-- sockets/dns/message.lisp | 80 +++++++++++++++++++++++++++-------------- sockets/namedb/hosts.lisp | 16 --------- sockets/namedb/services.lisp | 4 +-- sockets/pkgdcl.lisp | 3 ++ sockets/socket-options.lisp | 5 --- 7 files changed, 64 insertions(+), 63 deletions(-) diff --git a/sockets/conditions.lisp b/sockets/conditions.lisp index 719967f..f23c5c7 100644 --- a/sockets/conditions.lisp +++ b/sockets/conditions.lisp @@ -35,17 +35,6 @@ (:method ((err system-error)) (osicat-sys:system-error-message err))) -(defun print-message-if-not-null (condition stream &optional - (eof-place :before)) - (declare (type stream stream)) - (let ((msg (error-message condition))) - (when msg - (when (eq eof-place :before) - (fresh-line stream)) - (format stream "~A" msg) - (when (eq eof-place :after) - (fresh-line stream))))) - ;;;; Socket Errors (define-condition socket-error (nix:posix-error) ()) diff --git a/sockets/dns/dynamic-buffer.lisp b/sockets/dns/dynamic-buffer.lisp index 62927e5..e5b3145 100644 --- a/sockets/dns/dynamic-buffer.lisp +++ b/sockets/dns/dynamic-buffer.lisp @@ -105,8 +105,12 @@ :initarg :buffer :reader buffer-of))) (define-condition input-buffer-eof (dynamic-buffer-input-error) - ((bytes-requested :initarg :requested :reader bytes-requested) - (bytes-remaining :initarg :remaining :reader bytes-remaining)) + ((octets-requested :initarg :requested :reader octets-requested) + (octets-remaining :initarg :remaining :reader octets-remaining)) + (:report (lambda (condition stream) + (format stream "You requested ~a octets but only ~A are left in the buffer" + (octets-requested condition) + (octets-remaining condition)))) (:documentation "Signals that an INPUT-BUFFER contains less unread bytes than requested.")) diff --git a/sockets/dns/message.lisp b/sockets/dns/message.lisp index 38c68ac..11476f6 100644 --- a/sockets/dns/message.lisp +++ b/sockets/dns/message.lisp @@ -26,15 +26,15 @@ (defclass dns-message () ((id :initform 0 :initarg :id :accessor dns-message-id) (flags :initform 0 :initarg :flags :accessor dns-message-flags) - (decoded-flags :reader decoded-flags) - (qdcount :initarg :qdcount :reader dns-message-question-count) - (ancount :initarg :ancount :reader dns-message-answer-count) - (nscount :initarg :nscount :reader dns-message-authority-count) - (arcount :initarg :arcount :reader dns-message-additional-count) - (question :reader dns-message-question) - (answer :reader dns-message-answer) - (authority :reader dns-message-authority) - (additional :reader dns-message-additional)) + (decoded-flags :initform nil :accessor dns-message-decoded-flags) + (qdcount :initarg :qdcount :accessor dns-message-question-count) + (ancount :initarg :ancount :accessor dns-message-answer-count) + (nscount :initarg :nscount :accessor dns-message-authority-count) + (arcount :initarg :arcount :accessor dns-message-additional-count) + (question :accessor dns-message-question) + (answer :accessor dns-message-answer) + (authority :accessor dns-message-authority) + (additional :accessor dns-message-additional)) (:default-initargs :qdcount 1 :ancount 0 :nscount 0 :arcount 0)) (defmacro define-flags-bitfield (name offset length &optional (type :integer)) @@ -85,12 +85,16 @@ (defgeneric dns-flag-p (message flag) (:method ((msg dns-message) flag) - (member flag (decoded-flags msg) :test #'eq))) + (member flag (dns-message-decoded-flags msg) :test #'eq))) (defmethod initialize-instance :after ((msg dns-message) &key (qdcount 0) (ancount 0) (nscount 0) (arcount 0)) - (with-slots (id flags decoded-flags question answer authority additional) msg + (with-accessors ((id dns-message-id) (flags dns-message-flags) + (decoded-flags dns-message-decoded-flags) + (question dns-message-question) (answer dns-message-answer) + (authority dns-message-authority) (additional dns-message-additional)) + msg (setf decoded-flags (decode-flags msg) question (make-array qdcount :adjustable t :fill-pointer 0) answer (make-array ancount :adjustable t :fill-pointer 0) @@ -99,7 +103,11 @@ (defmethod print-object ((msg dns-message) stream) (print-unreadable-object (msg stream :type nil :identity nil) - (with-slots (id decoded-flags question qdcount ancount nscount arcount) msg + (with-accessors ((id dns-message-id) (decoded-flags dns-message-decoded-flags) + (question dns-message-question) + (qdcount dns-message-question-count) (ancount dns-message-answer-count) + (nscount dns-message-authority-count) (arcount dns-message-additional-count)) + msg (format stream "DNS ~A Id: ~A, Question: ~A Flags: ~S, Sections: QD(~A) AN(~A) NS(~A) AD(~A)" (if (response-field msg) :response :query) id question decoded-flags @@ -111,23 +119,29 @@ (class :initarg :class :accessor dns-record-class))) (defmethod initialize-instance :after ((record dns-record) &key) - (with-slots (name type class) record - (check-type name string "a string") - (check-type type (satisfies dns-record-type-p) "a valid record type") - (check-type class (member :in) ":IN"))) + (with-accessors ((name dns-record-name) + (type dns-record-type) + (class dns-record-class)) + record + (check-type name string "a string") + (check-type type (satisfies dns-record-type-p) "a valid record type") + (check-type class (member :in) ":IN"))) (defclass dns-question (dns-record) ()) (defmethod print-object ((question dns-question) stream) (print-unreadable-object (question stream :type nil :identity nil) - (with-slots (name type class) question + (with-accessors ((name dns-record-name) + (type dns-record-type) + (class dns-record-class)) + question (format stream "~S ~A ~A" name type class)))) (defmethod initialize-instance :after ((record dns-question) &key) - (with-slots (name) record - (let ((name-length (length name))) - (when (char/= #\. (aref name (1- name-length))) - (setf name (concatenate 'string name ".")))))) + (with-accessors ((name dns-record-name)) record + (let ((name-length (length name))) + (when (char/= #\. (aref name (1- name-length))) + (setf name (concatenate 'string name ".")))))) ;;;; Constructors @@ -173,7 +187,10 @@ (defgeneric write-record (buffer record) (:method ((buffer dynamic-buffer) (record dns-question)) - (with-slots (name type class) record + (with-accessors ((name dns-record-name) + (type dns-record-type) + (class dns-record-class)) + record (write-domain-name buffer name) (write-ub16 buffer (query-type-number type)) (write-ub16 buffer (query-class-number class))))) @@ -181,7 +198,9 @@ (defgeneric write-message-header (buffer message) (:method ((buffer dynamic-buffer) (message dns-message)) - (with-slots (id flags question answer authority additional) + (with-accessors ((id dns-message-id) (flags dns-message-flags) + (question dns-message-question) (answer dns-message-answer) + (authority dns-message-authority) (additional dns-message-additional)) message (write-ub16 buffer id) (write-ub16 buffer flags) @@ -192,7 +211,7 @@ (defgeneric write-dns-message (message) (:method ((message dns-message)) - (with-slots (question) message + (with-accessors ((question dns-message-question)) message (with-dynamic-buffer (buffer) (write-message-header buffer message) (write-record buffer (aref question 0)))))) @@ -205,12 +224,15 @@ (defmethod print-object ((rr dns-rr) stream) (print-unreadable-object (rr stream :type nil :identity nil) - (with-slots (name type class ttl data) rr + (with-accessors ((name dns-record-name) (type dns-record-type) + (class dns-record-class) (ttl dns-rr-ttl) + (data dns-rr-data)) + rr (format stream "~S ~A ~A: ~A" name type class (decode-rr rr))))) (defmethod initialize-instance :after ((rr dns-rr) &key) - (with-slots (ttl) rr + (with-accessors ((ttl dns-rr-ttl)) rr (check-type ttl (unsigned-byte 32) "a valid TTL"))) (defgeneric add-question (message question) @@ -421,7 +443,11 @@ (:method ((buffer dynamic-buffer)) (defparameter *msg* buffer) (let ((msg (read-message-header buffer))) - (with-slots (qdcount ancount nscount arcount) msg + (with-accessors ((qdcount dns-message-question-count) + (ancount dns-message-answer-count) + (nscount dns-message-authority-count) + (arcount dns-message-additional-count)) + msg (loop :for i :below (dns-message-question-count msg) :for q := (read-question buffer) :do (add-question msg q)) diff --git a/sockets/namedb/hosts.lisp b/sockets/namedb/hosts.lisp index 58bb1e0..7c0fa51 100644 --- a/sockets/namedb/hosts.lisp +++ b/sockets/namedb/hosts.lisp @@ -47,10 +47,6 @@ (setf addresses (ensure-list addresses)) (map-into addresses #'ensure-address addresses)))) -(defun host-random-address (host) - "Returns a random address from HOST's address list." - (random-elt (host-addresses host))) - (defun make-host (truename addresses &optional aliases) "Instantiates a HOST object." (make-instance 'host @@ -67,18 +63,6 @@ (defvar *hosts-cache* ()) (defvar *hosts-cache-lock* (bt:make-lock "/etc/hosts cache lock")) -(defun map-host-ipv4-addresses-to-ipv6 (hostobj) - (declare (type host hostobj)) - (with-accessors ((addresses host-addresses)) hostobj - (setf addresses - (mapcar (lambda (address) - (if (ipv4-address-p address) - (make-address (map-ipv4-vector-to-ipv6 - (address-name address))) - address)) - addresses))) - (values hostobj)) - (defun parse-/etc/hosts (file) (let (hosts) (flet ((parse-one-line (tokens) diff --git a/sockets/namedb/services.lisp b/sockets/namedb/services.lisp index 1297dd2..f29676c 100644 --- a/sockets/namedb/services.lisp +++ b/sockets/namedb/services.lisp @@ -92,9 +92,9 @@ proto))))))) (define-condition unknown-service () - ((name :initarg :name :initform nil :reader service-name)) + ((name :initarg :name :initform nil :reader unknown-service-name)) (:report (lambda (condition stream) - (format stream "Unknown service: ~S" (service-name condition)))) + (format stream "Unknown service: ~S" (unknown-service-name condition)))) (:documentation "Condition raised when a network service is not found.")) (defvar *tcp-services-cache-by-name* (make-hash-table :test #'equal)) diff --git a/sockets/pkgdcl.lisp b/sockets/pkgdcl.lisp index fdc257e..f7c3e15 100644 --- a/sockets/pkgdcl.lisp +++ b/sockets/pkgdcl.lisp @@ -70,6 +70,9 @@ #:error-code #:error-identifier #:error-message + #:resolver-error-data + #:unknown-protocol-name + #:unknown-service-name ;; Low-level Address Conversion #:address-to-vector diff --git a/sockets/socket-options.lisp b/sockets/socket-options.lisp index b1718ac..784b472 100644 --- a/sockets/socket-options.lisp +++ b/sockets/socket-options.lisp @@ -23,11 +23,6 @@ (in-package :net.sockets) -;;; TODO: manage socket options errors -(defun sockopt-error (retval level option action &optional val1 val2) - (declare (ignore retval level option action val1 val2)) - (error "Sockopt error !")) - ;;;; SETF ;;; This interface looks nice but doesn't work so well for the linger -- 2.11.4.GIT