1; client.ss - IRC Client library
2;
3;   Copyright (c) 2009  Higepon(Taro Minowa)  <higepon@users.sourceforge.jp>
4;
5;   Redistribution and use in source and binary forms, with or without
6;   modification, are permitted provided that the following conditions
7;   are met:
8;
9;   1. Redistributions of source code must retain the above copyright
10;      notice, this list of conditions and the following disclaimer.
11;
12;   2. Redistributions in binary form must reproduce the above copyright
13;      notice, this list of conditions and the following disclaimer in the
14;      documentation and/or other materials provided with the distribution.
15;
16;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
17;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
18;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
19;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
20;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
22;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
23;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
24;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27;
28;  $Id: client.ss 621 2008-11-09 06:22:47Z higepon $
29
30#|
31    Title: IRC Client
32
33    Simple IRC Client.
34
35
36    Example:
37    (start code)
38    ;; Just echo back
39    (import (rnrs)
40            (match)
41            (mosh irc client))
42
43    (irc-client
44     "irc.freenode.net" "6666" "kaela" "#higepon"
45     (lambda (msg return privmsg send)
46       (match msg
47         [('PRIVMSG who message)
48          (privmsg message)]
49         [else #f])))
50    (end code)
51
52    Example2:
53    (start code)
54    ;; Logger
55    (import (rnrs)
56            (mosh)
57            (match)
58            (only (srfi :19 time) date->string current-date)
59            (mosh irc client))
60    (irc-client
61     "irc.freenode.net" "6666" "kaela" "#higepon"
62     (lambda (msg return privmsg send)
63       (match msg
64         [('PRIVMSG who message)
65          (format #t "~a <~a> ~a\n" (date->string (current-date) "~H:~M") who message)]
66         [('STATUS 433 messaage)
67          (error 'irc (format "~a" messaage))]
68         [('NICK from to)
69          (format #t "nick from =~a to =~a\n" from to)]
70         [('PART name)
71          (format #t "part name=~a\n" name)]
72         [('JOIN name)
73          (format #t "join name=~a\n" name)]
74         [('TOPIC who topic)
75          (format #t "topic who=~a topic=~a\n" who topic)]
76         [('ERROR e)
77          (return e)]
78         [('RAW text)
79          #;(format (current-error-port) "LOG:~a\n" text)
80          #f]
81         [else #f])))
82    (end code)
83
84    library: (mosh irc client)
85
86    IRC Client Library
87|#
88
89(library (mosh irc client)
90  (export irc-client)
91  (import (rnrs)
92          (mosh)
93          (mosh socket))
94
95  #|
96      Function: irc-client
97
98      Prototype:
99      > (irc-client server port nick channel client-proc)
100
101  |#
102  (define (irc-client server port nick channel irc-client)
103    (let ([socket (make-client-socket server port)])
104      (define (send text)
105        (assert (<= (string-length text) 510))
106        (socket-send socket (string->utf8 (string-append text "\r\n"))))
107      (define (recv)
108        (utf8->string (socket-recv socket 512)))
109      (define (privmsg text)
110        (send (format "PRIVMSG ~a :~a" channel text)))
111      (send (format "NICK ~a" nick))
112      (send (format "USER ~a 0 * :~a" nick nick))
113      (send (format "JOIN ~a" channel))
114      (call/cc
115       (lambda (return)
116         (let loop ([data (recv)])
117           (irc-client `(RAW ,data) return privmsg send)
118           (cond
119            [(zero? (string-length data))
120             (irc-client (list 'CLOSED ) return privmsg send)
121             (return)]
122            [(#/:([^!]+).*PRIVMSG[^:]+:(.*)/ data) =>
123             (lambda (m)
124               (irc-client (list 'PRIVMSG (m 1) (m 2)) return privmsg send))]
125            [(#/^PING/ data)
126             (send "PONG 0")]
127            [(#/:[^\s]+\s+(\d+).*:(.+)/ data) =>
128             (lambda (m)
129               (irc-client `(STATUS ,(string->number (m 1)) ,(m 2)) return privmsg send))]
130            [(#/:([^!]+).*NICK.*:(.*)/ data) =>
131             (lambda (m) (irc-client `(NICK ,(m 1) ,(m 2)) return privmsg send))]
132            [(#/:([^!]+).*JOIN/ data) =>
133             (lambda (m) (irc-client `(JOIN ,(m 1)) return privmsg send))]
134            [(#/:([^!]+).*PART/ data) =>
135             (lambda (m) (irc-client `(PART ,(m 1)) return privmsg send))]
136            [(#/:([^!]+).*TOPIC.*:(.*)/ data) =>
137             (lambda (m) (irc-client `(TOPIC ,(m 1) ,(m 2)) return privmsg send))]
138            [else #f])
139            (loop (recv)))))
140       (socket-close socket)))
141)
142