tclozure.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) LICENSE
       ---
       tclozure.lisp (2858B)
       ---
            1 ;;;; See LICENSE for licensing information.
            2 
            3 ;;;; Functions for CCL 1.11 (IPv6) only, see openmcl.lisp for rest of functions.
            4 
            5 (in-package :usocket)
            6 
            7 #+ipv6
            8 (defun socket-connect (host port &key (protocol :stream) element-type
            9                                    timeout deadline nodelay
           10                                    local-host local-port)
           11   (when (eq nodelay :if-supported)
           12     (setf nodelay t))
           13   (with-mapped-conditions ()
           14     (let* ((remote (when (and host port)
           15                      (openmcl-socket:resolve-address :host (host-to-hostname host)
           16                                                      :port port
           17                                                      :socket-type protocol)))
           18            (local  (when (and local-host local-port)
           19                      (openmcl-socket:resolve-address :host (host-to-hostname local-host)
           20                                                      :port local-port
           21                                                      :socket-type protocol)))
           22            (mcl-sock (apply #'openmcl-socket:make-socket
           23                             `(:type ,protocol
           24                               ,@(when (or remote local)
           25                                   `(:address-family ,(openmcl-socket:socket-address-family (or remote local))))
           26                               ,@(when remote
           27                                   `(:remote-address ,remote))
           28                               ,@(when local
           29                                   `(:local-address ,local))
           30                               :format ,(to-format element-type protocol)
           31                               :external-format ,ccl:*default-external-format*
           32                               :deadline ,deadline
           33                               :nodelay ,nodelay
           34                               :connect-timeout ,timeout
           35                               :input-timeout ,timeout))))
           36       (ecase protocol
           37         (:stream
           38          (make-stream-socket :stream mcl-sock :socket mcl-sock))
           39         (:datagram
           40          (make-datagram-socket mcl-sock :connected-p (and remote t)))))))
           41 
           42 #+ipv6
           43 (defun socket-listen (host port
           44                       &key
           45                         (reuse-address nil reuse-address-supplied-p)
           46                         (reuseaddress (when reuse-address-supplied-p reuse-address))
           47                         (backlog 5)
           48                         (element-type 'character))
           49   (let ((local-address (openmcl-socket:resolve-address :host (host-to-hostname host)
           50                                                        :port port :connect :passive)))
           51     (with-mapped-conditions ()
           52       (make-stream-server-socket
           53         (openmcl-socket:make-socket :connect :passive
           54                                     :address-family (openmcl-socket:socket-address-family local-address)
           55                                     :local-address local-address
           56                                     :reuse-address reuseaddress
           57                                     :backlog backlog
           58                                     :format (to-format element-type :stream))
           59         :element-type element-type))))
           60 
           61 #+ipv6
           62 (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
           63   (let* ((ccl-socket (socket usocket))
           64          (socket-keys (ccl::socket-keys ccl-socket)))
           65     (with-mapped-conditions (usocket)
           66       (if (and host port)
           67           (openmcl-socket:send-to ccl-socket buffer size
           68                                   :remote-host (host-to-hostname host)
           69                                   :remote-port port
           70                                   :offset offset)
           71           (openmcl-socket:send-to ccl-socket buffer size
           72                                   :remote-address (getf socket-keys :remote-address)
           73                                   :offset offset)))))