Improved logging + allowed bot script reload.
[botbot.git] / botbot.scm
1 ;; Botbot: Very basic IRC bot
2 ;;
3 ;; Copyright (C) 2023 plugd
4
5 ;; This program is free software: you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation, either version 3 of the License, or
8 ;; (at your option) any later version.
9
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 ;; GNU General Public License for more details.
14
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
17
18 (import (chicken io)
19         (chicken port)
20         (chicken file)
21         (chicken string)
22         (chicken pathname)
23         (chicken process-context)
24         (chicken irregex)
25         matchable srfi-13 srfi-1 srfi-18
26         tcp6 openssl)
27
28 ;; Globals
29
30 (define irc-host #f)
31 (define irc-port #f)
32 (define bot-nick #f)
33 (define bot-channel #f)
34 (define bot-proc-file #f)
35 (define usetls #t)
36 (define allow-reload #f)
37
38 (define bot-proc #f)
39
40 (define verbosity-level 0)
41
42 (define ping-period 60) ;seconds
43
44 (tcp-read-timeout #f) ;disable read timeout
45
46 (define (launch-bot)
47   ;; (let-values (((in-port out-port) (tcp-connect host port)))
48   (load-bot)
49   (let-values (((in-port out-port)
50                 (if usetls
51                     (ssl-connect* hostname: irc-host port: (or irc-port 6697))
52                     (tcp-connect irc-host (or irc-port 6667)))))
53     ;; Connect to server
54     (if (establish-connection in-port out-port)
55         ;; (bot-loop in-port out-port)
56         (begin
57           (print "Successfully connected!")
58           (start-ping-timer out-port)
59           (bot-loop in-port out-port))
60         (print "Failed to establish connection. Aborting..."))))
61
62 (define (establish-connection in-port out-port)
63   (write-msg `(#f #f "NICK" (,bot-nick)) out-port)
64   (write-msg `(#f #f "USER" (,bot-nick "0" "*" ,bot-nick)) out-port)
65   (if bot-channel
66       (write-msg `(#f #f "JOIN" (,bot-channel)) out-port))
67   #t)
68
69 (define (start-ping-timer out-port)
70   (thread-start!
71    (lambda ()
72      (let loop ()
73        (thread-sleep! ping-period)
74        (write-msg `(#f #f "PING" (,irc-host)) out-port) ; send ping
75        (loop)))))
76
77 (define (load-bot)
78   (set! bot-proc (eval (with-input-from-file bot-proc-file read)))
79   (print "Loaded bot procedure file."))
80
81 (define (bot-loop in-port out-port)
82   (let ((privmsg (lambda (to . args)
83                    (let ((msg (list #f #f "PRIVMSG" (cons to args))))
84                      (write-msg msg out-port)
85                      (when (>= verbosity-level 1)
86                        (display "Responded with msg: ")
87                        (write msg)
88                        (newline))))))
89     (let loop ((msg (read-msg in-port)))
90       (match (cons (msg-source msg) (cons (msg-command msg) (msg-args msg)))
91         ((_ "PING" token)
92          (write-msg `(#f #f "PONG" (,token)) out-port))
93         ((source "PRIVMSG" target "bbreload")
94          (when (and allow-reload (string=? target bot-nick))
95            (print "Reveived reload command from " source)
96            (load-bot)
97            (privmsg source "Reloaded bot script.")))
98         ((source "PRIVMSG" target args ...)
99          (when (string=? target bot-nick)
100            (when (>= verbosity-level 1)
101              (display "Received msg: ")
102              (write msg)
103              (newline))
104            (bot-proc source args privmsg)))
105         (_
106          ;; Do nothing
107          ))
108       (loop (read-msg in-port)))))
109
110 (define (read-msg in-port)
111   (let ((msg (string->msg (read-line in-port))))
112     (when (>= verbosity-level 2)
113       (display "Received message: ")
114       (write msg)
115       (newline))
116     msg))
117
118 (define (write-msg msg out-port)
119   (with-output-to-port out-port
120     (lambda () (write-string (conc (msg->string msg) "\r\n"))))
121   (when (>= verbosity-level 2)
122     (print "Sent message: " msg)))
123
124 (define msg-regex
125   (irregex '(:
126              (? (: "@" (submatch (+ (~ " "))) (* " ")))
127              (? (: ":" (submatch (+ (~ " " "!" "@")))
128                    (* (~ " "))          ;discard non-nick portion
129                    (* " ")))
130              (submatch (+ (~ " ")))
131              (* " ")
132              (? (submatch (+ any))))))
133
134 (define (string->msg string)
135   (let ((match  (irregex-match msg-regex string)))
136     (list
137      (irregex-match-substring match 1) ; Tags
138      (irregex-match-substring match 2) ; Source
139      (string-upcase (irregex-match-substring match 3)) ; command
140      (parse-message-args (irregex-match-substring match 4))))) ;args
141
142 (define (msg->string msg)
143   (conc
144    (msg-command msg)
145    (let ((args (msg-args msg)))
146      (if args (conc " " (make-arg-string args)) ""))))
147
148 (define (make-arg-string args)
149   (let* ((revargs (reverse args))
150          (final-arg (car revargs))
151          (first-args (reverse (cdr revargs))))
152     (conc (string-join first-args " ")
153           " :" final-arg)))
154
155 (define (parse-message-args argstr)
156   (if argstr
157       (let ((idx (substring-index ":" argstr)))
158         (if idx
159             (append
160              (string-split (substring argstr 0 idx) " ")
161              (list (substring argstr (+ idx 1))))
162             (string-split argstr " ")))))
163
164 (define (msg-tags msg) (list-ref msg 0))
165 (define (msg-source msg) (list-ref msg 1))
166 (define (msg-command msg) (list-ref msg 2))
167 (define (msg-args msg) (list-ref msg 3))
168
169 (define (print-usage progname)
170   (let ((indent-str (make-string (string-length progname) #\space)))
171     (print "Usage:\n"
172            progname " [-h/--help]\n"
173            progname " [-p/--port PORT] [--notls] [-c/--channnel CHANNEL]\n"
174            indent-str " [-v/--verbose] [-a/--allow-reload]"
175            indent-str " proc-file host nick")))
176
177 (define (main)
178   (let ((progname (pathname-file (car (argv))))
179         (port 6697)
180         (channel #f))
181     (if (null? (command-line-arguments))
182         (print-usage progname)
183         (let loop ((args (command-line-arguments)))
184           (let ((this-arg (car args))
185                 (rest-args (cdr args)))
186             (if (string-prefix? "-" this-arg)
187                 (cond
188                  ((or (equal? this-arg "-h")
189                       (equal? this-arg "--help"))
190                   (print-usage progname))
191                  ((or (equal? this-arg "-p")
192                       (equal? this-arg "--port"))
193                   (set! irc-port (string->number (car rest-args)))
194                   (loop (cdr rest-args)))
195                  ((equal? this-arg "--notls")
196                   (set! usetls #f)
197                   (loop rest-args))
198                  ((or (equal? this-arg "-c")
199                       (equal? this-arg "--channel"))
200                   (set! bot-channel (car rest-args))
201                   (loop (cdr rest-args)))
202                  ((or (equal? this-arg "-v")
203                       (equal? this-arg "--verbose"))
204                   (set! verbosity-level (+ 1 verbosity-level))
205                   (loop rest-args))
206                  ((or (equal? this-arg "-a")
207                       (equal? this-arg "--allow-reload"))
208                   (set! allow-reload #t)
209                   (loop rest-args))
210                  (else
211                   (print "Unknown argument '" this-arg "'")
212                   (print-usage progname)))
213                 (match args
214                   ((procfile host nick)
215                    (set! bot-proc-file procfile)
216                    (set! irc-host host)
217                    (set! bot-nick nick)
218                    (launch-bot))
219                   (else
220                    (print "One or more invalid arguments.")
221                    (print-usage progname)))))))))
222
223 (main)