Added posix web server.
This commit is contained in:
Brad Nelson
@ -129,6 +129,7 @@ POSIX_BOOT = common/boot.fs common/conditionals.fs common/vocabulary.fs \
|
||||
common/tasks.fs common/utils.fs common/highlevel.fs common/filetools.fs \
|
||||
posix/posix_desktop.fs \
|
||||
common/streams.fs common/blocks.fs posix/telnetd.fs \
|
||||
posix/sockets.fs posix/httpd.fs posix/web_interface.fs \
|
||||
posix/autoboot.fs \
|
||||
common/fini.fs
|
||||
$(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)
|
||||
|
||||
@ -19,7 +19,7 @@ vocabulary streams streams definitions
|
||||
>r r@ >read @ r@ >offset c@
|
||||
r@ >read @ 1+ r@ @ mod r> >read ! ;
|
||||
: >stream ( a n st -- )
|
||||
swap 0 do over c@ over ch>stream swap 1+ swap loop 2drop ;
|
||||
swap for aft over c@ over ch>stream swap 1+ swap then next 2drop ;
|
||||
: stream> ( a n st -- )
|
||||
begin over 1 > over empty? 0= and while
|
||||
dup stream>ch >r rot dup r> swap c! 1+ rot 1- rot repeat 2drop 0 swap c! ;
|
||||
|
||||
@ -1,5 +1,4 @@
|
||||
( HTTP Daemon )
|
||||
include posix/sockets.fs
|
||||
|
||||
vocabulary httpd httpd definitions also posix
|
||||
|
||||
@ -8,48 +7,73 @@ vocabulary httpd httpd definitions also posix
|
||||
create chunk chunk-size allot
|
||||
0 value chunk-filled
|
||||
|
||||
8080 constant port
|
||||
-1 value sockfd -1 value clientfd
|
||||
: bs, ( n -- ) dup 256 / c, c, ;
|
||||
: s, ( n -- ) dup c, 256 / c, ;
|
||||
: l, ( n -- ) dup s, 65536 / s, ;
|
||||
create httpd-port AF_INET s, port bs, 0 l, 0 ,
|
||||
create httpd-port AF_INET s, here 0 bs, 0 l, 0 , constant port
|
||||
: port@ ( -- n ) port c@ 256 * port 1+ c@ + ;
|
||||
: port! ( n -- ) dup 256 / port c! port 1+ c! ;
|
||||
create client sizeof(sockaddr_in) allot variable client-len
|
||||
|
||||
defer broker
|
||||
|
||||
: client-type ( a n -- ) clientfd -rot write 0< if 2drop broker then ;
|
||||
: client-read ( -- n ) 0 >r clientfd rp@ 1 read 0< if rdrop broker then r> ;
|
||||
: client-type ( a n -- ) clientfd -rot write 0< if 2drop 1 throw then ;
|
||||
: client-read ( -- n ) 0 >r clientfd rp@ 1 read 0< if rdrop 1 throw then r> ;
|
||||
: client-emit ( ch -- ) >r rp@ 1 client-type rdrop ;
|
||||
: client-cr 13 client-emit nl client-emit ;
|
||||
|
||||
: connection ( n -- )
|
||||
dup 0< if drop exit then to clientfd
|
||||
clientfd chunk chunk-size read to chunk-filled
|
||||
chunk chunk-filled type cr
|
||||
s" HTTP/1.0 200 OK" client-type client-cr
|
||||
s" Content-type: text/html" client-type client-cr
|
||||
client-cr
|
||||
s" <!DOCTYPE html>" client-type client-cr
|
||||
s" <h1>Testing!</h1>" client-type client-cr
|
||||
s" <p>This is a test.</p>" client-type client-cr
|
||||
: handleClient
|
||||
clientfd close drop
|
||||
sockfd client client-len accept
|
||||
dup 0< if drop exit then to clientfd
|
||||
chunk chunk-size 0 fill
|
||||
clientfd chunk chunk-size read to chunk-filled
|
||||
( chunk chunk-filled type cr )
|
||||
;
|
||||
|
||||
: broker-connection
|
||||
begin
|
||||
." Listening on port " port . cr
|
||||
sockfd client client-len accept
|
||||
." Connected: " dup . cr connection
|
||||
again ;
|
||||
' broker-connection is broker
|
||||
|
||||
: server
|
||||
: serve ( port -- )
|
||||
port! ." Listening on port " port@ . cr
|
||||
AF_INET SOCK_STREAM 0 socket to sockfd
|
||||
sockfd SOL_SOCKET SO_REUSEADDR 1 >r rp@ 4 setsockopt rdrop throw
|
||||
sockfd httpd-port sizeof(sockaddr_in) bind throw
|
||||
sockfd max-connections listen throw broker ;
|
||||
sockfd max-connections listen throw
|
||||
;
|
||||
|
||||
variable goal variable goal#
|
||||
: end< ( n -- f ) chunk-filled < ;
|
||||
: in@<> ( n ch -- f ) >r chunk + c@ r> <> ;
|
||||
: skipto ( n ch -- n )
|
||||
>r begin dup r@ in@<> over end< and while 1+ repeat rdrop ;
|
||||
: skipover ( n ch -- n ) skipto 1+ ;
|
||||
: eat ( n ch -- n a n ) >r dup r> skipover swap over over - 1- >r chunk + r> ;
|
||||
: crnl= ( n -- f ) dup chunk + c@ 13 = swap 1+ chunk + c@ nl = and ;
|
||||
: header ( a n -- a n )
|
||||
goal# ! goal ! 0 nl skipover
|
||||
begin dup end< while
|
||||
dup crnl= if drop chunk 0 exit then
|
||||
[char] : eat goal @ goal# @ str= if 2 + 13 eat rot drop exit then
|
||||
nl skipover
|
||||
repeat drop chunk 0
|
||||
;
|
||||
: body ( -- a n )
|
||||
0 nl skipover
|
||||
begin dup end< while
|
||||
dup crnl= if 2 + chunk-filled over - swap chunk + swap exit then
|
||||
nl skipover
|
||||
repeat drop chunk 0
|
||||
;
|
||||
|
||||
: hasHeader ( a n -- f ) 2drop header 0 0 str= 0= ;
|
||||
: method ( -- a n ) 0 bl eat rot drop ;
|
||||
: path ( -- a n ) 0 bl skipover bl eat rot drop ;
|
||||
: send ( a n -- ) client-type ;
|
||||
|
||||
: response ( mime$ result$ status mime$ -- )
|
||||
s" HTTP/1.0 " client-type <# #s #> client-type
|
||||
bl client-emit client-type client-cr
|
||||
s" Content-type: " client-type client-type client-cr
|
||||
client-cr ;
|
||||
: ok-response ( mime$ -- ) s" OK" 200 response ;
|
||||
: bad-response ( mime$ -- ) s" text/plain" s" Bad Request" 400 response ;
|
||||
: notfound-response ( mime$ -- ) s" text/plain" s" Not Found" 404 response ;
|
||||
|
||||
only forth definitions
|
||||
|
||||
httpd server
|
||||
|
||||
135
ueforth/posix/web_interface.fs
Normal file
135
ueforth/posix/web_interface.fs
Normal file
@ -0,0 +1,135 @@
|
||||
( Server Terminal )
|
||||
|
||||
also streams also httpd
|
||||
vocabulary web-interface also web-interface definitions
|
||||
|
||||
r|
|
||||
<!html>
|
||||
<head>
|
||||
<title>esp32forth</title>
|
||||
<style>
|
||||
body {
|
||||
padding: 5px;
|
||||
background-color: #111;
|
||||
color: #2cf;
|
||||
overflow: hidden;
|
||||
}
|
||||
#prompt {
|
||||
width: 100%;
|
||||
padding: 5px;
|
||||
font-family: monospace;
|
||||
background-color: #ff8;
|
||||
}
|
||||
#output {
|
||||
width: 100%;
|
||||
height: 80%;
|
||||
resize: none;
|
||||
overflow-y: scroll;
|
||||
word-break: break-all;
|
||||
}
|
||||
</style>
|
||||
<link rel="icon" href="data:,">
|
||||
</head>
|
||||
<body>
|
||||
<h2>ESP32forth v7</h2>
|
||||
Upload File: <input id="filepick" type="file" name="files[]"></input><br/>
|
||||
<button onclick="ask('hex')">hex</button>
|
||||
<button onclick="ask('decimal')">decimal</button>
|
||||
<button onclick="ask('words')">words</button>
|
||||
<button onclick="ask('low led pin')">LED OFF</button>
|
||||
<button onclick="ask('high led pin')">LED ON</button>
|
||||
<br/>
|
||||
<textarea id="output" readonly></textarea>
|
||||
<input id="prompt" type="prompt"></input><br/>
|
||||
<script>
|
||||
var prompt = document.getElementById('prompt');
|
||||
var filepick = document.getElementById('filepick');
|
||||
var output = document.getElementById('output');
|
||||
function httpPost(url, data, callback) {
|
||||
var r = new XMLHttpRequest();
|
||||
r.onreadystatechange = function() {
|
||||
if (this.readyState == XMLHttpRequest.DONE) {
|
||||
if (this.status === 200) {
|
||||
callback(this.responseText);
|
||||
} else {
|
||||
callback(null);
|
||||
}
|
||||
}
|
||||
};
|
||||
r.open('POST', url);
|
||||
r.send(data);
|
||||
}
|
||||
function ask(cmd, callback) {
|
||||
httpPost('/input', cmd + '\n', function(data) {
|
||||
if (data !== null) { output.value += data; }
|
||||
output.scrollTop = output.scrollHeight; // Scroll to the bottom
|
||||
if (callback !== undefined) { callback(); }
|
||||
});
|
||||
}
|
||||
prompt.onkeyup = function(event) {
|
||||
if (event.keyCode === 13) {
|
||||
event.preventDefault();
|
||||
ask(prompt.value);
|
||||
prompt.value = '';
|
||||
}
|
||||
};
|
||||
filepick.onchange = function(event) {
|
||||
if (event.target.files.length > 0) {
|
||||
var reader = new FileReader();
|
||||
reader.onload = function(e) {
|
||||
var parts = e.target.result.replace(/[\r]/g, '').split('\n');
|
||||
function upload() {
|
||||
if (parts.length === 0) { filepick.value = ''; return; }
|
||||
ask(parts.shift(), upload);
|
||||
}
|
||||
upload();
|
||||
}
|
||||
reader.readAsText(event.target.files[0]);
|
||||
}
|
||||
};
|
||||
window.onload = function() {
|
||||
ask('');
|
||||
prompt.focus();
|
||||
};
|
||||
</script>
|
||||
| constant index-html# constant index-html
|
||||
|
||||
variable webserver
|
||||
20000 constant out-size
|
||||
200 stream input-stream
|
||||
out-size stream output-stream
|
||||
create out-string out-size 1+ allot align
|
||||
|
||||
: handle-index
|
||||
s" text/html" ok-response
|
||||
index-html index-html# send
|
||||
;
|
||||
|
||||
: handle-input
|
||||
body input-stream >stream pause
|
||||
out-string out-size output-stream stream>
|
||||
s" text/plain" ok-response
|
||||
out-string z>s send
|
||||
;
|
||||
|
||||
: serve-type ( a n -- ) output-stream >stream ;
|
||||
: serve-key ( -- n ) input-stream stream>ch ;
|
||||
|
||||
: handle1
|
||||
handleClient
|
||||
s" /" path str= if handle-index exit then
|
||||
s" /input" path str= if handle-input exit then
|
||||
notfound-response
|
||||
;
|
||||
|
||||
: do-serve begin handle1 pause again ;
|
||||
' do-serve 1000 1000 task webserver-task
|
||||
|
||||
: serve ( port -- )
|
||||
serve
|
||||
['] serve-type is type
|
||||
['] serve-key is key
|
||||
webserver-task start-task
|
||||
;
|
||||
|
||||
only forth definitions
|
||||
Reference in New Issue
Block a user