alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added posix web server.

Browse Source
This commit is contained in:
Brad Nelson
2021-06-06 17:56:48 -07:00
parent 8a6eda2f53
commit 98d49206f7
4 changed files with 190 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
ueforth/Makefile
View File

@ -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 \ common/tasks.fs common/utils.fs common/highlevel.fs common/filetools.fs \
posix/posix_desktop.fs \ posix/posix_desktop.fs \
common/streams.fs common/blocks.fs posix/telnetd.fs \ common/streams.fs common/blocks.fs posix/telnetd.fs \
posix/sockets.fs posix/httpd.fs posix/web_interface.fs \
posix/autoboot.fs \ posix/autoboot.fs \
common/fini.fs common/fini.fs
$(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN) $(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)

2
ueforth/common/streams.fs
View File

@ -19,7 +19,7 @@ vocabulary streams streams definitions
>r r@ >read @ r@ >offset c@ >r r@ >read @ r@ >offset c@
r@ >read @ 1+ r@ @ mod r> >read ! ; r@ >read @ 1+ r@ @ mod r> >read ! ;
: >stream ( a n st -- ) : >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 -- ) : stream> ( a n st -- )
begin over 1 > over empty? 0= and while 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! ; dup stream>ch >r rot dup r> swap c! 1+ rot 1- rot repeat 2drop 0 swap c! ;

82
ueforth/posix/httpd.fs
View File

@ -1,5 +1,4 @@
( HTTP Daemon ) ( HTTP Daemon )
include posix/sockets.fs
vocabulary httpd httpd definitions also posix vocabulary httpd httpd definitions also posix
@ -8,48 +7,73 @@ vocabulary httpd httpd definitions also posix
create chunk chunk-size allot create chunk chunk-size allot
0 value chunk-filled 0 value chunk-filled
8080 constant port
-1 value sockfd -1 value clientfd -1 value sockfd -1 value clientfd
: bs, ( n -- ) dup 256 / c, c, ; : bs, ( n -- ) dup 256 / c, c, ;
: s, ( n -- ) dup c, 256 / c, ; : s, ( n -- ) dup c, 256 / c, ;
: l, ( n -- ) dup s, 65536 / s, ; : 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 create client sizeof(sockaddr_in) allot variable client-len
defer broker : 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-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-emit ( ch -- ) >r rp@ 1 client-type rdrop ; : client-emit ( ch -- ) >r rp@ 1 client-type rdrop ;
: client-cr 13 client-emit nl client-emit ; : client-cr 13 client-emit nl client-emit ;
: connection ( n -- ) : handleClient
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
clientfd close drop 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 : serve ( port -- )
begin port! ." Listening on port " port@ . cr
." Listening on port " port . cr
sockfd client client-len accept
." Connected: " dup . cr connection
again ;
' broker-connection is broker
: server
AF_INET SOCK_STREAM 0 socket to sockfd AF_INET SOCK_STREAM 0 socket to sockfd
sockfd SOL_SOCKET SO_REUSEADDR 1 >r rp@ 4 setsockopt rdrop throw sockfd SOL_SOCKET SO_REUSEADDR 1 >r rp@ 4 setsockopt rdrop throw
sockfd httpd-port sizeof(sockaddr_in) bind 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 only forth definitions
httpd server

135
ueforth/posix/web_interface.fs Normal file
View 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