Author Topic: HTTP 1.1 compliant web server (work in progress) (Read 4952 times)

luke · « **on:** January 01, 2020, 07:17:54 am »

There seemed to be lots of chat about web servers over on Discord, so I thought I'd throw my hat in the ring. This is an attempt at writing a web server that fully supports HTTP 1.1 (the most common version). It is very basic at the moment, and does not support most things - but it can do basic file serving.

By default it runs on port 8080 (change the CONST PORT line to change this) and will serve any files from the directory it's running in. For example, if you run it from your QB64 directory you can put http://localhost:8080/source/qb64.bas into your browser and it'll get the QB64 source file from your hard drive.

For the most recent version, see https://github.com/flukiluke/http-toy

SpriggsySpriggs · « **Reply #1 on:** July 29, 2020, 09:21:40 pm »

@luke Is there a new update on this or is this still the latest source? I thought about using this code you have to make my own REST API server that will use Galleon's qb_framework to build a JSON response and send it to the clients, containing the information they requested in the URL using either CURL or URLMON.

luke · « **Reply #2 on:** July 30, 2020, 05:49:54 am »

To be honest I completely forgot about this. What you see there is the latest.

If you just want to answer requests programmatically you could just rewrite the http_do_get function; it's as complex as it is because it's dealing with files.

SpriggsySpriggs · « **Reply #3 on:** July 30, 2020, 06:06:30 am »

Appreciate it! I'll look into it

dbox · « **Reply #4 on:** December 16, 2021, 09:26:36 am »

@luke, this is awesome! I've been looking for a lightweight http server to test out game code that I'm converting to html. It's even better that you've already created one for QB64! The content I'm wanting to test is all just static html, javascript, images, etc.. So what you already have here is working perfectly for what I need.

I did find one issue that I thought I would mention. It looks like the num_active_connections counter is being incremented regardless of whether we are using an existing available connection from the array or not. After you've made the max number of requests (initially 8) to the web server it stops responding. I added a new line (55) to decrement this counter when we are using an existing connection which seems to resolve the issue.

Code: QB64: [Select]

Option _Explicit
DefLng A-Z
 
Const PORT = 8080
Const MAX_CONNECTIONS = 8
 
Const FALSE = 0
Const TRUE = -1
Dim Shared CRLF As String
CRLF = Chr$(13) + Chr$(10)
Const HTTP_10 = 1
Const HTTP_11 = 11
Const HTTP_GET = 1
Const HTTP_HEAD = 2
Type connection_t
    handle As Long
    read_buf As String
    http_version As Integer
    method As Integer
    request_uri As String
End Type
 
Type http_error_t
    code As Integer
    message As String
    connection As Integer
End Type
 
Type file_error_t
    failed As Integer
    code As Integer
End Type
 
Dim i
Dim num_active_connections
Dim server_handle
Dim Shared Connections(1 To MAX_CONNECTIONS) As connection_t
Dim Shared Http_error_info As http_error_t
Dim Shared File_error_info As file_error_t
 
On Error GoTo error_handler
 
server_handle = _OpenHost("TCP/IP:" + LTrim$(Str$(PORT)))
Do
    If num_active_connections < MAX_CONNECTIONS Then
        Dim new_connection
        new_connection = _OpenConnection(server_handle)
        If new_connection Then
            num_active_connections = num_active_connections + 1
            For i = 1 To MAX_CONNECTIONS
                If Connections(i).handle = 0 Then
                    Dim empty_connection As connection_t
                    Connections(i) = empty_connection
                    Connections(i).handle = new_connection
                    num_active_connections = num_active_connections - 1
                    Exit For
                End If
            Next i
        End If
    End If
 
    For i = 1 To MAX_CONNECTIONS
        If Connections(i).handle Then
            Dim buf$
            Get #Connections(i).handle, , buf$
            If buf$ <> "" Then
                Connections(i).read_buf = Connections(i).read_buf + buf$
                process_request i
                http_error_complete:
            End If
        End If
    Next i
    _Limit 240
Loop
 
 
 
error_handler:
If Err = 100 Then 'HTTP error
    Print "HTTP error"; Http_error_info.code; Http_error_info.message; " for connection"; Http_error_info.connection
    Resume http_error_complete
End If
Print "error"; Err; "on line"; _ErrorLine
End
 
file_error_handler:
File_error_info.failed = TRUE
File_error_info.code = Err
Resume Next
 
Sub http_send_status (c, code, message As String)
    Dim s$
    s$ = "HTTP/1.1" + Str$(code) + " " + message + CRLF
    Put #Connections(c).handle, , s$
End Sub
 
Sub http_send_header (c, header As String, value As String)
    Dim s$
    s$ = header + ": " + value + CRLF
    Put #Connections(c).handle, , s$
End Sub
 
Sub http_end_headers (c)
    Put #Connections(c).handle, , CRLF
End Sub
 
Sub http_send_body (c, body As String)
    Put #Connections(c).handle, , body
End Sub
 
Sub http_do_get (c)
    Dim filepath As String, filedata As String
    Dim fh
    filepath = get_requested_filesystem_path(c)
    Print filepath
    If Not _FileExists(filepath) Then http_error 404, "Not Found", c
 
    On Error GoTo file_error_handler
    fh = FreeFile
    File_error_info.failed = FALSE
    Open filepath For Binary As #fh
    On Error GoTo error_handler
    If File_error_info.failed Then http_error 403, "Permission Denied", c
 
    'Doing this all in one go isn't healthy for a number of reasons (memory usage, starving other clients)
    'It should be done in chunks in the main loop
    filedata = Space$(LOF(fh))
    Get #fh, , filedata
    Close #fh
    http_send_status c, 200, "OK"
    http_send_header c, "Content-Length", LTrim$(Str$(Len(filedata)))
    http_send_header c, "Connection", "close"
    http_end_headers c
    http_send_body c, filedata
    close_connection c
End Sub
 
Sub http_do_head (c)
    Print "http_do_head"
    Dim s$
    s$ = "HTTP/1.1 200 OK" + CRLF + CRLF
    Put #Connections(c).handle, , s$
End Sub
 
Sub close_connection (c)
    Close #Connections(c).handle
    Connections(c).handle = 0
End Sub
 
Function get_requested_filesystem_path$ (c)
    '7230 5.3 also 3986 for URI
    'Origin form only for now
    Dim raw_path As String
    raw_path = Connections(c).request_uri
    If Left$(raw_path, 1) <> "/" Then http_error 400, "Malformed URI", c
 
    Dim hash, questionmark, path_len
    hash = InStr(raw_path, "#") 'Clients shouldn't be sending fragments, but we will gracefully ignore them
    questionmark = InStr(raw_path, "?")
    path_len = Len(raw_path)
    If hash > 0 Then path_len = hash - 1
    If questionmark > 0 And questionmark < hash Then path_len = questionmark - 1
    ' Query strings are ignored for now
 
    'Dim cwd As String
    'cwd = _CWD$
    '$If WIN Then
    '    'raw_path = GXSTR_Replace(raw_path, "/", "\")
    '    cwd = GXSTR_Replace(cwd, "\", "/")
    '$End If
 
    get_requested_filesystem_path = _CWD$ + cannonicalise_path(percent_decode(Left$(raw_path, path_len)))
End Function
 
Function percent_decode$ (raw_string As String)
    Dim final_string As String, hexchars As String
    Dim i, c
    For i = 1 To Len(raw_string)
        c = Asc(raw_string, i)
        If c = 37 Then '%
            hexchars = Mid$(raw_string, i + 1, 2)
            If Len(hexchars) = 2 And InStr("0123456789abcdefABCDEF", Left$(hexchars, 1)) > 0 And InStr("0123456789abcdefABCDEF", Right$(hexchars, 1)) > 0 Then
                final_string = final_string + Chr$(Val("&H" + hexchars))
            Else
                'String ends in something like "%1", or is invalid hex characters
                final_string = final_string + "%" + hexchars
            End If
            i = i + Len(hexchars)
        Else
            final_string = final_string + Chr$(c)
        End If
    Next i
    percent_decode = final_string
End Function
 
 
Function cannonicalise_path$ (raw_path As String)
    Dim path As String
    ReDim segments(1 To 1) As String
    Dim i, uplevels
    split raw_path, "/", segments()
    For i = UBound(segments) To 1 Step -1
        If segments(i) = "." Or segments(i) = "" Then
            _Continue
        ElseIf segments(i) = ".." Then
            uplevels = uplevels + 1
        Else
            If uplevels = 0 Then
                path = "/" + segments(i) + path
            Else
                uplevels = uplevels - 1
            End If
        End If
    Next i
    If path = "" Then path = "/"
    'Note: if uplevels > 0 at this point, the path attempted to go above the root
    'This is usually a client trying to be naughty
    cannonicalise_path = path
End Function
 
'https://www.qb64.org/forum/index.php?topic=1607.0
Sub split (SplitMeString As String, delim As String, loadMeArray() As String)
    Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
    dpos = InStr(curpos, SplitMeString, delim)
    Do Until dpos = 0
        loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
        curpos = dpos + LD
        dpos = InStr(curpos, SplitMeString, delim)
    Loop
    loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
    ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub
 
 
Sub process_request (c)
    Dim eol
    Dim l As String
    Do
        eol = InStr(Connections(c).read_buf, CRLF)
        If eol = 0 Then Exit Sub
        l = Left$(Connections(c).read_buf, eol - 1)
        Connections(c).read_buf = Mid$(Connections(c).read_buf, eol + 2)
        If Connections(c).http_version = 0 Then 'First line not yet read
            process_start_line c, l
        Else
            If l = "" Then
                'headers complete; act upon request now
                Select Case Connections(c).method
                    Case HTTP_GET
                        http_do_get c
                    Case HTTP_HEAD
                        http_do_head c
                End Select
                Exit Sub
            Else
                process_header c, l
            End If
        End If
    Loop
End Sub
 
Sub process_start_line (c, l As String)
    '7230 3.1.1
    'METHOD uri HTTP/x.y
    Dim sp1, sp2
    sp1 = InStr(l, " ")
    If sp1 = 0 Then http_error 400, "Bad Request", c
 
    '7231 4.3
    Select Case Left$(l, sp1 - 1)
        Case "GET"
            Connections(c).method = HTTP_GET
        Case "HEAD"
            Connections(c).method = HTTP_HEAD
        Case Else
            http_error 501, "Not Implemented", c
    End Select
 
    sp2 = InStr(sp1 + 1, l, " ")
    If sp2 = 0 Or sp2 - sp1 = 1 Then http_error 400, "Bad Request", c
    Connections(c).request_uri = Mid$(l, sp1 + 1, sp2 - sp1 - 1)
 
    '7230 2.6
    If Mid$(l, sp2 + 1, 5) <> "HTTP/" Then
        http_error 400, "Bad Request", c
    End If
    Select Case Mid$(l, sp2 + 6)
        Case "1.0"
            Connections(c).http_version = HTTP_10
        Case "1.1"
            Connections(c).http_version = HTTP_11
        Case Else
            http_error 505, "HTTP Version Not Supported", c
    End Select
End Sub
 
Sub process_header (c, l As String)
    'All headers ignored for now
End Sub
 
Sub http_error (code, message As String, connection)
    http_send_status connection, code, message
    http_send_header connection, "Content-Length", "0"
    http_send_header connection, "Connection", "close"
    http_end_headers connection
    close_connection connection
    Http_error_info.code = code
    Http_error_info.message = message
    Http_error_info.connection = connection
    Error 100
End Sub
 

Would it be alright if I included this in the GX game engine project (https://www.qb64.org/forum/index.php?topic=4481.0) as a tool that can be used to test out exported games? I will of course add an attribution in the source with a link to this post.

luke · « **Reply #5 on:** December 16, 2021, 09:56:29 pm »

Good catch on the missing counter decrement.

As mentioned in the top post this is fairly incomplete as a webserver, but if it's sufficient for your purposes then feel free to distribute and make use of it. I have added some flowery pseudo-legal language to that effect.

News:

Author Topic: HTTP 1.1 compliant web server (work in progress) (Read 4952 times)

luke

HTTP 1.1 compliant web server (work in progress)

SpriggsySpriggs

Re: HTTP 1.1 compliant web server (work in progress)

luke

Re: HTTP 1.1 compliant web server (work in progress)

SpriggsySpriggs

Re: HTTP 1.1 compliant web server (work in progress)

dbox

Re: HTTP 1.1 compliant web server (work in progress)

luke

Re: HTTP 1.1 compliant web server (work in progress)