Moontalk server and client (provided by many parties)
Вы не можете выбрать более 25 тем Темы должны начинаться с буквы или цифры, могут содержать дефисы(-) и должны содержать не более 35 символов.

58 строки
1.5KB

  1. require util.4th
  2. require configuration.4th
  3. 0 variable! sendbuffer-len
  4. 4096 constant SENDBUFFER_SIZE
  5. create sendbuffer SENDBUFFER_SIZE allot
  6. CONFIG_C_FFI invert [IF]
  7. variable last-is-newline
  8. : (last) ( c-addr u -- c-addr )
  9. 1- + ;
  10. : (sanitize-char) ( c-addr -- )
  11. dup c@ dup 32 < swap 126 > or IF
  12. [char] ? swap c!
  13. ELSE
  14. drop
  15. THEN ;
  16. : sanitize ( c-addr u -- )
  17. dup 0<= IF
  18. 2drop EXIT
  19. THEN
  20. 2dup (last) c@ 10 = last-is-newline !
  21. 2dup
  22. bounds DO
  23. I (sanitize-char)
  24. LOOP
  25. last-is-newline @ IF
  26. (last) 10 swap c!
  27. ELSE
  28. 2drop
  29. THEN ;
  30. [ELSE]
  31. \ Calling C here is just optimization.
  32. c-library sanitizelib
  33. \c void sanitize(char *buffer, int buffersize) {
  34. \c int lastIsNewline = buffer[buffersize-1] == '\n' ? 1 : 0;
  35. \c for(int i = 0; i<buffersize; i++) {
  36. \c if(buffer[i]<32 || buffer[i]>126) { buffer[i] = '?'; }
  37. \c }
  38. \c if(lastIsNewline) { buffer[buffersize-1] = '\n'; }
  39. \c return;
  40. \c }
  41. c-function sanitize sanitize a n -- void
  42. end-c-library
  43. [THEN]
  44. : sendbuffer-reset ( -- ) 0 sendbuffer-len ! ;
  45. : (overflow?) ( n -- flag )
  46. sendbuffer-len @ + SENDBUFFER_SIZE u> ;
  47. : (append) ( str -- )
  48. dup -rot sendbuffer sendbuffer-len @ + swap move
  49. sendbuffer-len +! ;
  50. : sendbuffer-append ( str -- )
  51. dup (overflow?) abort" sendbuffer overflow" (append) ;
  52. : sendbuffer-sanitize ( -- )
  53. sendbuffer sendbuffer-len @ sanitize ;
  54. : sendbuffer@ ( -- str ) sendbuffer sendbuffer-len @ ;