@@ -0,0 +1,4 @@ | |||||
Patches prefered. | |||||
Pull requests and issues will be acknowledged. | |||||
Email me: emilwilliams@tuta.io |
@@ -12,4 +12,9 @@ moontalk.tcl: | |||||
moontalk.c: | moontalk.c: | ||||
IS INCOMPLETE, do not use it. | |||||
IS INCOMPLETE, do not use it. | |||||
To compile it, use bake <https://git.lain.church/emil/bake> or just run: | |||||
gcc -O2 -std=gnu99 moontalk.c -o moontalk -lncurses -ltinfo | |||||
Run -help for further details for usage. |
@@ -0,0 +1,69 @@ | |||||
80 constant COMMANDLINE_SIZE | |||||
create commandline COMMANDLINE_SIZE allot | |||||
variable cmdcursor | |||||
variable cmdready | |||||
: (cursor@) ( -- index-u ) cmdcursor @ ; | |||||
: (translate) ( index-u -- addr ) | |||||
commandline + ; | |||||
: (last-position) ( -- index-u ) | |||||
COMMANDLINE_SIZE 1- ; | |||||
: (tail) ( index-u -- length-u ) | |||||
COMMANDLINE_SIZE swap - ; | |||||
: (cursor-left) ( -- ) (cursor@) 1- 0 max cmdcursor ! ; | |||||
: (cursor-right) ( -- ) (cursor@) 1+ COMMANDLINE_SIZE 1- min cmdcursor ! ; | |||||
: (overwrite-char) ( c -- ) | |||||
commandline (cursor@) + c! ; | |||||
: (append-char) ( c -- ) | |||||
(cursor@) (last-position) <> IF | |||||
(cursor@) dup (translate) dup 1+ rot (tail) 1- move | |||||
THEN (overwrite-char) ; | |||||
: (backspace) ( -- ) | |||||
(cursor@) 0> IF | |||||
(cursor@) (translate) dup 1- (cursor@) (tail) move | |||||
bl (last-position) (translate) c! | |||||
(cursor-left) | |||||
THEN ; | |||||
: commandline-handlekey ( ekey-n -- ) | |||||
ekey>char if ( c ) | |||||
CASE | |||||
10 OF true cmdready ! ENDOF \ newline | |||||
13 OF true cmdready ! ENDOF \ carriage return | |||||
127 OF (backspace) ENDOF \ DEL | |||||
(append-char) (cursor-right) EXIT | |||||
ENDCASE | |||||
else ekey>fkey if ( key-id ) | |||||
case | |||||
k-left of (cursor-left) endof | |||||
k-right of (cursor-right) endof | |||||
endcase | |||||
else ( keyboard-event ) | |||||
drop \ just ignore an unknown keyboard event type | |||||
then then ; | |||||
: commandline-getline ( -- c-addr u ) | |||||
commandline COMMANDLINE_SIZE ; | |||||
: (update-cursorpos) ( -- ) | |||||
s\" \033[" type | |||||
(cursor@) 1+ s>d <# #s #> type | |||||
s" G" type ; | |||||
: (carriage-return) ( -- ) | |||||
13 emit ; | |||||
: commandline-redraw ( -- ) | |||||
(carriage-return) | |||||
commandline-getline type | |||||
(update-cursorpos) ; | |||||
: commandline-reset ( -- ) | |||||
commandline COMMANDLINE_SIZE bl fill | |||||
0 cmdcursor ! | |||||
false cmdready ! ; | |||||
: commandline-key? ( -- flag ) key? ; | |||||
: commandline-key ( -- ekey ) ekey ; | |||||
: commandline-ready? ( -- flag ) cmdready @ ; | |||||
commandline-reset |
@@ -1,6 +1,8 @@ | |||||
0 constant EVENT_IDLE | 0 constant EVENT_IDLE | ||||
1 constant EVENT_CONNECTION_NEW | |||||
2 constant EVENT_CONNECTION_CLOSED | |||||
3 constant EVENT_CONNECTION_SEND | |||||
4 constant EVENT_CONNECTION_RECV | |||||
1 constant EVENT_COMMANDLINE | |||||
2 constant EVENT_MOTD_CHANGED | |||||
3 constant EVENT_CONNECTION_NEW | |||||
4 constant EVENT_CONNECTION_CLOSED | |||||
5 constant EVENT_CONNECTION_SEND | |||||
6 constant EVENT_CONNECTION_RECV |
@@ -3,16 +3,29 @@ require eventloop.4th | |||||
require event-constants.4th | require event-constants.4th | ||||
require server.4th | require server.4th | ||||
variable clcounter | |||||
0 clcounter ! | |||||
: handle-command-line? ( -- flag ) | |||||
clcounter @ 10 >= dup IF | |||||
0 clcounter ! | |||||
ELSE | |||||
1 clcounter +! | |||||
THEN ; | |||||
: custom-eventloop ( -- ) | : custom-eventloop ( -- ) | ||||
BEGIN | BEGIN | ||||
handle-command-line? IF | |||||
0 EVENT_COMMANDLINE events.enqueue | |||||
THEN | |||||
eventloop.has-events? IF | eventloop.has-events? IF | ||||
eventloop.dispatch | eventloop.dispatch | ||||
ELSE | ELSE | ||||
server-idle? IF | server-idle? IF | ||||
10 ms false server-idle! | |||||
1 ms false server-idle! | |||||
THEN | THEN | ||||
0 0 events.enqueue eventloop.dispatch | 0 0 events.enqueue eventloop.dispatch | ||||
THEN | THEN | ||||
AGAIN ; | AGAIN ; | ||||
' custom-eventloop catch close-server throw | |||||
: main ( -- ) ['] custom-eventloop catch close-server throw ; | |||||
main |
@@ -0,0 +1,79 @@ | |||||
1024 constant MOTD_BUFFER_SIZE | |||||
create motdbuffer MOTD_BUFFER_SIZE allot | |||||
variable motd-length | |||||
: (update) ( str -- ) | |||||
MOTD_BUFFER_SIZE min dup motd-length ! | |||||
motdbuffer swap move ; | |||||
: motd-clear ( -- ) | |||||
motdbuffer MOTD_BUFFER_SIZE bl fill | |||||
0 motd-length ! ; | |||||
: motd-append ( str -- ) | |||||
MOTD_BUFFER_SIZE motd-length @ - min | |||||
motdbuffer motd-length @ + swap dup motd-length +! move ; | |||||
: motd@ ( -- str ) | |||||
motdbuffer motd-length @ ; | |||||
: motd-propagate ( -- ) | |||||
0 EVENT_MOTD_CHANGED events.enqueue ; | |||||
: .motd ( -- ) motd@ cr type ; | |||||
: (strallot) ( str -- ) | |||||
here swap dup allot move ; | |||||
: (append-banner) ( start-addr size-u -- start-addr size-u ) | |||||
BEGIN | |||||
10 parse | |||||
2dup s" end-motd-banner" search nip nip IF | |||||
2drop EXIT | |||||
THEN | |||||
dup 0<> IF | |||||
dup -rot (strallot) + 10 c, 1+ | |||||
ELSE | |||||
2drop REFILL invert IF | |||||
EXIT | |||||
THEN | |||||
THEN | |||||
AGAIN ; | |||||
: motd-banner ( "name" -- ) | |||||
create here 0 , 0 (append-banner) swap ! ; | |||||
: end-motd-banner ( -- ) | |||||
true abort" run motd-banner first." ; | |||||
: motd-banner@ ( addr -- str ) | |||||
dup cell + swap @ ; | |||||
: motd-compose ( message-str banner-str -- ) | |||||
motd-clear | |||||
( banner-str ) motd-append | |||||
s\" \n" motd-append | |||||
( message-str ) motd-append | |||||
s\" \n" motd-append ; | |||||
motd-banner motd-forth1 | |||||
________ ___ _______ _________ ____ ____ | |||||
|_ __ | .' `.|_ __ \ | _ _ ||_ || _| | |||||
| |_ \_|/ .-. \ | |__) ||_/ | | \_| | |__| | | |||||
| _| | | | | | __ / | | | __ | | |||||
_| |_ \ `-' /_| | \ \_ _| |_ _| | | |_ | |||||
|_____| `.___.'|____| |___||_____| |____||____| | |||||
end-motd-banner | |||||
motd-banner motd-forth2 | |||||
_______ _____ ______ _______ _ _ | |||||
|______ | | |_____/ | |_____| | |||||
| |_____| | \_ | | | | |||||
end-motd-banner | |||||
motd-banner motd-forth3 | |||||
_/_/_/_/ _/_/ _/_/_/ _/_/_/_/_/ _/ _/ | |||||
_/ _/ _/ _/ _/ _/ _/ _/ | |||||
_/_/_/ _/ _/ _/_/_/ _/ _/_/_/_/ | |||||
_/ _/ _/ _/ _/ _/ _/ _/ | |||||
_/ _/_/ _/ _/ _/ _/ _/ | |||||
end-motd-banner | |||||
: motd-current-banner ( -- str ) | |||||
motd-forth3 motd-banner@ ; | |||||
s" Lorem ipsum magnam quae aperiam maiores dolor quis ut." motd-current-banner motd-compose |
@@ -1,5 +1,5 @@ | |||||
variable sendbuffer-len 0 sendbuffer-len ! | variable sendbuffer-len 0 sendbuffer-len ! | ||||
2048 constant SENDBUFFER_SIZE | |||||
4096 constant SENDBUFFER_SIZE | |||||
create sendbuffer SENDBUFFER_SIZE allot | create sendbuffer SENDBUFFER_SIZE allot | ||||
\ Calling C here is just optimization. | \ Calling C here is just optimization. | ||||
@@ -7,7 +7,7 @@ c-library sanitizelib | |||||
\c void csanitize(char *buffer, int buffersize) { | \c void csanitize(char *buffer, int buffersize) { | ||||
\c int lastIsNewline = buffer[buffersize-1] == '\n' ? 1 : 0; | \c int lastIsNewline = buffer[buffersize-1] == '\n' ? 1 : 0; | ||||
\c for(int i = 0; i<buffersize; i++) { | \c for(int i = 0; i<buffersize; i++) { | ||||
\c if(buffer[i]<32 || buffer[i]>127) { buffer[i] = '?'; } | |||||
\c if(buffer[i]<32 || buffer[i]>126) { buffer[i] = '?'; } | |||||
\c } | \c } | ||||
\c if(lastIsNewline) { buffer[buffersize-1] = '\n'; } | \c if(lastIsNewline) { buffer[buffersize-1] = '\n'; } | ||||
\c return; | \c return; | ||||
@@ -2,6 +2,8 @@ require unix/socket.fs | |||||
require socket-extensions.4th | require socket-extensions.4th | ||||
require connections.4th | require connections.4th | ||||
require commandline.4th | |||||
require motd.4th | |||||
require sendbuffer.4th | require sendbuffer.4th | ||||
AF_INET constant SERVER_SOCKET_DOMAIN | AF_INET constant SERVER_SOCKET_DOMAIN | ||||
@@ -148,8 +150,7 @@ create optval /option_value allot | |||||
EVENT_CONNECTION_RECV events.enqueue | EVENT_CONNECTION_RECV events.enqueue | ||||
ELSE \ disconnected | ELSE \ disconnected | ||||
(queue-disconnect) | (queue-disconnect) | ||||
THEN | |||||
; | |||||
THEN ; | |||||
: (recv-warning) ( -- ) ." Warning: recv failed, disconnecting client." cr ; | : (recv-warning) ( -- ) ." Warning: recv failed, disconnecting client." cr ; | ||||
: (recv-error) ( recv-result-n connection-addr -- ) | : (recv-error) ( recv-result-n connection-addr -- ) | ||||
errno EAGAIN <> IF | errno EAGAIN <> IF | ||||
@@ -178,26 +179,17 @@ create optval /option_value allot | |||||
THEN | THEN | ||||
LOOP ; | LOOP ; | ||||
: server-idle-accept ( eventdata-n eventid-n -- ) | |||||
2drop (server-idle-accept) ; | |||||
: server-idle-recv ( eventdata-n eventid-n -- ) | |||||
2drop (server-idle-recv) ; | |||||
: server-connection-new ( connection-addr eventid-n -- ) | |||||
2drop ." New client connected!" cr ; | |||||
: server-connection-closed ( connection-addr eventid-n -- ) | |||||
2drop ." Client disconnected." cr ; | |||||
: (to-string) ( n -- addr c ) s>d <# #s #> ; | : (to-string) ( n -- addr c ) s>d <# #s #> ; | ||||
: (connectionnumber@) ( connection-addr -- c-addr u ) | |||||
: (connection.number>string) ( connection-addr -- c-addr u ) | |||||
connection.number @ (to-string) ; | connection.number @ (to-string) ; | ||||
: (connectionbuffer@) ( connection-addr -- c-addr u ) | |||||
: (connection.buffer>string) ( connection-addr -- c-addr u ) | |||||
dup connection.buffer swap connection.bufferlen @ ; | dup connection.buffer swap connection.bufferlen @ ; | ||||
: (format-sendbuffer) ( from-connection-addr -- ) | : (format-sendbuffer) ( from-connection-addr -- ) | ||||
>r sendbuffer-reset | >r sendbuffer-reset | ||||
s" Anon " sendbuffer-append | |||||
r@ (connectionnumber@) sendbuffer-append | |||||
s" : " sendbuffer-append | |||||
r> (connectionbuffer@) sendbuffer-append | |||||
s" Anon " sendbuffer-append | |||||
r@ (connection.number>string) sendbuffer-append | |||||
s" : " sendbuffer-append | |||||
r> (connection.buffer>string) sendbuffer-append | |||||
sendbuffer-sanitize ; | sendbuffer-sanitize ; | ||||
: (connected?) ( connection-addr -- ) | : (connected?) ( connection-addr -- ) | ||||
connection.connected @ ; | connection.connected @ ; | ||||
@@ -207,11 +199,13 @@ create optval /option_value allot | |||||
tuck (different-connection?) swap (connected?) and ; | tuck (different-connection?) swap (connected?) and ; | ||||
: (check-send) ( result-n -- ) | : (check-send) ( result-n -- ) | ||||
0< IF ." Warning: send failed." cr THEN ; | 0< IF ." Warning: send failed." cr THEN ; | ||||
: (send-sendbuffer) ( to-connection-addr -- ) | |||||
connection.fd @ sendbuffer@ 0 send (check-send) ; | |||||
: (send) ( from-connection-addr to-connection-addr -- ) | : (send) ( from-connection-addr to-connection-addr -- ) | ||||
nip connection.fd @ sendbuffer@ 0 send (check-send) ; | |||||
(send-sendbuffer) ; | |||||
: (try-send) ( from-connection-addr to-connection-addr -- ) | : (try-send) ( from-connection-addr to-connection-addr -- ) | ||||
2dup (send?) IF | 2dup (send?) IF | ||||
(send) | |||||
nip (send-sendbuffer) | |||||
ELSE | ELSE | ||||
2drop | 2drop | ||||
THEN ; | THEN ; | ||||
@@ -221,10 +215,82 @@ create optval /option_value allot | |||||
dup I connections.at (try-send) | dup I connections.at (try-send) | ||||
LOOP drop ; | LOOP drop ; | ||||
: server-idle-accept ( eventdata-n eventid-n -- ) | |||||
2drop (server-idle-accept) ; | |||||
: server-idle-recv ( eventdata-n eventid-n -- ) | |||||
2drop (server-idle-recv) ; | |||||
variable (strstart) | |||||
variable (strend) | |||||
: (>str) ( startindex-n endindex-n str-addr -- c-addr u ) | |||||
tuck + -rot + tuck - ; | |||||
: (newline?) ( char -- flag ) 10 = ; | |||||
\ TODO: FIXME: refactor and create words to be able to conveniently | |||||
\ TODO: FIXME: send "Server: ..." messages. This will be useful in the repl too. | |||||
: (prepare-motd) ( -- ) | |||||
\ TODO: FIXME: just write a proper parser at this point.... | |||||
sendbuffer-reset | |||||
-1 (strstart) ! | |||||
-1 (strend) ! | |||||
motd@ 0 DO | |||||
(strstart) @ -1 = IF | |||||
I (strstart) ! | |||||
THEN | |||||
dup I + c@ (newline?) IF | |||||
I (strend) ! | |||||
THEN | |||||
(strend) @ -1 <> IF | |||||
s" Server: " sendbuffer-append | |||||
dup (strstart) @ (strend) @ rot (>str) sendbuffer-append | |||||
s\" \n" sendbuffer-append | |||||
-1 (strstart) ! | |||||
-1 (strend) ! | |||||
THEN | |||||
LOOP drop ; | |||||
: (prepare-empty-line) ( -- ) | |||||
sendbuffer-reset s\" Server: \n" sendbuffer-append ; | |||||
: (prepare-identity) ( connection-addr -- ) | |||||
sendbuffer-reset | |||||
s\" Server: You are now known as \"Anon " sendbuffer-append | |||||
(connection.number>string) sendbuffer-append | |||||
s\" \".\n" sendbuffer-append ; | |||||
: server-connection-new ( connection-addr eventid-n -- ) | |||||
drop ." New client connected!" cr | |||||
dup (prepare-motd) (send-sendbuffer) | |||||
dup (prepare-empty-line) (send-sendbuffer) | |||||
dup (prepare-identity) | |||||
(send-sendbuffer) ; | |||||
: server-connection-closed ( connection-addr eventid-n -- ) | |||||
2drop ." Client disconnected." cr ; | |||||
: server-commandline ( eventdata-n eventid-n -- ) | |||||
2drop commandline-ready? IF | |||||
space commandline-getline ['] evaluate catch dup 0= IF | |||||
drop ." ok" | |||||
ELSE | |||||
." error code: " . 2drop | |||||
THEN | |||||
cr | |||||
commandline-reset | |||||
ELSE | |||||
commandline-key? IF | |||||
commandline-key commandline-handlekey | |||||
commandline-redraw | |||||
THEN | |||||
THEN ; | |||||
: server-motd-changed ( eventdata-n eventid-n -- ) | |||||
2drop (prepare-motd) | |||||
connections.count 0 DO | |||||
I connections.at (send-sendbuffer) | |||||
LOOP ; | |||||
' server-idle-accept EVENT_IDLE eventhandlers.append | ' server-idle-accept EVENT_IDLE eventhandlers.append | ||||
' server-idle-recv EVENT_IDLE eventhandlers.append | ' server-idle-recv EVENT_IDLE eventhandlers.append | ||||
' server-connection-new EVENT_CONNECTION_NEW eventhandlers.append | ' server-connection-new EVENT_CONNECTION_NEW eventhandlers.append | ||||
' server-connection-closed EVENT_CONNECTION_CLOSED eventhandlers.append | ' server-connection-closed EVENT_CONNECTION_CLOSED eventhandlers.append | ||||
' server-recv EVENT_CONNECTION_RECV eventhandlers.append | ' server-recv EVENT_CONNECTION_RECV eventhandlers.append | ||||
' server-commandline EVENT_COMMANDLINE eventhandlers.append | |||||
' server-motd-changed EVENT_MOTD_CHANGED eventhandlers.append | |||||
initialize-server | initialize-server |