Skip to content
This repository
Fetching contributors…

Cannot retrieve contributors at this time

file 112 lines (104 sloc) 4.411 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
;;;
;;; Low-level networking implementations
;;;

(in-package #:ql-network)

(definterface host-address (host)
  (:implementation t
    host)
  (:implementation sbcl
    (ql-sbcl:host-ent-address (ql-sbcl:get-host-by-name host))))

(definterface open-connection (host port)
  (:documentation "Open and return a network connection to HOST on the
given PORT.")
  (:implementation t
    (declare (ignore host port))
    (error "Sorry, quicklisp in implementation ~S is not supported yet."
           (lisp-implementation-type)))
  (:implementation allegro
    (ql-allegro:make-socket :remote-host host
                            :remote-port port))
  (:implementation abcl
    (let ((socket (qlb-abcl:make-socket host port)))
      (qlb-abcl:get-socket-stream socket :element-type '(unsigned-byte 8))))
  (:implementation ccl
    (ql-ccl:make-socket :remote-host host
                        :remote-port port))
  (:implementation clisp
    (ql-clisp:socket-connect port host :element-type '(unsigned-byte 8)))
  (:implementation cmucl
    (let ((fd (ql-cmucl:connect-to-inet-socket host port)))
      (ql-cmucl:make-fd-stream fd
                               :element-type '(unsigned-byte 8)
                               :binary-stream-p t
                               :input t
                               :output t)))
  (:implementation scl
    (let ((fd (ql-scl:connect-to-inet-socket host port)))
      (ql-scl:make-fd-stream fd
:element-type '(unsigned-byte 8)
:input t
:output t)))
  (:implementation ecl
    (let* ((endpoint (ql-ecl:host-ent-address
                      (ql-ecl:get-host-by-name host)))
           (socket (make-instance 'ql-ecl:inet-socket
                                  :protocol :tcp
                                  :type :stream)))
      (ql-ecl:socket-connect socket endpoint port)
      (ql-ecl:socket-make-stream socket
                                 :element-type '(unsigned-byte 8)
                                 :input t
                                 :output t
                                 :buffering :full)))
  (:implementation lispworks
    (ql-lispworks:open-tcp-stream host port
                                  :direction :io
                                  :read-timeout nil
                                  :element-type '(unsigned-byte 8)
                                  :timeout 5))
  (:implementation sbcl
    (let* ((endpoint (ql-sbcl:host-ent-address
                      (ql-sbcl:get-host-by-name host)))
           (socket (make-instance 'ql-sbcl:inet-socket
                                  :protocol :tcp
                                  :type :stream)))
      (ql-sbcl:socket-connect socket endpoint port)
      (ql-sbcl:socket-make-stream socket
                                  :element-type '(unsigned-byte 8)
                                  :input t
                                  :output t
                                  :buffering :full))))

(definterface read-octets (buffer connection)
  (:documentation "Read from CONNECTION into BUFFER. Returns the
number of octets read.")
  (:implementation t
    (read-sequence buffer connection))
  (:implementation allegro
    (ql-allegro:read-vector buffer connection))
  (:implementation clisp
    (ql-clisp:read-byte-sequence buffer connection
                                  :no-hang nil
                                  :interactive t)))

(definterface write-octets (buffer connection)
  (:documentation "Write the contents of BUFFER to CONNECTION.")
  (:implementation t
    (write-sequence buffer connection)
    (finish-output connection)))

(definterface close-connection (connection)
  (:implementation t
    (ignore-errors (close connection))))

(definterface call-with-connection (host port fun)
  (:documentation "Establish a network connection to HOST on PORT and
call FUN with that connection as the only argument. Unconditionally
closes the connection afterwareds via CLOSE-CONNECTION in an
unwind-protect. See also WITH-CONNECTION.")
  (:implementation t
    (let (connection)
      (unwind-protect
           (progn
             (setf connection (open-connection host port))
             (funcall fun connection))
        (when connection
          (close-connection connection))))))

(defmacro with-connection ((connection host port) &body body)
  `(call-with-connection ,host ,port (lambda (,connection) ,@body)))
Something went wrong with that request. Please try again.