From 98d49206f7b3b1d8a1c0143208eb370f850bce52 Mon Sep 17 00:00:00 2001 From: Brad Nelson Date: Sun, 6 Jun 2021 17:56:48 -0700 Subject: [PATCH] Added posix web server. --- ueforth/Makefile | 1 + ueforth/common/streams.fs | 2 +- ueforth/posix/httpd.fs | 82 +++++++++++++------- ueforth/posix/web_interface.fs | 135 +++++++++++++++++++++++++++++++++ 4 files changed, 190 insertions(+), 30 deletions(-) create mode 100644 ueforth/posix/web_interface.fs diff --git a/ueforth/Makefile b/ueforth/Makefile index 957826b..5951216 100644 --- a/ueforth/Makefile +++ b/ueforth/Makefile @@ -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) diff --git a/ueforth/common/streams.fs b/ueforth/common/streams.fs index f496fd4..9107643 100644 --- a/ueforth/common/streams.fs +++ b/ueforth/common/streams.fs @@ -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! ; diff --git a/ueforth/posix/httpd.fs b/ueforth/posix/httpd.fs index e6d708e..27c5b05 100644 --- a/ueforth/posix/httpd.fs +++ b/ueforth/posix/httpd.fs @@ -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" " client-type client-cr - s"

Testing!

" client-type client-cr - s"

This is a test.

" 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 diff --git a/ueforth/posix/web_interface.fs b/ueforth/posix/web_interface.fs new file mode 100644 index 0000000..811d04f --- /dev/null +++ b/ueforth/posix/web_interface.fs @@ -0,0 +1,135 @@ +( Server Terminal ) + +also streams also httpd +vocabulary web-interface also web-interface definitions + +r| + + +esp32forth + + + + +

ESP32forth v7

+Upload File:
+ + + + + +
+ +
+ +| 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