30k simple web server

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
zoomkat
Posts: 15
Joined: Apr 08, 2007 22:31

Post by zoomkat »

Does this web server support a cgi function for running programs and sending the result back to the client brouser?
axipher
Posts: 891
Joined: Dec 27, 2005 16:37
Location: Sudbury,Ontario

Post by axipher »

Hey, this sounds awesome, I get it to compile and run fine, but after typing "localhost" in the browser, just a blank page comes up, I have "sws.exe" in "c:\web" and "index.html" in "c:\web\wwwroot\". What am I doing wrong? I tried it in both Firefox2 and IE7
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

Post by parakeet »

axipher wrote:Hey, this sounds awesome, I get it to compile and run fine, but after typing "localhost" in the browser, just a blank page comes up, I have "sws.exe" in "c:\web" and "index.html" in "c:\web\wwwroot". What am I doing wrong? I tried it in both Firefox2 and IE7
Hi,
Maybe your page index.html displays blank ? Just kidding.
To fix it out, please open your file directly, not by http, by either
-double-clicking the filename in your file explorer, or by
-opening the web browser and browsing to file://c:/web/wwwroot/index.html

Yours,
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

Post by parakeet »

zoomkat wrote:Does this web server support a cgi function for running programs and sending the result back to the client brouser?
Not yet, but this is not hard to implement. On reception of a http request, a function reads a file on the disk and sends back the file content as a http response to the client browser.

Instead of reading from a file, it should call a cgi or whatever other program and send its output as a http response
Alboz
Posts: 1
Joined: Oct 14, 2008 20:12
Location: Mogi Mirim - Brazil

upload a file

Post by Alboz »

Hi everyone.

In my HTML code there is a botton that select a file and other botton that send the post command to a free basic server (simple 30K). But it does not work! Only the path and name of file are recived on server. How can the server get the file and sabe it on its own folder?

Thanks.
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

Re: upload a file

Post by parakeet »

Alboz wrote:Hi everyone.

In my HTML code there is a botton that select a file and other botton that send the post command to a free basic server (simple 30K). But it does not work! Only the path and name of file are recived on server. How can the server get the file and sabe it on its own folder?

Thanks.
This is because a file upload is in fact an http post request. The file contents is sent in the same way as any other form field (except that it is encoded, since a file may contain binary data).

The code of the 30k web server only copes with http get requests, because it does not analyse what is after the first line of the http request it receives (it searches for the first "CRLF found twice").

If you want to upload files, you must also parse what follows the first line. Read on the web about http post requests structures. Alternatively you can use fiddler to see in real time the http requests and responses.

Anselme
Curtis
Posts: 1
Joined: Apr 20, 2011 5:02
Location: los angeles

Post by Curtis »

Yeah it is simple to do a web server in expert. But in some people that are beginner in doing a web server it is so difficult. Like me I am beginner in doing a web server. However, thanks a lot for sharing this info to us.

[spam deleted by Moderator]
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

Not yet, but this is not hard to implement. On reception of a http request, a function reads a file on the disk and sends back the file content as a http response to the client browser.

Instead of reading from a file, it should call a cgi or whatever other program and send its output as a http response
How do you know which port to use on the return of the CGI server response?



:M
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

Post by parakeet »

kiyotewolf wrote: How do you know which port to use on the return of the CGI server response?
:M
A browser sends a request to the port 80 of the webserver. The server accepts the connection and leaves it open. Then the server reads the received request, calls any program (can be freebasic) by any means (can be a dll, a shell, an exe, another webserver...) but pays attention on catching the text output of the called program (the cgi). Then the server replies to the browser by copying the caught output inside the response which is then sent to the browser, using the connection that is still open.

The connection is always initiated by the browser, and remains open during the whole execution on the server and cgi side, this is why no port has to be configured at the CGI program.

Anselme
Last edited by parakeet on May 30, 2011 7:32, edited 1 time in total.
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

I got a REALLY OLD book on the internet, I'm finally learning how half this stuff works.



:M
geminis4941
Posts: 64
Joined: Jul 15, 2009 12:41

Re: 30k simple web server

Post by geminis4941 »

This is a impressive sample I'have been playing with. I'have pending tranfering files to the server (upload documents and images) , and tranfer data records eficiently to the server ( not by parameters in a POST query). If any has some idea of how do this....
It could be considered a hybrid server. Good Job
parakeet
thrive4
Posts: 70
Joined: Jun 25, 2021 15:32

Re: 30k simple web server

Post by thrive4 »

Great little webserver mucho kudos to 'parkeet' and
other contributions made!

Here are some workarounds for some issues I came
across while using the code.

a) handles are not released on win 7 and win 10

Code: Select all

            ' possible fix for issue with increasing handles 
            ThreadDetach( client->recvthread )        
@line 230 and 238

b) urls can not contain http://site.doman?parameter=something

Code: Select all

            ' tricky hack to accept parameters append to url aka page.html?title=etc
            stPath = mid(stPath, 1, instrrev(stPath, "?") - 1)
@line 158

c) added custom 404 and 403 see full code
403

Code: Select all

<!DOCTYPE html>
<html lang="en">
<head>
    <meta name="viewport" content="width=device-width, initial-scale=1" charset="utf-8" />
    <meta name="keywords" content="403 server error">
    <title>index</title>
    <link rel="icon" type="image/x-icon" href="../images/favicon.jpg">
    <link rel="stylesheet" href="../font.css" />
    <link rel="stylesheet" href="../main.css" />
</head>
<body>
403 - You are not authorised to access this resource.
</body>
</html>
404

Code: Select all

<!DOCTYPE html>
<html lang="en">
<head>
    <meta name="viewport" content="width=device-width, initial-scale=1" charset="utf-8" />
    <meta name="keywords" content="404 server error">
    <title>index</title>
    <link rel="icon" type="image/x-icon" href="../images/favicon.jpg">
    <link rel="stylesheet" href="../font.css" />
    <link rel="stylesheet" href="../main.css" />
</head>
<body>
404 - The URL you asked for does not exist on this website.
</body>
</html>
Complete code (based on suggestions made by 'cha0s)
viewtopic.php?p=104766#p104766
Create folders wwwroot (content website) and errors (403 and 404)

Const HOMEDIR = "wwwroot"
Const SERVERERROR = "errors"

Code: Select all

' courtesy https://www.freebasic.net/forum/viewtopic.php?t=4199&hilit=Simple+Web+Server
' Simple Web Server, (c) Anselme Dewavrin 2006 - dewavrin@yahoo.com
' Feel free to use it, provided you mention my name.
' based on the example provided with freebasic tweaked by thrive4 march 2024.

#include once "win/winsock2.bi"
#include once "windows.bi"
#include once "win/shellapi.bi"
#include once "fbthread.bi"

Const WM_SHELLNOTIFY  = WM_USER + 5
Const ID_RUN          = 1001
Const ID_PAUSE        = 1002
Const ID_EXIT         = 1003
Const SERVER_ADDR     = "127.0.0.1"
Const HOMEDIR         = "wwwroot"
Const SERVERERROR     = "errors"
Const DEFAULT_PORT    = 80
Const SERVER_BUFFSIZE = 16

Dim Shared note       As NOTIFYICONDATA
Dim Shared TB_CREATED As Integer
Dim Shared szAppName  As String
Dim Shared As Integer ServerPort = DEFAULT_PORT

Type CLIENT
        socket      As SOCKET
        ip          As Integer
        port        As Integer
        recvthread  As any ptr
        prev        As CLIENT Ptr
        Next        As CLIENT Ptr
End Type

Type SERVERCTX
        socket          As SOCKET
        acceptthread    As any ptr
        isrunning       As Integer
        globmutex       As any ptr
        filemutex       As any ptr
        clientlisthead  As CLIENT Ptr
End Type
Dim Shared ctx As SERVERCTX


' multithreaded socket handling
Sub serverDel( Byval client As CLIENT Ptr )
    Dim s As SOCKET
    ' not already removed?
    If( client->socket <> NULL ) Then
        's = NULL
        Swap s, client->socket        ' this should be atomic..
        ' close connection
        shutdown(s, 2)
        closesocket(s)
        ' recv thread stills running?
        If( client->recvthread <> NULL ) Then
                threadwait( client->recvthread )
        End If
        ' remove from list
        If( client->next ) Then
                client->next->prev = client->prev
        End If
        If( client->prev ) Then
                client->prev->next = client->next
        Else
                ctx.clientlisthead = client->next
        End If
    End If
End Sub

Function serverEnd( ) As Integer
        Dim client As CLIENT Ptr
        ctx.isrunning = FALSE

        ' close the listening socket
        If( ctx.socket <> 0 ) Then
            shutdown(ctx.socket, 2 )
            closesocket( ctx.socket )
            ctx.socket = 0
        End If

        ' remove all clients yet running
        Dim i As Integer
        Do
            client = ctx.clientlisthead
            If( client = NULL ) Then
                Exit Do
            End If
            serverDel( client )
        Loop
        ' shutdown winsock
        Function = WSACleanup( )
End Function

' thread waiting for data to arrive, parsing HTTP GET requests and sending responses
Sub serverReceive( Byval client As CLIENT Ptr )

    Dim PacketBuffer(SERVER_BUFFSIZE) As Byte
    Dim As Integer  ReceivedLen = 0
    Dim As Byte Ptr ReceivedBuffer = 0
    Dim As String   stNL   = Chr(13) & Chr(10)
    Dim As String   stNLNL = stNL & stNL

    Dim FileBuffer() As Byte 'fix for fb0.16beta, thx v1ctor
    Dim SendBuffer() As Byte 'fix for fb0.16beta, thx v1ctor
    Dim FileHandle As Ubyte

    'receive loop
    Do While( ctx.isrunning And (client->socket <> NULL) )
        ' block until some data
        Dim bytes As Integer
        bytes = recv( client->socket, @PacketBuffer(0), SERVER_BUFFSIZE, 0 )
        ' connection closed?
        If( bytes <= 0 ) Then
            Exit Do
        End If

        ' accumulate received data
        ReceivedBuffer = reallocate(ReceivedBuffer, bytes + ReceivedLen)
        Dim i As Integer
        For i=0 To bytes-1
            ReceivedBuffer[ReceivedLen+i] = PacketBuffer(i)
        Next i
        ReceivedLen += bytes

        'CRLF found twice ?
        If (ReceivedLen >= 4)                   And _
           (ReceivedBuffer[ReceivedLen-4] = 13) And _
           (ReceivedBuffer[ReceivedLen-3] = 10) And _
           (ReceivedBuffer[ReceivedLen-2] = 13) And _
           (ReceivedBuffer[ReceivedLen-1] = 10) Then
            'extract get path + url decoding (special chars are coded %XY)
            Dim As String stPath = HOMEDIR
            Dim As Integer iAcc = 0, iHex = 0
            For i = 4 To ReceivedLen-1
                Dim c As Byte
                c = ReceivedBuffer[i]
                If c = Asc(" ") Then Exit For
                If iHex <> 0 Then
                    iHex += 1   'decode hex code
                    iAcc *= 16
                    iAcc += (c-48)
                    If iHex = 3 Then
                        c = iAcc
                        iAcc = 0
                        iHex = 0
                    Endif
                Endif
                If c=Asc("%") Then 'hex code coming ?
                    iHex = 1
                    iAcc = 0
                Endif
                If iHex = 0 Then stPath += Chr(c)
            Next i

            ' tricky hack to accept parameters append to url aka page.html?title=etc
            stPath = mid(stPath, 1, instrrev(stPath, "?") - 1)

            If (stPath = HOMEDIR + "/") Or _  'default page and
               (Instr(stPath,"..") <> 0) Then 'restrict to wwwroot
                stPath = HOMEDIR + "/index.html"
            End If

            ' get rid of received data
            ReceivedLen = 0
            Deallocate(ReceivedBuffer)

            ' prepare response
            Dim As String  stReponseHeader
            Dim As Integer FileLength = 0

            ' read requested file from disk (no mutex, thanx to Zerospeed)
            If dir(stPath) = "" Then
                stReponseHeader = "HTTP/1.1 404 Not Found" & stNL & stNL
                stPath = exepath + "/" + SERVERERROR + "/" + "404.html"
            end if
            FileHandle = Freefile
            If Open( stPath For Binary Access Read Shared As #FileHandle ) <> 0 Then
                stReponseHeader = "HTTP/1.1 403 Forbbiden" & stNL & stNL
                stPath = exepath + "/" + SERVERERROR + "/" + "403.html"
            Else
                FileLength = Lof(FileHandle)    'file len
                If FileLength <> 0 Then
                    reDim FileBuffer(FileLength) As Byte
                    Get #FileHandle, , FileBuffer()
                End If
                Close #FileHandle

                stReponseHeader = "HTTP/1.1 200 OK" & stNL
                stReponseHeader += "Cache-Control: private" & stNL
                stReponseHeader += "content-length : " & Str(FileLength) & stNL & stNL
            End If

            'copy response header to sendbuffer
            Dim HeaderLength As Integer
            HeaderLength = Len(stReponseHeader)

            Dim As Integer SendBufferLen = HeaderLength + FileLength
            reDim SendBuffer(SendBufferLen) As Byte

            'copy loop (thx v1ctor for this simplified version)
            For i = 0 To HeaderLength-1
                SendBuffer(i) = stReponseHeader[i]
            Next i

            'copy response data to sendbuffer
            If FileLength <> 0 Then
                For i = 0 To FileLength-1
                    SendBuffer(i+HeaderLength) = FileBuffer(i)
                Next i
            End If

            'send response
            Dim As Byte Ptr sendptr
            sendptr = @sendBuffer(0)
            Do While (ctx.isrunning And (client->socket <> NULL) And (SendBufferLen > 0))
                ' loop until the whole buffer is sent
                bytes = send( client->socket, sendptr, SendBufferLen, 0 )
                ' connection closed?
                If( bytes <= 0 ) Then
                    Exit Do
                End If
                sendptr       += bytes
                SendBufferLen -= bytes
            Loop 'send loop

            ' remove client
            ' possible fix for issue with increasing handles 
            ThreadDetach( client->recvthread )        
            client->recvthread = NULL
            serverDel( client )

        End If 'bFound
    Loop 'receive loop

    ' remove client
    ThreadDetach( client->recvthread )
    client->recvthread = NULL

    serverDel( client )
End Sub


Sub serverAccept( Byval unused As any ptr )
    Dim sa As sockaddr_in
    Dim s  As SOCKET

    Do While( ctx.isrunning )

        Dim salen As Integer
        salen = Len( sockaddr_in )
        s = accept( ctx.socket, cptr( PSOCKADDR, @sa ), @salen )
        If( s = INVALID_SOCKET ) Then
                Exit Do
        End If
        Dim client As CLIENT Ptr
       
        ' access global data, lock it
        mutexlock( ctx.globmutex )
       
        ' allocate node
        client = allocate( Len( CLIENT ) )
       
        ' add to head of list
        client->next = ctx.clientlisthead
        ctx.clientlisthead = client
        If client->next Then client->next->prev = client
        client->prev = NULL
        mutexunlock( ctx.globmutex )       
        ' setup the client
        client->socket      = s
        client->ip          = (@sa)->sin_addr.S_addr
        client->port        = (@sa)->sin_port
        ' start new recv and send threads
        client->recvthread  = threadcreate( cast( sub( byval as any ptr ), @serverReceive ), client )
    Loop

    ctx.isrunning = FALSE
End Sub


Function serverRun( ) As Integer
    ' start winsock
    Dim wsaData As WSAData
    If( WSAStartup( MAKEWORD( 2, 0 ), @wsaData ) <> 0 ) Then
            'print "error calling WSAStartup: "; WSAGetLastError( )
            Return FALSE
    End If

    If( wsaData.wVersion <> MAKEWORD( 2, 0 ) ) Then
            WSACleanup( )       
            Return FALSE
    End If

    ' create a socket for listening
    ctx.socket = opensocket( AF_INET, SOCK_STREAM, IPPROTO_TCP )
    If( ctx.socket = NULL ) Then
            'print "error calling opensocket: "; WSAGetLastError( )
            Return FALSE
    End If

    ' bind it to the server port
    Dim sa As sockaddr_in
    sa.sin_port         = htons( ServerPort )
    sa.sin_family       = AF_INET
    sa.sin_addr.S_addr  = INADDR_ANY
    If(bind( ctx.socket, cptr( PSOCKADDR, @sa ), Len( sa ) ) = SOCKET_ERROR ) Then
        'print "error calling bind: "; WSAGetLastError( )
        Return FALSE
    End If       

    If( listen( ctx.socket, SOMAXCONN ) = SOCKET_ERROR ) Then
        Return FALSE
    End If

    ctx.clientlisthead = NULL
    ctx.isrunning = TRUE
    ctx.globmutex = mutexcreate( )
    ctx.filemutex = mutexcreate( )
    ctx.acceptthread = threadcreate( @serverAccept ) 'launch accept thread
   
    Function = TRUE
End Function

' tray icon
Function WndProc ( Byval hWnd As HWND, Byval message As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM ) As LRESULT

   Static pt As Point
   Function = 0

   Select Case (message)
        Case WM_CREATE
            TB_CREATED = RegisterWindowMessage ("TaskbarCreated")
            Exit Function
        Case WM_DESTROY
            UnregisterClass (szAppName, GetModuleHandle( null ))
            Shell_NotifyIcon (NIM_DELETE, @note)
            PostQuitMessage( 0 )
            Exit Function
        case WM_COMMAND
            If LOWORD (wParam)= ID_RUN Then
                If ctx.isrunning = FALSE Then serverRun( ) end if'Listenning on 80
            End If
            If LOWORD (wParam)= ID_PAUSE Then
                If ctx.isrunning = TRUE Then serverEnd( ) end if'pause
            End If
            If LOWORD (wParam) = ID_EXIT Then
                DestroyWindow (hWnd)
            End If
       Case WM_SHELLNOTIFY
            If (lParam = WM_RBUTTONDOWN) Or (lParam = WM_LBUTTONDOWN) Then
                GetCursorPos (@pt)
                SetForegroundWindow (hWnd)
                Dim MainMenu As HANDLE
                Dim FileMenu As HANDLE
                MainMenu = CreateMenu ()
                FileMenu = CreateMenu ()
                If ctx.isrunning = TRUE Then
                    AppendMenu (FileMenu, MF_STRING Or MF_CHECKED Or MF_GRAYED, ID_RUN, "&Run")
                    AppendMenu (FileMenu, MF_STRING, ID_PAUSE, "&Pause")
                Else
                    AppendMenu (FileMenu, MF_STRING, ID_RUN, "&Run")
                    AppendMenu (FileMenu, MF_STRING Or MF_CHECKED Or MF_GRAYED, ID_PAUSE, "&Pause")
                End If
                AppendMenu (FileMenu, MF_STRING, ID_EXIT, "E&xit")
                InsertMenu (MainMenu, 0, MF_POPUP, cuint(FileMenu), "invisible menu")
                TrackPopupMenuEx (FileMenu, TPM_LEFTALIGN Or TPM_RIGHTBUTTON, pt.x, pt.y, hWnd, NULL)
                PostMessage (hWnd, WM_NULL, 0, 0)
            End If
       Case TB_CREATED
            Shell_NotifyIcon (NIM_ADD, @note)
   End Select

   Function = DefWindowProc( hWnd, message, wParam, lParam )

End Function

'---------------- SIMILI-WINMAIN ----------------
Dim hInstance As HINSTANCE
hInstance = GetModuleHandle( null )

If Command$ <> "" Then
    ServerPort = Val(Command$)
Endif

If( FALSE = serverRun( ) ) Then End

Dim wMsg As MSG
Dim wcls As WNDCLASS
Dim hWnd As HWND

szAppName = "app"

' already running ?
hWnd=FindWindow(szAppName,NULL)
If hWnd <> 0 Then
    End
end If

With wcls
  .style = CS_HREDRAW Or CS_VREDRAW
  .lpfnWndProc   = @WndProc
  .cbClsExtra    = 0
  .cbWndExtra    = 0
  .hInstance     = hInstance
  .hIcon         = LoadIcon (hInstance, MAKEINTRESOURCE (1))
  .hCursor       = LoadCursor( NULL, IDC_ARROW )
  .hbrBackground = GetStockObject( WHITE_BRUSH )
  .lpszMenuName  = NULL
  .lpszClassName = Strptr( szAppName )
End With

If( RegisterClass( @wcls ) = FALSE ) Then
    End
end If

' Create the window and _BUT DONT_ show it
hWnd = CreateWindowEx( 0, szAppName, "", 0, 0, 0, 0, 0, NULL, NULL, hInstance, NULL )

note.cbSize = sizeof (NOTIFYICONDATA)
note.hWnd             = hWnd
note.hIcon            = LoadIcon (hInstance, MAKEINTRESOURCE (1))
note.uFlags           = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
note.uCallbackMessage = WM_SHELLNOTIFY
note.szTip            = szAppName
Shell_NotifyIcon (NIM_ADD, @note)

'wait for quit message
While GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE
    TranslateMessage( @wMsg )
    DispatchMessage( @wMsg )
Wend

'eventually stop server
If ctx.isrunning = TRUE Then
    serverEnd( )
End If 
demo app.rc

Code: Select all

//=============================================================================
// Generic project resource file
//=============================================================================

// add helpfile in exe windows only
//helpfile rcdata "help.txt"

// add an icon windows only?
FB_PROGRAM_ICON ICON "app.ico"
1 ICON "app.ico"

// add version and file info in exe windows only
VS_VERSION_INFO VERSIONINFO
FILEVERSION 1, 0, 0, 000
PRODUCTVERSION 1, 0, 0, 0
 FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
 FILEFLAGS 0x9L
#else
 FILEFLAGS 0x8L
#endif
 FILEOS 0x4L
 FILETYPE 0x1L
 FILESUBTYPE 0x0L
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040904b0"
        BEGIN
            VALUE "Comments", "via "
            VALUE "CompanyName", "parakeet"
            VALUE "FileDescription", "simple windows webserver"
            VALUE "FileVersion", "1, 0, 0, 000"
            VALUE "InternalName", ""
            VALUE "LegalCopyright", "parakeet"
            VALUE "OriginalFilename", "webserver"
            VALUE "PrivateBuild", ""
            VALUE "ProductName", "webserver"
            VALUE "ProductVersion", "1, 0, 0, 0"
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200
    END
END
Some final notes...
Tried adding logging regrettably couldn't figure out how
to get the useragent and ip from the browser.

Anno 2024 compiled with fb FreeBASIC-1.10.1-gcc-9.3 (32 bit)
the compiled .exe clocks in at around 98kb ehhhr a bit more
then the initial 30kb in 2006 ....
Post Reply