@@ -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: | |||
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 | |||
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 server.4th | |||
variable clcounter | |||
0 clcounter ! | |||
: handle-command-line? ( -- flag ) | |||
clcounter @ 10 >= dup IF | |||
0 clcounter ! | |||
ELSE | |||
1 clcounter +! | |||
THEN ; | |||
: custom-eventloop ( -- ) | |||
BEGIN | |||
handle-command-line? IF | |||
0 EVENT_COMMANDLINE events.enqueue | |||
THEN | |||
eventloop.has-events? IF | |||
eventloop.dispatch | |||
ELSE | |||
server-idle? IF | |||
10 ms false server-idle! | |||
1 ms false server-idle! | |||
THEN | |||
0 0 events.enqueue eventloop.dispatch | |||
THEN | |||
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 ! | |||
2048 constant SENDBUFFER_SIZE | |||
4096 constant SENDBUFFER_SIZE | |||
create sendbuffer SENDBUFFER_SIZE allot | |||
\ Calling C here is just optimization. | |||
@@ -7,7 +7,7 @@ c-library sanitizelib | |||
\c void csanitize(char *buffer, int buffersize) { | |||
\c int lastIsNewline = buffer[buffersize-1] == '\n' ? 1 : 0; | |||
\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 if(lastIsNewline) { buffer[buffersize-1] = '\n'; } | |||
\c return; | |||
@@ -2,6 +2,8 @@ require unix/socket.fs | |||
require socket-extensions.4th | |||
require connections.4th | |||
require commandline.4th | |||
require motd.4th | |||
require sendbuffer.4th | |||
AF_INET constant SERVER_SOCKET_DOMAIN | |||
@@ -148,8 +150,7 @@ create optval /option_value allot | |||
EVENT_CONNECTION_RECV events.enqueue | |||
ELSE \ disconnected | |||
(queue-disconnect) | |||
THEN | |||
; | |||
THEN ; | |||
: (recv-warning) ( -- ) ." Warning: recv failed, disconnecting client." cr ; | |||
: (recv-error) ( recv-result-n connection-addr -- ) | |||
errno EAGAIN <> IF | |||
@@ -178,26 +179,17 @@ create optval /option_value allot | |||
THEN | |||
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 #> ; | |||
: (connectionnumber@) ( connection-addr -- c-addr u ) | |||
: (connection.number>string) ( connection-addr -- c-addr u ) | |||
connection.number @ (to-string) ; | |||
: (connectionbuffer@) ( connection-addr -- c-addr u ) | |||
: (connection.buffer>string) ( connection-addr -- c-addr u ) | |||
dup connection.buffer swap connection.bufferlen @ ; | |||
: (format-sendbuffer) ( from-connection-addr -- ) | |||
>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 ; | |||
: (connected?) ( connection-addr -- ) | |||
connection.connected @ ; | |||
@@ -207,11 +199,13 @@ create optval /option_value allot | |||
tuck (different-connection?) swap (connected?) and ; | |||
: (check-send) ( result-n -- ) | |||
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 -- ) | |||
nip connection.fd @ sendbuffer@ 0 send (check-send) ; | |||
(send-sendbuffer) ; | |||
: (try-send) ( from-connection-addr to-connection-addr -- ) | |||
2dup (send?) IF | |||
(send) | |||
nip (send-sendbuffer) | |||
ELSE | |||
2drop | |||
THEN ; | |||
@@ -221,10 +215,82 @@ create optval /option_value allot | |||
dup I connections.at (try-send) | |||
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-recv EVENT_IDLE eventhandlers.append | |||
' server-connection-new EVENT_CONNECTION_NEW eventhandlers.append | |||
' server-connection-closed EVENT_CONNECTION_CLOSED 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 |