Update of /project/unetwork/cvsroot/unetwork/src In directory common-lisp.net:/tmp/cvs-serv1760 Modified Files: base-cmu.lisp base-sbcl.lisp http.lisp nntp.lisp package.lisp pop3.lisp smtp.lisp unetwork.asd uri-streams.lisp Added Files: socket.lisp Log Message: Cleaned up socket and connection classes Date: Tue Mar 23 08:02:21 2004 Author: mvilleneuve Index: unetwork/src/base-cmu.lisp diff -u unetwork/src/base-cmu.lisp:1.1 unetwork/src/base-cmu.lisp:1.2 --- unetwork/src/base-cmu.lisp:1.1 Fri Mar 12 09:46:38 2004 +++ unetwork/src/base-cmu.lisp Tue Mar 23 08:02:21 2004 @@ -12,8 +12,6 @@ (in-package :unetwork) -;;; Name service - (defun resolve-host-ip (hostname) "Return the IP address of a host." (let ((host (ext:lookup-host-entry hostname))) @@ -21,13 +19,7 @@ (error 'unknown-host-error :host hostname)) (first (ext:host-entry-addr-list host)))) -;;; Sockets - -(defclass socket () - ((sock :initarg :sock :reader socket-sock) - (stream :initarg :stream :reader socket-stream))) - -(defun socket-open (host port &key (type :text)) +(defun open-socket (host port &key (type :text)) "Open a socket on specified host and port. Keyword argument TYPE can be either :TEXT or :BINARY (defaults to :TEXT)." (handler-case @@ -41,15 +33,13 @@ (make-instance 'socket :sock sock :stream stream)) (simple-error () (error 'connection-error :host host)))) -(defun socket-close (socket) +(defun close-socket (socket) "Close a socket." (ext:close-socket (socket-sock socket))) -;;; Server sockets - -(defun server-socket-open (port) +(defun open-server-socket (port) "Open a server socket on localhost on specified port." - (ext:create-inet-listener port )) + (ext:create-inet-listener port)) (defun server-socket-accept (server-socket &key timeout) "Accept a connection on a server socket. Return the @@ -61,6 +51,6 @@ :element-type '(unsigned-byte 8)))) (make-instance 'socket :sock sock :stream stream)))) -(defun server-socket-close (server-socket) +(defun close-server-socket (server-socket) "Close a server socket." (unix:unix-close server-socket)) Index: unetwork/src/base-sbcl.lisp diff -u unetwork/src/base-sbcl.lisp:1.2 unetwork/src/base-sbcl.lisp:1.3 --- unetwork/src/base-sbcl.lisp:1.2 Fri Mar 12 12:09:34 2004 +++ unetwork/src/base-sbcl.lisp Tue Mar 23 08:02:21 2004 @@ -19,11 +19,7 @@ (error 'unknown-host-error :host hostname)) (sb-bsd-sockets:host-ent-address host))) -(defclass socket () - ((sock :initarg :sock :reader socket-sock) - (stream :initarg :stream :reader socket-stream))) - -(defun socket-open (host port &key (type :text)) +(defun open-socket (host port &key (type :text)) "Open a socket on specified host and port. Keyword argument TYPE can be either :TEXT or :BINARY (defaults to :TEXT)." (handler-case @@ -39,11 +35,11 @@ (make-instance 'socket :sock sock :stream stream))) (simple-error () (error 'connection-error :host host)))) -(defun socket-close (socket) +(defun close-socket (socket) "Close a socket." (sb-bsd-sockets:socket-close (socket-sock socket))) -(defun server-socket-open (port) +(defun open-server-socket (port) "Open a server socket on localhost on specified port." (error "Not implemented yet.")) @@ -52,6 +48,6 @@ resulting socket." (error "Not implemented yet.")) -(defun server-socket-close (server-socket) +(defun close-server-socket (server-socket) "Close a server socket." (error "Not implemented yet.")) Index: unetwork/src/http.lisp diff -u unetwork/src/http.lisp:1.2 unetwork/src/http.lisp:1.3 --- unetwork/src/http.lisp:1.2 Fri Mar 12 12:12:04 2004 +++ unetwork/src/http.lisp Tue Mar 23 08:02:21 2004 @@ -35,7 +35,7 @@ three values: the response code as an integer, the resource properties (headers) as an assoc list, and the connection socket." (assert (eq (uri-scheme uri) :http)) - (let* ((socket (socket-open (uri-host uri) + (let* ((socket (open-socket (uri-host uri) (or (uri-port uri) +http-default-port+))) (stream (socket-stream socket))) (format stream "~A ~A~@[?~A~] HTTP/1.0~%" @@ -59,7 +59,7 @@ (make-instance 'document :text content :properties properties))) - (socket-close socket)))) + (close-socket socket)))) (defun http-read-response (socket) (let* ((stream (socket-stream socket)) @@ -83,8 +83,24 @@ do (vector-push-extend byte content) finally (return content)))) +(defclass http-connection (connection) + ()) + +(defmethod open-protocol-connection ((uri uri) (protocol (eql :http))) + (multiple-value-bind (response-code properties socket) + (http-open-connection uri "GET") + (make-instance 'http-connection + :socket socket + :status response-code + :properties properties))) + +(defmethod close-connection ((connection http-connection)) + (close-socket (connection-socket connection))) + +#| (register-uri-input-stream-handler :http (lambda (uri) (http-open-connection uri "GET")) (lambda (socket) (socket-close socket))) +|# \ No newline at end of file Index: unetwork/src/nntp.lisp diff -u unetwork/src/nntp.lisp:1.2 unetwork/src/nntp.lisp:1.3 --- unetwork/src/nntp.lisp:1.2 Fri Mar 12 12:12:04 2004 +++ unetwork/src/nntp.lisp Tue Mar 23 08:02:21 2004 @@ -12,13 +12,13 @@ (in-package :unetwork) -(unless (boundp '+nntp-default-port) - (defconstant +nntp-default-port 119)) +(unless (boundp '+nntp-default-port+) + (defconstant +nntp-default-port+ 119)) (defun nntp-open-connection (server user password &optional (port +nntp-default-port)) "Open a connection to a NNTP server. Returns the connection socket." - (let ((socket (socket-open server port :type :text))) + (let ((socket (open-socket server port :type :text))) (unless (null user) (nntp-handle-command socket "AUTHINFO USER" (list user) :expect '("281" "381"))) @@ -31,7 +31,7 @@ "Close a connection to a NNTP server." (let ((stream (socket-stream socket))) (format stream "CLOSE~%")) - (socket-close socket)) + (close-socket socket)) (defun nntp-get-groups (socket) "Get the list of all groups on the server. Returns a list of lists Index: unetwork/src/package.lisp diff -u unetwork/src/package.lisp:1.2 unetwork/src/package.lisp:1.3 --- unetwork/src/package.lisp:1.2 Fri Mar 12 12:11:03 2004 +++ unetwork/src/package.lisp Tue Mar 23 08:02:21 2004 @@ -20,6 +20,28 @@ #:authenticate-error #:protocol-error + #:socket + #:socket-sock + #:socket-stream + + #:connection + #:connection-socket + #:connection-status + #:connection-properties + #:open-connection + + #:document + #:document-properties + #:document-text + + #:resolve-host-ip + #:socket + #:open-socket + #:close-socket + #:open-server-socket + #:close-server-socket + #:server-socket-accept + #:uri #:uri-scheme #:uri-host @@ -36,24 +58,12 @@ #:with-uri-input-stream - #:resolve-host-ip - #:socket - #:socket-open - #:socket-close - #:server-socket-open - #:server-socket-close - #:server-socket-accept - - #:document - #:document-properties - #:document-text - #:+http-default-port+ #:http-ensure-url-port-path #:http-get #:http-head - #:+pop3-default-port + #:+pop3-default-port+ #:pop3-open-connection #:pop3-close-connection #:pop3-authenticate Index: unetwork/src/pop3.lisp diff -u unetwork/src/pop3.lisp:1.2 unetwork/src/pop3.lisp:1.3 --- unetwork/src/pop3.lisp:1.2 Fri Mar 12 12:12:04 2004 +++ unetwork/src/pop3.lisp Tue Mar 23 08:02:21 2004 @@ -23,7 +23,7 @@ (defun pop3-open-connection (server &optional (port +pop3-default-port+)) "Open a connection to a POP3 server. Returns the connection socket." - (let* ((socket (socket-open server port :type :text)) + (let* ((socket (open-socket server port :type :text)) (stream (socket-stream socket))) (loop as line = (trim-line (read-line stream nil nil)) until (or (null line) @@ -73,7 +73,7 @@ (pop3-authenticate ,socket ,user ,password) ,@body (ignore-errors (pop3-close-connection ,socket))) - (socket-close ,socket)))) + (close-socket ,socket)))) (defun pop3-handle-command (socket command &rest params) (handle-simple-command "POP3" socket command params Index: unetwork/src/smtp.lisp diff -u unetwork/src/smtp.lisp:1.2 unetwork/src/smtp.lisp:1.3 --- unetwork/src/smtp.lisp:1.2 Fri Mar 12 12:12:04 2004 +++ unetwork/src/smtp.lisp Tue Mar 23 08:02:21 2004 @@ -17,7 +17,7 @@ (defun smtp-open-connection (server &optional (port +smtp-default-port+)) "Open a connection to a SMTP server. Returns the connection socket." - (let* ((socket (socket-open server port :type :text)) + (let* ((socket (open-socket server port :type :text)) (stream (socket-stream socket))) (read-line stream) socket)) @@ -27,7 +27,7 @@ (let ((stream (socket-stream socket))) (format stream "QUIT~%") (finish-output stream)) - (socket-close socket)) + (close-socket socket)) (defun smtp-send-mail (socket sender recipients subject data) "Send a mail from SENDER (an email address) to RECIPIENTS (a list Index: unetwork/src/unetwork.asd diff -u unetwork/src/unetwork.asd:1.3 unetwork/src/unetwork.asd:1.4 --- unetwork/src/unetwork.asd:1.3 Thu Mar 18 07:30:14 2004 +++ unetwork/src/unetwork.asd Tue Mar 23 08:02:21 2004 @@ -17,7 +17,10 @@ (defsystem unetwork-base :components ((:file "package") - (:file "errors"))) + (:file "errors") + (:file "utilities") + (:file "document" :depends-on ("utilities")) + (:file "socket"))) (defsystem unetwork-cmu :depends-on (:unetwork-base) @@ -32,10 +35,8 @@ :depends-on (:puri #+cmu :unetwork-cmu #+sbcl :unetwork-sbcl) - :components ((:file "utilities") - (:file "url") + :components ((:file "url") (:file "uri-streams") - (:file "document" :depends-on ("utilities")) (:file "http" :depends-on ("uri-streams")) (:file "pop3") (:file "smtp") Index: unetwork/src/uri-streams.lisp diff -u unetwork/src/uri-streams.lisp:1.1 unetwork/src/uri-streams.lisp:1.2 --- unetwork/src/uri-streams.lisp:1.1 Fri Mar 12 09:46:38 2004 +++ unetwork/src/uri-streams.lisp Tue Mar 23 08:02:21 2004 @@ -14,32 +14,19 @@ (defparameter *uri-input-stream-handlers* '()) -(defun register-uri-input-stream-handler (scheme opener closer) - "Registers input stream handler functions for a protocol (SCHEME). -OPENER must take an URI as argument and return two functions: -stream properties as an assoc list, and socket. -CLOSER must take a socket as argument and take necessary -actions in order to terminate the session." - (push (cons scheme (list opener closer)) *uri-input-stream-handlers*)) - -(defmacro with-uri-input-stream ((stream uri-string - &optional response-code properties) +(defmacro with-uri-input-stream ((stream uri-string &optional status properties) &body body) - "Opens an input stream to the resource at a given uri. Resource properties -are bound to the variable PROPERTIES, if provided. Evaluates the BODY -forms in an implicit PROGN, then closes the stream." - (with-gensyms (uri socket scheme functions) + "Opens an input stream to the resource at a given uri. Initial connection +status and resource properties are bound to the variables STATUS and +PROPERTIES, if provided. Evaluates the BODY forms in an implicit PROGN, +then closes the stream." + (with-gensyms (uri socket connection) `(let* ((,uri (parse-uri ,uri-string)) - (,scheme (uri-scheme ,uri)) - (,functions (cdr (assoc ,scheme *uri-input-stream-handlers*)))) - (assert (not (null ,functions))) - (let ((socket-opener (first ,functions)) - (socket-closer (second ,functions))) - (multiple-value-bind (,(or response-code (gensym)) - ,(or properties (gensym)) - ,socket) - (funcall socket-opener ,uri) - (unwind-protect - (let ((,stream (socket-stream ,socket))) - ,@body) - (funcall socket-closer ,socket))))))) + (,connection (open-connection ,uri)) + (,(or status (gensym)) (connection-status ,connection)) + (,(or properties (gensym)) (connection-properties ,connection)) + (,socket (connection-socket ,connection))) + (unwind-protect + (let ((,stream (socket-stream ,socket))) + ,@body) + (close-connection ,connection)))))