[43] | 1 | ;; |
---|
| 2 | ;; extract from OKUYAMA Atsushi's "IRCBOT", http://homepage3.nifty.com/oatu/gauche/try.html |
---|
| 3 | ;; |
---|
| 4 | (use gauche.net) |
---|
| 5 | (use gauche.logger) |
---|
| 6 | (use gauche.threads) |
---|
| 7 | (use gauche.charconv) |
---|
| 8 | (use file.util) |
---|
| 9 | (use srfi-19) |
---|
| 10 | |
---|
| 11 | (require "./setting") |
---|
| 12 | |
---|
| 13 | ;; =============================================== |
---|
| 14 | ;; util |
---|
| 15 | |
---|
| 16 | (define (guard-read-line port) |
---|
| 17 | (guard (exc |
---|
| 18 | ((<read-error> exc) "read error.") |
---|
| 19 | (else "error.")) |
---|
| 20 | (read-line port)) |
---|
| 21 | ) |
---|
| 22 | |
---|
| 23 | ;; =============================================== |
---|
| 24 | ;; logging |
---|
| 25 | |
---|
| 26 | (define (make-log-path) |
---|
| 27 | (build-path log-dir (date->string (current-date) "~Y-~m-~d.log")) |
---|
| 28 | ) |
---|
| 29 | |
---|
| 30 | (define log-drain (make <log-drain> :path (make-log-path) :prefix "~T: ")) |
---|
| 31 | |
---|
| 32 | (define (write-log . msg) |
---|
| 33 | (let1 msg1 (apply string-append msg) |
---|
| 34 | (display msg1) |
---|
| 35 | (newline) |
---|
| 36 | (let1 path (make-log-path) |
---|
| 37 | ;; log rotate |
---|
| 38 | (unless |
---|
| 39 | (string=? path (slot-ref log-drain 'path)) |
---|
| 40 | (set! log-drain (make <log-drain> :path path :prefix "~T: ")) |
---|
| 41 | )) |
---|
| 42 | (log-format log-drain "~a" (ces-convert msg1 "*JP" log-encoding)))) |
---|
| 43 | |
---|
| 44 | (define (write-debug-log . msg) |
---|
| 45 | (when debug |
---|
| 46 | (let1 msg1 (apply string-append msg) |
---|
| 47 | (write-log "[DEBUG] " msg1)))) |
---|
| 48 | |
---|
| 49 | ;; =============================================== |
---|
| 50 | ;; irc |
---|
| 51 | |
---|
| 52 | (define irc-socket |
---|
| 53 | (make-client-socket 'inet irc-server irc-server-port)) |
---|
| 54 | |
---|
| 55 | (define irc-socket-input-port |
---|
| 56 | (open-input-conversion-port |
---|
| 57 | (socket-input-port irc-socket :buffering #f) |
---|
| 58 | irc-in-encoding)) |
---|
| 59 | |
---|
| 60 | (define irc-socket-output-port |
---|
| 61 | (open-output-conversion-port |
---|
| 62 | (socket-output-port irc-socket :buffering #f) |
---|
| 63 | irc-out-encoding)) |
---|
| 64 | |
---|
| 65 | (define (irc-send-body . msg) |
---|
| 66 | (let1 msg1 (apply string-append msg) |
---|
| 67 | (display (string-append msg1 "\r\n") irc-socket-output-port) |
---|
| 68 | (flush irc-socket-output-port))) |
---|
| 69 | |
---|
| 70 | (define (irc-send-internal . msg) |
---|
| 71 | (let1 msg1 (apply string-append msg) |
---|
| 72 | (write-debug-log "[SEND] " msg1) |
---|
| 73 | (irc-send-body msg1))) |
---|
| 74 | |
---|
| 75 | (define (irc-send . msg) |
---|
| 76 | (let1 msg1 (apply string-append msg) |
---|
| 77 | (write-log "[SEND] " msg1) |
---|
| 78 | (irc-send-body msg1))) |
---|
| 79 | |
---|
| 80 | ;;; |
---|
| 81 | ;;; |
---|
| 82 | ;;; |
---|
| 83 | (irc-send "NICK " bot-nick) |
---|
| 84 | (irc-send "USER " bot-nick " " irc-server " " irc-client-address " " bot-nick) |
---|
| 85 | (irc-send "JOIN " irc-channel) |
---|
| 86 | |
---|
| 87 | (let loop ((str (string-incomplete->complete (guard-read-line irc-socket-input-port)))) |
---|
| 88 | (if (eof-object? str) |
---|
| 89 | (begin (socket-close irc-socket)) |
---|
| 90 | (begin |
---|
| 91 | (let ((str-list (string-split str " "))) |
---|
| 92 | (cond ((string=? "PING" (list-ref str-list 0)) |
---|
| 93 | (write-debug-log "[PING RECEIVED]" str) |
---|
| 94 | (irc-send-internal "PONG " (list-ref str-list 1))) |
---|
| 95 | ((and (string=? "PRIVMSG" (list-ref str-list 1)) |
---|
| 96 | (string=? bot-nick (list-ref str-list 2))) |
---|
| 97 | (write-log (string-append "msg got from " ((#/^[^!]*!/ (list-ref str-list 0))))) |
---|
| 98 | ) |
---|
| 99 | (else (write-log "[RECEIVED] " str))) |
---|
| 100 | ) |
---|
| 101 | (loop (string-incomplete->complete (guard-read-line irc-socket-input-port)))) |
---|
| 102 | )) |
---|