summaryrefslogtreecommitdiff
path: root/irc/core.rkt
diff options
context:
space:
mode:
Diffstat (limited to 'irc/core.rkt')
-rw-r--r--irc/core.rkt23
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))))