From: Doug Coleman Date: Wed, 22 Dec 2021 18:10:36 +0000 (-0600) Subject: http.websockets: Initial commit X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=75fc55dfbfe50cc319bba95efbf8133568395cde http.websockets: Initial commit Need to factor out add-origin-header and handling the connections. The http integration is a little sloppy as well. Try this: "demo.piesocket.com/v3/1?api_key=oCdCMcMPQpbvNjUIzqtvF1d2X2okWpDQj4AwARJuAgtjhzKxVEjQU6IdCjwm¬ify_self=1" add-websocket-headers http-request* nip [ in>> stream>> ] [ out>> stream>> ] bi dup . [ ! "hello" f 1 f send-websocket-text [ B default-handle-websocket ] read-websocket-loop ] with-streams --- diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index b0bad5ff61..ccdf79db0e 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors ascii assocs calendar combinators +USING: accessors arrays ascii assocs calendar combinators combinators.short-circuit destructors environment hashtables -http http.client.post-data http.parsers io io.crlf io.encodings -io.encodings.ascii io.encodings.binary io.encodings.iana -io.encodings.string io.files io.pathnames io.sockets -io.sockets.secure io.timeouts kernel math math.order math.parser -mime.types namespaces present sequences splitting urls -vocabs.loader ; +http http.client.post-data http.parsers http.websockets io +io.crlf io.encodings io.encodings.ascii io.encodings.binary +io.encodings.iana io.encodings.string io.files io.pathnames +io.sockets io.sockets.secure io.timeouts kernel math math.order +math.parser mime.types namespaces present sequences splitting +urls vocabs.loader ; IN: http.client ERROR: too-many-redirects ; @@ -218,32 +218,40 @@ SYMBOL: redirects pick no-proxy? [ nip ] [ [ request-url ] dip derive-url ] if ] [ nip ] if check-proxy ; -: (with-http-request) ( request quot: ( chunk -- ) -- response ) - swap ?default-proxy - request [ - [ - [ - [ in>> ] [ out>> ] bi - [ ?https-tunnel ] with-streams* - ] - [ - out>> - [ request get write-request ] - with-output-stream* - ] [ - in>> [ - read-response dup redirect? - request get redirects>> 0 > and [ t ] [ - [ nip response set ] - [ read-response-body ] - [ ] - 2tri f - ] if - ] with-input-stream* - ] tri - ] with-disposal - [ do-redirect ] [ nip ] if - ] with-variable ; inline recursive +SYMBOL: request-socket +: (with-http-request) ( request quot: ( chunk -- ) -- response/websocket ) + [ + swap ?default-proxy + request [ + |dispose + dup request-socket [ + [ + [ in>> ] [ out>> ] bi + [ ?https-tunnel ] with-streams* + ] + [ + out>> + [ request get write-request ] + with-output-stream* + ] [ + in>> [ + read-response { + { [ dup redirect? request get redirects>> 0 > and ] [ request-socket get &dispose drop t ] } + { [ dup check-websocket-upgraded? ] [ request-socket get 2array f ] } + [ + request-socket get &dispose drop + [ nip response set ] + [ read-response-body ] + [ ] + 2tri f + ] + } cond + ] with-input-stream* + ] tri + ] with-variable + [ do-redirect ] [ nip ] if + ] with-variable + ] with-destructors ; inline recursive : ( url method -- request ) @@ -258,9 +266,14 @@ PRIVATE> : with-http-request ( request quot: ( chunk -- ) -- response ) with-http-request* check-response ; inline -: http-request* ( request -- response data ) +: http-request* ( request -- response data/websocket-stream ) BV{ } clone [ '[ _ push-all ] with-http-request* ] keep - B{ } like over content-encoding>> decode [ >>body ] keep ; + over array? [ + drop first2 + ] [ + B{ } like + over content-encoding>> decode [ >>body ] keep + ] if ; : http-request ( request -- response data ) http-request* [ check-response ] dip ; diff --git a/basis/http/websockets/authors.txt b/basis/http/websockets/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/http/websockets/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/http/websockets/websockets.factor b/basis/http/websockets/websockets.factor new file mode 100644 index 0000000000..1309eda583 --- /dev/null +++ b/basis/http/websockets/websockets.factor @@ -0,0 +1,143 @@ +! Copyright (C) 2021 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.enums alien.syntax assocs base64 +byte-arrays combinators combinators.short-circuit crypto.xor +http http.client io io.binary io.encodings.string +io.encodings.utf8 kernel math math.bitwise multiline namespaces +prettyprint random sequences strings tools.hexdump ; +IN: http.websockets + +! TODO: multiplexing, fragmented send + +CONSTANT: websocket-version "13" + +: random-websocket-key ( -- base64 ) + 16 random-bytes >base64 >string ; + +: add-websocket-headers ( request -- request ) + "connection" over header>> delete-at + "Upgrade" "Connection" set-header + "no-cache" "Pragma" set-header + "no-cache" "Cache-Control" set-header + "websocket" "Upgrade" set-header + ! "http://www.websocket.org" "Origin" set-header + "https://www.piesocket.com" "Origin" set-header + websocket-version "Sec-WebSocket-Version" set-header + random-websocket-key "Sec-WebSocket-Key" set-header + "permessage-deflate; client_max_window_bits" "Sec-WebSocket-Extensions" set-header + "gzip, deflate" "Accept-Encoding" set-header + "en-US,en;q=0.9,sw-TZ;q=0.8,sw;q=0.7,es-US;q=0.6,es;q=0.5,de-DE;q=0.4,de;q=0.3,fr-FR;q=0.2,fr;q=0.1" "Accept-Language" set-header ; + +: add-origin-header ( request origin -- request ) "Origin" set-header ; + +ENUM: WEBSOCKET-OPCODE + { WS-CONTINUE 0 } + { WS-TEXT 1 } + { WS-BINARY 2 } + { WS-CONNECTION-CLOSE 8 } + { WS-PING 9 } + { WS-PONG 0xa } ; + +: get-read-payload-length ( -- length masked? ) + read1 [ + { + { [ dup 125 <= ] [ ] } + { [ dup 126 = ] [ drop 2 read be> ] } + { [ dup 127 = ] [ drop 8 read be> ] } + } cond + ] [ + 0x80 mask? + ] bi ; + +: get-write-payload-length ( bytes -- length-byte length-bytes/f ) + length { + { [ dup 125 <= ] [ f ] } + { [ dup 0xffff <= ] [ [ drop 126 ] [ 2 >be ] bi ] } + [ [ drop 127 ] [ 8 >be ] bi ] + } cond ; + +! The final packet of a fragmented send has high bit set +! opcode should be WS-TEXT or WS-binary +! mask is a random 4 bytes to XOR with the data, optional +: send-websocket-bytes ( bytes mask? opcode final? -- ) + 0b10000000 0b0 ? bitor write1 + [ + [ + get-write-payload-length [ 0x80 bitor ] dip + [ write1 ] [ [ write ] when* ] bi* + ] [ + 4 random-bytes + [ write drop ] + [ xor-crypt [ write ] when* ] 2bi + ] bi + ] [ + [ get-write-payload-length [ write1 ] [ [ write ] when* ] bi* ] + [ [ write ] when* ] bi + ] if flush ; + +: send-websocket-text ( bytes mask? opcode fin? -- ) + [ utf8 encode ] 3dip send-websocket-bytes ; + +: read-payload ( -- payload ) + get-read-payload-length [ [ 4 read ] dip read xor-crypt ] [ read ] if ; + +: send-pong ( payload -- ) + t 0xa t send-websocket-bytes ; + +SYMBOL: websocket-received + +ERROR: unsupported-opcode n ; +: read-websocket ( -- loop? obj opcode ) + read1 [ + [ 0x80 mask? drop ] [ 7 clear-bit ] bi + [ + WEBSOCKET-OPCODE number>enum + { + { f [ f "disconnected" ] } + ! { WS-CONTINUE [ t websocket-received dup get push ] } + { WS-TEXT [ t read-payload ] } + { WS-BINARY [ t read-payload utf8 decode ] } + { WS-CONNECTION-CLOSE [ f read1 ] } + { WS-PING [ t read-payload [ send-pong ] keep ] } + { WS-PONG [ t read-payload ] } + [ unsupported-opcode ] + } case + ] keep + ] [ + f f f + ] if* ; + +: read-websocket-loop ( quot -- ) + '[ + websocket-received V{ } clone [ + read-websocket @ + ] with-variable + ] loop ; inline + + +: default-handle-websocket ( obj opcode -- ) + WEBSOCKET-OPCODE number>enum + { + { f [ [ drop "closed with error" . ] with-global ] } + ! { WS-CONTINUE [ ] } + { WS-TEXT [ [ [ hexdump. ] with-global ] when* ] } + { WS-BINARY [ [ [ hexdump. ] with-global ] when* ] } + { WS-CONNECTION-CLOSE [ [ [ . ] when* ] with-global ] } + { WS-PING [ [ [ hexdump. ] with-global ] when* ] } + [ 2drop ] + } case ; + +: check-websocket-upgraded? ( response -- ? ) + { + [ code>> 101 = ] + [ + header>> { + [ "connection" of "upgrade" = ] + [ "upgrade" of "websocket" = ] + } 1&& + ] + } 1&& ; + +: start-websocket ( url -- response ) + add-websocket-headers http-request* drop + dup check-websocket-upgraded? [ ] [ ] if ;