From a82db588459534f845e0c64fcac6d289b3c01a03 Mon Sep 17 00:00:00 2001 From: Janneke Nieuwenhuizen Date: Sun, 13 Aug 2023 11:18:12 +0200 Subject: [PATCH] irc: Refactor using (8sync contrib irc) library from Snuik. Switch to new IRC library while retaining 0.4.2 api compatibility. * 8sync/systems/irc.scm: Rewrite using low level irc functions from (8sync contrib irc). (irc-socket-setup): Remove, (): Update to use %irc:default-port. Add dispatch-message handler. (irc-bot-init): Refactor using irc:listen, irc:user, irc:nick. (irc-bot-main-loop): Dispatch to... (dispatch-message): ...this new message handler. (handle-message): New overridable handler. Invoke legacy handle-misc-input and handle-line handlers for PRIVMSG. --- 8sync/systems/irc.scm | 296 +++++++++++++++++++++--------------------- 1 file changed, 146 insertions(+), 150 deletions(-) diff --git a/8sync/systems/irc.scm b/8sync/systems/irc.scm index 0007de8..ac4efa6 100644 --- a/8sync/systems/irc.scm +++ b/8sync/systems/irc.scm @@ -21,7 +21,9 @@ #:use-module (8sync repl) #:use-module (8sync agenda) #:use-module (8sync actors) + #:use-module (8sync contrib irc) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) #:use-module (ice-9 getopt-long) #:use-module (ice-9 format) #:use-module (ice-9 receive) @@ -32,109 +34,13 @@ #:export ( irc-bot-username irc-bot-server irc-bot-channels irc-bot-port - irc-bot-send-line + dispatch-message handle-message - handle-line handle-misc-input - handle-user-join handle-user-quit + default-irc-port ;REMOVEME compat + irc-bot-send-line ;REMOVEME compat + handle-line handle-misc-input)) ;REMOVEME compat - default-irc-port)) - - -;;; Network stuff -;;; ============= - -(define default-irc-port 6665) - -(define* (irc-socket-setup hostname #:optional (inet-port default-irc-port)) - (let* ((s (socket PF_INET SOCK_STREAM 0)) - (flags (fcntl s F_GETFL)) - (ip-address (inet-ntop AF_INET (car (hostent:addr-list (gethost hostname)))))) - (cond (s - (fcntl s F_SETFL (logior O_NONBLOCK flags)) - (connect s AF_INET (inet-pton AF_INET ip-address) inet-port) - s) - (else - (8sleep 1) - (irc-socket-setup hostname inet-port))))) - -(define irc-eol "\r\n") - -(define (startswith-colon? str) - (and (> (string-length str) 0) - (eq? (string-ref str 0) - #\:))) - -;; TODO: This needs a cleanup. Maybe even just using a regex is fine. -(define (parse-line line) - (define (parse-params pre-params) - ;; This is stupid and imperative but I can't wrap my brain around - ;; the right way to do it in a functional way :\ - (let ((param-list '()) - (currently-building '())) - (for-each - (lambda (param-item) - (cond - ((startswith-colon? param-item) - (if (not (eq? currently-building '())) - (set! param-list - (cons - (reverse currently-building) - param-list))) - (set! currently-building (list param-item))) - (else - (set! currently-building (cons param-item currently-building))))) - pre-params) - ;; We're still building something, so tack that on there - (if (not (eq? currently-building '())) - (set! param-list - (cons (reverse currently-building) param-list))) - ;; return the reverse of the param list - (reverse param-list))) - - (match (string-split line #\space) - (((? startswith-colon? prefix) - command - pre-params ...) - (values prefix command - (parse-params pre-params))) - ((command pre-params ...) - (values #f command - (parse-params pre-params))))) - -(define (strip-colon-if-necessary string) - (if (and (> (string-length string) 0) - (string-ref string 0)) - (substring/copy string 1) - string)) - -;; @@: Not sure if this works in all cases, like what about in a non-privmsg one? -(define (irc-line-username irc-line-prefix) - (let* ((prefix-name (strip-colon-if-necessary irc-line-prefix)) - (exclaim-index (string-index prefix-name #\!))) - (if exclaim-index - (substring/copy prefix-name 0 exclaim-index) - prefix-name))) - -(define (condense-privmsg-line line) - "Condense message line and do multiple value return of - (channel message emote?)" - (define (strip-last-char string) - (substring/copy string 0 (- (string-length string) 1))) - (let* ((channel-name (caar line)) - (rest-params (apply append (cdr line)))) - (match rest-params - (((or "\x01ACTION" ":\x01ACTION") middle-words ... (= strip-last-char last-word)) - (values channel-name - (string-join - (append middle-words (list last-word)) - " ") - #t)) - (((= strip-colon-if-necessary first-word) rest-message ...) - (values channel-name - (string-join (cons first-word rest-message) " ") - #f))))) - -;;; A goofy default +;;; A goofy default handler. (define* (echo-message irc-bot speaker channel-name line-text emote? #:key (port (current-output-port))) "Simply echoes the message to the PORT." @@ -158,7 +64,7 @@ (channels #:init-keyword #:channels #:getter irc-bot-channels) (port #:init-keyword #:port - #:init-value default-irc-port + #:init-value %irc:default-port #:getter irc-bot-port) (socket #:accessor irc-bot-socket) (actions #:allocation #:each-subclass @@ -166,7 +72,8 @@ (*init* irc-bot-init) (*cleanup* irc-bot-cleanup) (main-loop irc-bot-main-loop) - (handle-line handle-line) + (dispatch-message dispatch-message) + (handle-line handle-line) ;REMOVEME compat (send-line irc-bot-send-line-action)))) (define (irc-bot-realname irc-bot) @@ -175,20 +82,19 @@ (define (irc-bot-init irc-bot message) "Initialize the IRC bot" - (define socket - (irc-socket-setup (irc-bot-server irc-bot) - (irc-bot-port irc-bot))) + (define socket (irc:listen (irc-bot-server irc-bot) + #:port (irc-bot-port irc-bot) + #:sleep 8sleep)) + (define flags (fcntl socket F_GETFL)) + + (fcntl socket F_SETFL (logior O_NONBLOCK flags)) (set! (irc-bot-socket irc-bot) socket) - (format socket "USER ~a ~a ~a :~a~a" - (irc-bot-username irc-bot) - "*" "*" ; hostname and servername - (irc-bot-realname irc-bot) irc-eol) - (format socket "NICK ~a~a" (irc-bot-username irc-bot) irc-eol) - (for-each - (lambda (channel) - (format socket "JOIN ~a~a" channel irc-eol)) - (irc-bot-channels irc-bot)) + (irc:user socket (irc-bot-username irc-bot) + #:real (irc-bot-realname irc-bot)) + (irc:nick socket (irc-bot-username irc-bot)) + + (for-each (cute irc:join socket <>) (irc-bot-channels irc-bot)) (<- (actor-id irc-bot) 'main-loop)) @@ -197,8 +103,10 @@ (define (irc-bot-main-loop irc-bot message) (define socket (irc-bot-socket irc-bot)) - (define line (string-trim-right (read-line socket) #\return)) - (dispatch-raw-line irc-bot line) + (define line (irc:receive socket)) + (define message (or (false-if-exception (irc:line->message line)) + line)) + (<- (actor-id irc-bot) 'dispatch-message message) (cond ;; The port's been closed for some reason, so stop looping ((port-closed? socket) @@ -221,46 +129,134 @@ (define* (irc-bot-send-line-action irc-bot message channel line #:key emote?) "Action handler for sending lines. Real behavior happens in -irc-bot-send-line." - (irc-bot-send-line irc-bot channel line #:emote? emote?)) +irc:send-line." + (define socket (irc-bot-socket irc-bot)) + (irc:send-line socket channel line #:emote? emote?)) + + +;;; +;;; Likely-to-be-overridden generic methods +;;; +(define-method (dispatch-message (irc-bot ) 8sync-message message) + "Dispatch an ." + (match message + ((and ($ ) + (= irc:message-command 'PING) + (= irc:message-message message)) + (irc:pong (irc-bot-socket irc-bot) message)) + (_ (handle-message irc-bot message)))) + +(define-method (handle-message (irc-bot ) message) + (match message + ((and ($ ) + (= irc:message-line line) + (= irc:message-command command) + (= irc:message-speaker speaker) + (= irc:message-channel channel) + (= irc:message-message message) + (= irc:message-emote? emote?)) + (or + (case command + ((PRIVMSG) + (handle-line irc-bot #f speaker channel message emote?)) ;REMOVEME compat + (else + (handle-misc-input irc-bot line))) ;REMOVEME compat + (echo-message irc-bot speaker channel message #f + #:port (current-error-port)))))) + + +;;; +;;; Compatibility with 0.4.2. +;;; +(define default-irc-port %irc:default-port) +(define irc-eol %irc:eol) (define* (irc-bot-send-line irc-bot channel line #:key emote?) - ;; TODO: emote? handling - (format (irc-bot-socket irc-bot) "PRIVMSG ~a :~a~a" - channel line irc-eol)) + (define socket (irc-bot-socket irc-bot)) + (irc:send-line socket channel line)) +(define-method (handle-line (irc-bot ) ;REMOVEME compat + 8sync-message + username channel-name line-text emote?) + "Keep compatibility with previous release." + #f) -;;; Likely-to-be-overridden generic methods +(define-method (handle-misc-input (irc-bot ) ;REMOVEME compat + (line )) + "Keep compatibility with previous release." + #f) -(define-method (dispatch-raw-line (irc-bot ) raw-line) - "Dispatch a raw line of input" - (receive (line-prefix line-command line-params) - (parse-line raw-line) - (match line-command - ("PING" - (display (string-append "PONG" irc-eol) - (irc-bot-socket irc-bot))) - ("PRIVMSG" - (receive (channel-name line-text emote?) - (condense-privmsg-line line-params) - (let ((username (irc-line-username line-prefix))) - (<- (actor-id irc-bot) 'handle-line - username channel-name - line-text emote?)))) - (_ (handle-misc-input irc-bot raw-line))))) +(define (startswith-colon? str) + (and (> (string-length str) 0) + (eq? (string-ref str 0) + #\:))) -(define-method (handle-line (irc-bot ) message - username channel-name line-text emote?) - (echo-message irc-bot username channel-name line-text emote? - #:port (current-error-port))) +;; TODO: This needs a cleanup. Maybe even just using a regex is fine. +(define (parse-line line) ;REMOVEME compat + (define (parse-params pre-params) + ;; This is stupid and imperative but I can't wrap my brain around + ;; the right way to do it in a functional way :\ + (let ((param-list '()) + (currently-building '())) + (for-each + (lambda (param-item) + (cond + ((startswith-colon? param-item) + (if (not (eq? currently-building '())) + (set! param-list + (cons + (reverse currently-building) + param-list))) + (set! currently-building (list param-item))) + (else + (set! currently-building (cons param-item currently-building))))) + pre-params) + ;; We're still building something, so tack that on there + (if (not (eq? currently-building '())) + (set! param-list + (cons (reverse currently-building) param-list))) + ;; return the reverse of the param list + (reverse param-list))) -(define-method (handle-misc-input (irc-bot ) raw-line) - (display raw-line) - (newline)) + (match (string-split line #\space) + (((? startswith-colon? prefix) + command + pre-params ...) + (values prefix command + (parse-params pre-params))) + ((command pre-params ...) + (values #f command + (parse-params pre-params))))) -(define-method (handle-user-join (irc-bot ) user channel) - 'TODO) +(define (strip-colon-if-necessary string) ;REMOVME compat + (if (and (> (string-length string) 0) + (string-ref string 0)) + (substring/copy string 1) + string)) -(define-method (handle-user-quit (irc-bot ) user channel) - 'TODO) +;; @@: Not sure if this works in all cases, like what about in a non-privmsg one? +(define (irc-line-username irc-line-prefix) ;REMOVME compat + (let* ((prefix-name (strip-colon-if-necessary irc-line-prefix)) + (exclaim-index (string-index prefix-name #\!))) + (if exclaim-index + (substring/copy prefix-name 0 exclaim-index) + prefix-name))) +(define (condense-privmsg-line line) ;REMOVME compat + "Condense message line and do multiple value return of + (channel message emote?)" + (define (strip-last-char string) + (substring/copy string 0 (- (string-length string) 1))) + (let* ((channel-name (caar line)) + (rest-params (apply append (cdr line)))) + (match rest-params + (((or "\x01ACTION" ":\x01ACTION") middle-words ... (= strip-last-char last-word)) + (values channel-name + (string-join + (append middle-words (list last-word)) + " ") + #t)) + (((= strip-colon-if-necessary first-word) rest-message ...) + (values channel-name + (string-join (cons first-word rest-message) " ") + #f))))) -- 2.31.1