Paste: websockets

Author:	erg
Mode:	factor
Date:	Sat, 20 Mar 2021 00:57:45

Plain Text |

Delete Paste

! Copyright (C) 2021 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs base64 byte-arrays combinators
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

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
    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 ;

CONSTANT: websocket-opcode-continue-frame 0
CONSTANT: websocket-opcode-text-frame 1
CONSTANT: websocket-opcode-binary-frame 2
CONSTANT: websocket-opcode-connection-close-frame 8
CONSTANT: websocket-opcode-ping-frame 9
CONSTANT: websocket-opcode-pong-frame 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 ;

! : send-websocket-fragmented ( bytes opcode -- ) 0b10000000 bitor

: 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 ;

ERROR: unsupported-opcode n ;
: read-websocket ( -- loop? obj opcode )
    read1 [
        [ 0x80 mask? drop ] [ 7 clear-bit ] bi
        [
            {
                { f [ f "disconnected" ] }
                { 0 [ t unsupported-opcode ] }
                { 1 [ t read-payload ] }
                { 2 [ t read-payload utf8 decode ] }
                { 8 [ f read1 ] }
                { 9 [ t read-payload [ send-pong ] keep ] }
                { 0xa [ t read-payload ] }
                [ unsupported-opcode ]
            } case
        ] keep
    ] [
        f f f
    ] if* ;

: read-websocket-loop ( quot -- )
    '[
        read-websocket @
    ] loop ; inline

: handle-websocket ( obj opcode -- )
    {
        { f [ [ drop "closed with error" . ] with-global ] }
        { 1 [ [ [ hexdump. ] with-global ] when* ] }
        { 2 [ [ [ hexdump. ] with-global ] when* ] }
        { 8 [ [ [ hexdump. ] when* "ping received" . flush ] with-global ] }
        { 9 [ [ [ hexdump. ] with-global ] when* ] }
        [ 2drop ]
    } case ;



![[
"echo.websocket.org/?encoding=text" <get-request> add-websocket-headers
start-websocket
stream>> [ in>> stream>> ] [ out>> stream>> ] bi
[
    [ handle-websocket ] read-websocket-loop
] with-streams
]]

Annotation: websockets debugging

Author:	erg
Mode:	factor
Date:	Wed, 22 Dec 2021 15:37:33

Plain Text |

Delete Annotation

! broken code but useful message
"demo.piesocket.com/v3/channel_1?api_key=oCdCMcMPQpbvNjUIzqtvF1d2X2okWpDQj4AwARJuAgtjhzKxVEjQU6IdCjwm&notify_self" <get-request> add-websocket-headers
[ B ] with-http-request*
stream>> [ in>> stream>> ] [ out>> stream>> ] bi
[
    [ handle-websocket ] read-websocket-loop
] with-streams



T{ response
    { version "1.1" }
    { code 101 }
    { message "Switching Protocols" }
    { header
        H{
            { "connection" "upgrade" }
            { "date" "Wed, 22 Dec 2021 15:36:41 GMT" }
            {
                "sec-websocket-accept"
                "DfQEuzI/e3PfEK2oSkBI0h4SzQY="
            }
            { "server" "nginx/1.18.0 (Ubuntu)" }
            { "x-powered-by" "Ratchet/0.4.1" }
            { "upgrade" "websocket" }
        }
    }
    { cookies { } }
    { content-encoding utf8 }
}

Annotation: websockets with http

Author:	erg
Mode:	factor
Date:	Wed, 22 Dec 2021 17:46:44

Plain Text |

Delete Annotation

SYMBOL: request-socket
: (with-http-request) ( request quot: ( chunk -- ) -- response/websocket )
    [
        swap ?default-proxy
        request [
            <request-socket> |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

: http-request* ( request -- response data/stream )
    BV{ } clone [ '[ _ push-all ] with-http-request* ] keep
    over array? [
        drop first2
    ] [
        B{ } like
        over content-encoding>> decode [ >>body ] keep
    ] if ;



"demo.piesocket.com/v3/1?api_key=oCdCMcMPQpbvNjUIzqtvF1d2X2okWpDQj4AwARJuAgtjhzKxVEjQU6IdCjwm&notify_self=1"

<get-request> add-websocket-headers http-request* nip
[ in>> stream>> ] [ out>> stream>> ] bi
[
    "hello" f 1 f send-websocket-text
    [ B handle-websocket ] read-websocket-loop
] with-streams

Annotation: git diff

Author:	erg
Mode:	factor
Date:	Fri, 21 Jan 2022 20:16:24

Plain Text |

Delete Annotation

 DEFER: (with-http-request)
+DEFER: start-websocket

 SYMBOL: redirects

@@ -128,6 +129,15 @@ SYMBOL: redirects
         quot (with-http-request)
     ] [ too-many-redirects ] if ; inline recursive

+:: do-redirect-websocket ( response -- response )
+    redirects inc
+    redirects get request get redirects>> < [
+        request get clone
+        response "location" header redirect-url
+        response code>> 307 = [ "GET" >>method f >>post-data ] unless
+        start-websocket
+    ] [ too-many-redirects ] if ; inline recursive
+
 : read-chunk-size ( -- n )
     read-crlf ";" split1 drop [ blank? ] trim-tail
     hex> [ "Bad chunk size" throw ] unless* ;
@@ -245,6 +255,41 @@ SYMBOL: redirects
         [ do-redirect ] [ nip ] if
     ] with-variable ; inline recursive

+TUPLE: websocket response stream ;
+
+: <websocket> ( response stream -- websocket )
+    websocket new
+        swap >>stream
+        swap >>response ; inline
+
+: start-websocket ( request -- websocket )
+    ?default-proxy
+    request [
+        [
+            <request-socket> |dispose
+            [
+                [
+                    [ in>> ] [ out>> ] bi
+                    [ ?https-tunnel ] with-streams*
+                ]
+                [
+                    out>>
+                    [ request get write-request ]
+                    with-output-stream*
+                ] [
+                    in>> [
+                        read-response
+                        dup response set
+                        dup redirect?
+                        request get redirects>> 0 > and
+                        [ response get t ] [ f f ] if
+                    ] with-input-stream*
+                ] tri
+            ] keep -rot
+        ] with-destructors
+        [ swap dispose do-redirect-websocket ] [ nip ] if
+    ] with-variable <websocket> ; inline recursive
+

New Annotation

Summary:
Author:
Mode:	textPostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonqdocrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsparqlsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt
Body:

Done