An HTTPD Scheme for Rebol 3 [Experimental]

httpd.reb

Rebol [
    Title: "HTTPD Scheme"
    Date: 10-Jun-2013
    Author: [
        "Christopher Ross-Gill" 4-Jan-2017 "Adaptation to Scheme"
        "Andreas Bolka" 4-Nov-2009 "A Tiny HTTP Server"
    ]
    File: %httpd.reb
    Version: 0.2.0
    Rights: http://opensource.org/licenses/Apache-2.0
    Purpose: {
        A Tiny Static Webserver Scheme for Rebol 3

        Based on 'A Tiny HTTP Server' by Andreas Bolka
        https://github.com/earl/rebol3/blob/master/scripts/shttpd.r
    }
]

attempt [_: none] ; for Rebolsource Rebol 3 Compatibility

sys/make-scheme [
    Title: "HTTP Server"
    Name: 'httpd

    Actor: [
        Open: func [port [port!]][
            ; probe port/spec
            port/locals: make object! [
                subport: open [
                    scheme: 'tcp
                    port-id: port/spec/port-id
                ]
                subport/awake: :port/scheme/awake-server
                subport/locals: make object! [
                    parent: :port
                    body: _
                ]
            ]

            port
        ]

        Close: func [port [port!]][
            close port/locals/subport
        ]
    ]

    Status-Codes: make map! [
        200 "OK" 400 "Forbidden" 404 "Not Found"
    ]

    Respond: func [port response][
        write port ajoin ["HTTP/1.0 " response/status " " status-codes/(response/status) crlf]
        write port ajoin ["Content-Type: " response/type crlf]
        write port ajoin ["Content-Length: " length? response/content crlf]
        write port crlf
           ;; Manual chunking is only necessary because of several bugs in R3's
           ;; networking stack (mainly cc#2098 & cc#2160; in some constellations also
           ;; cc#2103). Once those are fixed, we should directly use R3's internal
           ;; chunking instead: `write port body`.
        port/locals/body: to binary! response/content
    ]

    Send-Chunk: func [port [port!]][
           ;; Trying to send data >32'000 bytes at once will trigger R3's internal
           ;; chunking (which is buggy, see above). So we cannot use chunks >32'000
           ;; for our manual chunking.
        either empty? port/locals/body [_][
            attempt [write port take/part port/locals/body 32'000]
        ]
    ]

    Awake-Client: use [from-actions chars][
        from-actions: ["GET" | "POST"]
        chars: complement union space: charset " " charset [#"^@" - #"^_"]
        
        func [event [event!] /local port request response][
            port: event/port

            switch event/type [
                read [
                    either find port/data to-binary rejoin [crlf crlf][
                        response: port/locals/parent/awake request: make object! [
                            action: target: _
                            parse to-string port/data [
                                copy action from-actions some space
                                copy target some chars some space
                                "HTTP/" ["1.0" | "1.1"]
                            ]
                        ]
                        respond port response
                    ][
                        read port
                    ]
                ]
                wrote [unless send-chunk port [close port] port]
                close [close port]
            ]
        ]
    ]

    Awake-Server: func [event [event!] /local client] [
        if event/type = 'accept [
            client: first event/port
            client/awake: :awake-client
            read client
        ]
        event
    ]
]

test-httpd.reb

Rebol [
    Title: "Test HTTPD Scheme"
    Date: 31-Jan-2017
    Author: "Christopher Ross-Gill"
    File: %test-httpd.reb
    Version: 0.1.0
    Rights: http://opensource.org/licenses/Apache-2.0
]

do %httpd.reb

server: open [
    Scheme: 'httpd
    Port-ID: 8080
    Awake: func [
        request [object!]
    ][
        make object! compose [
            Status: 200
            Type: "text/html"
            Content: reword "<h1>OK! $action :: $target</h1>" compose [
                action (request/action)
                target (request/target)
            ]
        ]
    ]
]

attempt [browse http://127.0.0.1:8080/try/this/path]

wait server

It is big mistake to form the request header using multiple write calls like you do here: https://gist.github.com/rgchris/73510e7d643eb0a6b9fa69b849cd9880#file-httpd-reb-L53-L56

The thing is, that you should not write port until you receive wrote event from previous write action. Which is actually what you do with Send-Chunk. If you don't wait, you risc that the data are not sent yet and the second write interfere with the first one.

Another issue is, that in the Send-Chunk call is used take call, which internally move content of the output buffer, which is also not efficient. It also causes a crash when the data require internal loop (over 32000). That is something what should be examined. Although you are on Ren-C anyway and there will not be single line same today.

The mentioned bug 2098 was fixed with this patch: https://www.curecode.org/rebol3/ticket.rsp?id=2098

And I was not able to reproduce this: metaeducation/rebol-issues#2160 with this script not using multiple writes and sending a big file in one write.

I've modified the scheme a little bit here: https://gist.github.com/Oldes/ece2f714b73d305ccf517463a2760fe6