VB.NET, 7203

You can define any port and any base directory using --port and --base, respectively.
No, this isn't really a golfing solution. But being VB.NET, there's really no point anyway. On the plus side, this one has lots more features.
Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.Text.RegularExpressions
Public Module Server
Private Const READ_BUFFER_SIZE As Integer = 1024
#Region "Content-Type Identification"
Private ReadOnly ContentTypes As New Dictionary(Of String, String) From {
{".htm", "text/html"},
{".html", "text/html"},
{".js", "text/javascript"},
{".css", "text/css"},
{".png", "image/png"},
{".jpg", "image/jpeg"},
{".jpeg", "image/jpeg"},
{".gif", "image/gif"}
} 'Feel free to add more.
''' <summary>
''' Retrieves the Content-Type of the specified file.
''' </summary>
''' <param name="filepath">The file for which to retrieve the Content-Type.</param>
Private Function GetContentType(ByVal filepath As String) As String
Dim ext As String = IO.Path.GetExtension(filepath)
If ContentTypes.ContainsKey(ext) Then _
Return ContentTypes(ext)
Return "text/plain"
End Function
#End Region
#Region "Server Main()"
Public Sub Main(ByVal args() As String)
Try
'Get a dictionary of options passed:
Dim options As New Dictionary(Of String, String) From {
{"--port", "8080"},
{"--address", "127.0.0.1"},
{"--base", String.Empty}
}
For i As Integer = 0 To args.Length - 2
If args(i).StartsWith("-") AndAlso options.ContainsKey(args(i)) Then _
options(args(i)) = args(i + 1)
Next
'Get the base directory:
Dim basedir As String = Path.Combine(My.Computer.FileSystem.CurrentDirectory, options("--base"))
'Start listening:
Dim s As New TcpListener(IPAddress.Parse(options("--address")), Integer.Parse(options("--port"))) 'Can be changed.
Dim client As TcpClient
s.Start()
Do
'Wait for the next TCP client, and accept the connection:
client = s.AcceptTcpClient()
'Read the data being sent to the server:
Dim ns As NetworkStream = client.GetStream()
Dim sendingData As New Text.StringBuilder()
Dim rdata(READ_BUFFER_SIZE - 1) As Byte
Dim read As Integer
Do
read = ns.Read(rdata, 0, READ_BUFFER_SIZE)
sendingData.Append(Encoding.UTF8.GetString(rdata, 0, read))
Loop While read = READ_BUFFER_SIZE
'Get the method and requested file:
#If Not Debug Then
Try
#End If
If sendingData.Length > 0 Then
Dim data As String = sendingData.ToString()
Dim headers() As String = data.Split({ControlChars.Cr, ControlChars.Lf}, StringSplitOptions.RemoveEmptyEntries)
Dim basicRequestInfo() As String = headers(0).Split(" "c)
Dim method As String = basicRequestInfo(0)
Dim filepath As String = basicRequestInfo(1).Substring(1)
Dim actualFilepath As String = Path.Combine(basedir, Uri.UnescapeDataString(Regex.Replace(filepath, "\?.*$", "")).TrimStart("/"c).Replace("/"c, "\"c))
Dim httpVersion As String = basicRequestInfo(2)
'Set up the response:
Dim responseHeaders As New Dictionary(Of String, String)
Dim statusCode As String = "200"
Dim statusReason As String = "OK"
Dim responseContent() As Byte = {}
'Check the HTTP version - we only support HTTP/1.0 and HTTP/1.1:
If httpVersion <> "HTTP/1.0" AndAlso httpVersion <> "HTTP/1.1" Then
statusCode = "505"
statusReason = "HTTP Version Not Supported"
responseContent = Encoding.UTF8.GetBytes("505 HTTP Version Not Supported")
Else
'Attempt to check if the requested path is a directory; if so, we'll add index.html to it:
Try
If filepath = String.Empty OrElse filepath = "/" Then
actualFilepath = Path.Combine(basedir, "index.html")
filepath = "/"
ElseIf Directory.Exists(actualFilepath) Then
actualFilepath = Path.Combine(actualFilepath, "index.html")
End If
Catch
'Ignore the error; it will appear once again when we try to read the file.
End Try
'Check the method - we only support GET and HEAD:
If method = "GET" Then
'Make sure nobody's trying to hack the system by requesting ../whatever or an absolute path:
If filepath.Contains("..") Then
statusCode = "403"
statusReason = "Forbidden"
responseContent = Encoding.UTF8.GetBytes("403 Forbidden")
Console.WriteLine("Access to {0} was forbidden.", filepath)
ElseIf Not File.Exists(actualFilepath) Then
statusCode = "404"
statusReason = "Not Found"
responseContent = Encoding.UTF8.GetBytes("404 Not Found")
Console.WriteLine("A request for file {0} resulted in a 404 Not Found. The actual path was {1}.", filepath, actualFilepath)
Else
Try
'Read the requested file:
responseContent = File.ReadAllBytes(actualFilepath)
'Get the requested file's length:
responseHeaders.Add("Content-Length", responseContent.Length.ToString())
'And get its content type too:
responseHeaders.Add("Content-Type", GetContentType(actualFilepath))
Catch
'Couldn't get the file's information - assume forbidden.
statusCode = "403"
statusReason = "Forbidden"
responseContent = Encoding.UTF8.GetBytes("403 Forbidden")
End Try
End If
ElseIf method = "HEAD" Then
'Make sure nobody's trying to hack the system by requesting ../whatever or an absolute path:
If filepath.Contains("..") Then
statusCode = "403"
statusReason = "Forbidden"
responseContent = Encoding.UTF8.GetBytes("403 Forbidden")
Console.WriteLine("Access to {0} was forbidden.", filepath)
ElseIf Not File.Exists(actualFilepath) Then
statusCode = "404"
statusReason = "Not Found"
responseContent = Encoding.UTF8.GetBytes("404 Not Found")
Console.WriteLine("A request for file {0} resulted in a 404 Not Found.", filepath)
Else
Try
'Get the requested file's length:
responseHeaders.Add("Content-Length", New FileInfo(actualFilepath).Length.ToString())
'And get its content type too:
responseHeaders.Add("Content-Type", GetContentType(actualFilepath))
Catch
'Couldn't get the file's information - assume forbidden.
statusCode = "403"
statusReason = "Forbidden"
responseContent = Encoding.UTF8.GetBytes("403 Forbidden")
End Try
End If
Else
'Unknown method:
statusCode = "405"
statusReason = "Method Not Allowed"
End If
'Prepare the response:
Dim response As New List(Of Byte)
'Prepare the response's HTTP version and status:
response.AddRange(Encoding.UTF8.GetBytes("HTTP/1.1 " & statusCode & statusReason & ControlChars.CrLf))
'Prepare the response's headers:
Dim combinedResponseHeaders As New List(Of String)
For Each header As KeyValuePair(Of String, String) In responseHeaders
combinedResponseHeaders.Add(header.Key & ": " & header.Value)
Next
response.AddRange(Encoding.UTF8.GetBytes(String.Join(ControlChars.CrLf, combinedResponseHeaders.ToArray())))
'Prepare the response's content:
response.Add(13)
response.Add(10)
response.Add(13)
response.Add(10)
response.AddRange(responseContent)
'Finally, write the response:
ns.Write(response.ToArray(), 0, response.Count)
End If
End If
#If Not Debug Then
Catch ex As Exception
Console.WriteLine("Serious error while processing request:")
Console.WriteLine(ex.ToString())
Dim errorResponse() As Byte = Encoding.UTF8.GetBytes("HTTP/1.1 500 Internal Server Error" & ControlChars.CrLf & ControlChars.CrLf & "500 Internal Server Error")
ns.Write(errorResponse, 0, errorResponse.Length)
End Try
#End If
'And at last, close the connection:
client.Close()
Loop
Catch ex As SocketException
Console.WriteLine("SocketException occurred. Is the socket already in use?")
Console.ReadKey(True)
End Try
End Sub
#End Region
End Module
I even decided to put it on GitHub :) https://github.com/minitech/DevServ
..in the path as a way of breaking out of the defined document root). – Peter Taylor Mar 2 at 12:02