Writing your own web server.
Results 1 to 4 of 4

Thread: Writing your own web server.

  1. #1
    Senior Member
    Join Date
    Apr 2002
    Posts
    324

    Writing your own web server.

    Overview.

    In this tutorial I am going to be describing how to build a basic web server application. To be more presise, an application that listens on a TCP/IP port, authenticates incoming connections and serves data to authenticated clients. The code examples given below were written in VB6. I have tried to pick a simple case study for this article, but with a little work you can add all sorts of whistles and bells once you have the basic theory.

    The 'Log Server' case study.

    I have a control called TRON. TRON sits beneath all the other controls in my toolkit with the sole purpose of accepting debugging data from controls above it and outputting that data in some way so I can view it. That might be direct to screen or console, or appended to a text file for later examination.

    I also wanted my TRON control to provide data to a basic web server. This basic web server would serve debugging information to developers working on any software that includes the TRON control. My web server app would then allow me (and other developers) to telnet into the box and see debug information in real time. I also wanted multiple clients to be able to connect similtainiously and for connecting clients to be authenticated prior to recieving any debug information.

    You can download the source files for this program at the end of the document (11k) - DON'T try to complie the code below as I've changed the line endings for pagination.

    How does it work.

    I used 2 MSWinsock controls, one called WSock to handle incoming requests on port 255 from clients wishing to view debug information and one called PLink for TRON to send debug informatin to on port 1. The PLink winsock control accepts data sent to it on port 1 from my TRON control and relays that information to each of the connected and authenticated clients. Of course your firewall should be set to disallow incoming connections on port 1, because the connections to PLINK are not authenticated. Data sent to a PLink socket simply adds itself to the buffer value in the Log Server, which is then relayed to authenticated clients.

    For the internal communications on the local machine between TRON controls and the Log Server I could have used DDE (I'm showing my age here) or Dynamic(?) Data Exchange that provides an async methodology for communication between running programs. However my TRON control is in fact an ActiveX component and DDE does not work from within ActiveX

    Creating the project

    In VB6 you will need:
    1 Form
    1 Module

    Under the components menu add a reference to MS Winsock. Place 2 Winsock controls on the form and call them WSock and PLink.
    Set the index of both the Winsock controls as 0 (so that they are instantiated as an array and we can load new instances of them at runtime).
    Now add a timer control called timer to the form and set the interval to 250 and enabled to false. When we receive incoming data from a PLink socket (ie from TRON) the timer is activated. The code for the timer event distributes the incoming data from the buffer to authenticated clients. A DoEvents command in the timer code allows new data to be added to the buffer as it arrives.

    In the module add the following code:

    Code:
     Option Explicit
    
    'Connection states
    Public Enum tState
      tUsername = 0
      'Waiting for username
      tPassword = 1
      'Waiting for passsword
      tAuthenticated = 3
      'Connection is authenticated
      tGone = 4
      'Connection is closed
    End Enum
    
    'Connection Type
    Public Type tConnection
      Index As Integer
      'Holds index of Socket
      State As tState
      'Holds connection state
      'SEE: Enum tState
      username As String
      'Holds connection username
      password As String
      'Holds connection password
      ReTries As Integer
      'Number login attempts
      'used to disconnect after
      '3 retries.
    End Type
    Our tState type allows us to set the mode for our connection and deal with incoming/outgoing data accordingly - we dont want to send log data to a client unless their connection state is authenticated. We also need to know what information we expect next from the client. We also want to have a command set for authenticated and unauthenticated connections. Because our connection has a state we would refer to this a 'Stated Service'. FTP,SMTP and POP3 all fall into the category of Stated services. HTTP on the other hand is a stateless service, in that it records no information about the user from connection to connection and closes the connection when it finishes sending the requested data. Therefore all client data has to be stored on the client, which is why we need to use cookies (or variant thereof) with HTTP.

    This Type Connection declares the properties of a connection, and includes a value for the connection state, as defined by the tState type. In our web server we are going to assign a connection to each client that logs into port 255. In our main code the CN array holds an array of connections that we can use to access the properties for each connection at runtime.

    The Log Server Code

    Add the following code to your form. The internal documentation is (for me) quite good so the code should be quite readable.
    Code:
    '***************
    'Log Server By NTSA
    'October 2002
    'www.ntsa.org.uk
    '***************
    
    'Array of connections
    Dim CN() As tConnection
    'Message buffer
    Dim buffer As String
    
    Option Explicit
    
    Private Sub Form_Load()
    
      'Accept incoming Clients on port 255
      'This allows external clients to view
      'log server Log Server data
      ReDim CN(0)
      Wsock(0).LocalPort = 255
      Wsock(0).Listen
      
      'Accept incoming notifications on Port 1
      'This allows other applications to send
      'data to be proxied to viewers.
      PLink(0).LocalPort = 1
      PLink(0).Listen
      
    End Sub
    
    Private Sub Timer_Timer()
      
      Dim n As Integer
      Dim flds
      
      'Loop while there is data in the buffer
      Do While Len(buffer) <> 0
        'The flds variant is used to hold the
        'array of messages in the buffer
        flds = Split(buffer, ":|:")
        'Iterate through the connections
        For n = 1 To UBound(CN)
          'If the connection has been autenticated
          'AND the socket is ok (7)
          If CN(n).State = tAuthenticated And Wsock(n).State = 7 Then
            'Send the left most item from the buffer
            'to connection n
            Wsock(n).SendData flds(0) & vbCrLf
            'Doesn't actually send data until
            'DoEvents called
            DoEvents
          End If
        Next n
        'This DoEvents allows the DataArrival event to
        'continue adding newly received information
        'to the buffer
        DoEvents
        'Remove the left most item from the buffer
        buffer = Right(buffer, Len(buffer) - (Len(flds(0)) + 3))
      Loop
      Timer.Enabled = False
      
    End Sub
    
    Private Sub Wsock_ConnectionRequest(Index As Integer,  _
    	ByVal requestID As Long)
      
      'New incoming external connection
      Dim n As Long
      'Get the index of the next
      'WSock object
      n = Wsock.UBound + 1
      'Load the WSock Object
      Load Wsock(n)
      
      'Create value of type tConnection
      'for this WSock object
      ReDim Preserve CN(n)
      'Set the Connection index to that of the
      'WSock control.
      CN(n).Index = Index
      'Set the state of the connection
      CN(n).State = tUsername
      
      'Accept the connection
      Wsock(n).Accept (requestID)
      
      'Display the connection message
      Wsock(n).SendData ConnectionMessage(n)
      
    End Sub
    
    Private Sub Wsock_DataArrival(Index As Integer,  _
    	ByVal bytesTotal As Long)
      
      'String Value to hold incoming data
      Dim StrVal As String
     
      'Get the incoming data
      Wsock(Index).GetData StrVal, vbString
      
      'Remove crlf characters
      StrVal = Replace(StrVal, Chr(10), "")
      StrVal = Replace(StrVal, Chr(13), "")
      
      'Commands to be run regardless of
      'connection state.
      Select Case LCase(StrVal)
        Case "quit"
          'Send a disconnection Message
          Wsock(Index).SendData DisConnectionMessage
          DoEvents
          'Set connection state as tGone
          CN(Index).State = tGone
          'Close the WSock object
          Wsock(Index).Close
      End Select
          
      'Process the incoming data dependant
      'upon the connection state
      Select Case CN(Index).State
        'Getting username
        Case tUsername
          'If the left hand side of the command is "user "
          If LCase(Left(StrVal, Len("user "))) = "user " Then
            'If the bit after user is not blank
            If Len(Right(StrVal, Len(StrVal) - Len("user "))) > 0 Then
              'Set the username for this connection
              CN(Index).username = Right(StrVal, Len(StrVal) - Len("user "))
              'Change connection state to accept password
              CN(Index).State = tPassword
            Else
              'No user name
              Wsock(Index).SendData "No Username supplied." & vbCrLf
              DoEvents
              CN(Index).State = tUsername
            End If
          Else
            'Any other input while connection
            'is in the tUsername state
            Wsock(Index).SendData "Not logged in." & vbCrLf
            DoEvents
            CN(Index).State = tUsername
          End If
        
        'Getting password
        Case tPassword
            'If left hand side of command is "pass "
            If LCase(Left(StrVal, Len("pass "))) = "pass " Then
              'If value is not blank
              If Len(Right(StrVal, Len(StrVal) - Len("pass "))) > 0 Then
                'set the connection password
                CN(Index).password = Right(StrVal, Len(StrVal) - Len("pass "))
                'Is the username/password valid?
                If ValidPassword(CN(Index).username, CN(Index).password) Then
                  'Set the connection stsate to authenticated
                  CN(Index).State = tAuthenticated
                  'Send a message to the client to tell them
                  'that they authenticated ok
                  Wsock(Index).SendData "Authenticated." & vbCrLf
                  DoEvents
                Else
                  'Invalid user/pass
                  Wsock(Index).SendData "Invalid username/password. Login fails." & vbCrLf
                  DoEvents
                  'Increment the connection retry value
                  CN(Index).ReTries = CN(Index).ReTries + 1
                  'On 3 retries
                  If CN(Index).ReTries = 3 Then
                    'Send quitting message
                    Wsock(Index).SendData "3 failed logins. Disconnecting." & vbCrLf
                    DoEvents
                    'Set the connection state as gone
                    CN(Index).State = tGone
                    'Close the socket
                    Wsock(Index).Close
                  Else
                    'If connection not @ max retries
                    'set the connection state back to tUsername
                    CN(Index).State = tUsername
                  End If
                End If
              Else
                'Password is blank
                Wsock(Index).SendData "No Password Supplied. Login fails." & vbCrLf
                DoEvents
                CN(Index).State = tUsername
              End If
            Else
              'Command is not pass ***
              Wsock(Index).SendData "Expecting password. Login fails." & vbCrLf
              DoEvents
              'Set the connection stats back to tUsername
              CN(Index).State = tUsername
            End If
            
        'Commands to accept if the connection
        'has been authenticated
        Case tAuthenticated
          Select Case LCase(StrVal)
            Case "quit"
              Wsock(Index).SendData DisConnectionMessage
              DoEvents
              CN(Index).State = tGone
              Wsock(Index).Close
            Case Else
              'Unrecognised command
              Wsock(Index).SendData "Command not recognised." & vbCrLf
              DoEvents
          End Select
          
      End Select
      
    End Sub
    
    Private Sub PLink_ConnectionRequest(Index As Integer,  _
    	ByVal requestID As Long)
      
      Dim n As Long
        
        'Incoming connection from
        'an application
        n = PLink.UBound + 1
        'load the next PLink socket
        Load PLink(n)
        'Accept the connection
        PLink(n).Accept (requestID)
        
    End Sub
    
    
    Private Sub PLink_DataArrival(Index As Integer, _
    	 ByVal bytesTotal As Long)
      
      'When data arrives from application
      
      Dim StrVal, sp, s As String
      Dim n, x As Integer
      Dim strvals()
      
      'Get the incoming data
      PLink(Index).GetData StrVal, vbString
      
      'Remove crlf characters
      StrVal = Replace(StrVal, Chr(10), "")
      StrVal = Replace(StrVal, Chr(13), "")
      
      'Add the incoming message to the
      'message buffer
      buffer = buffer & StrVal & ":|:"
      
      'Enable the timer to read data from
      'the buffer and send it to connected,
      'authenticated clients
      Timer.Enabled = True
    
    End Sub
    
    Private Function ConnectionMessage(cid As Long) As String
    
      'A connection message
      'This could be loaded from a file,
      'the registry, or a database
      
      Dim cm As String
      
      cm = "" & vbCrLf
      cm = cm & "===================================================" & vbCrLf
      cm = cm & " Log Server v1.0 by Simon Barnett." & vbCrLf
      cm = cm & " Connected to Log Server at " & Now() & vbCrLf
      cm = cm & " Your Connection ID is: " & CStr(cid) & vbCrLf
      cm = cm & " There are currently : " & CStr(UserCount) & " sessions open." & vbCrLf
      cm = cm & "===================================================" & vbCrLf
      cm = cm & vbCrLf
      
      ConnectionMessage = cm
      
    End Function
    
    Private Function DisConnectionMessage() As String
    
      'A DISconnection message
      'This could be loaded from a file,
      'the registry, or a database
      
      Dim dm As String
      dm = vbCrLf & "Bye then!" & vbCrLf
      DisConnectionMessage = dm
    
    End Function
    
    Private Function UserCount() As Integer
      
      'Get a count of active
      'external sockets
      Dim n As Integer
      UserCount = 0
      'Iterate through sockets
      For n = 1 To Wsock.UBound
        'If the socted is ok (7)
        If Wsock(n).State = 7 Then
          'Increment UserCount value
          UserCount = UserCount + 1
          DoEvents
        End If
      Next
    
    End Function
    
    Private Sub Wsock_Error(Index As Integer, _
    	ByVal Number As Integer,  _
    	Description As String,  _
    	ByVal Scode As Long,  _
    	ByVal Source As String,  _
    	ByVal HelpFile As String,  _
    	ByVal HelpContext As Long,  _
    	CancelDisplay As Boolean)
      
      'If the client disconnent is not clean then this event
      'will fire to handle socket/connection cleanup
      
      If Number = 10053 Then
        'Set the connection stat as tGone
        CN(Index).State = tGone
        'Close the socket
        Wsock(Index).Close
      End If
    End Sub
    
    Private Function ValidPassword(username As String,  _
    	password As String)
    
      'Validation for passed username and
      'password combination.
      'Usernames/Password should NOT be hard coded
      
      If username = "username And password = "password" Then
        ValidPassword = True
      Else
        ValidPassword = False
      End If
      
    End Function
    Running the code.

    Once you have a complied version of the above up and running you will want to log into your new web server. to do that we telnet to the IP of the machine the log server is running on (eg 127.0.0.1) with netcat or similar telnet app. We get a log in screen that should look something like this:
    ===================================================
    Log Server v1.0 by Simon Barnett.
    Connected to Log Server at 03/10/2002 10:14:34 AM
    Your Connection ID is: 4
    There are currently : 3 sessions open.
    ===================================================
    Now we log in (in the same format as a pop3 login) using the format:
    user username
    pass password
    If our login validates (in the code above the ValidPassword function should be linked to a password list) then the client sees:
    Authenticated.
    Now that the connection has been authenticated any information sent to the log server by a TRON control will be relayed to the client. For example when a program references an c:\test.ini file to find the value of colour for the fruit.apple key the following debugging messages are relayed to TRON. TRON send the messages on port 1 to the Log Server and the Log Server distributes the following data to the clients on port 255:
    03/10/2002 10:19:57 AM|INIFile|Loading INI File: c:\test.ini
    03/10/2002 10:19:57 AM|Filesys|The file c:\test.ini already exists.
    03/10/2002 10:19:57 AM|Filesys|Opening file c:\test.ini with fHandle 0
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'apple=green'
    03/10/2002 10:19:57 AM|Strings|Found 1 occurence(s).
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'orange=orange'
    03/10/2002 10:19:57 AM|Strings|Found 1 occurence(s).
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'banana=yellow'
    03/10/2002 10:19:57 AM|Strings|Found 1 occurence(s).
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'carrot=orange'
    03/10/2002 10:19:57 AM|Strings|Found 1 occurence(s).
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'potato=brown'
    03/10/2002 10:19:57 AM|Strings|Found 1 occurence(s).
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'peas=green'
    03/10/2002 10:19:57 AM|Strings|Found 1 occurence(s).
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'listitem1'
    03/10/2002 10:19:57 AM|Strings|Found 0 occurence(s).
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'listitem2'
    03/10/2002 10:19:57 AM|Strings|Found 0 occurence(s).
    03/10/2002 10:19:57 AM|Strings|Looking for '=' in 'listitem3'
    03/10/2002 10:19:57 AM|Strings|Found 0 occurence(s).
    03/10/2002 10:19:57 AM|INIFile|Getting KeyData: fruit.apple.
    03/10/2002 10:19:57 AM|INIFile|Found key matching 'fruit.apple.': Fruit.apple.green
    03/10/2002 10:19:58 AM|INIFile|Right hand side of key is: green
    03/10/2002 10:19:58 AM|Strings|Looking for '.' in 'green'
    03/10/2002 10:19:58 AM|Strings|Found 0 occurence(s).
    03/10/2002 10:19:58 AM|INIFile|GetKey(0) Returns green
    To test the Log Server you can telnet into port 1 and poke data into the log buffer. It will be relayed to authenticated clients connected on port 255.

    Maybe it's just me - but I thought that was kinda neat Till next time - look both ways and don't talk to strangers.
    \"I may not agree with what you say, but I will defend to the death your right to say it.\"
    Sir Winston Churchill.

  2. #2
    It's a gas!
    Join Date
    Jul 2002
    Posts
    699
    Well i agree, this is a pretty good tut!

    You obviously put alot of work into this, so have a greenie or two!

    r3b00+

  3. #3
    Banned
    Join Date
    Sep 2002
    Posts
    108
    Great job! I have never learned how to code a webserver or anything like that, and I'm happy I can finally read a tutorial explaining how. Another great tutorial from you, kudo's.

  4. #4
    Senior Member
    Join Date
    Apr 2002
    Posts
    324
    Thanks!
    \"I may not agree with what you say, but I will defend to the death your right to say it.\"
    Sir Winston Churchill.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •