Store information on joined channels and channel membership
When a user JOINs or is in RPL_NAMREPLY, it will be saved; all rooms whch the client joins will be saved in a channel list, as well.
This commit is contained in:
parent
60df8be95e
commit
fe77077c68
153
ircc.scm
153
ircc.scm
|
|
@ -22,6 +22,10 @@
|
|||
openssl)
|
||||
|
||||
|
||||
;; ——————————————————————————————————————————————————————————————————————————————
|
||||
;; Main
|
||||
;; ——————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
;; Connect to the given IRC server, returning an IRC connection object.
|
||||
(define (irc:connect host port username nick #!optional (password #f) (realname #f))
|
||||
(let ([conn (make-hash-table)])
|
||||
|
|
@ -29,6 +33,10 @@
|
|||
(ssl-connect* hostname: host port: port))
|
||||
(hash-table-set! conn 'in in)
|
||||
(hash-table-set! conn 'out out)
|
||||
(hash-table-set! conn 'username username)
|
||||
(hash-table-set! conn 'nick nick)
|
||||
(hash-table-set! conn 'realname realname)
|
||||
(hash-table-set! conn 'channels (make-hash-table))
|
||||
|
||||
(if password
|
||||
(irc:write-cmd conn "PASS" password))
|
||||
|
|
@ -38,6 +46,26 @@
|
|||
conn))
|
||||
|
||||
|
||||
;; Basic loop for using an IRC connection, using two hook functions:
|
||||
;; (on-command connection command params sender)
|
||||
;; (on-reply connection reply-code params sender)
|
||||
(define (irc:loop connection on-command on-reply)
|
||||
(let* ([output (irc:read-alist connection)]
|
||||
[command (alist-ref 'command output)]
|
||||
[reply (alist-ref 'reply output)]
|
||||
[params (alist-ref 'params output)]
|
||||
[sender (alist-ref 'sender output)])
|
||||
(if (and on-command (car command))
|
||||
(apply on-command (append (list connection) command (list params) sender)))
|
||||
(if (and on-reply (car reply))
|
||||
(apply on-reply (append (list connection) reply (list params) sender)))
|
||||
(irc:loop connection on-command on-reply)))
|
||||
|
||||
|
||||
;; ——————————————————————————————————————————————————————————————————————————————
|
||||
;; I/O
|
||||
;; ——————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
;; Read-in the next reply or command from the server, into a parsable alist with
|
||||
;; four keys:
|
||||
(define (irc:read-alist conn)
|
||||
|
|
@ -62,13 +90,9 @@
|
|||
(write-line text (hash-table-ref connection 'in)))
|
||||
|
||||
|
||||
;; Join the given channel. Not much to say, really.
|
||||
(define (irc:join conn channel #!optional key)
|
||||
(let* ([params-sans-key (list conn "JOIN" channel)]
|
||||
[params (if key (append params-sans-key `(,key))
|
||||
params-sans-key)])
|
||||
(apply irc:write-cmd params)))
|
||||
|
||||
;; ——————————————————————————————————————————————————————————————————————————————
|
||||
;; Processing/saving metadata
|
||||
;; ——————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
;; The user should have more-or-less total control over how to respond to
|
||||
;; received messages, but ircc has to sneakily process some responses itself,
|
||||
|
|
@ -87,15 +111,102 @@
|
|||
;; Handle some replies necssary for basic functionality
|
||||
(define (irc:process-reply-internally conn reply params #!optional sender)
|
||||
(cond [(eq? reply RPL_WELCOME)
|
||||
(hash-table-set! conn 'registered #t)]))
|
||||
(hash-table-set! conn 'registered #t)
|
||||
(hash-table-set! conn 'nick (car params))]
|
||||
[(eq? reply RPL_NAMREPLY)
|
||||
(let ([channel (third params)]
|
||||
[chan-symbol (second params)]
|
||||
[users (cdddr params)])
|
||||
(irc:channel-set! conn channel 'symbol chan-symbol)
|
||||
(apply
|
||||
(lambda (user)
|
||||
(irc:channel-user-add! conn channel user))
|
||||
users))]))
|
||||
|
||||
|
||||
;; Handle some commands necessary for basic funcitonality
|
||||
;; Handle some commands necessary for basic functionality
|
||||
(define (irc:process-command-internally conn command params #!optional sender)
|
||||
(cond [(string=? command "PING")
|
||||
(irc:write-cmd conn "PONG" (last params))]))
|
||||
(irc:write-cmd conn "PONG" (last params))]
|
||||
[(string=? command "JOIN")
|
||||
(let ([room-name (car params)]
|
||||
[new-user (car (string-split sender "!"))])
|
||||
(if (irc:user-is-self? conn new-user)
|
||||
(irc:channel-add! conn room-name))
|
||||
(irc:channel-user-add! conn room-name new-user))]))
|
||||
|
||||
|
||||
;; ——————————————————————————————————————————————————————————————————————————————
|
||||
;; Metadata accessors
|
||||
;; ——————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
;; Return whether or not the given string (username/nick/whatever) is equivalent
|
||||
;; to current user.
|
||||
(define (irc:user-is-self? conn user-string)
|
||||
(or (string=? (hash-table-ref conn 'username) user-string)
|
||||
(string=? (hash-table-ref conn 'nick)
|
||||
(car (string-split user-string "!")))
|
||||
(string=? (hash-table-ref conn 'client) user-string)))
|
||||
|
||||
|
||||
;; Add a channel of name `chan` to the internal list of channels
|
||||
(define (irc:channel-add! conn chan)
|
||||
(hash-table-set! (hash-table-ref conn 'channels) chan (make-hash-table))
|
||||
(hash-table-set! (irc:channel-table conn chan) 'users '()))
|
||||
|
||||
|
||||
;; Remove a channel of name `chan` from the internal list of channels
|
||||
(define (irc:channel-remove! conn chan)
|
||||
(hash-table-remove! (hash-table-ref conn 'channels) chan))
|
||||
|
||||
|
||||
;; Return a list of saved channels by name
|
||||
(define (irc:channels conn)
|
||||
(hash-table-keys (hash-table-ref conn 'channels)))
|
||||
|
||||
|
||||
;; Return a saved channel's table
|
||||
(define (irc:channel-table conn chan)
|
||||
(hash-table-ref (hash-table-ref conn 'channels) chan))
|
||||
|
||||
|
||||
;; Get a stored value associated with a channel, by key
|
||||
(define (irc:channel-get conn chan key)
|
||||
(hash-table-ref (irc:channel-table conn chan) key))
|
||||
|
||||
|
||||
;; Associate a value with a given channel, by key
|
||||
(define (irc:channel-set! conn chan key value)
|
||||
(hash-table-set! (irc:channel-table conn chan)
|
||||
key value))
|
||||
|
||||
|
||||
;; Returns a list of users that are stored as members of the given channel
|
||||
(define (irc:channel-users conn chan)
|
||||
(irc:channel-get conn chan 'users))
|
||||
|
||||
|
||||
;; Add a user to a channel's list of users, by nick
|
||||
(define (irc:channel-user-add! conn chan nick)
|
||||
(irc:channel-set!
|
||||
conn chan 'users
|
||||
(append (irc:channel-get conn chan 'users)
|
||||
(list nick))))
|
||||
|
||||
|
||||
;; Remove a user from a channel's list of users, by nick
|
||||
(define (irc:channel-user-del! conn chan nick)
|
||||
(irc:channel-set!
|
||||
conn chan 'users
|
||||
(filter (lambda (a-nick)
|
||||
(not (string=? nick a-nick)))
|
||||
(irc:channel-users conn name))))
|
||||
|
||||
|
||||
;; —————————————————————————————————————————————————————————————————————————————
|
||||
;; Parsing lines/commands
|
||||
;; —————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
;; Construct a string to write to IRC for the given command and parameters.
|
||||
(define (irc:cmd->string command . parameters)
|
||||
(let ([parameters
|
||||
|
|
@ -133,21 +244,9 @@
|
|||
(sender ,sender))))
|
||||
|
||||
|
||||
;; Basic loop for using an IRC connection, using two hook functions:
|
||||
;; (on-command connection command params sender)
|
||||
;; (on-reply connection reply-code params sender)
|
||||
(define (irc:loop connection on-command on-reply)
|
||||
(let* ([output (irc:read-alist connection)]
|
||||
[command (alist-ref 'command output)]
|
||||
[reply (alist-ref 'reply output)]
|
||||
[params (alist-ref 'params output)]
|
||||
[sender (alist-ref 'sender output)])
|
||||
(if (and on-command (car command))
|
||||
(apply on-command (append (list connection) command (list params) sender)))
|
||||
(if (and on-reply (car reply))
|
||||
(apply on-reply (append (list connection) reply (list params) sender)))
|
||||
(irc:loop connection on-command on-reply)))
|
||||
|
||||
;; —————————————————————————————————————————————————————————————————————————————
|
||||
;; Misc. helpers
|
||||
;; —————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
;; Just car's the value of alist-ref (if it exists)
|
||||
(define (alist-car-ref key alist)
|
||||
|
|
@ -157,6 +256,10 @@
|
|||
#f)))
|
||||
|
||||
|
||||
;; —————————————————————————————————————————————————————————————————————————————
|
||||
;; IRC constants
|
||||
;; —————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
(define RPL_WELCOME 1)
|
||||
(define RPL_WHOISUSER 311)
|
||||
(define RPL_ENDOFWHO 315)
|
||||
|
|
|
|||
Reference in New Issue