1 ;;; 8sync --- Asynchronous programming for Guile
2 ;;; Copyright © 2015, 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
3 ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
5 ;;; This file is part of 8sync.
7 ;;; 8sync is free software: you can redistribute it and/or modify it
8 ;;; under the terms of the GNU Lesser General Public License as
9 ;;; published by the Free Software Foundation, either version 3 of the
10 ;;; License, or (at your option) any later version.
12 ;;; 8sync is distributed in the hope that it will be useful,
13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU Lesser General Public License for more details.
17 ;;; You should have received a copy of the GNU Lesser General Public
18 ;;; License along with 8sync. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (8sync systems irc)
21 #:use-module (8sync repl)
22 #:use-module (8sync agenda)
23 #:use-module (8sync actors)
24 #:use-module (8sync contrib irc)
25 #:use-module (srfi srfi-9)
26 #:use-module (srfi srfi-26)
27 #:use-module (ice-9 getopt-long)
28 #:use-module (ice-9 format)
29 #:use-module (ice-9 receive)
30 #:use-module (ice-9 rdelim)
31 #:use-module (ice-9 q)
32 #:use-module (ice-9 match)
33 #:use-module (oop goops)
35 irc-bot-username irc-bot-server irc-bot-channels irc-bot-port
37 irc-bot-init irc-bot-cleanup
38 dispatch-message handle-message))
40 ;;; A goofy default handler.
41 (define* (echo-message irc-bot speaker channel-name
42 line-text emote? #:key (port (current-output-port)))
43 "Simply echoes the message to the PORT."
45 (format port "~a emoted ~s in channel ~a\n"
46 speaker line-text channel-name)
47 (format port "~a said ~s in channel ~a\n"
48 speaker line-text channel-name)))
54 (define-class <irc-bot> (<actor>)
55 (username #:init-keyword #:username
56 #:getter irc-bot-username)
57 (realname #:init-keyword #:realname
59 (server #:init-keyword #:server
60 #:getter irc-bot-server)
61 (channels #:init-keyword #:channels
62 #:getter irc-bot-channels)
63 (port #:init-keyword #:port
64 #:init-value %irc:default-port
65 #:getter irc-bot-port)
66 (socket #:accessor irc-bot-socket)
67 (actions #:allocation #:each-subclass
68 #:init-thunk (build-actions
70 (*cleanup* irc-bot-cleanup)
71 (main-loop irc-bot-main-loop)
72 (dispatch-message dispatch-message)
73 (send-line irc-bot-send-line-action))))
75 (define (irc-bot-realname irc-bot)
76 (or (slot-ref irc-bot 'realname)
77 (irc-bot-username irc-bot)))
79 (define-method (irc-bot-init (irc-bot <irc-bot>) message)
80 "Initialize the IRC bot"
81 (define socket (irc:listen (irc-bot-server irc-bot)
82 #:port (irc-bot-port irc-bot)
84 (define flags (fcntl socket F_GETFL))
86 (fcntl socket F_SETFL (logior O_NONBLOCK flags))
87 (set! (irc-bot-socket irc-bot) socket)
89 (irc:user socket (irc-bot-username irc-bot)
90 #:real (irc-bot-realname irc-bot))
91 (irc:nick socket (irc-bot-username irc-bot))
93 (for-each (cute irc:join socket <>) (irc-bot-channels irc-bot))
95 (<- (actor-id irc-bot) 'main-loop))
97 (define-method (irc-bot-cleanup (irc-bot <irc-bot>) message)
98 (close (irc-bot-socket irc-bot)))
100 (define (irc-bot-main-loop irc-bot message)
101 (define socket (irc-bot-socket irc-bot))
102 (define line (irc:receive socket))
103 (define message (or (false-if-exception (irc:line->message line))
105 (<- (actor-id irc-bot) 'dispatch-message message)
107 ;; The port's been closed for some reason, so stop looping
108 ((port-closed? socket)
110 ;; We've reached the EOF object, which means we should close
111 ;; the port ourselves and stop looping
112 ((eof-object? (peek-char socket))
115 ;; ;; Looks like we've been killed somehow... well, stop running
117 ;; ((actor-am-i-dead? irc-bot)
118 ;; (if (not (port-closed? socket))
121 ;; Otherwise, let's read till the next line!
123 (<- (actor-id irc-bot) 'main-loop))))
125 (define* (irc-bot-send-line-action irc-bot message
126 channel line #:key emote?)
127 "Action handler for sending lines. Real behavior happens in
129 (define socket (irc-bot-socket irc-bot))
130 (irc:send-line socket channel line #:emote? emote?))
134 ;;; Likely-to-be-overridden generic methods
136 (define-method (dispatch-message (irc-bot <irc-bot>) 8sync-message message)
137 "Dispatch an <irc:message>."
139 ((and ($ <irc:message>)
140 (= irc:message-command 'PING)
141 (= irc:message-message message))
142 (irc:pong (irc-bot-socket irc-bot) message))
143 (_ (handle-message irc-bot message))))
145 (define-method (handle-message (irc-bot <irc-bot>) message)
147 ((and ($ <irc:message>)
148 (= irc:message-line line)
149 (= irc:message-command command)
150 (= irc:message-speaker speaker)
151 (= irc:message-channel channel)
152 (= irc:message-message message)
153 (= irc:message-emote? emote?))
154 (echo-message irc-bot speaker channel message #f
155 #:port (current-error-port)))))