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