diff --git a/CONTRIB b/CONTRIB new file mode 100644 index 0000000..bc8e96f --- /dev/null +++ b/CONTRIB @@ -0,0 +1,4 @@ +Patches prefered. +Pull requests and issues will be acknowledged. + +Email me: emilwilliams@tuta.io diff --git a/client/README b/client/README index 0ec3e74..7834c5d 100644 --- a/client/README +++ b/client/README @@ -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 or just run: + gcc -O2 -std=gnu99 moontalk.c -o moontalk -lncurses -ltinfo + + Run -help for further details for usage. diff --git a/server/eventloop-server-experiment/commandline.4th b/server/eventloop-server-experiment/commandline.4th new file mode 100644 index 0000000..cd1f74b --- /dev/null +++ b/server/eventloop-server-experiment/commandline.4th @@ -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 diff --git a/server/eventloop-server-experiment/event-constants.4th b/server/eventloop-server-experiment/event-constants.4th index 7348ed5..77f6681 100644 --- a/server/eventloop-server-experiment/event-constants.4th +++ b/server/eventloop-server-experiment/event-constants.4th @@ -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 diff --git a/server/eventloop-server-experiment/main.4th b/server/eventloop-server-experiment/main.4th index f3f7222..306a282 100644 --- a/server/eventloop-server-experiment/main.4th +++ b/server/eventloop-server-experiment/main.4th @@ -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 diff --git a/server/eventloop-server-experiment/motd.4th b/server/eventloop-server-experiment/motd.4th new file mode 100644 index 0000000..adfeec2 --- /dev/null +++ b/server/eventloop-server-experiment/motd.4th @@ -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 diff --git a/server/eventloop-server-experiment/sendbuffer.4th b/server/eventloop-server-experiment/sendbuffer.4th index 4bc00bf..e6a50fb 100644 --- a/server/eventloop-server-experiment/sendbuffer.4th +++ b/server/eventloop-server-experiment/sendbuffer.4th @@ -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; i127) { buffer[i] = '?'; } +\c if(buffer[i]<32 || buffer[i]>126) { buffer[i] = '?'; } \c } \c if(lastIsNewline) { buffer[buffersize-1] = '\n'; } \c return; diff --git a/server/eventloop-server-experiment/server.4th b/server/eventloop-server-experiment/server.4th index f53cb14..5116c91 100644 --- a/server/eventloop-server-experiment/server.4th +++ b/server/eventloop-server-experiment/server.4th @@ -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