diff options
| -rw-r--r-- | irc/core.rkt | 23 |
1 files changed, 15 insertions, 8 deletions
diff --git a/irc/core.rkt b/irc/core.rkt index bbe6905..a24747e 100644 --- a/irc/core.rkt +++ b/irc/core.rkt @@ -55,10 +55,11 @@ [cmd (message-command msg)] [args (message-args msg)] [suff (message-suffix msg)]) - ; (when tags (fprintf out "@~A " tags)) - ; (if tags - ; (map (λ (t) (map clean t)) tags) - ; tags) + (when (pair? tags) + (fprintf out "@~A " + (string-join + (map (λ (t) (string-append (car t) "=" (cdr t))) tags) + ";"))) (when prefix (fprintf out ":~A " (clean prefix))) (fprintf out "~A" (clean (symbol->string cmd))) @@ -119,17 +120,23 @@ (message tags prefix cmd args suffix)) (define (send msg #:conn [conn (current-connection)]) + (define formatted (~a msg)) + (define capped (substring formatted 0 (min 510 (string-length formatted)))) (call-with-semaphore (connection-output-lock conn) - (thunk (log-irc-info "» ~a" msg) - (fprintf (connection-output conn) "~A\r\n" msg) - (flush-output (connection-output conn))))) + (thunk (log-irc-info "» ~a" capped) + (define out (connection-output conn)) + (display capped out) + (display "\r\n" out) + (flush-output out)))) (define (listen) (let ([input (connection-input (current-connection))]) (let loop () (let* ([l (read-line input 'any)] [msg (msg-parse l)]) - (log-irc-info "« ~a" msg) + (when (not (string=? (~a msg) l)) + (log-irc-warning "Message roundtrip lossy:\nActual: ~a\nParsed: ~a" l msg)) + (log-irc-info "« ~a" l) (thread (thunk (hook-process msg)))) (loop)))) |