Code: Select all
:Namespace SimpleHttpServer
⍝ Simple Http Server to listen and respond to AJAX request 'GET' and 'POST' on a local machine.
⍝ It is using the .Net HttpListener class (https://docs.microsoft.com/en-us/dotnet/api/system.net.httplistener).
⍝ Will respond at one request at a time. Does not support websocket.
⍝ USAGE:
⍝ To start the server: SimpleHttpServer.Start
⍝ To stop the server: SimpleHttpServer.Stop
⍝ Typical AJAX request for testing:
⍝ req = new XMLHttpRequest()
⍝ req.onreadystatechange = function() {if (this.readyState == 4 && this.status == 200) {alert(this.responseText);}}
⍝ req.onerror = function() {if (this.readyState == 4 && this.status == 200) {alert(this.responseText);}}
⍝ req.open('GET','http://localhost:8080/dir1/mypage.html?key1=value1&key2=value2&key3=value3')
⍝ req.send()
⍝ req.open('POST','http://localhost:8080/dir1/mypage.html?key1=value1&key2=value2&key3=value3')
⍝ req.send("data for POST request goes here")
⍝ System variables
(⎕IO ⎕ML ⎕WX)←1 3 3
⍝ .Net namespace used
⎕USING←'System.Net,system.dll' 'System.IO,mscorlib.dll' 'System,mscorlib.dll'
⍝ Global variable(s):
⍝ _listener
∇ r←Start
:Access Public
⍝ To Start the server.
:Trap 0
:If (~HttpListener.IsSupported)
r←0 'HttpListener is not supported. Windows XP SP2, Server 2003, or higher is required to use the HttpListener class.'
:Else
_listener←⎕NULL
_listener←⎕NEW HttpListener
_listener.AuthenticationSchemes←_listener.AuthenticationSchemes.Anonymous
⍝ Following prefix works best on non admin machine.
⍝ Otherwise you get Access Denied error when starting to listen.
⍝ Port 80/443 are reserved already for standard HTTP/HTTPS, better not used them.
_listener.Prefixes.Add(⊂'http://localhost:8080/')
_listener.Start
⍝ Wait on another thread so it does not block current thread.
{}Listener&⍬
r←1
:End
:Else
r←0 ⎕EXCEPTION ⍝ was .Message
:End
∇
∇ r←Stop
:Access Public
⍝ To Stop the server.
:Trap 0
_listener.Abort
_listener←⎕NULL
r←1
:Else
r←0
:End
∇
∇ r←IsListening
:Access Public
:Trap 0
r←_listener.IsListening
:Else
r←0
:EndTrap
∇
∇ Listener arg;data_json;keyRequest
⎕←'Listening on ',∊⌷_listener.Prefixes
⎕←'Current Thread: ',⍕⎕TID
2503⌶1 ⍝ Mark Thread as Uninterruptible. If there is an error on another thread this one will not stop.
BEGIN:
:While _listener.IsListening
:Trap 0
context←_listener.GetContext ⍝ The GetContext method blocks while waiting for a request.
:Else
:If _listener≡⎕NULL
→0
:ElseIf ~_listener.IsListening
⍝ There is no error. It was terminated by the .Stop method
_listener←⎕NULL
→0
:Else
⍝ There is an error while listening.
SendInternalErrorResponse(⎕EXCEPTION.Message)
⎕←⎕EXCEPTION.Message
{}Stop
{}Start
→BEGIN
:EndIf
:EndTrap
⍝ Get client Request and Response from the context.
(clientRequest clientResponse)←context.(Request Response)
⍝ Common to GET and POST request.
(length encoding inputStream)←clientRequest.(ContentLength64 ContentEncoding InputStream)
requestText←clientRequest.Url.UnescapeDataString(⊂clientRequest.RawUrl) ⍝ URL is removed
⍝ Usefull code to be used for the business logic.
⍝ clientRequest.Headers.Count ⍝ quantity of key/value pair in header
⍝ clientRequest.Headers.AllKeys ⍝ List of all keys in the header
⍝ clientRequest.Headers.get_Item(⊂'keyName') ⍝ Will return ⎕NULL if it does not exist
⍝ (⊂'keyName') ∊ clientRequest.Headers.AllKeys ⍝ To test if a key exist
⍝ clientRequest.QueryString.Count ⍝ quantity of key/value pair in query string
⍝ clientRequest.QueryString.AllKeys ⍝ List of all keys in the query string
⍝ clientRequest.QueryString.get_Item(⊂'keyName') ⍝ Will return ⎕NULL if it does not exist
⍝ (⊂'keyName') ∊ clientRequest.QueryString.AllKeys ⍝ To test if a key exist
⍝ ⎕←'request Text: ',requestText
⍝ ⎕←'request path: ',clientRequest.Url.AbsolutePath
⍝ ⎕←'request Data: ',data
⍝ ⎕←'request Keys: ',clientRequest.QueryString.AllKeys
⍝ ⎕←'header Keys: ',clientRequest.Headers.AllKeys
:Select clientRequest.HttpMethod
:Case 'POST'
⍝ *** POST *** request was received.
⍝ This is the data sent with the POST request
data_json←(⎕NEW StreamReader(inputStream,encoding)).ReadToEnd
⎕←'POST: ',data_json
⍝ Business logic for a POST request goes here.
⍝ :If (⊂'api_key')∊clientRequest.QueryString.AllKeys
⍝ :AndIf '20FE4ADA4F873972E1F18F5457DF6A95'≡clientRequest.QueryString.get_Item(⊂'api_key')
:If 1
:Select ↑r←#.Server.POSTRequestHandler data_json
:Case 200
⍝ OK
SendTextResponse''
:Case 400
⍝ The request is ill formed
SendBadRequestResponse data
:Case 500
⍝ Bug during the APL execution
SendInternalErrorResponse 2⊃r
:Else
∘
:EndSelect
:Else
SendUnauthorizedResponse'asshole'
:EndIf
:Case 'GET'
⍝ *** GET *** request was received.
⎕←'GET: ',requestText
⍝ :If (⊂'api_key')∊clientRequest.QueryString.AllKeys
⍝ :AndIf '20FE4ADA4F873972E1F18F5457DF6A95'≡clientRequest.QueryString.get_Item(⊂'api_key')
⍝ :AndIf (⊂'request')∊clientRequest.QueryString.AllKeys
:If (⊂'request')∊clientRequest.QueryString.AllKeys
keyRequest←clientRequest.QueryString.get_Item(⊂'request')
:Select ↑r←#.Server.GETRequestHandler keyRequest
:Case 200
⍝ OK
SendTextResponse 2⊃r
:Case 400
⍝ The request is ill formed
SendBadRequestResponse''
:Case 500
⍝ Bug during the APL execution
SendInternalErrorResponse 2⊃r
:Else
∘
:EndSelect
:Else
SendUnauthorizedResponse'asshole'
:EndIf
:Else
⎕←'Don''t know what to do with: ',clientRequest.HttpMethod
SendBadRequestResponse clientRequest.HttpMethod
:EndSelect
:EndWhile
⍝ Should not be here. Restarting the server.
{}Stop
{}Start
∇
∇ SendTextResponse text
⍝ Status OK 200
⍝ Send a text response to the client.
⍝ To allow requesting code from any origin to access the resource.
⍝ We are "opting out" of the "same origin policy".
clientResponse.AppendHeader('Access-Control-Allow-Origin'(,'*'))
⍝ Prepare the response.
clientResponse.(StatusCode StatusDescription)←HttpStatusCode.OK'OK' ⍝ req.status and req.statusText in Javascript
clientResponse.ContentEncoding←Text.Encoding.UTF8
clientResponse.ContentType←'text/html' ⍝ req.getResponseHeader("content-type") is working but req.responseType is empty
⍝ Write response to the OutputStream.
text←Text.Encoding.UTF8.GetBytes(⊂text)
clientResponse.ContentLength64←Convert.ToInt64(⍴text)
clientResponse.OutputStream.Write(text 0(≢text)) ⍝ was (⍬⍴⍴text)
⍝ Closing the response will send it to the client.
clientResponse.Close ⍬
∇
∇ SendInternalErrorResponse text
⍝ Error 500
clientResponse.AppendHeader('Access-Control-Allow-Origin'(,'*'))
clientResponse.(StatusCode StatusDescription)←HttpStatusCode.InternalServerError'Internal Server Error'
clientResponse.ContentEncoding←Text.Encoding.UTF8
clientResponse.ContentType←'text/html'
⍝ Write response to the OutputStream.
text←Text.Encoding.UTF8.GetBytes(⊂text)
clientResponse.ContentLength64←Convert.ToInt64(⍴text)
clientResponse.OutputStream.Write(text 0(≢text)) ⍝ was (⍬⍴⍴text)
⍝ Closing the response will send it to the client.
clientResponse.Close ⍬
∇
∇ SendBadRequestResponse text
⍝ Error 400
clientResponse.AppendHeader('Access-Control-Allow-Origin'(,'*'))
clientResponse.(StatusCode StatusDescription)←HttpStatusCode.BadRequest'BadRequest'
clientResponse.ContentEncoding←Text.Encoding.UTF8
clientResponse.ContentType←'text/html'
⍝ Write response to the OutputStream.
text←Text.Encoding.UTF8.GetBytes(⊂text)
clientResponse.ContentLength64←Convert.ToInt64(⍴text)
clientResponse.OutputStream.Write(text 0(≢text)) ⍝ was (⍬⍴⍴text)
⍝ Closing the response will send it to the client.
clientResponse.Close ⍬
∇
∇ SendUnauthorizedResponse text
⍝ Error 401
clientResponse.AppendHeader('Access-Control-Allow-Origin'(,'*'))
clientResponse.(StatusCode StatusDescription)←HttpStatusCode.Unauthorized'Unauthorized'
clientResponse.ContentEncoding←Text.Encoding.UTF8
clientResponse.ContentType←'text/html'
⍝ Write response to the OutputStream.
text←Text.Encoding.UTF8.GetBytes(⊂text)
clientResponse.ContentLength64←Convert.ToInt64(⍴text)
clientResponse.OutputStream.Write(text 0(≢text)) ⍝ was (⍬⍴⍴text)
⍝ Closing the response will send it to the client.
clientResponse.Close ⍬
∇
:EndNamespace
Comments and suggestions for improvements are welcome.