Writing an IRC Bot with Guile Scheme

News

An IRC Bot with Guile Scheme?

Goals

  • Leaving a message for another user who is offline
  • Making it possible to call back chat history (reply to old messages)
  • Attempt to make a simple Matrix bridge
  • Provide a way for community members to connect their IRC account

    Community member puts their IRC nick in a web page, the IRC bot contacts them via private message and asks them to paste a token they got from the web page.

  • Add some fun commands of some sort
  • Make it possible to gather funny quotes from IRC and relay them to the forum somehow

The Final Code

(use-modules (json)
             (irc irc)
             (irc handlers)
             ((irc message) #:renamer (symbol-prefix-proc 'msg:))
             (ice-9 regex)
             (ice-9 match)
             (ice-9 threads)
             (ice-9 textual-ports)
             (web uri)
             (web client)
             (web server)
             (web request)
             (web response)
             (sxml simple)
             (system repl server)
             (system repl coop-server))

(define libera-irc #f)
(define libera-nick "crafter-bot")
(define libera-channel "#systemcrafters-live")

(define (libera-irc-connect)
  (set! libera-irc (make-irc #:nick libera-nick
                             #:realname "Crafter Bot"
                             #:server "irc.libera.chat"
                             #:port 6697
                             #:ssl #t))

  (install-ping-handler! libera-irc)
  (install-printer! libera-irc)

  (do-connect libera-irc)
  (do-register libera-irc)
  ;; (do-privmsg libera-irc "NickServ"
  ;;             (format #f "identify ~a ~a"
  ;;                     libera-nick
  ;;                     (get-libera-pass)))
  (do-wait libera-irc)

  (add-message-hook! libera-irc (lambda (msg)
                                  (libera-message-hook msg)))
  (do-join libera-irc libera-channel))

(define (send-msg! recipient msg-text)
  (do-privmsg libera-irc
              recipient
              msg-text))

(define counter 0)

(define (handle-message msg sender)
  (let* ((message-text (msg:trailing msg))
         (command-parts (string-split message-text #\ ))
         (command (and (pair? command-parts)
                       (car command-parts))))
    (case (and command (string->symbol command))
      ((!hello)
       (send-msg! libera-channel (format #f "Hello, ~a!" sender)))

      ((!slap)
       (let ((target (and (pair? (cdr command-parts))
                          (cadr command-parts))))
         (if target
             (send-msg! libera-channel (format #f "~a slaps ~a around with a bit of trout"
                                sender target))
             (send-msg! libera-channel (format #f "~a slaps themself around with a bit of trout"
                                sender)))))

      ((!leftpad)
       (send-msg! libera-channel "Thank you leftpad 🙏"))

      ;; ((!roll)
      ;;  (let* ((sides (and (pair? (cdr command-parts))
      ;;                     ;; TODO: Make this handle negative numbers!
      ;;                     (with-exception-handler
      ;;                         (lambda (exn) 6)
      ;;                       (lambda ()
      ;;                         (string->number (cadr command-parts)))
      ;;                       #:unwind? #t))))
      ;;    (send-msg! libera-channel (format #f
      ;;                       "You rolled a ~a!"
      ;;                       (+ (random (or (and sides (> 0 sides))
      ;;                                      6)) 1)))))

      ((!profile)
       (send-msg! libera-channel "✅ emacs mention in the profile"))

      ((!forum)
       (send-msg! libera-channel "You can join the forum at https://forum.systemcrafters.net"))

      ((!count)
       (set! counter (+ counter 1))
       (send-msg! libera-channel (format #f "You bothered me ~a times!" counter))))))

(define (handle-private-message msg sender)
  (let ((message-text (msg:trailing msg)))
    (format #t "*** Excuse me, ~a told me this: ~a\n" sender message-text)
    (send-msg! sender (format #f "Hello!  You told me: '~a'" message-text))))

(define (libera-message-hook msg)
  (let ((sender (and (eqv? (msg:prefix-type msg) 'USER)
                   (car (msg:prefix msg)))))
    (when (and sender
               (equal? (msg:command msg) 'PRIVMSG))
      ;; Handle message
      (cond
       ((string=? (msg:middle msg) libera-channel)
        (handle-message msg sender))
       ((string=? (msg:middle msg) libera-nick)
        (handle-private-message msg sender))))))

      ;; (push-message! `((name . ,nick)
      ;;                  (text . ,(msg:trailing msg))))

;;; Message Queue

(define message-queue '())
(define queue-mutex (make-mutex))

(define (push-message! msg)
   (with-mutex queue-mutex
    (set! message-queue (cons msg message-queue))))

(define (pop-messages!)
  (with-mutex queue-mutex
    (let ((msgs message-queue))
      (set! message-queue '())
      msgs)))

;;; Main Threads

(define repl-server-socket
  (make-tcp-server-socket #:port 37147))

(define irc-thread
  (call-with-new-thread
   (lambda ()
     (define repl-server (spawn-coop-repl-server repl-server-socket))

     (format #t "Connecting to IRC...\n")
     (libera-irc-connect)
     (format #t "IRC connected, polling...\n")

     (while #t
       (poll-coop-repl-server repl-server)
       (let ((msg (do-listen libera-irc)))
         (when msg
           (run-message-hook libera-irc msg)))

       (usleep 500)))))

(join-thread irc-thread)
Subscribe to the System Crafters Newsletter!
Stay up to date with the latest System Crafters news and updates! Read the Newsletter page for more information.
Name (optional)
Email Address