X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=8sync%2Fsystems%2Firc.scm;h=d13294c06ea10b200c1dbb226ee80be19be25679;hb=381c180279b47d0536f12da170c3911475af0755;hp=536c9a26ce38ff3e2002fa6b7e15f18db375625f;hpb=165231476f466b4dbeca51c981cf0dfa2963ff16;p=8sync.git diff --git a/8sync/systems/irc.scm b/8sync/systems/irc.scm old mode 100755 new mode 100644 index 536c9a2..d13294c --- a/8sync/systems/irc.scm +++ b/8sync/systems/irc.scm @@ -1,9 +1,6 @@ -#!/usr/bin/guile \ --e main -s -!# - ;;; 8sync --- Asynchronous programming for Guile -;;; Copyright (C) 2015 Christopher Allan Webber +;;; Copyright © 2015, 2016, 2017 Christopher Allan Webber +;;; Copyright © 2023 Janneke Nieuwenhuizen ;;; ;;; This file is part of 8sync. ;;; @@ -24,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) @@ -35,28 +34,158 @@ #:export ( irc-bot-username irc-bot-server irc-bot-channels irc-bot-port - handle-line handle-misc-input - handle-user-join handle-user-quit + irc-bot-init irc-bot-cleanup + dispatch-message handle-message + + default-irc-port ;REMOVEME compat + irc-bot-send-line ;REMOVEME compat + handle-line handle-misc-input)) ;REMOVEME compat + +;;; 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." + (if emote? + (format port "~a emoted ~s in channel ~a\n" + speaker line-text channel-name) + (format port "~a said ~s in channel ~a\n" + speaker line-text channel-name))) + + +;;; Bot +;;; === + +(define-class () + (username #:init-keyword #:username + #:getter irc-bot-username) + (realname #:init-keyword #:realname + #:init-value #f) + (server #:init-keyword #:server + #:getter irc-bot-server) + (channels #:init-keyword #:channels + #:getter irc-bot-channels) + (port #:init-keyword #:port + #:init-value %irc:default-port + #:getter irc-bot-port) + (socket #:accessor irc-bot-socket) + (actions #:allocation #:each-subclass + #:init-thunk (build-actions + (*init* irc-bot-init) + (*cleanup* irc-bot-cleanup) + (main-loop irc-bot-main-loop) + (dispatch-message dispatch-message) + (handle-line handle-line) ;REMOVEME compat + (send-line irc-bot-send-line-action)))) + +(define (irc-bot-realname irc-bot) + (or (slot-ref irc-bot 'realname) + (irc-bot-username irc-bot))) + +(define-method (irc-bot-init (irc-bot ) message) + "Initialize the 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) + + (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)) + +(define-method (irc-bot-cleanup (irc-bot ) message) + (close (irc-bot-socket irc-bot))) + +(define (irc-bot-main-loop irc-bot message) + (define socket (irc-bot-socket irc-bot)) + (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) + 'done) + ;; We've reached the EOF object, which means we should close + ;; the port ourselves and stop looping + ((eof-object? (peek-char socket)) + (close socket) + 'done) + ;; ;; Looks like we've been killed somehow... well, stop running + ;; ;; then! + ;; ((actor-am-i-dead? irc-bot) + ;; (if (not (port-closed? socket)) + ;; (close socket)) + ;; 'done) + ;; Otherwise, let's read till the next line! + (else + (<- (actor-id irc-bot) 'main-loop)))) + +(define* (irc-bot-send-line-action irc-bot message + channel line #:key emote?) + "Action handler for sending lines. Real behavior happens in +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)))) - default-irc-port)) +(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)))))) -;;; Network stuff -;;; ============= +;;; +;;; Compatibility with 0.4.2. +;;; +(define default-irc-port %irc:default-port) +(define irc-eol %irc:eol) -(define default-irc-port 6665) +(define* (irc-bot-send-line irc-bot channel line #:key emote?) + (define socket (irc-bot-socket irc-bot)) + (irc:send-line socket channel line)) -(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)))))) - (fcntl s F_SETFL (logior O_NONBLOCK flags)) - (connect s AF_INET - (inet-pton AF_INET ip-address) - inet-port) - s)) +(define-method (handle-line (irc-bot ) ;REMOVEME compat + 8sync-message + username channel-name line-text emote?) + "Keep compatibility with previous release." + #f) -(define irc-eol "\r\n") +(define-method (handle-misc-input (irc-bot ) ;REMOVEME compat + (line )) + "Keep compatibility with previous release." + #f) (define (startswith-colon? str) (and (> (string-length str) 0) @@ -64,7 +193,7 @@ #\:))) ;; TODO: This needs a cleanup. Maybe even just using a regex is fine. -(define (parse-line line) +(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 :\ @@ -100,21 +229,21 @@ (values #f command (parse-params pre-params))))) -(define (strip-colon-if-necessary string) +(define (strip-colon-if-necessary string) ;REMOVME compat (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) +(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) +(define (condense-privmsg-line line) ;REMOVME compat "Condense message line and do multiple value return of (channel message emote?)" (define (strip-last-char string) @@ -132,120 +261,3 @@ (values channel-name (string-join (cons first-word rest-message) " ") #f))))) - -;;; A goofy default -(define (echo-message irc-bot speaker channel-name - line-text emote?) - "Simply echoes the message to the current-output-port." - (if emote? - (format #t "~a emoted ~s in channel ~a\n" - speaker line-text channel-name) - (format #t "~a said ~s in channel ~a\n" - speaker line-text channel-name))) - - -;;; Bot -;;; === - -(define-class () - (username #:init-keyword #:username - #:getter irc-bot-username) - (realname #:init-keyword #:realname - #:init-value #f) - (server #:init-keyword #:server - #:getter irc-bot-server) - (channels #:init-keyword #:channels - #:getter irc-bot-channels) - (port #:init-keyword #:port - #:init-value default-irc-port - #:getter irc-bot-port) - (socket #:accessor irc-bot-socket) - (actions #:allocation #:each-subclass - #:init-value (build-actions - (init irc-bot-init) - (main-loop irc-bot-main-loop) - (send-line irc-bot-send-line)))) - -(define (irc-bot-realname irc-bot) - (or (slot-ref irc-bot 'realname) - (irc-bot-username irc-bot))) - -(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))) - (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-bot (actor-id irc-bot) 'main-loop)) - -(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) - (cond - ;; The port's been closed for some reason, so stop looping - ((port-closed? socket) - 'done) - ;; We've reached the EOF object, which means we should close - ;; the port ourselves and stop looping - ((eof-object? (peek-char socket)) - (close socket) - 'done) - ;; ;; Looks like we've been killed somehow... well, stop running - ;; ;; then! - ;; ((actor-am-i-dead? irc-bot) - ;; (if (not (port-closed? socket)) - ;; (close socket)) - ;; 'done) - ;; Otherwise, let's read till the next line! - (else - (<- irc-bot (actor-id irc-bot) 'main-loop)))) - -(define* (irc-bot-send-line irc-bot message - channel line #:key emote?) - ;; TODO: emote? handling - (format (irc-bot-socket irc-bot) "PRIVMSG ~a :~a~a" - channel line irc-eol)) - -;;; Likely-to-be-overridden generic methods - -(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 "PONG" (irc-bot-socket irc-bot))) - ("PRIVMSG" - (receive (channel-name line-text emote?) - (condense-privmsg-line line-params) - (let ((username (irc-line-username line-prefix))) - (irc-bot-handle-line irc-bot username channel-name - line-text emote?)))) - (_ (irc-bot-handle-misc-input irc-bot raw-line))))) - -(define-method (handle-line (irc-bot ) username channel-name - line-text emote?) - (echo-message irc-bot username channel-name line-text emote?)) - -(define-method (handle-misc-input (irc-bot ) raw-line) - (display raw-line) - (newline)) - -(define-method (handle-user-join (irc-bot ) user channel) - 'TODO) - -(define-method (handle-user-quit (irc-bot ) user channel) - 'TODO) -