From 6430952b5dc2df536f9d1d8548f92db9b212f72a Mon Sep 17 00:00:00 2001 From: Jaidyn Levesque <10477760+JadedCtrl@users.noreply.github.com> Date: Fri, 6 Jan 2023 11:51:54 -0600 Subject: [PATCH] IRCv3 CAP negotation + userhost-in-name; Storing data of server users Adds basic support for IRCv3's capability negoation, along with support for userhost-in-name. Also adds storing data associated with a specific user, with irc:user-* functions; right now, the only value used is 'hostmask, which is stored when the user's hostmask is encountered. --- ircc.scm | 113 +++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 101 insertions(+), 12 deletions(-) diff --git a/ircc.scm b/ircc.scm index 8f4a62c..cd650a9 100644 --- a/ircc.scm +++ b/ircc.scm @@ -18,7 +18,7 @@ (import scheme (chicken io) (chicken tcp) - srfi-1 srfi-69 srfi-130 + srfi-1 srfi-19 srfi-69 srfi-130 openssl) @@ -37,7 +37,10 @@ (hash-table-set! conn 'nick nick) (hash-table-set! conn 'realname realname) (hash-table-set! conn 'channels (make-hash-table)) + (hash-table-set! conn 'users (make-hash-table)) + (hash-table-set! conn 'capabilities '()) + (irc:write-cmd conn "CAP" "REQ" "userhost-in-names") (if password (irc:write-cmd conn "PASS" password)) (irc:write-cmd conn "USER" username "*" "0" @@ -87,6 +90,7 @@ ;; Write a line to the IRC server connection. (define (irc:write-line text connection) + (print text) (write-line text (hash-table-ref connection 'in))) @@ -130,7 +134,10 @@ (irc:channel-set! conn channel 'symbol chan-symbol) (apply (lambda (user) - (irc:channel-user-add! conn channel user)) + (irc:channel-user-add! conn channel (irc:hostmask-nick user)) + (irc:user-add! conn (irc:hostmask-nick user)) + (if (irc:hostmask? user) + (irc:user-set! conn (irc:hostmask-nick user) 'hostmask user))) users))])) @@ -138,25 +145,67 @@ (define (irc:process-command-internally conn command params #!optional sender) (cond [(string=? command "PING") (irc:write-cmd conn "PONG" (last params))] + [(and (string=? command "CAP") + (string=? (second params) "ACK")) + (hash-table-set! conn 'capabilities (map string->symbol (cddr params))) + (irc:write-cmd conn "CAP" "END")] [(string=? command "JOIN") (let ([room-name (car params)] - [new-user (car (string-split sender "!"))]) + [new-user sender]) (if (irc:user-is-self? conn new-user) (irc:channel-add! conn room-name)) - (irc:channel-user-add! conn room-name new-user))])) + (if (irc:hostmask? new-user) + (irc:user-set! conn (irc:hostmask-nick new-user) + 'hostmask new-user)) + (irc:channel-user-add! conn room-name (irc:hostmask-nick 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))) +;; Return whether or not the given capability has been agreed upon +;; between the server and this connection +(define (irc:capability? conn capability) + (member capability (hash-table-ref conn 'capabilities))) + + +;; Add a user of the given nick to the internal list of users +(define (irc:user-add! conn nick) + (let ([users-table (hash-table-ref conn 'users)]) + (if (not (hash-table-exists? users-table nick)) + (hash-table-set! users-table nick '())))) + + +;; Remove a user from the internal list of users +(define (irc:user-delete! conn nick) + (hash-table-delete! (hash-table-ref conn 'users) nick)) + + +;; Associate a piece of data with a user, by nick +(define (irc:user-set! conn nick key value) + (let ([users-table (hash-table-ref conn 'users)]) + (irc:user-add! conn nick) + (hash-table-set! + users-table nick + (alist-update key value + (irc:user-alist conn nick))))) + + +;; Return a pice of stored data relating to a user, by nick +(define (irc:user-get conn nick key) + (irc:user-add! conn nick) + (alist-car-ref key (irc:user-alist conn nick))) + + +;; Return an alist of data stored relating to the given user +(define (irc:user-alist conn nick) + (let ([users-hash (hash-table-ref conn 'users)]) + (irc:user-add! conn nick) + (if (hash-table-exists? users-hash nick) + (hash-table-ref users-hash nick) + #f))) ;; Add a channel of name `chan` to the internal list of channels @@ -166,7 +215,7 @@ ;; Remove a channel of name `chan` from the internal list of channels -(define (irc:channel-remove! conn chan) +(define (irc:channel-delete! conn chan) (hash-table-remove! (hash-table-ref conn 'channels) chan)) @@ -308,11 +357,13 @@ ;; Returns a list of parameters from the parsed-out verb section of a line (define (irc:line-verb-params verb) + (print verb) (let* ([params (cdr verb)] [other-params '()] [last-param '()]) (map (lambda (param) (cond + [(string-null? param) #f] [(and (string=? (string-take param 1) ":") (null? last-param)) (set! last-param @@ -331,6 +382,43 @@ last-param))))) +;; ————————————————————————————————————————————————————————————————————————————— +;; Mucking around with hostmasks +;; ————————————————————————————————————————————————————————————————————————————— + +;; Return the nick part of a hostmask +(define (irc:hostmask-nick hostmask) + (car (string-split hostmask "!"))) + + +;; The username/ident part of a hostmask +(define (irc:hostmask-ident hostmask) + (car (string-split (cadr (string-split hostmask "!")) + "@"))) + + +;; The host part of a hostmask +(define (irc:hostmask-host hostmask) + (cadr (string-split hostmask "@"))) + + +;; Return whether or not a string is likely a valid hostmask +(define (irc:hostmask? string) + (let ([at-! (string-contains string "!")] + [at-@ (string-contains string "@")] + [at-. (string-contains string ".")]) + (and at-! at-@ at-. + (string-cursor