git.m455.casa

ruth

clone url: git://git.m455.casa/ruth


src/ruth.rkt

1 #lang racket/base
2
3 (require openssl
4 racket/tcp
5 racket/list
6 racket/string
7 racket/file
8 racket/system
9 racket/port
10 racket/match
11 "config.rkt")
12
13 ;; ------------------------------------------------------------------------
14 ;; Helper utils
15 ;; ------------------------------------------------------------------------
16 ;; The string-trim removes a trailing "\n" that (system ...)
17 ;; appends to any script output
18 (define (shell-command command-string)
19 (string-trim
20 (with-output-to-string
21 (lambda () (system command-string)))))
22
23 (define (config-ref key)
24 (hash-ref config key))
25
26 (define (second a-list)
27 (car (cdr a-list)))
28
29 (define (vector->random-number vec)
30 (let* ([vector-length (vector-length vec)]
31 [random-number (random vector-length)])
32 random-number))
33
34 (define (list->random-number lst)
35 (let* ([list-length (length lst)]
36 [random-number (random list-length)])
37 random-number))
38
39 ;; ---------------------------
40 ;; Constants
41 ;; ---------------------------
42 (define bot-name (config-ref 'nickname))
43
44 (define command-rollcall "!rollcall")
45 (define command-bot-name (string-append "!" bot-name))
46 (define command-cpu "!cpu")
47 (define command-nicethings "!nicethings")
48 (define command-hug "!hug")
49 (define command-water "!water")
50 (define command-feed "!feed")
51 (define command-crisis "!crisis")
52 (define command-pluckafuck "!pluckafuck")
53
54 ;; ------------------------------------------------------------------------
55 ;; Commands
56 ;; ------------------------------------------------------------------------
57 (define (rollcall)
58 (format
59 (string-append
60 "I respond to !rollcall, !~a, !cpu, !nicethings, !hug, !crisis, !pluckafuck, !feed ~a, !water ~a."
61 " For more information, check out http://tilde.town/wiki/socializing/irc/bots/~a.html")
62 bot-name
63 bot-name
64 bot-name
65 bot-name))
66
67 (define (cpu)
68 (shell-command
69 "ps -A -o pcpu | tail -n+2 | paste -sd+ | bc | awk '{print \"cpu used: \" $1 \"%\"}'"))
70
71 (define (nicethings)
72 (shell-command "nicethings"))
73
74 (define (feed)
75 (let* ([vectorof-replies
76 #("happily chomps away at some 1s and 0s" "jumps up and catches a hexidecimal in her mouth, swallowing it hole"
77 "transforms into a little robot dog eating bits and bytes out of your hand"
78 "transforms into a little robot cat, purring away happily as he eats little robot kitty cat nip out of your hand"
79 "noms away at a few of your text files by accident"
80 "beeps a bit, and gently picks up a snack from your hand, chewing away at it happily")]
81 [random-number (vector->random-number vectorof-replies)]
82 [random-reply (vector-ref vectorof-replies random-number)])
83 random-reply))
84
85 (define (water)
86 (let* ([vectorof-replies
87 #("���%0x00~#<3� sparks and glitches a bit, and then smiles"
88 "opens her mouth to catch the water, and licks her lips after"
89 "opens up her robot head and a little robotic sprout pops out"
90 "ducks a bit, attempting to dodge the water, but then realizes she enjoys it and grins happily"
91 "pulls out a bucket and catches your water")]
92 [random-number (vector->random-number vectorof-replies)]
93 [random-reply (vector-ref vectorof-replies random-number)])
94 random-reply))
95
96 (define (hug nickname)
97 (let* ([vectorof-replies
98 #("offers ~a a big, warm bot hug"
99 "seems to notice that ~a could use a hug, and offers them one"
100 "'s robotic arms clank a bit as she opens her arms, offering a hug to ~a"
101 "transforms her arms into two large body pillows, offering ~a a hug"
102 "turns into a big, fuzzy, heated blanket for ~a"
103 "turns into a treehouse, containing all kinds of things that ~a adores")]
104 [random-number (vector->random-number vectorof-replies)]
105 [random-reply (vector-ref vectorof-replies random-number)])
106 (format random-reply nickname)))
107
108 (define (crisis)
109 "https://tilde.town/wiki/crisis.html")
110
111 (define (pluckafuck)
112 (let ([fileof-fucks "/home/archangelic/public_html/unique_fucks.txt"])
113 (if (file-exists? fileof-fucks)
114 (let* ([listof-fucks (file->lines fileof-fucks)]
115 [vectorof-fucks (list->vector listof-fucks)]
116 [random-number (vector->random-number vectorof-fucks)]
117 [random-fuck (vector-ref vectorof-fucks random-number)])
118 random-fuck)
119 (format "Couldn't find ~a" fileof-fucks))))
120
121 ;; ------------------------------------------------------------------------
122 ;; IRC builders
123 ;; ------------------------------------------------------------------------
124 ;; The (define-values ..) here is required because (tcp-connect ...)
125 ;; returns two values: an input-port (from-server) and an output port
126 ;; (to-server)
127 (define-values (from-server to-server)
128 (let ([host (config-ref 'host)]
129 [port (config-ref 'port)])
130 (if (config-ref 'ssl)
131 (ssl-connect host port 'secure)
132 (tcp-connect host port))))
133
134 ;; The (flush-output ...) here is required because we are using TCP ports,
135 ;; and according to the Racket docs on (flush-output ...), TCP ports use
136 ;; buffered data
137 ;; Source:
138 ;; https://docs.racket-lang.org/reference/port-buffers.html#%28def._%28%28quote._~23~25kernel%29._flush-output%29%29
139 (define (send a-string)
140 (write-string (string-append a-string "\r\n") to-server)
141 (flush-output to-server))
142
143 (define (ping-check server-data-string)
144 (when (equal? "PING" (substring server-data-string 0 4))
145 (send "PONG :message")))
146
147 (define (send-message channel message)
148 (send (format "PRIVMSG ~a :~a" channel message)))
149
150 (define (send-action channel action)
151 (send (format "PRIVMSG ~a :\x01ACTION ~a\x01" channel action)))
152
153 (define (send-pass)
154 (send
155 (format "PASS ~a" (config-ref 'pass))))
156
157 (define (send-nick)
158 (send
159 (format "NICK ~a" (config-ref 'nickname))))
160
161 (define (send-user)
162 (send
163 (format "USER ~a 0.0.0.0 ~a :~a"
164 (config-ref 'nickname)
165 (config-ref 'username)
166 (config-ref 'realname))))
167
168 (define (join-channels)
169 (for ([channel (config-ref 'channels)])
170 (send (format "JOIN ~a" channel))))
171
172 (define (check-for-e channel nickname message)
173 (let* ([oulipo-channel? (equal? channel "#oulipo")]
174 [thirtybot? (equal? nickname "thirtybot")]
175 [e-list (string->list "ЕеEe℮𝚎∈𝖾Єℯ𝕖⋳ᗴəᵉꗋ𝔼𝙴ΕᎬ𝘌Ɛ⋿ⴹ𝖤ƸꜪℇĘɛεЕꜫȨéèëêēẽÉÈÊËĒĔẼĖėĘęĚě")]
176 [contains-e? (ormap (lambda (x) (member x (string->list message)))
177 e-list)])
178 (if (and contains-e? oulipo-channel? (not thirtybot?))
179 (send-message channel "fuuuuuuuuuuuuuccccccccccccccccccccccccckkkkkkkkkkk")
180 'hangout)))
181
182 ;; Split message should look something like the following:
183 ;; nick username channel message
184 ;; :m455!m455@localhost PRIVMSG #tildetown :hmmm let me open up town's tmux
185 (define (get-nickname split-server-data)
186 (let* ([nickname-block (list-ref split-server-data 0)]
187 [colon-removed (substring nickname-block 1)])
188 (string-trim colon-removed #px"(!.+)$")))
189
190 (define (get-username split-server-data)
191 (let* ([username-block (list-ref split-server-data 0)]
192 [username-matches (regexp-match #rx"![~]?(.+)@" username-block)])
193 (list-ref username-matches 1)))
194
195 (define (get-channel split-server-data)
196 (list-ref split-server-data 2))
197
198 (define (get-message split-server-data)
199 (let* ([first-word (list-ref split-server-data 3)]
200 [colon-removed (substring first-word 1)])
201 (cons colon-removed (list-tail split-server-data 4))))
202
203 (define (commands-listen server-data-string)
204 (let ([split-server-data (string-split server-data-string)])
205 (when (equal? (list-ref split-server-data 1) "PRIVMSG")
206 (let* ([nickname (get-nickname split-server-data)]
207 [username (get-username split-server-data)]
208 [channel (get-channel split-server-data)]
209 [message-split (get-message split-server-data)])
210 (match message-split
211 ;; 2-item matches
212 [(list (== command-water)
213 (== bot-name))
214 (send-action channel (water))]
215
216 [(list (== command-feed)
217 (== bot-name))
218 (send-action channel (feed))]
219
220 [(list (== command-hug) arg)
221 (send-action channel (hug arg))]
222
223 ;; 1-items matches
224 [(list (== command-hug))
225 (send-action channel (hug nickname))]
226
227 [(list (or (== command-rollcall)
228 (== command-bot-name)))
229 (send-message channel (rollcall))]
230
231 [(list (== command-cpu))
232 (send-message channel (cpu))]
233
234 [(list (== command-nicethings))
235 (send-message channel (nicethings))]
236
237 [(list (== command-crisis))
238 (send-message channel (crisis))]
239
240 [(list (== command-pluckafuck))
241 (send-message channel (pluckafuck))]
242
243 [_ 'hangout])
244
245 (check-for-e channel nickname (string-join message-split))))))
246
247 (define (initialize-connection)
248 (when (config-ref 'pass)
249 (send-pass))
250 (send-nick)
251 (send-user)
252 (join-channels)
253 (sleep 1))
254
255 ;; (connection-loop) is outside of the (let ...), so each time the loop
256 ;; is called, new values are assigned inside of the let statement
257 (define (connection-loop)
258 (let ([server-data-string (read-line from-server)])
259 (displayln server-data-string)
260 (ping-check server-data-string)
261 (commands-listen server-data-string)
262 (sleep 1))
263 (connection-loop))
264
265 (define (main)
266 (initialize-connection)
267 (connection-loop))
268
269 (main)