anchor.diff:        (force-output stream))))
   
   (defun skip-bytes (stream number)
  -  "skip-bytes stream number => side effect
  -
  -Read and discard NUMBER bytes from STREAM."
  +  "Read and discard NUMBER bytes from STREAM."
     (dotimes (num number)
       (read-byte stream)))
   
  -(defun websocket-process-connection (stream message-handler &optional (version :draft-hixie-76))
  -  "websocket-process-connection stream message-handler &optional version => REPL*
  -
  -Implements the main WebSocket loop for supported protocol versions. Framing is
  -handled automatically, MESSAGE-HANDLER ought to handle the actual payloads.
  -
  -*Not really a REPL because it doesn't print implicitly but it does what you'd
  -expect from the name."
  +(defun websocket-process-connection (stream message-handler
  +                                     &optional (version :rfc-6455))
  +  "Implements the main WebSocket loop for supported protocol
  +versions. Framing is handled automatically, MESSAGE-HANDLER ought to
  +handle the actual payloads.
  +
  +*Not really a REPL because it doesn't print implicitly but it does
  +what you'd expect from the name."
     (ecase version
       ((:draft-hixie-76 :draft-hybi-00)
  -     (loop for type = (read-byte stream) do 
  -          (cond ((= #x00 type)
  -                 (do ((reader (make-in-memory-output-stream))
  -                      (data (read-byte stream) (read-byte stream)))
  -                     ((= #xff data)
  -                      (funcall message-handler (utf-8-bytes-to-string (get-output-stream-sequence reader))))
  -                   (write-byte data reader)))
  +     (loop for type = (read-byte stream)
  +           do (cond
  +                ((= #x00 type)
  +                 (loop with reader = (make-in-memory-output-stream)
  +                       for byte = (read-byte stream)
  +                       until (= byte #xff)
  +                       do (write-byte byte reader)
  +                       finally (return
  +                                 (funcall message-handler
  +                                          (utf-8-bytes-to-string
  +                                           (get-output-stream-sequence
  +                                            reader))))))
                   ((= #xff type)
                    (let ((data (read-byte stream)))
                      (if (= #x00 data)
                          (return) ; regular termination
                          (do* ((data data (read-byte stream))
  -                             (length (logand #x7f data) (+ (* 128 length) (logand #x7f data))))
  +                             (length (logand #x7f data)
  +                                     (+ (* 128 length) (logand #x7f data))))
                               ((= #x80 (logand #x80 data))
                                (skip-bytes stream length))))))
                   (t (error 'websocket-illegal-frame-type ; irregular termination
  -                          :type type))))))) 
  -
  -(defmethod process-connection :around ((*acceptor* websocket-acceptor) (socket t))
  -  "process-connection :around websocket-acceptor t => context
  -
  -Continue the process with *WEBSOCKET-SOCKET* bound to the original TCP socket
  -and *HUNCHENTOOT-VERSION* enhanced by the Hunchensocket version."
  +                          :type type)))))
  +    (:rfc-6455
  +     (hunchentoot-error "Not implemented yet!"))))
  +
  +(defmethod process-connection :around ((*acceptor* websocket-acceptor)
  +                                       (socket t))
  +  "Continue the process with *WEBSOCKET-SOCKET* bound to the original
  +TCP socket and *HUNCHENTOOT-VERSION* enhanced by the Hunchensocket
  +version."
     (let ((*websocket-socket* socket))
  -       ; (hunchentoot-asd:*hunchentoot-version* (format nil "~a Hunchensocket 0" hunchentoot-asd:*hunchentoot-version*)))
       (call-next-method)))
  -  
  -(defmethod process-connection ((*acceptor* websocket-acceptor) (socket t))
  -  "process-connection websocket-acceptor t => context
  -
  -Enclose the connection processing with a general error handler w/logging."
  - ; (handler-case
  -      (call-next-method))
  -   ; (error (condition)
  -   ;   (log-message* :error "WebSocket connection terminated unexpectedly: ~a" condition))))
  -
  -(defmethod process-request :around ((request websocket-request))
  -  "process-request :around websocket-request => context / side effect / stream
  -
  -First, continue the process with HTTP 101 added to Hunchentoot's list of
  -*APPROVED-RETURN-CODES*. If that status code got issued in the response after
  -regular processing, hijack the connection and continue to process it as a
  -WebSocket one.
  -
  -PS: I *do* know what I'm doing, Mister!"
  -  ;(let ((*approved-return-codes* (cons +http-switching-protocols+
  -  ;                                     *approved-return-codes*)))
  -    (let ((stream (call-next-method)))
  -      (prog1 stream
  -        (when (= +http-switching-protocols+ (return-code*))
  -          (force-output stream)
  -          (let ((timeout (websocket-timeout (request-acceptor request))))
  -            (set-timeouts *websocket-socket* timeout timeout))
  -          (handler-case
  -              (let ((*websocket-stream* stream)
  -                    (*websocket-stream-mutex* (make-lock)))
  -                (websocket-process-connection stream
  -                                              (funcall (websocket-request-handler request) stream *websocket-stream-mutex*))) ; custom handshake
  -            (end-of-file ()
  -              (log-message* :debug "WebSocket connection terminated"))
  -            (websocket-illegal-frame-type (condition)
  -              (log-message* :error "WebSocket illegal frame type 0x~x encountered, terminating"
  -                           (websocket-illegal-frame-type-of condition))))))));)
  -
  -(defun dispatch-websocket-handlers (request)
  -  "dispatch-websocket-handlers request => handler
  -
  -Try to dispatch REQUEST against the available *WEBSOCKET-HANDLERS*, evaluating
  -to the first match which should be a `λ stream mutex -> λ message' handshake /
  -message handler closure (please consult the README)."
  -  (print "dispatch-websocket-handlers")
  +
  +(defun find-websocket-resource (request)
  +  "Compute a suitable handler for REQUEST.
  +
  +A handler is a function of two arguments STREAM and MUTEX. STREAM can
  +be read and written to and MUTEX shouldn't be there."
     (some #'(lambda (handler)
               (funcall handler request))
  -        *websocket-handlers*))
  -
  -(defmethod handle-request ((*acceptor* websocket-acceptor) (*request* websocket-request))
  -  "handle-request websocket-acceptor websocket-request => context
  -
  -WebSocket junction. Try to continue as a WebSocket connection if the Upgrade and
  -WebSocket request headers were issued and a suitable WebSocket handler could be
  -found."
  -  (if (and (search "upgrade" (string-downcase (header-in* :connection)))
  -           (string= "websocket" (string-downcase (header-in* :upgrade))))
  -      (if-let ((handler (dispatch-websocket-handlers *request*)))
  -        (prog1 (websocket-handle-handshake *request* *reply*)
  -          (setf (websocket-request-handler *request*) handler))
  -        (hunchentoot-error "WebSocket request rejected (no suitable handler found)"))
  -      (call-next-method)))
  +        *websocket-dispatchers*))
  +
  ++
  +;;; Hook onto normal hunchentoot processing
  +;;;
  +;;; The `:around' specilization of `process-request' will first call
  +;;; the main hunchentoot one, which will call our
  +;;; `handle-request'. That will in turn try to figure out if the
  +;;; client is requesting websockets, handshake and set
  +;;; `+http-switching-protocols+'. It will also eventually reply to the
  +;;; client, but hopefully keep the stream alive. That happens if:
  +;;;
  +;;; 1. There are suitable "Connection" and "Upgrade" headers and
  +;;;    `websocket-resource' object is found for request.
  +;;; 2. The websocket handshake completes sucessfully
  +;;; 
  +;;; If 1 fails, normal hunchentoot processing is resumed. If 2 or 3
  +;;; fail, an error is signalled. 
  +
  +(defmethod process-request :around ((request websocket-request))
  +  "First, continue the process with HTTP 101 added to Hunchentoot's
  +list of *APPROVED-RETURN-CODES*. If that status code got issued in the
  +response after regular processing, hijack the connection and continue
  +to process it as a WebSocket one.
  +
  +PS: I *do* know what I'm doing, Mister!"
  +  (let ((stream (call-next-method)))
  +    (prog1 stream
  +      (when (= +http-switching-protocols+ (return-code*))
  +        (force-output stream)
  +        (let ((timeout (websocket-timeout (request-acceptor request))))
  +          (set-timeouts *websocket-socket* timeout timeout))
  +        (handler-case
  +            (let ((*websocket-stream* stream)
  +                  (*websocket-stream-mutex* (make-lock)))
  +              (websocket-process-connection
  +               stream
  +               (funcall (websocket-resource request) stream
  +                        *websocket-stream-mutex*)))
  +                                        ; custom handshake
  +          (end-of-file ()
  +            (log-message* :debug "WebSocket connection terminated"))
  +          (websocket-illegal-frame-type (condition)
  +            (log-message*
  +             :error "WebSocket illegal frame type 0x~x encountered, terminating"
  +             (websocket-illegal-frame-type-of condition))))))))
  +
  +(defun websocket-handle-handshake (request reply)
  +  "Analyse REQUEST for WebSocket handshake.
  +
  +Destructively modify REPLY accordingly in case of success, exit
  +non-locally with an error instead. "
  +  (let ((requested-version (header-in* :sec-websocket-version request)))
  +    (cond ((not (equal "13" requested-version))
  +           (hunchentoot-error
  +            "Unsupported websocket version ~a" requested-version))
  +          ((header-in :sec-websocket-draft request)
  +           (hunchentoot-error
  +            "Websocket draft is unsupported"))
  +          ((header-in :sec-websocket-key request)
  +           (let ((sec-websocket-key+magic
  +                   (concatenate 'string (header-in :sec-websocket-key request)
  +                                "258EAFA5-E914-47DA-95CA-C5AB0DC85B11")))
  +             (setf (header-out :sec-websocket-accept reply)
  +                   (base64:usb8-array-to-base64-string
  +                    (ironclad:digest-sequence
  +                     'ironclad:sha1
  +                     (ironclad:ascii-string-to-byte-array sec-websocket-key+magic))))
  +             (setf (header-out :sec-websocket-origin reply)
  +                   (header-in :origin request))
  +             (setf (header-out :sec-websocket-location reply)
  +                   (or (websocket-uri request (header-in :host request)
  +                                      (ssl-p (request-acceptor request)))))
  +             (setf (header-out :sec-websocket-protocol reply)
  +                   (header-in :sec-websocket-protocol request))
  +             (setf (return-code* reply) +http-switching-protocols+
  +                   (header-out :upgrade reply) "WebSocket"
  +                   (header-out :connection reply) "Upgrade"
  +                   (content-type* reply) "application/octet-stream")))
  +          (t (hunchentoot-error "Unsupported unknown websocket version")))))
  +
  +(defmethod handle-request ((*acceptor* websocket-acceptor)
  +                           (*request* websocket-request))
  +  "WebSocket junction. Try to continue as a WebSocket connection if
  +the Upgrade and WebSocket request headers were issued and a suitable
  +WebSocket handler could be found."
  +  (cond ((and (search "upgrade" (string-downcase (header-in* :connection)))
  +              (string= "websocket" (string-downcase (header-in* :upgrade)))
  +              (setf (websocket-resource *request*)
  +                    (find-websocket-resource *request*)))
  +         (websocket-handle-handshake *request* *reply*)
  +         (values nil nil nil) ;; as per `handle-request''s contract.
  +         )
  +        (t
  +         (call-next-method))))
  +
  +;; Local Variables:
  +;; coding: utf-8-unix
  +;; End:
  
positive.code:   ((key :initarg :key :reader websocket-illegal-key-of
          :initform (required-argument :key)
          :documentation "Original, spurious key argument"))
    (:documentation "Signal in case the client has sent an erroneous handshake key"))
  
  (define-condition websocket-illegal-frame-type (condition)
    ((type :initarg :type :reader websocket-illegal-frame-type-of
           :initform (required-argument :type)
           :documentation "Spurious frame type received"))
    (:documentation "Signal in case the client has sent a spurious frame type"))
  
  (defun integer-octets-32be (number)
    "integer-octets-32be number => unsigned byte array
  
  Transform NUMBER into 32bit big endian octets. Required for the (luckily
  obsoleted) old \"hixie\" and early \"hybi\" WebSocket drafts."
    (let ((result (make-array 4 :element-type '(unsigned-byte 8))))
      (dotimes (index 4 result)
        (let ((position #+little-endian (- 24 (* 8 index)) #-little-endian (* 8 index)))
          (setf (aref result index)
                (ldb (byte 8 position) number))))))
  
  (let ((digit-scanner (create-scanner "[^\\d]"))
        (space-scanner (create-scanner "[^ ]")))
    (defun websocket-keyhasha (key)
      "websocket-keyhash key => unsigned byte array
  
  Process a (legacy) WebSocket key and evaluate to a byte sequence that becomes
  part of the challenge. An error will be signalled in case the key is spurious."
      (let ((number (parse-integer (regex-replace-all digit-scanner key "")
                                   :junk-allowed nil))
            (spaces (length (regex-replace-all space-scanner key ""))))
        (if (or (zerop spaces)
                (not (zerop (mod number spaces))))
            (error 'websocket-illegal-key :initarg key)
            (integer-octets-32be (/ number spaces)))))) ; crack-smoking mac pussies at google want big endian
  
  (defun read-bytes-array (stream number)
    "read-bytes-array stream number => unsigned byte array
  
  Read NUMBER bytes from Chunga STREAM into array and return it."
    (let ((result (make-array number :element-type '(unsigned-byte 8))))
      (dotimes (index number result)
        (setf (aref result index)
              (char-int (read-char* stream t))))))
  
  (defun read-key3 (request)
    "read-key3 request => unsigned byte array
  
  Read eight bytes from REQUEST's content stream and return them as a byte
  array."
    (read-bytes-array (content-stream request) 8))
  
  (defun digest-key (key)
    "digest-key key => unsigned byte array
  
  Evaluates to MD5 digest of KEY sequence."
    (digest-sequence :md5 key))
  
  (defun websocket-uri (request host &optional ssl)
    "websocket-uri request host &optional ssl => URI string
  
  Evaluate arguments to corresponding WebSocket (ws:// or wss://) URL."
    (format nil "~:[ws~;wss~]://~a~a" ssl host (script-name request)))
  
  (defun handle-handshake-legacy (request reply)
    "handle-handshake-legacy request reply => challenge
  
  Legacy (< draft-hybi-02) method of performing a WebSocket handshake. Still in
  use for FF4 (if activated) and many versions of Chromium. Also sets the
  Sec-WebSocket-Origin, Sec-WebSocket-Location and Sec-WebSocket-Protocol response
  headers, if successful. The challenge is sent over the raw TCP socket."
    (prog1
        (let* ((stream (make-in-memory-output-stream)))
          (mapc #'(lambda (key)
                    (write-sequence key stream))
                (list (websocket-keyhash (header-in :sec-websocket-key1 request))
                      (websocket-keyhash (header-in :sec-websocket-key2 request))
                      (read-key3 request)))
          (digest-key (get-output-stream-sequence stream)))
      (setf (header-out :sec-websocket-origin reply) (header-in :origin request)
            (header-out :sec-websocket-location reply) (or (websocket-uri request (header-in :host request)
                                                                          (ssl-p (request-acceptor request))))
            (header-out :sec-websocket-protocol reply) (header-in :sec-websocket-protocol request))))
  
  (defun handle-handshake (request reply)
    "handle-handshake for v13
  
  Also sets the
  Sec-WebSocket-Origin, Sec-WebSocket-Location and Sec-WebSocket-Protocol response
  headers, if successful. The challenge is sent over the raw TCP socket."
    (prog1
      (let ((sec-websocket-key+magic
              (concatenate 'string (header-in :sec-websocket-key request) "258EAFA5-E914-47DA-95CA-C5AB0DC85B11")))
      (setf (header-out :sec-websocket-accept reply)
        (base64:usb8-array-to-base64-string
          (ironclad:digest-sequence 'ironclad:sha1 (ironclad:ascii-string-to-byte-array sec-websocket-key+magic))))
      (setf (header-out :sec-websocket-origin reply) (header-in :origin request)
            (header-out :sec-websocket-location reply) (or (websocket-uri request (header-in :host request)
                                                                          (ssl-p (request-acceptor request))))
            (header-out :sec-websocket-protocol reply) (header-in :sec-websocket-protocol request)))))
  
  (defun websocket-handle-handshake (request reply)
    "websocket-handle-handshake request reply => handshake
  
  Try to determine the WebSocket handshake version by checking REQUEST headers and
  handle accordingly, if possible."
    (handler-case
        (prog1
            (cond ((not (equal "13" (header-in* :sec-websocket-version request)))
                   (error 'websocket-unsupported-version :version (header-in* :sec-websocket-version request)));; (header-in :sec-websocket-version request)))
                  ((header-in :sec-websocket-draft request)
                   (error 'websocket-unsupported-version (header-in :sec-websocket-draft request)))
                  ((header-in :sec-websocket-key request)
                   (handle-handshake request reply))
                  (t (error 'websocket-unsupported-version :version "unknown")))
          (setf
            (return-code* reply) +http-switching-protocols+
            (header-out :upgrade reply) "WebSocket"
            (header-out :connection reply) "Upgrade"
            (content-type* reply) "application/octet-stream"))
      (websocket-illegal-key (condition)
        (hunchentoot-error "Illegal key ~a encountered" (websocket-illegal-key-of condition)))
      (websocket-unsupported-version ()
        (hunchentoot-error "WebSocket handshake failed because of unsupported protocol version"))))
  
  (defun websocket-send-term (&optional (stream *websocket-stream*) (mutex *websocket-stream-mutex*))
    "websocket-send-term &optional stream mutex => side effect
  
  Send the magic WebSocket termination sequence across STREAM."
    (with-lock-held (mutex)
      (write-sequence +websocket-terminator+ stream)
      (force-output stream)))
  
  (defun websocket-send-message (message &optional (stream *websocket-stream*) (mutex *websocket-stream-mutex*))
    "websocket-send-message &optional stream mutex => side effect
  
  Encode MESSAGE as UTF-8 bytes and send it across STREAM in a proper frame."
    (when (> (length message) 0) ; empty message would send terminator
      (log-message* :debug "Going to send websocket message ~a" message)
      (with-lock-held (mutex)
  
negative.code: ;;;; Hunchensocket - websocket.lisp
  ;;;;
  ;;;; Hunchentoot-based WebSocket (draft) implementation Copyright (C)
  ;;;; 2011 Alexander Kahl <e-user@fsfe.org>
  ;;;; 2014 Joao Tavora
  ;;;;
  ;;;; This file is part of Hunchensocket.  Redistribution and use in
  ;;;; source and binary forms, with or without modification, are
  ;;;; permitted provided that the following conditions are met:
  ;;;;
  ;;;;   * Redistributions of source code must retain the above copyright
  ;;;;     notice, this list of conditions and the following disclaimer.
  ;;;;
  ;;;;   * Redistributions in binary form must reproduce the above
  ;;;;     copyright notice, this list of conditions and the following
  ;;;;     disclaimer in the documentation and/or other materials
  ;;;;     provided with the distribution.
  ;;;;
  ;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  ;;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  ;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  