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