;ELC ;;; Compiled ;;; in Emacs version 26.3 ;;; with all optimizations. ;;; This file uses dynamic docstrings, first added in Emacs 19.29. ;;; This file does not contain utf-8 non-ASCII characters, ;;; and so can be loaded in Emacs versions earlier than 23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (byte-code "\300\301!\210\300\302!\210\300\303!\210\300\304!\210\300\305!\210\300\306!\210\307\310\311\312!\"\210\307\313\314\312!\"\210\307\315\313\"\210\316\315\317\320#\210\321\312\322\313#\323\312\324\325\324$\210\326\327\324\330\324\331%\210\326\332\324\333\324\334%\210\326\335\324\336\324\337%\210\326\340\324\341\324\342%\210\326\343\324\344\324\345%\210\326\346\324\347\324\350%\210\326\351\324\352\324\353%\210\326\354\324\355\324\356%\207" [require web-server-status-codes mail-parse mm-encode url-util eieio cl-lib defalias ws-server-p eieio-make-class-predicate ws-server ws-server--eieio-childp eieio-make-child-predicate ws-server-child-p make-obsolete "use (cl-typep ... \\='ws-server) instead" "25.1" define-symbol-prop cl-deftype-satisfies eieio-defclass-internal nil ((handlers :initarg :handlers :accessor handlers :initform nil) (process :initarg :process :accessor process :initform nil) (port :initarg :port :accessor port :initform nil) (requests :initarg :requests :accessor requests :initform nil)) cl-generic-define-method requests ((this ws-server)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp requests eieio-oref] 4 "Retrieve the slot `requests' from an object of class `ws-server'.\n\n(fn THIS)"] \(setf\ requests\) (value (this ws-server)) #[514 "\300\301#\207" [eieio-oset requests] 6 "\n\n(fn VALUE THIS)"] port ((this ws-server)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp port eieio-oref] 4 "Retrieve the slot `port' from an object of class `ws-server'.\n\n(fn THIS)"] \(setf\ port\) (value (this ws-server)) #[514 "\300\301#\207" [eieio-oset port] 6 "\n\n(fn VALUE THIS)"] process ((this ws-server)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp process eieio-oref] 4 "Retrieve the slot `process' from an object of class `ws-server'.\n\n(fn THIS)"] \(setf\ process\) (value (this ws-server)) #[514 "\300\301#\207" [eieio-oset process] 6 "\n\n(fn VALUE THIS)"] handlers ((this ws-server)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp handlers eieio-oref] 4 "Retrieve the slot `handlers' from an object of class `ws-server'.\n\n(fn THIS)"] \(setf\ handlers\) (value (this ws-server)) #[514 "\300\301#\207" [eieio-oset handlers] 6 "\n\n(fn VALUE THIS)"]] 7) #@66 Create a new object of class type `ws-server'. (fn &rest SLOTS) (defalias 'ws-server #[128 "\300\301\302#\207" [apply make-instance ws-server] 5 (#$ . 2645)]) (byte-code "\300\301\302\303#\300\207" [function-put ws-server compiler-macro ws-server--anon-cmacro] 4) #@26 (fn WHOLE &rest SLOTS) (defalias 'ws-server--anon-cmacro #[385 "\211@;\204\207\300\301\302@@#@\303@DABB\"\207" [macroexp--warn-and-return format "Obsolete name arg %S to constructor %S" identity] 7 (#$ . 2917)]) (byte-code "\300\301\302\303!\"\210\300\304\305\303!\"\210\300\306\304\"\210\307\306\310\311#\210\312\303\313\304#\314\303\315\316\315$\210\317\320\315\321\315\322%\210\317\323\315\324\315\325%\210\317\326\315\327\315\330%\210\317\331\315\332\315\333%\210\317\334\315\335\315\336%\210\317\337\315\340\315\341%\210\317\342\315\343\315\344%\210\317\345\315\346\315\347%\210\317\350\315\351\315\352%\210\317\353\315\354\315\355%\210\317\356\315\357\315\360%\210\317\361\315\362\315\363%\210\317\364\315\365\315\366%\210\317\367\315\370\315\371%\210\317\372\315\373\315\374%\210\317\375\315\376\315\377%\207" [defalias ws-request-p eieio-make-class-predicate ws-request ws-request--eieio-childp eieio-make-child-predicate ws-request-child-p make-obsolete "use (cl-typep ... \\='ws-request) instead" "25.1" define-symbol-prop cl-deftype-satisfies eieio-defclass-internal nil ((process :initarg :process :accessor process :initform nil) (pending :initarg :pending :accessor pending :initform #1="") (context :initarg :context :accessor context :initform nil) (boundary :initarg :boundary :accessor boundary :initform nil) (index :initarg :index :accessor index :initform 0) (active :initarg :active :accessor active :initform nil) (headers :initarg :headers :accessor headers :initform (list nil)) (body :initarg :body :accessor body :initform #1#)) cl-generic-define-method body ((this ws-request)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp body eieio-oref] 4 "Retrieve the slot `body' from an object of class `ws-request'.\n\n(fn THIS)"] \(setf\ body\) (value (this ws-request)) #[514 "\300\301#\207" [eieio-oset body] 6 "\n\n(fn VALUE THIS)"] headers ((this ws-request)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp headers eieio-oref] 4 "Retrieve the slot `headers' from an object of class `ws-request'.\n\n(fn THIS)"] \(setf\ headers\) (value (this ws-request)) #[514 "\300\301#\207" [eieio-oset headers] 6 "\n\n(fn VALUE THIS)"] active ((this ws-request)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp active eieio-oref] 4 "Retrieve the slot `active' from an object of class `ws-request'.\n\n(fn THIS)"] \(setf\ active\) (value (this ws-request)) #[514 "\300\301#\207" [eieio-oset active] 6 "\n\n(fn VALUE THIS)"] index ((this ws-request)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp index eieio-oref] 4 "Retrieve the slot `index' from an object of class `ws-request'.\n\n(fn THIS)"] \(setf\ index\) (value (this ws-request)) #[514 "\300\301#\207" [eieio-oset index] 6 "\n\n(fn VALUE THIS)"] boundary ((this ws-request)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp boundary eieio-oref] 4 "Retrieve the slot `boundary' from an object of class `ws-request'.\n\n(fn THIS)"] \(setf\ boundary\) (value (this ws-request)) #[514 "\300\301#\207" [eieio-oset boundary] 6 "\n\n(fn VALUE THIS)"] context ((this ws-request)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp context eieio-oref] 4 "Retrieve the slot `context' from an object of class `ws-request'.\n\n(fn THIS)"] \(setf\ context\) (value (this ws-request)) #[514 "\300\301#\207" [eieio-oset context] 6 "\n\n(fn VALUE THIS)"] pending ((this ws-request)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp pending eieio-oref] 4 "Retrieve the slot `pending' from an object of class `ws-request'.\n\n(fn THIS)"] \(setf\ pending\) (value (this ws-request)) #[514 "\300\301#\207" [eieio-oset pending] 6 "\n\n(fn VALUE THIS)"] process ((this ws-request)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp process eieio-oref] 4 "Retrieve the slot `process' from an object of class `ws-request'.\n\n(fn THIS)"] \(setf\ process\) (value (this ws-request)) #[514 "\300\301#\207" [eieio-oset process] 6 "\n\n(fn VALUE THIS)"]] 7) #@67 Create a new object of class type `ws-request'. (fn &rest SLOTS) (defalias 'ws-request #[128 "\300\301\302#\207" [apply make-instance ws-request] 5 (#$ . 6893)]) (byte-code "\300\301\302\303#\300\207" [function-put ws-request compiler-macro ws-request--anon-cmacro] 4) #@26 (fn WHOLE &rest SLOTS) (defalias 'ws-request--anon-cmacro #[385 "\211@;\204\207\300\301\302@@#@\303@DABB\"\207" [macroexp--warn-and-return format "Obsolete name arg %S to constructor %S" identity] 7 (#$ . 7170)]) #@31 List holding all web servers. (defvar ws-servers nil (#$ . 7399)) #@53 Logging time format passed to `format-time-string'. (defvar ws-log-time-format "%Y.%m.%d.%H.%M.%S.%N" (#$ . 7471)) #@34 This GUID is defined in RFC6455. (defvar ws-guid "258EAFA5-E914-47DA-95CA-C5AB0DC85B11" (#$ . 7592)) #@1371 Start a server using HANDLERS and return the server object. HANDLERS may be a single function (which is then called on every request) or a list of conses of the form (MATCHER . FUNCTION), where the FUNCTION associated with the first successful MATCHER is called. Handler functions are called with two arguments, the process and the request object. A MATCHER may be either a function (in which case it is called on the request object) or a cons cell of the form (KEYWORD . STRING) in which case STRING is matched against the value of the header specified by KEYWORD. Any supplied NETWORK-ARGS are assumed to be keyword arguments for `make-network-process' to which they are passed directly. For example, the following starts a simple hello-world server on port 8080. (ws-start (lambda (request) (with-slots (process headers) request (process-send-string process "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\n\r\nhello world"))) 8080) Equivalently, the following starts an identical server using a function MATCH and the `ws-response-header' convenience function. (ws-start \='(((lambda (_) t) . (lambda (proc request) (ws-response-header proc 200 \='("Content-type" . "text/plain")) (process-send-string proc "hello world") t))) 8080) (fn HANDLERS PORT &optional LOG-BUFFER &rest NETWORK-ARGS) (defalias 'ws-start #[898 "\302\303\304\305%\205\306!\307\310\311\312\313\314\315 !\316\317\320\321\322\323W\324\325\326\327\330\331\320D\2056\332D\"\333\205>\334&\"\266 B\207" [emacs-major-version ws-servers make-instance ws-server :handlers :port get-buffer-create \(setf\ process\) apply make-network-process :name "ws-server" :service port :filter ws-filter :server t :nowait 26 :family ipv4 :coding no-conversion :plist append :log-buffer :log #[771 "\301!\302\303!\304\"r\211q\210db\210\305\306\307!@A@%c)\207" [ws-log-time-format process-contact plist-get process-plist :log-buffer format "%s %s %s %s" format-time-string] 11 "\n\n(fn PROC REQUEST MESSAGE)"]] 29 (#$ . 7701)]) #@27 Stop SERVER. (fn SERVER) (defalias 'ws-stop #[257 "\301\"\302\303\304\305\306\307!\"\306!C\"\"\207" [ws-servers remove mapc delete-process append mapcar process requests] 8 (#$ . 9797)]) #@35 Stop all servers in `ws-servers'. (defalias 'ws-stop-all #[0 "\301\302\"\207" [ws-servers mapc ws-stop] 3 (#$ . 9997) nil]) #@74 HTTP methods from http://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html. (defvar ws-http-common-methods '(GET HEAD POST PUT DELETE TRACE) (#$ . 10128)) (defvar ws-http-method-rx (byte-code "\301\302\303\304\305#\"\207" [ws-http-common-methods format "^\\(%s\\) \\([^[:space:]]+\\) \\([^[:space:]]+\\)$" mapconcat symbol-name "\\|"] 6)) #@60 Thin wrapper around `url-parse-query-string'. (fn STRING) (defalias 'ws-parse-query-string #[257 "\300\301\302\303\304#\"\207" [mapcar #[257 "\211@A@B\207" [] 3 "\n\n(fn PAIR)"] url-parse-query-string nil allow-newlines] 7 (#$ . 10471)]) #@74 Parse HTTP headers in STRING reporting errors to PROC. (fn PROC STRING) (defalias 'ws-parse #[514 "\301\302\"\2036\211\303\304\"!\303\305\"\302\306\"\203-\307\211\224OB\310\311\307\225\312O!!B\2021BC\266\202\202\237\302\313\"\203\202\211\303\304\"!\303\305\"\314\315\316\"\203s\317!\302\320\"\203h\211\307\211\224O\307\225\312OB\202n\321\322#\262\202z\321\323#BBC\266\202\202\237\302\324\"\203\230\211\303\304\"!\303\305\"BC\202\237\321\325#\210\312\207" [ws-http-method-rx #[257 "\300\301\226P!\207" [intern ":"] 4 "\n\n(fn S)"] string-match match-string 1 2 "?" 0 ws-parse-query-string url-unhex-string nil "^AUTHORIZATION: \\([^[:space:]]+\\) \\(.*\\)$" :AUTHORIZATION eql :BASIC base64-decode-string ":" ws-error "bad credentials: %S" "un-support protocol: %s" "^\\([^[:space:]]+\\): \\(.*\\)$" "bad header: %S"] 12 (#$ . 10718)]) #@15 (fn STRING) (defalias 'ws-trim #[257 "\211G\300V\203/\301\302\303\304O\"\203\211\300\303O\211\262\204\301\302\300\305O\"\203/\211\305\304O\211\262\204\207" [0 string-match "[ \n]" -1 nil 1] 6 (#$ . 11604)]) #@20 (fn PROC STRING) (defalias 'ws-parse-multipart/form #[514 "\300\301\"\205J\302\303\304\"!A\305\225\306\300\307#\211\262\2038\211U\2048\310!\311O\"\241\210\312\\\262\202\313\314\"A\315\312\\\306OBBB\266\203\207" [string-match "Content-Disposition:[[:space:]]*\\(.*\\) \n" mail-header-parse-content-disposition match-string 1 0 nil " \n" last ws-parse 2 assoc name content] 11 (#$ . 11831)]) #@20 (fn PROC STRING) (defalias 'ws-filter #[514 "\300\301!\302\"\303\304\305\306\307\310!\311\"\312\313%\314\315\"\"\204/\211\316\315\317\320\321 #\314\315\"B#\266\303\304\305\306\307\310!\322\"\312\313%\314\315\"\"\211\211\316\323\314\323\"P#\266\324!?\205\251\211\325\326\"\266\3272u\330!\203s\331\314\332\"\"\202t\3330\333=?\205\251\300\301!\334\"\211\203\212\335\"\210\210\316\315\336\304\305\337\307\310 !\340\"\341\342%\314\315\"\"#\266\343!\262\207" [plist-get process-plist :server cl-find-if make-byte-code 257 "\300\301!\232\207" vconcat vector [process] 4 "\n\n(fn C)" slot-value requests eieio-oset make-instance ws-request :process [process] pending active \(setf\ active\) t close-connection ws-parse-request ws-call-handler handlers :keep-alive :ender process-send-string cl-remove-if "\301\300\302!\"\207" [eql process] 5 "\n\n(fn R)" delete-process] 15 (#$ . 12253)]) #@114 Parse request STRING from REQUEST with process PROC. Return non-nil only when parsing is complete. (fn REQUEST) (defalias 'ws-parse-request #[257 "\3002w\211\301\302\303\"\203\304\302\303\"P\202\305P\306\211\307\302\310\"\302\311\"#\211\262\203lG\\\302\311\"U\203\265\204_\302\310\"\302\311\"\306O\312\301\"\203[\313\314\315\306O#\266\210\316\262\317\302\320\"\321\"\203\226\322\323\324\325\326\327\n!\330\"\331\332%\333\334\335\336\337\302\f\310\"\302 \311\"\306O!#!\"\210\340\300\316\"\210\202a\317\302\320\"\341\"\203\255\342\302\303\"P\262\202a\340\300\316\"\210\202a\317\302\320\"\341\"\203\343\302\344\"!\345\302\346\"\302\310\"\302 \311\"O\"C\241\210\302\310\"G\315\\V\203a\302\310\"\211\315\\O\304\230\203a\340\300\316\"\210\202a\347\302\346\"\302\310\"\302\311\"O\"\211@@\203V\317@@\350\"\203V\351@A!\211\2035\211A\262\242\202<\352\353\306GD\"\313\303\354\303\"A#\266\313\320\355\227!#\266\343\302\344\"!\241\266\313\311#\266\202\266\211\356\306\"\266\3060\207" [finished-parsing-headers " \n" slot-value boundary "--" "" nil string-match pending index string-prefix-p eieio-oset body 2 t eql context application/x-www-form-urlencoded mapc make-byte-code 257 "\301\302\300\303\"!C\241\207" vconcat vector [last slot-value headers] 5 "\n\n(fn PAIR)" ws-parse-query-string replace-regexp-in-string "\\+" " " ws-trim throw multipart/form-data " \n--" last headers ws-parse-multipart/form process ws-parse :CONTENT-TYPE mail-header-parse-content-type signal wrong-number-of-arguments assoc intern \(setf\ active\)] 17 (#$ . 13186)]) #@25 (fn REQUEST HANDLERS) (defalias 'ws-call-handler #[514 "\3002>\301!\203#\302\300\3031!0\202!\304\305!\306#\262\"\210\307\310\311\312\313\314!\315\"\316\317%\"\210\304\305!\320\321!#0\207" [matched-handler functionp throw (error) ws-error process "Caught Error: %S" mapc make-byte-code 257 "\211@A:\203\"\301@\302\300!\"\203\"\303A\301@\302\300!\"A\"\204.\304!\205E\300!\205E\305\306\3071;\300!0\202D\310\311\300!\312#\262\"\207" vconcat vector [assoc headers string-match functionp throw matched-handler (error) ws-error process "Caught Error: %S"] 10 "\n\n(fn HANDLER)" "no handler matched request: %S" headers] 9 (#$ . 14839)]) #@28 (fn PROC MSG &rest ARGS) (defalias 'ws-error #[642 "\301\302!\303\"\304!\203)rq\210db\210\305\306\307!@A@\310\305\n\n#%c\210)\310\311$\207" [ws-log-time-format plist-get process-plist :log-buffer process-contact format "%s %s %s WS-ERROR: %s" format-time-string apply ws-send-500] 14 (#$ . 15511)]) (byte-code "\300\301\302\303!\"\210\300\304\305\303!\"\210\300\306\304\"\210\307\306\310\311#\210\312\303\313\304#\314\303\315\316\315$\210\317\320\315\321\315\322%\210\317\323\315\324\315\325%\210\317\326\315\327\315\330%\210\317\331\315\332\315\333%\210\317\334\315\335\315\336%\210\317\337\315\340\315\341%\210\317\342\315\343\315\344%\210\317\345\315\346\315\347%\210\317\350\315\351\315\352%\210\317\353\315\354\315\355%\210\317\356\315\357\315\360%\210\317\361\315\362\315\363%\207" [defalias ws-message-p eieio-make-class-predicate ws-message ws-message--eieio-childp eieio-make-child-predicate ws-message-child-p make-obsolete "use (cl-typep ... \\='ws-message) instead" "25.1" define-symbol-prop cl-deftype-satisfies eieio-defclass-internal nil ((process :initarg :process :accessor process :initform #1="") (pending :initarg :pending :accessor pending :initform #1#) (active :initarg :active :accessor active :initform nil) (new :initarg :new :accessor new :initform nil) (data :initarg :data :accessor data :initform #1#) (handler :initarg :handler :accessor handler :initform #1#)) cl-generic-define-method handler ((this ws-message)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp handler eieio-oref] 4 "Retrieve the slot `handler' from an object of class `ws-message'.\n\n(fn THIS)"] \(setf\ handler\) (value (this ws-message)) #[514 "\300\301#\207" [eieio-oset handler] 6 "\n\n(fn VALUE THIS)"] data ((this ws-message)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp data eieio-oref] 4 "Retrieve the slot `data' from an object of class `ws-message'.\n\n(fn THIS)"] \(setf\ data\) (value (this ws-message)) #[514 "\300\301#\207" [eieio-oset data] 6 "\n\n(fn VALUE THIS)"] new ((this ws-message)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp new eieio-oref] 4 "Retrieve the slot `new' from an object of class `ws-message'.\n\n(fn THIS)"] \(setf\ new\) (value (this ws-message)) #[514 "\300\301#\207" [eieio-oset new] 6 "\n\n(fn VALUE THIS)"] active ((this ws-message)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp active eieio-oref] 4 "Retrieve the slot `active' from an object of class `ws-message'.\n\n(fn THIS)"] \(setf\ active\) (value (this ws-message)) #[514 "\300\301#\207" [eieio-oset active] 6 "\n\n(fn VALUE THIS)"] pending ((this ws-message)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp pending eieio-oref] 4 "Retrieve the slot `pending' from an object of class `ws-message'.\n\n(fn THIS)"] \(setf\ pending\) (value (this ws-message)) #[514 "\300\301#\207" [eieio-oset pending] 6 "\n\n(fn VALUE THIS)"] process ((this ws-message)) #[257 "\300\301\"\205 \302\301\"\207" [slot-boundp process eieio-oref] 4 "Retrieve the slot `process' from an object of class `ws-message'.\n\n(fn THIS)"] \(setf\ process\) (value (this ws-message)) #[514 "\300\301#\207" [eieio-oset process] 6 "\n\n(fn VALUE THIS)"]] 7) #@67 Create a new object of class type `ws-message'. (fn &rest SLOTS) (defalias 'ws-message #[128 "\300\301\302#\207" [apply make-instance ws-message] 5 (#$ . 18717)]) (byte-code "\300\301\302\303#\300\207" [function-put ws-message compiler-macro ws-message--anon-cmacro] 4) #@26 (fn WHOLE &rest SLOTS) (defalias 'ws-message--anon-cmacro #[385 "\211@;\204\207\300\301\302@@#@\303@DABB\"\207" [macroexp--warn-and-return format "Obsolete name arg %S to constructor %S" identity] 7 (#$ . 18995)]) #@533 Establish a web socket connection with request. If the connection is successful this function will throw `:keep-alive' to `close-connection' skipping any remaining code in the request handler. If no web-socket connection is established (e.g., because REQUEST is not attempting to establish a connection) then no actions are taken and nil is returned. Second argument HANDLER should be a function of one argument which will be called on all complete messages as they are received and parsed from the network. (fn REQUEST HANDLER) (defalias 'ws-web-socket-connect #[514 "\300\301\302\303\"\"\205O\304\302\305\"\306\307\310B\311\312B\313\314\300\301\302\n\303\"\"A!B%\210\315\302\305\"\316\"\210\317\302\305\"\320\321\322\323\324\302 \305\"%D\"\210\325\302\305\"\326\"\210\302\305\"\207" [assoc :SEC-WEBSOCKET-KEY slot-value headers ws-response-header process 101 "Upgrade" "websocket" "Connection" "upgrade" "Sec-WebSocket-Accept" ws-web-socket-handshake set-process-coding-system binary set-process-plist :message make-instance ws-message :handler :process set-process-filter ws-web-socket-filter] 15 (#$ . 19226)]) #@23 (fn PROCESS STRING) (defalias 'ws-web-socket-filter #[514 "\300\301!\302\"\303!\203\211\304\"\266\202,\211\305\306!P\"\266\211\307\310\"\266\311!\210\211\307\312\"\262\207" [plist-get process-plist :message active \(setf\ new\) \(setf\ pending\) pending \(setf\ active\) t ws-web-socket-parse-messages nil] 7 (#$ . 20362)]) #@25 (fn MASKING-KEY DATA) (defalias 'ws-web-socket-mask #[514 "\300\301\302G\303\245T\"\"\300\304\305\306#\"\207" [apply concat make-list 4 string cl-mapcar logxor] 9 (#$ . 20711)]) #@82 Web socket filter to pass whole frames to the client. See RFC6455. (fn MESSAGE) (defalias 'ws-web-socket-parse-messages #[257 "\211\300C\301C\301\211\302\240\210\303\262\304\305\306\307\310   #\311\"\312\313%\262\301\211\211\211\211\211\314!\211@\262\315\314\316#\262\315\316\"!\317\300\"\203H\320\202\236\317\314\"\203S\321\202\236\317\322\"\203^\323\202\236\324\325\"\203i\326\202\236\317\327\"\203t\330\202\236\317\331\"\203\332\202\236\317\333\"\203\212\334\202\236\324\335\"\203\225\336\202\236\337\340\341\"\342#\262\262\210\343\344\"\204\264\337\340\f\341\"\345\"\210\314!\211@\262\315\314\"!\262\210\346=\204\325\337\340\f\341\"\347\"\210\350U\203\347\322!!\262\202\366\351U\203\366\327!!\262\203 \315\340\f\352\" \242\f\211\242\316\\\240#\262\n\353\354\340\354\"\355\315\340\352\"\242\242\f\\#\"P#\266\203\211\340 \354\" \353\354\356#\266 \353\357\301#\266 \353\352\356#\266 \353\360\301#\266\317\330\"\204s\340\f\361\"\340 \341\"\"\210\202\205\362\340 \341\"\363\364\365\314\366\"\327\"\300\"\"\210\210\202\255 \242\\\340\f\352\"GW\203\255\n\353\352\340\352\"\242\\\301O#\266\266 \360!\205\270\367!\262\207" [0 nil #[514 "C\300\301\"\302\303\304\305\306\307\"\310\"\311\312%\313\314\315S\"!\"\210\313\316\301\"!\262\207" [make-bool-vector nil mapc make-byte-code 257 "\302\303\"\300\242Y\205\300\211\242Z\240\210\301\304I\207" vconcat vector [expt 2 t] 5 "\n\n(fn PLACE)" reverse number-sequence 0 append] 12 "\n\n(fn INT SIZE)"] #[257 "\300C\301\302\303\304\305\306\307\310!\311\"\312\313%\314!\"\"\207" [0 apply + mapcar make-byte-code 257 "\211\203\f\301\302\300\242\"\202 \303\300\211\242T\240\210\207" vconcat vector [expt 2 0] 4 "\n\n(fn BIT)" reverse] 11 "\n\n(fn BITS)"] make-byte-code 257 "\303\304\305\306\307\310\311\312\302!\313\"\314\315%\316\317\300\320\"\301\242\301\211\242 \\\240#\"\"\207" vconcat vector [apply append mapcar make-byte-code 257 "\300\242\301\"\207" vconcat vector [8] 4 "\n\n(fn INT)" cl-subseq slot-value pending] 11 "\n\n(fn LENGTH)" 1 cl-subseq 4 eql :CONTINUATION :TEXT 2 :BINARY memql (3 4 5 6 7) :NON-CONTROL 8 :CLOSE 9 :PING 10 :PONG (11 12 13 14 15) :CONTROL ws-error slot-value process "Web Socket Fail: bad opcode %d" cl-every null "Web Socket Fail: non-zero RSV 1 2 or 3" t "Web Socket Fail: client must mask data" 126 127 pending eieio-oset data ws-web-socket-mask "" active new handler process-send-string unibyte-string logior lsh 7 ws-web-socket-parse-messages] 24 (#$ . 20902)]) #@74 Frame STRING for web socket communication. (fn STRING &optional OPCODE) (defalias 'ws-web-socket-frame #[513 "\300G\206\301\302\301\"\203\300\202'\302\303\"\203\304\202'\305\306\307#\205'\310\262\311W\203<\312\313\314\315\"\"\"\202\244\316W\203\\\312\313\314\315\"\"\311\317\314\320\"\321\"\317\321\"$\202\244\312\313\314\315\"\"\322\317\314\323\"\321\"\317\314\324\"\321\"\317\314\325\"\321\"\317\314 \326\"\321\"\317\314\n\327\"\321\"\317\314 \330\"\321\"\317\314\f\320\"\321\"\317\f\321\"&\nP\207" [1 :TEXT eql :BINARY 2 error "cl-ecase failed: %s, %s" (:TEXT :BINARY) nil 126 unibyte-string logior lsh 7 65536 logand -8 255 127 -56 -48 -40 -32 -24 -16] 18 (#$ . 23505)]) #@61 Command used for the "compress" Content or Transfer coding. (defvar ws-compress-cmd "compress" (#$ . 24231)) #@60 Command used for the "deflate" Content or Transfer coding. (defvar ws-deflate-cmd "zlib-flate -compress" (#$ . 24346)) #@57 Command used for the "gzip" Content or Transfer coding. (defvar ws-gzip-cmd "gzip" (#$ . 24471)) #@59 Return a function which applies CMD to strings. (fn CMD) (defalias 'ws-encoding-cmd-to-fn '(macro . #[257 "\300\301\302\303\304\305\306\307BBBB\310BBBE\207" [lambda (s) with-temp-buffer (insert s) shell-command-on-region (point-min) (point-max) (nil 'replace) ((buffer-string))] 10 (#$ . 24574)])) #@82 Convert STRING to a valid chunk for HTTP chunked Transfer-encoding. (fn STRING) (defalias 'ws-chunk #[257 "\300\301\302!#\207" [format "%x \n%s \n" string-bytes] 5 (#$ . 24881)]) #@592 Send the headers for an HTTP response to PROC. CODE should be an HTTP status code, see `ws-status-codes' for a list of known codes. When "Content-Encoding" or "Transfer-Encoding" headers are supplied any subsequent data written to PROC using `ws-send' will be encoded appropriately including sending the appropriate data upon the end of transmission for chunked transfer encoding. For example with the header ("Content-Encoding" . "gzip"), any data subsequently written to PROC using `ws-send' will be compressed using the command specified in `ws-gzip-cmd'. (fn PROC CODE &rest HEADERS) (defalias 'ws-response-header #[642 "\301\302\"A\301\303\"A\203f\304\305\306\307!\310\311\"\203!\312\202\\\310\313\"\203,\314\202\\\310\315\"\2037\316\202\\\317\320\"\203B\320\202\\\310\321\"\203S\322\n\323 #\202\\\324\325\326#\205\\\327\262D\330 !\"\"\210\211\203\272\304\305\331\230\205v\332\333D\334\307!\317\335\"\203\206\336\202\260\310\337\"\203\221\340\202\260\310\341\"\203\234\342\202\260\310\343\"\203\247\344\202\260\324\325\345#\205\260\327\262D\330\n!#\"\210\266\346\347\301\"A#\350\351\"B\352!\353\211D\241\210\354\355\320\356#\"\207" [ws-status-codes assoc "Content-Encoding" "Transfer-Encoding" set-process-plist append :content-encoding intern memql (compress x-compress) #[257 "\301\302!r\211q\210\303\304\305\306\307!\310\"\311$\216c\210\312ed\313\314%\210\315 *\207" [ws-compress-cmd generate-new-buffer #1=" *temp*" make-byte-code 0 "\301\300!\205 \302\300!\207" vconcat vector [buffer-name kill-buffer] 2 shell-command-on-region nil replace buffer-string] 8 "\n\n(fn S)"] (deflate x-deflate) #[257 "\301\302!r\211q\210\303\304\305\306\307!\310\"\311$\216c\210\312ed\313\314%\210\315 *\207" [ws-deflate-cmd generate-new-buffer #1# make-byte-code 0 "\301\300!\205 \302\300!\207" vconcat vector [buffer-name kill-buffer] 2 shell-command-on-region nil replace buffer-string] 8 "\n\n(fn S)"] (gzip x-gzip) #[257 "\301\302!r\211q\210\303\304\305\306\307!\310\"\311$\216c\210\312ed\313\314%\210\315 *\207" [ws-gzip-cmd generate-new-buffer #1# make-byte-code 0 "\301\300!\205 \302\300!\207" vconcat vector [buffer-name kill-buffer] 2 shell-command-on-region nil replace buffer-string] 8 "\n\n(fn S)"] eql identity (exi pack200-zip) ws-error "`%s' Content-encoding not supported." error "cl-ecase failed: %s, %s" (x-compress compress x-deflate deflate x-gzip gzip identity pack200-zip exi) nil process-plist "chunked" :ender "0 \n \n" :transfer-encoding chunked ws-chunk (compress x-compress) #[257 "\301\302!r\211q\210\303\304\305\306\307!\310\"\311$\216c\210\312ed\313\314%\210\315 *\207" [ws-compress-cmd generate-new-buffer #1# make-byte-code 0 "\301\300!\205 \302\300!\207" vconcat vector [buffer-name kill-buffer] 2 shell-command-on-region nil replace buffer-string] 8 "\n\n(fn S)"] (deflate x-deflate) #[257 "\301\302!r\211q\210\303\304\305\306\307!\310\"\311$\216c\210\312ed\313\314%\210\315 *\207" [ws-deflate-cmd generate-new-buffer #1# make-byte-code 0 "\301\300!\205 \302\300!\207" vconcat vector [buffer-name kill-buffer] 2 shell-command-on-region nil replace buffer-string] 8 "\n\n(fn S)"] (gzip x-gzip) #[257 "\301\302!r\211q\210\303\304\305\306\307!\310\"\311$\216c\210\312ed\313\314%\210\315 *\207" [ws-gzip-cmd generate-new-buffer #1# make-byte-code 0 "\301\300!\205 \302\300!\207" vconcat vector [buffer-name kill-buffer] 2 shell-command-on-region nil replace buffer-string] 8 "\n\n(fn S)"] (chunked x-compress compress x-deflate deflate x-gzip gzip) format "HTTP/1.1 %d %s" mapcar #[257 "\300\301@A#\207" [format "%s: %s"] 5 "\n\n(fn H)"] last "" process-send-string mapconcat " \n"] 15 (#$ . 25070)]) #@134 Send STRING to process PROC. If any Content or Transfer encodings are in use, apply them to STRING before sending. (fn PROC STRING) (defalias 'ws-send #[514 "\300\301!\302\"\206\n\303\300\301!\304\"\206\303\305!!\"\207" [plist-get process-plist :content-encoding identity :transfer-encoding process-send-string] 9 (#$ . 28787)]) #@98 Send 500 "Internal Server Error" to PROC with an optional message. (fn PROC &rest MSG-AND-ARGS) (defalias 'ws-send-500 #[385 "\300\301\302#\210\303\203\304\305\"\202\306\"\210\307\310\311\"\207" [ws-response-header 500 ("Content-type" . "text/plain") process-send-string apply format "500 Internal Server Error" throw close-connection nil] 7 (#$ . 29133)]) #@86 Send 404 "Not Found" to PROC with an optional message. (fn PROC &rest MSG-AND-ARGS) (defalias 'ws-send-404 #[385 "\300\301\302#\210\303\203\304\305\"\202\306\"\210\307\310\311\"\207" [ws-response-header 404 ("Content-type" . "text/plain") process-send-string apply format "404 Not Found" throw close-connection nil] 7 (#$ . 29505)]) #@148 Send PATH to PROC. Optionally explicitly set MIME-TYPE, otherwise it is guessed by `mm-default-file-encoding'. (fn PROC PATH &optional MIME-TYPE) (defalias 'ws-send-file #[770 "\211\206 \300!\206 \301\302\303\304!r\211q\210\305\306\307\310\311!\312\"\313$\216\314!\210\315\316\317B\320deZB$\210\321 *\262\"\207" [mm-default-file-encoding "application/octet-stream" process-send-string generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205 \302\300!\207" vconcat vector [buffer-name kill-buffer] 2 insert-file-contents-literally ws-response-header 200 "Content-type" "Content-length" buffer-string] 14 (#$ . 29854)]) #@180 Send a listing of files in DIRECTORY to PROC. Optional argument MATCH is passed to `directory-files' and may be used to limit the files sent. (fn PROC DIRECTORY &optional MATCH) (defalias 'ws-send-directory-list #[770 "\300\301\302\303B#\210\304\305\306\307\310\311\312\313\n!\314\"\315\316%\317\320#\321#\322Q\"\207" [ws-response-header 200 "Content-type" "text/html" process-send-string ""] 13 (#$ . 30499)]) #@239 Check if PATH is under the PARENT directory. If so return PATH, if not return nil. Note: the PARENT directory must be full expanded as with `expand-file-name' and should not contain e.g., "~" for a user home directory. (fn PARENT PATH) (defalias 'ws-in-directory-p #[514 "\211G\300U\203 \207\301\"\211GGY\205 \300GO\230\205 \211\207" [0 expand-file-name] 7 (#$ . 31175)]) #@513 Return a version of HANDLER protected by CREDENTIALS. HANDLER should be a function as passed to `ws-start', and CREDENTIALS should be an alist of elements of the form (USERNAME . PASSWORD). Optional argument REALM sets the realm in the authentication challenge. Optional arguments UNAUTH and INVALID should be functions which are called on the request when no authentication information, or invalid authentication information are provided respectively. (fn HANDLER CREDENTIALS &optional REALM UNAUTH INVALID) (defalias 'ws-with-authentication #[1282 "\300\301\302\303\304     %\305\"\306\307%\207" [make-byte-code 257 "\211\305\306\307\310\"\"AA\211\2045\303\203\303!\202a\311\307\312\"\313\314\315\316\302\206&\317\"B\320$\210\321\307\312\"\322\"\202a\211A\305@\301\"A\230\203G\300!\202a\304\203Q\304!\202a\311\307\312\"\323\324#\210\321\307\312\"\325\"\262\207" vconcat vector [assoc :AUTHORIZATION slot-value headers ws-response-header process 401 "WWW-Authenticate" format "Basic realm=%S" "restricted" ("Content-type" . "text/plain") process-send-string "authentication required" 403 ("Content-type" . "text/plain") "invalid credentials"] 10 "\n\n(fn REQUEST)"] 15 (#$ . 31566)]) #@53 Perform the handshake defined in RFC6455. (fn KEY) (defalias 'ws-web-socket-handshake #[257 "\301\302\303!P\304\211\305$!\207" [ws-guid base64-encode-string sha1 ws-trim nil binary] 7 (#$ . 32785)]) (provide 'web-server)