cmucl.lisp

(in-package :trivial-sockets)

(defun resolve-hostname (name)
  (cond
   ((eql name :any) "0.0.0.0")
   ((typep name '(vector number 4)) (format nil "~{~A~^.~}" (coerce name 'list)))
   (t name)))

(defun pretty-stream-name (host port)
  (format nil "~A:~A" (resolve-hostname host) port))

(defun open-stream (peer-host peer-port 
			      &key (local-host :any) (local-port 0)
			      (external-format :default)
			      (element-type 'character)
			      (protocol :tcp))
  (unless (eql external-format :default)
    (error 'unsupported :feature :external-format))
  (unless (and (eql local-host :any) (eql local-port 0))
    (error 'unsupported :feature :bind))
  (unless (member protocol '(:tcp :udp))
    (error 'unsupported :feature `(:protocol ,protocol)))
  ;; connect-to-inet-socket signals simple-erors.  not great
  (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
    (let ((s (ext:connect-to-inet-socket
              (resolve-hostname peer-host) peer-port
             (case protocol
               (:tcp :stream)
               (:udp :datagram)))))
      (sys:make-fd-stream s :input t :output t :element-type element-type
			  :buffering :full
                          :name (pretty-stream-name peer-host peer-port)))))

(defun open-server (&key (host :any) (port 0)
                    (reuse-address t)
                    (backlog 1)
                    (protocol :tcp))
  "Returns a SERVER object and the port that was bound, as multiple values"
  (unless (member protocol '(:tcp :udp))
    (error 'unsupported :feature `(:protocol ,protocol)))
  (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
    (let ((socket (if (equal (resolve-hostname host) "0.0.0.0")
                      ;; create-inet-listener barfs on `:host nil'
                      (ext:create-inet-listener port (case protocol
                                                      (:tcp :stream)
                                                      (:udp :datagram))
                                                :reuse-address reuse-address
                                                :backlog backlog)
                      (ext:create-inet-listener port (case protocol
                                                      (:tcp :stream)
                                                      (:udp :datagram))
                                                :reuse-address reuse-address
                                                :backlog backlog
                                                :host host))))
      (multiple-value-bind (host port)
          (ext:get-socket-host-and-port socket)
        (declare (ignore host))
        (values socket port)))))
			      
(defun close-server (server)
  (unix:unix-close server))

(defun accept-connection (socket
			  &key
			  (external-format :default)
                          (element-type 'character)
                          (buffering :full)) ; (member :full :line :none)
  (unless (eql external-format :default)
    (error 'unsupported :feature :external-format))
  (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
    (let ((fd (ext:accept-tcp-connection socket)))
    (multiple-value-bind (peer-host peer-port)
        (ext:get-peer-host-and-port fd)
      (sys:make-fd-stream fd
                          :input t :output t
                          :element-type element-type
                          :auto-close t
                          :buffering buffering
                          :name (pretty-stream-name peer-host peer-port))))))