You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
poolboi/poolboi.rkt

186 lines
5.9 KiB

#lang racket/base
(require racket/tcp
racket/list
racket/string
racket/file
racket/system
racket/port
racket/match)
;; ---------------------------
;; Constants
;; ---------------------------
(define host "127.0.0.1")
(define port 6667)
(define bot-name "poolboi")
(define channel "#javapool")
(define command-status "!status")
;; Note: `localhost` may need to be modified depending on the IRC server
(define topic-regex #rx"^:[A-Za-z0-9_~]+![A-Za-z0-9_~]+@localhost TOPIC [#&][A-Za-z0-9_-]+ :(.*)$")
(define output-file "/home/m455/public_html/javapool.txt")
(define rss-title "javapool updates")
(define rss-url-base "http://tilde.town/~m455")
(define rss-description "updates on the javapool")
(define rss-file "javapool.rss")
(define rss-output-file (string-append "/home/m455/public_html/" rss-file))
(define rss-file-url (string-append rss-url-base "/" rss-file))
(define banned-shit "]]>")
(define rss-header
(format
#<<string-block
<?xml version="1.0" encoding="UTF-8" ?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
<channel>
<title>~a</title>
<link>~a</link>
<description>~a</description>
<atom:link href="~a" rel="self" type="application/rss+xml" />
string-block
rss-title
rss-url-base
rss-description
rss-file-url
))
(define rss-item
#<<string-block
<item>
<title><![CDATA[~a]]></title>
<link>~a</link>
<guid><![CDATA[~a]]></guid>
<pubDate>~a</pubDate>
</item>
string-block
)
(define rss-footer
#<<string-block
</channel>
</rss>
string-block
)
;; ------------------------------------------------------------------------
;; 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 (get-date)
(shell-command "date +'%Y-%m-%d'"))
(define (date->rss-date date)
(shell-command (format "date -Rd'~a'" date)))
;; ------------------------------------------------------------------------
;; Commands
;; ------------------------------------------------------------------------
(define (file->dates-and-topics file)
(map (lambda (x) (string-split x "\t"))
(file->lines file)))
(define (update-logs channel-topic)
(let ([topic (string-replace channel-topic banned-shit "")])
;; append to javapool.txt
(display-to-file (string-append (get-date) "\t" topic "\n")
output-file
#:exists
'append)
;; create javapool.rss
;; header
(display-to-file rss-header rss-output-file #:exists 'truncate)
;; items
(for ([pair (file->dates-and-topics output-file)])
(let* ([date (date->rss-date (car pair))]
[topic-rss (cadr pair)]
[item (format rss-item topic-rss rss-file-url topic-rss date)])
(display-to-file item rss-output-file #:exists 'append)))
;; footer
(display-to-file rss-footer rss-output-file #:exists 'append)))
;; ------------------------------------------------------------------------
;; 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 host 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-string message-string)
(send-bytes/utf-8 (format "PRIVMSG ~a :~a" channel-string message-string)))
(define (send-action channel-string action-string)
(send-bytes/utf-8 (format "PRIVMSG ~a :\x01ACTION ~a\x01" channel-string action-string)))
(define (send-nick)
(send-bytes/utf-8
(format "NICK ~a" bot-name)))
(define (send-user)
(send-bytes/utf-8
(format "USER ~a 0.0.0.0 ~a :~a" bot-name bot-name bot-name)))
(define (join-channel channel-string)
(send-bytes/utf-8 (format "JOIN ~a" channel-string)))
;; * Look for message that look like `:m455!m455@localhost TOPIC #m455-dev :test change`
;; * The (when ...) prevents (cadr ...) from being called on a #f if no matches are found.
;; * regexp-match returns a two-item list if a match is found. (cadr ..) gets the second item
;; * regexp-match returns #f if no match is found.
(define (check-for-topic server-data-string)
(let ([regex-match-found (regexp-match topic-regex server-data-string)])
(when regex-match-found (string-trim (cadr regex-match-found)))))
(define (listen-for-topic server-data-string)
(let ([topic (check-for-topic server-data-string)])
(when (string? topic)
(update-logs topic))))
(define (initialize-connection)
(send-nick)
(send-user)
(join-channel channel)
(sleep 1))
;; (connection-loop) is outside of the (let ...), so each time the
;; loop is called, new values are assigned to the let statement bindings
(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)
(listen-for-topic server-data-string)
(sleep 1))
(connection-loop))
(define (main)
(initialize-connection)
(connection-loop))
(main)