From: plugd <plugd@thelambdalab.xyz>
Date: Thu, 31 Aug 2023 21:35:43 +0000 (+0200)
Subject: Basically functional.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=1969a19bcad35af317399be1b1d9dae50ee91331;p=botbot.git

Basically functional.
---

diff --git a/botbot.scm b/botbot.scm
index 18ad842..443ca13 100644
--- a/botbot.scm
+++ b/botbot.scm
@@ -7,50 +7,75 @@
         (chicken pathname)
         (chicken process-context)
         (chicken irregex)
-        matchable srfi-13 srfi-1
+        matchable srfi-13 srfi-1 srfi-18
         uri-common 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 bot-proc #f)
+
+(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! bot-proc (eval (with-input-from-file bot-proc-file read)))
+  (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" (,bot-host)) out-port) ; send ping
+       (loop)))))
 
 (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)
+                   (write-msg (list #f #f "PRIVMSG" (cons to args)) 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 bot-nick)
+           (bot-proc source args privmsg)))
+        (_
+         ;; Do nothing
+         ))
+      (loop (read-msg in-port)))))
 
 (define (read-msg in-port)
   (let ((msg (string->msg (read-line in-port))))
-    (print "Received message: " msg)
+    (display "Received message: ")
+    (write msg)
+    (newline)
     msg))
 
 (define (write-msg msg out-port)
@@ -91,12 +116,12 @@
 
 (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))
@@ -104,14 +129,48 @@
 (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 " 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)))
+                 (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)
+                   (launch-bot))
+                  (else
+                   (print "One or more invalid arguments.")
+                   (print-usage progname)))))))))
 
 (main)
diff --git a/pgbot.scm b/pgbot.scm
new file mode 100644
index 0000000..d79a4da
--- /dev/null
+++ b/pgbot.scm
@@ -0,0 +1,80 @@
+(let ((url-alist '())
+      (url-list-file "phlog_list.txt"))
+
+  (import matchable srfi-1
+          (chicken file)
+          (chicken string)
+          (chicken pretty-print))
+
+  (if (file-exists? url-list-file)
+      (let ((res (with-input-from-file url-list-file read)))
+        (if (pair? res)
+            (set! url-alist res))))
+
+  (define (save-url-list)
+    (with-output-to-file url-list-file
+      (lambda () (pretty-print url-alist))))
+
+  (define (set-url nick url)
+    (let ((nick-symb (string->symbol nick)))
+      (set! url-alist
+        (alist-cons nick-symb url (alist-delete  nick-symb url-alist)))
+      (save-url-list)))
+
+  (define (get-url nick)
+    (let* ((nick-symb (string->symbol nick))
+           (record (assoc nick-symb url-alist)))
+      (and record (cdr record))))
+
+  (define (clear-url nick)
+    (let* ((nick-symb (string->symbol nick)))
+      (set! url-alist (alist-delete nick-symb url-alist))
+      (save-url-list)))
+
+  (lambda (source args privmsg)
+    (match (string-split (car args))
+      (("hello")
+       (privmsg source "hello yourself!"))
+
+      ((",seturl" url)
+       (set-url source url)
+       (privmsg source "updated url"))
+
+      ((",geturl" nick)
+       (print "in geturl")
+       (privmsg source
+                (let ((url (get-url nick)))
+                  (if url
+                      (conc "URL for " nick ": " url)
+                      (conc "No URL for " nick " in database")))))
+
+      ((",rmurl")
+       (clear-url source)
+       (privmsg source "cleared url"))
+
+      ((",list")
+       (if (null? url-alist)
+           (privmsg source "No registered phlog/gemlog/blog URLs. :(")
+           (begin
+             (privmsg source "Current URL list:")
+             (for-each
+              (lambda (record)
+                (let ((nick (symbol->string (car record)))
+                      (url (cdr record)))
+                  (privmsg source (conc "  " nick ": " url))))
+              url-alist))))
+
+      ((",announce")
+       (let ((url (get-url source)))
+         (if url
+             (privmsg "#phloggersgarage"
+                      (conc source " has published a new post at " url "!"))
+             (privmsg source "Register your *log URL first using ,seturl <URL>."))))
+
+      (_
+       (privmsg source "Hi!  Here are the valid pgbot commands:")
+       (privmsg source " ,seturl [url] : Save your *log URL for others to see")
+       (privmsg source " ,rmurl : Remove your *log URL if one is saved.")
+       (privmsg source " ,geturl [nick] : Retrieve the *log URL belonging to [nick].")
+       (privmsg source " ,list : List all currently stored *log URLs.")
+       (privmsg source " ,accounce : Announce a new *log entry to #phloggersgarage! Huzzah!")))))