From 1969a19bcad35af317399be1b1d9dae50ee91331 Mon Sep 17 00:00:00 2001 From: plugd Date: Thu, 31 Aug 2023 23:35:43 +0200 Subject: [PATCH] Basically functional. --- botbot.scm | 129 ++++++++++++++++++++++++++++++++++++++--------------- pgbot.scm | 80 +++++++++++++++++++++++++++++++++ 2 files changed, 174 insertions(+), 35 deletions(-) create mode 100644 pgbot.scm 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 .")))) + + (_ + (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!"))))) -- 2.20.1