syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

/LIST

This commit is contained in:
Tony Garnock-Jones 2019-01-29 20:47:17 +00:00
parent 7e2284ac11
commit 1e3e978e36
1 changed files with 18 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
syndicate/examples/ircd/session.rkt
View File

@ -9,6 +9,7 @@
(require/activate imperative-syndicate/reload)
(require/activate imperative-syndicate/drivers/tcp)
(require syndicate/support/hash)
(require (only-in racket/list append*))
(define (ircd-connection-facet this-conn peer-host)
(define (send-to-remote #:newline [with-newline #t] fmt . vs)
@ -160,6 +161,23 @@
(define Present (string-join (filter on? Nicks) " "))
(send! (ircd-event conn (irc-message server-prefix 303 '("*") Present)))))
(spawn #:name 'list-responder
(stop-when-reloaded)
(define/query-hash topics (ircd-channel-topic $Ch $topic) Ch topic)
(define/query-hash counts (ircd-channel-user-count $Ch $count) Ch count)
(on (message (ircd-action $conn (irc-message _ "LIST" $requested-channel-names0 _)))
(define requested-channel-names
(append* (map (lambda (ns) (string-split ns #px",+")) requested-channel-names0)))
(send! (ircd-event conn (irc-message server-prefix 321 '("*" "Channel") "Users Name")))
(for [(Ch (if (null? requested-channel-names)
(in-hash-keys (topics))
(in-list requested-channel-names)))]
(when (hash-has-key? (topics) Ch)
(define topic (hash-ref (topics) Ch))
(define count (hash-ref (counts) Ch 0))
(send! (ircd-event conn (irc-message server-prefix 322 (list "*" Ch count) topic)))))
(send! (ircd-event conn (irc-message server-prefix 323 '("*") "End of /LIST")))))
(spawn #:name 'session-listener-factory
(stop-when-reloaded)
(during/spawn (ircd-listener $port)