diff --git a/ircc.scm b/ircc.scm index bc0256b..c820cd9 100644 --- a/ircc.scm +++ b/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)