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)

Enjoyed this stream? Explore our hands-on courses for deeper, structured learning on Guile Scheme and more.

Get the System Crafters Newsletter
Updates on open source tools, tutorials, and community projects. We'll also occasionally let you know about new courses and resources.
Name (optional)
Email Address