;; Botbot: Very basic IRC bot
+;;
+;; Copyright (C) 2023 plugd
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(import (chicken io)
(chicken port)
(chicken string)
(chicken pathname)
(chicken process-context)
+ (chicken condition)
(chicken irregex)
- matchable srfi-13 srfi-1
- uri-common tcp6 openssl)
+ matchable srfi-13 srfi-1 srfi-18
+ tcp6 openssl)
;; Globals
-(define nick "botbot")
-(define username "#phloggersgarage bot")
+(define irc-host #f)
+(define irc-port #f)
+(define bot-nick #f)
+(define bot-channel #f)
+(define bot-proc-file #f)
+(define usetls #t)
+(define allow-reload #f)
+
+(define bot-proc #f)
+
+(define verbosity-level 0)
+
+(define ping-period 60) ;seconds
(tcp-read-timeout #f) ;disable read timeout
-(define (launch-bot host port)
- (let-values (((in-port out-port) (tcp-connect host port)))
+(define (launch-bot)
+ ;; (let-values (((in-port out-port) (tcp-connect host port)))
+ (set-buffering-mode! (current-output-port) #:line)
+ (let-values (((in-port out-port)
+ (if usetls
+ (ssl-connect* hostname: irc-host port: (or irc-port 6697))
+ (tcp-connect irc-host (or irc-port 6667)))))
;; Connect to server
(if (establish-connection in-port out-port)
;; (bot-loop in-port out-port)
(begin
(print "Successfully connected!")
+ (start-ping-timer out-port)
(bot-loop in-port out-port))
(print "Failed to establish connection. Aborting..."))))
(define (establish-connection in-port out-port)
- (write-msg `(#f #f "NICK" (,nick)) out-port)
- (write-msg `(#f #f "USER" (,nick "0" "*" ,username)) out-port)
- (let ((msg (read-msg in-port)))
- (print msg)
- (string=? (msg-command msg) "001")))
+ (write-msg `(#f #f "NICK" (,bot-nick)) out-port)
+ (write-msg `(#f #f "USER" (,bot-nick "0" "*" ,bot-nick)) out-port)
+ (if bot-channel
+ (write-msg `(#f #f "JOIN" (,bot-channel)) out-port))
+ #t)
+
+(define (start-ping-timer out-port)
+ (thread-start!
+ (lambda ()
+ (let loop ()
+ (thread-sleep! ping-period)
+ (write-msg `(#f #f "PING" (,irc-host)) out-port) ; send ping
+ (loop)))))
+
+(define (load-bot)
+ (let ((new-bot-proc
+ (condition-case
+ (eval (with-input-from-file bot-proc-file read))
+ (o (exn)
+ (print-error-message o)
+ #f))))
+ (if new-bot-proc
+ (begin
+ (set! bot-proc new-bot-proc)
+ (print "Loaded bot procedure file."))
+ (print "Error loading procedure file."))
+ new-bot-proc))
(define (bot-loop in-port out-port)
- (let loop ((msg (read-msg in-port)))
- (match (cons (msg-source msg) (cons (msg-command msg) (msg-args msg)))
- ((_ "PING" token)
- (write-msg `(#f #f "PONG" (,token)) out-port))
- ((source "PRIVMSG" target args ...)
- (when (string=? target nick)
- (print "Someone sent me this message: " args)
- (write-msg `(#f #f "PRIVMSG" (,source "Message received!")) out-port)))
- (_
- ; Do nothing
- ))
- (loop (read-msg in-port))))
+ (let ((privmsg (lambda (to . args)
+ (let ((msg (list #f #f "PRIVMSG" (cons to args))))
+ (write-msg msg out-port)
+ (when (>= verbosity-level 1)
+ (display "Responded with msg: ")
+ (write msg)
+ (newline))))))
+ (let loop ((msg (read-msg in-port)))
+ (match (cons (msg-source msg) (cons (msg-command msg) (msg-args msg)))
+ ((_ "PING" token)
+ (write-msg `(#f #f "PONG" (,token)) out-port))
+ ((source "PRIVMSG" target "bbreload")
+ (when (and allow-reload (string=? target bot-nick))
+ (print "Reveived reload command from " source)
+ (if (load-bot)
+ (privmsg source "Reloaded bot script.")
+ (privmsg source "Error loading bot script."))))
+ ((source "PRIVMSG" target args ...)
+ (when (string=? target bot-nick)
+ (when (>= verbosity-level 1)
+ (display "Received msg: ")
+ (write msg)
+ (newline))
+ (condition-case
+ (bot-proc source args privmsg)
+ (o (exn)
+ (print "Error executing bot script.")
+ (print-error-message o)))))
+ (_
+ ;; Do nothing
+ ))
+ (loop (read-msg in-port)))))
(define (read-msg in-port)
(let ((msg (string->msg (read-line in-port))))
- (print "Received message: " msg)
+ (when (>= verbosity-level 2)
+ (display "Received message: ")
+ (write msg)
+ (newline))
msg))
(define (write-msg msg out-port)
(with-output-to-port out-port
(lambda () (write-string (conc (msg->string msg) "\r\n"))))
- (print "Sent message: " msg))
+ (when (>= verbosity-level 2)
+ (print "Sent message: " msg)))
(define msg-regex
(irregex '(:
(define (parse-message-args argstr)
(if argstr
- (let ((first-split (string-split argstr ":")))
- (if (null? first-split)
- #f
+ (let ((idx (substring-index ":" argstr)))
+ (if idx
(append
- (string-split (car first-split) " ")
- (cdr first-split))))))
+ (string-split (substring argstr 0 idx) " ")
+ (list (substring argstr (+ idx 1))))
+ (string-split argstr " ")))))
(define (msg-tags msg) (list-ref msg 0))
(define (msg-source msg) (list-ref msg 1))
(define (msg-args msg) (list-ref msg 3))
(define (print-usage progname)
- (print "Usage: " progname " host port"))
+ (let ((indent-str (make-string (string-length progname) #\space)))
+ (print "Usage:\n"
+ progname " [-h/--help]\n"
+ progname " [-p/--port PORT] [--notls] [-c/--channnel CHANNEL]\n"
+ indent-str " [-v/--verbose] [-a/--allow-reload]\n"
+ indent-str " proc-file host nick")))
(define (main)
- (let ((progname (pathname-file (car (argv)))))
- (match (command-line-arguments)
- ((host port)
- (launch-bot host (string->number port)))
- (_
- (print-usage progname)))))
+ (let ((progname (pathname-file (car (argv))))
+ (port 6697)
+ (channel #f))
+ (if (null? (command-line-arguments))
+ (print-usage progname)
+ (let loop ((args (command-line-arguments)))
+ (let ((this-arg (car args))
+ (rest-args (cdr args)))
+ (if (string-prefix? "-" this-arg)
+ (cond
+ ((or (equal? this-arg "-h")
+ (equal? this-arg "--help"))
+ (print-usage progname))
+ ((or (equal? this-arg "-p")
+ (equal? this-arg "--port"))
+ (set! irc-port (string->number (car rest-args)))
+ (loop (cdr rest-args)))
+ ((equal? this-arg "--notls")
+ (set! usetls #f)
+ (loop rest-args))
+ ((or (equal? this-arg "-c")
+ (equal? this-arg "--channel"))
+ (set! bot-channel (car rest-args))
+ (loop (cdr rest-args)))
+ ((or (equal? this-arg "-v")
+ (equal? this-arg "--verbose"))
+ (set! verbosity-level (+ 1 verbosity-level))
+ (loop rest-args))
+ ((or (equal? this-arg "-a")
+ (equal? this-arg "--allow-reload"))
+ (set! allow-reload #t)
+ (loop rest-args))
+ (else
+ (print "Unknown argument '" this-arg "'")
+ (print-usage progname)))
+ (match args
+ ((procfile host nick)
+ (set! bot-proc-file procfile)
+ (set! irc-host host)
+ (set! bot-nick nick)
+ (if (load-bot)
+ (launch-bot)
+ (error "Could not load bot procedure.")))
+ (else
+ (print "One or more invalid arguments.")
+ (print-usage progname)))))))))
(main)
The Lambda Lab / projects / botbot.git / blobdiff