8sync/systems/irc.scm

   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>
   4 ;;;
   5 ;;; This file is part of 8sync.
   6 ;;;
   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.
  11 ;;;
  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.
  16 ;;;
  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/>.
  19
  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)
  34   #:export (<irc-bot>
  35             irc-bot-username irc-bot-server irc-bot-channels irc-bot-port
  36
  37             irc-bot-init irc-bot-cleanup
  38             dispatch-message handle-message))
  39
  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."
  44   (if emote?
  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)))
  49
  50 \f
  51 ;;; Bot
  52 ;;; ===
  53
  54 (define-class <irc-bot> (<actor>)
  55   (username #:init-keyword #:username
  56             #:getter irc-bot-username)
  57   (realname #:init-keyword #:realname
  58             #:init-value #f)
  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
  69                          (*init* irc-bot-init)
  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))))
  74
  75 (define (irc-bot-realname irc-bot)
  76   (or (slot-ref irc-bot 'realname)
  77       (irc-bot-username irc-bot)))
  78
  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)
  83                              #:sleep 8sleep))
  84   (define flags (fcntl socket F_GETFL))
  85
  86   (fcntl socket F_SETFL (logior O_NONBLOCK flags))
  87   (set! (irc-bot-socket irc-bot) socket)
  88
  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))
  92
  93   (for-each (cute irc:join socket <>) (irc-bot-channels irc-bot))
  94
  95   (<- (actor-id irc-bot) 'main-loop))
  96
  97 (define-method (irc-bot-cleanup (irc-bot <irc-bot>) message)
  98   (close (irc-bot-socket irc-bot)))
  99
 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))
 104                       line))
 105   (<- (actor-id irc-bot) 'dispatch-message message)
 106   (cond
 107    ;; The port's been closed for some reason, so stop looping
 108    ((port-closed? socket)
 109     'done)
 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))
 113     (close socket)
 114     'done)
 115    ;; ;; Looks like we've been killed somehow... well, stop running
 116    ;; ;; then!
 117    ;; ((actor-am-i-dead? irc-bot)
 118    ;;  (if (not (port-closed? socket))
 119    ;;      (close socket))
 120    ;;  'done)
 121    ;; Otherwise, let's read till the next line!
 122    (else
 123     (<- (actor-id irc-bot) 'main-loop))))
 124
 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
 128 irc:send-line."
 129   (define socket (irc-bot-socket irc-bot))
 130   (irc:send-line socket channel line #:emote? emote?))
 131
 132 \f
 133 ;;;
 134 ;;; Likely-to-be-overridden generic methods
 135 ;;;
 136 (define-method (dispatch-message (irc-bot <irc-bot>) 8sync-message message)
 137   "Dispatch an <irc:message>."
 138   (match 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))))
 144
 145 (define-method (handle-message (irc-bot <irc-bot>) message)
 146   (match 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)))))