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) |