Initial commit.

diff --git a/botbot.scm b/botbot.scm
new file mode 100644 (file)
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)