aboutsummaryrefslogtreecommitdiff
path: root/src/ruth.rkt
blob: 0e3e22a7c11b2fe518d57049d90ac2f0f6f1a6e5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
#lang racket/base

(require racket/tcp
         racket/list
         racket/string
         racket/file
         racket/system
         racket/port
         racket/match
         "config.rkt")

;; ------------------------------------------------------------------------
;; Helper utils
;; ------------------------------------------------------------------------
;; The string-trim removes a trailing "\n" that (system ...)
;; appends to any script output
(define (shell-command command-string)
  (string-trim
    (with-output-to-string
      (lambda () (system command-string)))))

(define (config-ref key)
  (hash-ref config key))

(define (second a-list)
  (car (cdr a-list)))

(define (vector->random-number vec)
  (let* ([vector-length (vector-length vec)]
         [random-number (random vector-length)])
    random-number))

(define (list->random-number lst)
  (let* ([list-length   (length lst)]
         [random-number (random list-length)])
    random-number))

;; ---------------------------
;; Constants
;; ---------------------------
(define bot-name (config-ref 'nickname))

(define command-rollcall "!rollcall")
(define command-bot-name (string-append "!" bot-name))
(define command-cpu "!cpu")
(define command-nicethings "!nicethings")
(define command-hug "!hug")
(define command-water "!water")
(define command-feed "!feed")
(define command-crisis "!crisis")
(define command-pluckafuck "!pluckafuck")

;; ------------------------------------------------------------------------
;; Commands
;; ------------------------------------------------------------------------
(define (rollcall)
  (format
    (string-append
      "I respond to !rollcall, !~a, !cpu, !nicethings, !hug, !crisis, !pluckafuck, !feed ~a, !water ~a."
      " For more information, check out http://tilde.town/wiki/socializing/irc/bots/~a.html")
    bot-name
    bot-name
    bot-name
    bot-name))

(define (cpu)
  (shell-command
    "ps -A -o pcpu | tail -n+2 | paste -sd+ | bc | awk '{print \"cpu used: \" $1 \"%\"}'"))

(define (nicethings)
  (shell-command "nicethings"))

(define (feed)
  (let* ([vectorof-replies
           #("happily chomps away at some 1s and 0s" "jumps up and catches a hexidecimal in her mouth, swallowing it hole"
             "transforms into a little robot dog eating bits and bytes out of your hand"
             "transforms into a little robot cat, purring away happily as he eats little robot kitty cat nip out of your hand"
             "noms away at a few of your text files by accident"
             "beeps a bit, and gently picks up a snack from your hand, chewing away at it happily")]
         [random-number (vector->random-number vectorof-replies)]
         [random-reply  (vector-ref vectorof-replies random-number)])
    random-reply))

(define (water)
  (let* ([vectorof-replies
           #("���%0x00~#<3� sparks and glitches a bit, and then smiles"
             "opens her mouth to catch the water, and licks her lips after"
             "opens up her robot head and a little robotic sprout pops out"
             "ducks a bit, attempting to dodge the water, but then realizes she enjoys it and grins happily"
             "pulls out a bucket and catches your water")]
         [random-number (vector->random-number vectorof-replies)]
         [random-reply  (vector-ref vectorof-replies random-number)])
    random-reply))

(define (hug nickname)
  (let* ([vectorof-replies
           #("offers ~a a big, warm bot hug"
             "seems to notice that ~a could use a hug, and offers them one"
             "'s robotic arms clank a bit as she opens her arms, offering a hug to ~a"
             "transforms her arms into two large body pillows, offering ~a a hug"
             "turns into a big, fuzzy, heated blanket for ~a"
             "turns into a treehouse, containing all kinds of things that ~a adores")]
         [random-number  (vector->random-number vectorof-replies)]
         [random-reply   (vector-ref vectorof-replies random-number)])
    (format random-reply nickname)))

(define (crisis)
  "https://tilde.town/wiki/crisis.html")

(define (pluckafuck)
  (let ([fileof-fucks "/home/archangelic/public_html/unique_fucks.txt"])
    (if (file-exists? fileof-fucks)
      (let* ([listof-fucks   (file->lines fileof-fucks)]
             [vectorof-fucks (list->vector listof-fucks)]
             [random-number  (vector->random-number vectorof-fucks)]
             [random-fuck    (vector-ref vectorof-fucks random-number)])
        random-fuck)
      (format "Couldn't find ~a" fileof-fucks))))

;; ------------------------------------------------------------------------
;; IRC builders
;; ------------------------------------------------------------------------
;; The (define-values ..) here is required because (tcp-connect ...)
;; returns two values: an input-port (from-server) and an output port
;; (to-server)
(define-values (from-server to-server)
  (tcp-connect (config-ref 'host)
               (config-ref 'port)))

;; The (flush-output ...) here is required because we are using TCP ports,
;; and according to the Racket docs on (flush-output ...), TCP ports use
;; buffered data
;; Source:
;; https://docs.racket-lang.org/reference/port-buffers.html#%28def._%28%28quote._~23~25kernel%29._flush-output%29%29
(define (send-bytes/utf-8 a-string)
  (let* ([string-rn             (string-append a-string "\r\n")]
         [string-as-bytes/utf-8 (string->bytes/utf-8 string-rn)])
    (write-bytes string-as-bytes/utf-8 to-server)
    (flush-output to-server)))

(define (ping-check server-data-string)
  (when (equal? "PING" (substring server-data-string 0 4))
    (send-bytes/utf-8 "PONG :message")))

(define (send-message channel message)
  (send-bytes/utf-8 (format "PRIVMSG ~a :~a" channel message)))

(define (send-action channel action)
  (send-bytes/utf-8 (format "PRIVMSG ~a :\x01ACTION ~a\x01" channel action)))

(define (send-nick)
  (send-bytes/utf-8
    (format "NICK ~a" (config-ref 'nickname))))

(define (send-user)
  (send-bytes/utf-8
    (format "USER ~a 0.0.0.0 ~a :~a"
            (config-ref 'nickname)
            (config-ref 'username)
            (config-ref 'realname))))

(define (join-channels)
  (for ([channel (config-ref 'channels)])
    (send-bytes/utf-8 (format "JOIN ~a" channel))))

(define (check-for-e channel nickname message)
  (let* ([oulipo-channel? (equal? channel "#oulipo")]
         [thirtybot?      (equal? nickname "thirtybot")]
         [e-list          (string->list "ЕеEe℮𝚎∈𝖾Єℯ𝕖⋳ᗴəᵉꗋ𝔼𝙴ΕᎬ𝘌Ɛ⋿ⴹ𝖤ƸꜪℇĘɛεЕꜫȨéèëêēẽÉÈÊËĒĔẼĖėĘęĚě")]
         [contains-e?     (ormap (lambda (x) (member x (string->list message)))
                                 e-list)])
    (if (and contains-e? oulipo-channel? (not thirtybot?))
      (send-message channel "fuuuuuuuuuuuuuccccccccccccccccccccccccckkkkkkkkkkk")
      'hangout)))

;; Split message should look something like the following:
;;  nick username               channel    message
;; :m455!m455@localhost PRIVMSG #tildetown :hmmm let me open up town's tmux
(define (get-nickname split-server-message)
  (let* ([nickname-block (list-ref split-server-message 0)]
         [colon-removed  (substring nickname-block 1)])
    (string-trim colon-removed #px"(!.+)$")))

(define (get-username split-server-message)
  (let* ([username-block   (list-ref split-server-message 0)]
         [username-matches (regexp-match #rx"![~]?(.+)@" username-block)])
    (list-ref username-matches 1)))

(define (get-channel split-server-message)
  (list-ref split-server-message 2))

(define (get-message split-server-message)
  (let* ([first-word    (list-ref split-server-message 3)]
         [colon-removed (substring first-word 1)])
    (cons colon-removed (list-tail split-server-message 4))))

(define (commands-listen server-data-string)
  (let ([split-server-message (string-split server-data-string)])
    (when (equal? (list-ref split-server-message 1) "PRIVMSG")
      (let* ([nickname       (get-nickname split-server-message)]
             [username       (get-username split-server-message)]
             [channel        (get-channel split-server-message)]
             [message-split  (get-message split-server-message)]
             [message-joined (string-join message-split)])
        (match message-split
          ;; 2-item matches
          [(list (== command-water)
                 (== bot-name))
           (send-action channel (water))]

          [(list (== command-feed)
                 (== bot-name))
           (send-action channel (feed))]

          [(list (== command-hug) arg)
           (send-action channel (hug arg))]

          ;; 1-items matches
          [(list (== command-hug))
           (send-action channel (hug nickname))]

          [(list (or (== command-rollcall)
                     (== command-bot-name)))
           (send-message channel (rollcall))]

          [(list (== command-cpu))
           (send-message channel (cpu))]

          [(list (== command-nicethings))
           (send-message channel (nicethings))]

          [(list (== command-crisis))
           (send-message channel (crisis))]

          [(list (== command-pluckafuck))
           (send-message channel (pluckafuck))]

          [_ 'hangout])

        (check-for-e channel nickname message-joined)))))

(define (initialize-connection)
  (send-nick)
  (send-user)
  (join-channels)
  (sleep 1))

;; (connection-loop) is outside of the (let ...), so each time the loop
;; is called, new values are assigned inside of the let statement
(define (connection-loop)
  (let* ([lineof-bytes       (read-bytes-line from-server)]
         [server-data-string (bytes->string/utf-8 lineof-bytes)])
    (displayln server-data-string)
    (ping-check server-data-string)
    (commands-listen server-data-string)
    (sleep 1))
  (connection-loop))

(define (main)
  (initialize-connection)
  (connection-loop))

(main)