From: plugd Date: Thu, 31 Aug 2023 12:25:30 +0000 (+0200) Subject: Initial commit. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=273fafc2aba33998bbc737e7b524b923f3d6cfc3;p=botbot.git Initial commit. --- 273fafc2aba33998bbc737e7b524b923f3d6cfc3 diff --git a/botbot.scm b/botbot.scm new file mode 100644 index 0000000..18ad842 --- /dev/null +++ b/botbot.scm @@ -0,0 +1,117 @@ +;; Botbot: Very basic IRC bot + +(import (chicken io) + (chicken port) + (chicken file) + (chicken string) + (chicken pathname) + (chicken process-context) + (chicken irregex) + matchable srfi-13 srfi-1 + uri-common tcp6 openssl) + +;; Globals + +(define nick "botbot") +(define username "#phloggersgarage bot") + +(tcp-read-timeout #f) ;disable read timeout + +(define (launch-bot host port) + (let-values (((in-port out-port) (tcp-connect host port))) + ;; Connect to server + (if (establish-connection in-port out-port) + ;; (bot-loop in-port out-port) + (begin + (print "Successfully connected!") + (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"))) + +(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)))) + +(define (read-msg in-port) + (let ((msg (string->msg (read-line in-port)))) + (print "Received message: " msg) + 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)) + +(define msg-regex + (irregex '(: + (? (: "@" (submatch (+ (~ " "))) (* " "))) + (? (: ":" (submatch (+ (~ " " "!" "@"))) + (* (~ " ")) ;discard non-nick portion + (* " "))) + (submatch (+ (~ " "))) + (* " ") + (? (submatch (+ any)))))) + +(define (string->msg string) + (let ((match (irregex-match msg-regex string))) + (list + (irregex-match-substring match 1) ; Tags + (irregex-match-substring match 2) ; Source + (string-upcase (irregex-match-substring match 3)) ; command + (parse-message-args (irregex-match-substring match 4))))) ;args + +(define (msg->string msg) + (conc + (msg-command msg) + (let ((args (msg-args msg))) + (if args (conc " " (make-arg-string args)) "")))) + +(define (make-arg-string args) + (let* ((revargs (reverse args)) + (final-arg (car revargs)) + (first-args (reverse (cdr revargs)))) + (conc (string-join first-args " ") + " :" final-arg))) + +(define (parse-message-args argstr) + (if argstr + (let ((first-split (string-split argstr ":"))) + (if (null? first-split) + #f + (append + (string-split (car first-split) " ") + (cdr first-split)))))) + +(define (msg-tags msg) (list-ref msg 0)) +(define (msg-source msg) (list-ref msg 1)) +(define (msg-command msg) (list-ref msg 2)) +(define (msg-args msg) (list-ref msg 3)) + +(define (print-usage progname) + (print "Usage: " progname " host port")) + +(define (main) + (let ((progname (pathname-file (car (argv))))) + (match (command-line-arguments) + ((host port) + (launch-bot host (string->number port))) + (_ + (print-usage progname))))) + +(main)