├── .gitignore ├── LICENSE.txt ├── README.md ├── info.rkt └── irc ├── ctcp.rkt ├── examples ├── disconnect-test.rkt └── echobot.rkt ├── info.rkt ├── irc.scrbl ├── main.rkt └── private └── numeric-replies.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | irc/doc 2 | compiled 3 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2013 Jonathan Schuster 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | racket-irc 2 | === 3 | 4 | Racket IRC library 5 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | 3 | (define version "1.0") 4 | (define deps (list "base")) 5 | (define build-deps (list "racket-doc" "rackunit-lib" "scribble-lib")) 6 | (define collection 'multi) 7 | -------------------------------------------------------------------------------- /irc/ctcp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide ctcp-action) 4 | 5 | (require "main.rkt") 6 | 7 | ;; Translates a low-level to mid-level message (or maybe the other way around?) 8 | (define (low-level-quote m) 9 | (define m-quote "\020") 10 | ; NUL -> m-quote 0 11 | ; newline -> m-quote n 12 | ; carriage return: m-quote r 13 | ; m-quote : mquote mquote 14 | (regexp-replaces m 15 | `([,m-quote ,(string-append m-quote m-quote)] 16 | ["\n" "\020n"] 17 | ["r" "\020r"] 18 | ["\000" "\0200"]))) 19 | 20 | ;; TODO: define low-level-unquote 21 | 22 | ;; TODO: test low-level quote 23 | 24 | 25 | (define x-delim "\001") 26 | 27 | ;; Character inside x-delimiter is \000 or \002-\377 28 | 29 | 30 | ;; Extended message: either: 31 | ;; * empty, 32 | ;; * sequence of one or more non-space (\040) characters, followed by optional single space + sequence of non-space characters 33 | 34 | ;; part before space is tag, after is data 35 | 36 | ;; extended data allowed only in privmsg and notice (always as privmsg unless in reply to another privmsg query) 37 | 38 | ;; there may be 0 or more extended messgaes in the privmsg, along with non-extended data 39 | 40 | (define x-quote "\134") 41 | 42 | (define (ctcp-level-quote m) 43 | (regexp-replaces m 44 | `([,x-quote ,(string-append x-quote x-quote)] 45 | [,x-delim ,(string-append x-quote "a")]))) 46 | 47 | (define (ctcp-action connection target action-message) 48 | (irc-send-message connection 49 | target 50 | (low-level-quote (string-append x-delim "ACTION " (ctcp-level-quote action-message) x-delim)))) 51 | -------------------------------------------------------------------------------- /irc/examples/disconnect-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; Connects, joins a channel, and disconnects soon after to check for any errors on disconnecting 4 | 5 | (require irc 6 | racket/async-channel) 7 | 8 | (define-values (conn ready) 9 | (irc-connect "irc.libera.chat" 6667 "rackbot" "rbot" "Racket Bot" #:return-eof #t)) 10 | 11 | (sync ready) 12 | 13 | (irc-join-channel conn "##racketirctest") 14 | 15 | (define incoming (irc-connection-incoming conn)) 16 | 17 | (thread (lambda () (sleep 15) (irc-quit conn))) 18 | 19 | (let loop () 20 | (define next-msg (async-channel-get incoming)) 21 | (printf "msg: ~s\n" next-msg) 22 | (unless (eof-object? next-msg) (loop))) 23 | -------------------------------------------------------------------------------- /irc/examples/echobot.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require racket/async-channel) 4 | (require irc) 5 | 6 | (define-values (connection ready-event) 7 | (irc-connect "irc.libera.chat" 6667 "schubot" "schubot" "Schuster's Echo Bot")) 8 | (void (sync ready-event)) 9 | 10 | (irc-join-channel connection "##racketirctest") 11 | (define incoming (irc-connection-incoming connection)) 12 | 13 | (let loop () 14 | (define message (async-channel-get incoming)) 15 | (match message 16 | [(irc-message prefix "PRIVMSG" params _) 17 | (define prefix-match (regexp-match #rx"^[^!]+" prefix)) 18 | (define message-match (regexp-match #rx"schubot: (.*)" (second params))) 19 | (when (and prefix-match message-match) 20 | (irc-send-message connection "##racketirctest" 21 | (string-append (first prefix-match) ": " (second message-match))))] 22 | [_ (void)]) 23 | (loop)) 24 | -------------------------------------------------------------------------------- /irc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | 3 | (define scribblings '(("irc.scrbl" ()))) 4 | -------------------------------------------------------------------------------- /irc/irc.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket/base 4 | "main.rkt")) 5 | 6 | @title{IRC Client Library} 7 | 8 | @defmodule[irc] 9 | 10 | @;; TODO: make IRC a code thing 11 | The irc library allows you to develop IRC clients and communicate over IRC. 12 | 13 | @section{Quick Start} 14 | 15 | To use the IRC client library, first create a connection with @racket[irc-connect]. For example, to 16 | connect to the Libera.Chat network (irc.libera.chat, port 6667) with nickname "rackbot", username "rbot", and real 17 | name "Racket Bot", do 18 | 19 | @racketblock[ 20 | (define-values (connection ready) 21 | (irc-connect "irc.libera.chat" 6667 "rackbot" "rbot" "Racket Bot"))] 22 | 23 | This defines an @racket[irc-connection] object which must be used for all future communication with 24 | this server, as well as an event that will be ready for synchronization when the server is ready to 25 | accept more commands (i.e. when the connection has been fully established). 26 | 27 | Once the returned event fires, you can use other IRC commands. For example, if you have a connection 28 | object named @racket[connection], you can join the #racket channel with 29 | 30 | @racket[(irc-join-channel connection "#racket")] 31 | 32 | Once you have joined, you can send a message on that channel with the following: 33 | 34 | @racket[(irc-send-message connection "#racket" "Hello, world!")] 35 | 36 | @section{Data Structures} 37 | 38 | @defstruct*[irc-message 39 | ([prefix (or/c string? #f)] 40 | [command string?] 41 | [parameters (listof string?)] 42 | [content string?])]{ 43 | 44 | Represents an IRC message, parsed into the @racket[prefix], @racket[command], and 45 | @racket[parameters]. If the message did not contain a prefix, @racket[prefix] is @racket[#f]. The 46 | original raw message line is available in the @racket[content] field.} 47 | 48 | @section{Procedures} 49 | 50 | @defproc[(irc-connection? [object any]) 51 | boolean?]{ 52 | 53 | Returns true if the given object is an IRC connection; false otherwise.} 54 | 55 | @defproc[(irc-connect [server string?] 56 | [port (and/c exact-nonnegative-integer? 57 | (integer-in 1 65535))] 58 | [nick string?] 59 | [username string?] 60 | [real-name string?] 61 | [#:return-eof return-eof boolean? #f] 62 | [#:ssl ssl (or/c ssl-client-context? 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12 boolean?) #f]) 63 | (values irc-connection? evt?)]{ 64 | 65 | Connects to @racket[server] on @racket[port] using @racket[nick] as the IRC nickname, 66 | @racket[username] as the username, and @racket[real-name] as the user's real name. Returns a 67 | connection object and an event that will be ready for synchronization when the server is ready to 68 | accept more commands. If @racket[return-eof] is @racket[#t], the incoming stream will include an 69 | end-of-file whenever the underlying TCP stream receives one (e.g. if the connection fails). 70 | If @racket[ssl] is not @racket[#f] the connection will be made over SSL/TLS with the appropriate 71 | SSL/TLS mode or client context.} 72 | 73 | @defproc[(irc-connection-incoming [connection irc-connection?]) 74 | async-channel?]{ 75 | 76 | Returns the channel for incoming messages on the given connection. All responses from the server are 77 | sent to this channel, and will be an @racket[irc-message] or one of its subtypes, or @racket[eof] if 78 | the server closes the connection and the @racket[return-eof] option was used when establishing the 79 | connection.} 80 | 81 | @defproc[(irc-join-channel [connection irc-connection?] 82 | [channel string?]) 83 | void?]{ 84 | 85 | Joins the IRC channel @racket[channel].} 86 | 87 | @defproc[(irc-part-channel [connection irc-connection?] 88 | [channel string?]) 89 | void?]{ 90 | 91 | Parts from (leaves) the IRC channel @racket[channel].} 92 | 93 | @defproc[(irc-send-message [connection irc-connection?] 94 | [target string?] 95 | [message string?]) 96 | void?]{ 97 | 98 | Sends @racket[message] to @racket[target]. @racket[target] should be either a channel name or an IRC 99 | nick.} 100 | 101 | @defproc[(irc-send-notice [connection irc-connection?] 102 | [target string?] 103 | [notice string?]) 104 | void?]{ 105 | 106 | Sends the notice @racket[notice] to @racket[target]. @racket[target] should be either a channel name 107 | or an IRC nick.} 108 | 109 | @defproc[(irc-get-connection [host string?] 110 | [port (and/c exact-nonnegative-integer? 111 | (integer-in 1 65535))] 112 | [#:return-eof return-eof boolean? #f] 113 | [#:ssl ssl (or/c ssl-client-context? 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12 boolean?) #f]) 114 | irc-connection?]{ 115 | 116 | Establishes a connection to the IRC server @racket[host] on the given @racket[port]. When 117 | @racket[return-eof] is @racket[#t], @racket[eof] will be returned over the incoming channel when the 118 | server closes the connection. If @racket[ssl] is not @racket[#f] the connection will be made over 119 | SSL/TLS with the appropriate SSL/TLS mode or client context. 120 | 121 | Use this form instead of @racket[irc-connect] when you want more control over when to send the NICK 122 | and USER commands.} 123 | 124 | @defproc[(irc-set-nick [connection irc-connection?] 125 | [nick string?]) 126 | void?]{ 127 | 128 | Sets the nickname for this connection to @racket[nick]. Note that @racket[irc-connect] runs this 129 | command for you when the connection is first established.} 130 | 131 | @defproc[(irc-set-user-info [connection irc-connection?] 132 | [username string?] 133 | [real-name string?]) 134 | void?]{ 135 | 136 | Sets the user name and real name for this connection to @racket[username] and @racket[real-name], 137 | respectively . Note that @racket[irc-connect] runs this command for you when the connection is first 138 | established.} 139 | 140 | @defproc[(irc-quit [connection irc-connection?] 141 | [quit-message string? ""]) 142 | void?]{ 143 | 144 | Quits the IRC session with an optional @racket[quit-message] and closes the connection.} 145 | 146 | @defproc[(irc-send-command [connection irc-connection?] 147 | [command string?] 148 | [args string?] ...) 149 | void?]{ 150 | 151 | Sends the given IRC @racket[command] ands its @racket[args] over the given @racket[connection]. This 152 | is the most general method for sending commands to IRC, but the other functions described above 153 | should be preferred where applicable.} 154 | 155 | @section{CTCP} 156 | 157 | CTCP is an embeded protocol within IRC that allows for actions such as @code{/me} commands. This 158 | package currently has basic support for CTCP. 159 | 160 | @defproc[(ctcp-action [connection irc-connection?] 161 | [target string?] 162 | [action string?]) 163 | void?]{ 164 | 165 | Sends the given action to the target, usually displayed in the channel as " " 166 | (i.e. the expected result of a @code{/me} command). @racket[target] should be either a channel name 167 | or an IRC nick.} 168 | 169 | @section{Further Information} 170 | 171 | For more information on the IRC client protocol, see @hyperlink["http://tools.ietf.org/html/rfc2812" "RFC 2812"]. 172 | -------------------------------------------------------------------------------- /irc/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide irc-get-connection 4 | irc-connection-incoming 5 | irc-send-command 6 | irc-send-message 7 | irc-send-notice 8 | irc-join-channel 9 | irc-part-channel 10 | irc-connect 11 | irc-set-nick 12 | irc-set-user-info 13 | irc-quit 14 | irc-connection? 15 | (struct-out irc-message)) 16 | 17 | ;; --------------------------------------------------------------------------------------------------- 18 | 19 | (require racket/async-channel 20 | racket/list 21 | racket/match 22 | racket/string 23 | racket/tcp 24 | openssl 25 | "private/numeric-replies.rkt") 26 | 27 | (module+ test 28 | (require rackunit)) 29 | 30 | (struct irc-connection (in-port out-port in-channel handlers)) 31 | (struct irc-message (prefix command parameters content) #:transparent) 32 | 33 | (define irc-connection-incoming irc-connection-in-channel) 34 | 35 | (define (irc-get-connection host port 36 | #:return-eof [return-eof #f] 37 | #:ssl [ssl #f]) 38 | (define-values (in out) (match ssl 39 | [#f (tcp-connect host port)] 40 | [#t (ssl-connect host port)] 41 | [_ (ssl-connect host port ssl)])) 42 | (file-stream-buffer-mode out 'line) 43 | (define in-channel (make-async-channel)) 44 | (define handlers (make-hash)) 45 | (define connection (irc-connection in out in-channel handlers)) 46 | (add-handler connection send-to-user) 47 | (add-handler connection handle-ping) 48 | 49 | (thread (lambda () 50 | (let loop () 51 | (sync in) 52 | (define line (if (port-closed? in) eof (read-line in 'return-linefeed))) 53 | (cond 54 | [(eof-object? line) 55 | (when return-eof 56 | (async-channel-put in-channel line))] 57 | [else 58 | (define message (parse-message line)) 59 | (when message 60 | ;; convert to list here so that we can remove hash table elements during the loop 61 | (for ([kv (hash->list (irc-connection-handlers connection))]) 62 | ((cdr kv) message connection (car kv)))) 63 | (loop)])))) 64 | connection) 65 | 66 | (define (irc-send-command connection command . parameters) 67 | (fprintf (irc-connection-out-port connection) 68 | "~a ~a\r\n" 69 | command 70 | (string-join parameters))) 71 | 72 | (define (add-handler connection callback) 73 | (hash-set! (irc-connection-handlers connection) (gensym) callback)) 74 | 75 | (define (remove-handler connection handler-id) 76 | (hash-remove! (irc-connection-handlers connection) handler-id)) 77 | 78 | (define (send-to-user message connection handler-key) 79 | (async-channel-put (irc-connection-in-channel connection) message)) 80 | 81 | (define (handle-ping message connection handler-key) 82 | (match message 83 | [(irc-message _ "PING" params _) 84 | (irc-send-command connection "PONG" (string-append ":" (first params)))] 85 | [_ (void)])) 86 | 87 | (define (irc-set-nick connection nick) 88 | (irc-send-command connection "NICK" nick)) 89 | 90 | (define (irc-set-user-info connection username real-name) 91 | (irc-send-command connection 92 | "USER" 93 | username 94 | "0" 95 | "*" 96 | (string-append ":" real-name))) 97 | 98 | 99 | ;; Connects to an IRC server, returning the connection and an event that will be ready for 100 | ;; synchronization when the server is ready for more commands 101 | (define (irc-connect server port nick username real-name 102 | #:return-eof [return-eof #f] 103 | #:ssl [ssl #f] 104 | #:password [password #f]) 105 | (define connection (irc-get-connection server port #:return-eof return-eof #:ssl ssl)) 106 | (define sema (make-semaphore)) 107 | (add-handler connection (listen-for-connect sema)) 108 | (when password 109 | (irc-send-command connection "PASS" password)) 110 | (irc-set-nick connection nick) 111 | (irc-set-user-info connection username real-name) 112 | (values connection sema)) 113 | 114 | (define ((listen-for-connect sema) message connection handler-id) 115 | (match message 116 | [(irc-message _ RPL_WELCOME _ _) 117 | (semaphore-post sema) 118 | (remove-handler connection handler-id)] 119 | [_ (void)])) 120 | 121 | (define (irc-join-channel connection channel) 122 | (irc-send-command connection "JOIN" channel)) 123 | 124 | (define (irc-part-channel connection channel) 125 | (irc-send-command connection "PART" channel)) 126 | 127 | (define (irc-send-message connection target message) 128 | (irc-send-command connection 129 | "PRIVMSG" 130 | target 131 | (string-append ":" message))) 132 | 133 | (define (irc-send-notice connection target message) 134 | (irc-send-command connection 135 | "NOTICE" 136 | target 137 | (string-append ":" message))) 138 | 139 | (define (irc-quit connection [quit-message ""]) 140 | (if (string=? quit-message "") 141 | (irc-send-command connection "QUIT") 142 | (irc-send-command connection "QUIT" quit-message)) 143 | (close-output-port (irc-connection-out-port connection)) 144 | (close-input-port (irc-connection-in-port connection))) 145 | 146 | ;; Given the string of an IRC message, returns an irc-message that has been parsed as far as possible, 147 | ;; or #f if the input was unparsable 148 | (define (parse-message message) 149 | (define parts (string-split message " " #:trim? #f)) 150 | (define prefix (if (and (pair? parts) 151 | (string-prefix? (list-ref parts 0) ":")) 152 | (substring (list-ref parts 0) 1) 153 | #f)) 154 | (cond [(> (length parts) (if prefix 1 0)) 155 | (define command (list-ref parts (if prefix 1 0))) 156 | (define param-parts (list-tail parts (if prefix 2 1))) 157 | (irc-message prefix command (parse-params param-parts) message)] 158 | [else #f])) 159 | 160 | ;; Given the list of param parts, return the list of params 161 | (define (parse-params parts) 162 | (define first-tail-part (find-first-tail-part parts)) 163 | (cond [first-tail-part 164 | (define tail-with-colon (string-join (list-tail parts first-tail-part))) 165 | (define tail-param (if (string-prefix? tail-with-colon ":") 166 | (substring tail-with-colon 1) 167 | tail-with-colon)) 168 | (append (take parts first-tail-part) 169 | (list tail-param))] 170 | [else parts])) 171 | 172 | ;; Return the index of the first part that starts the tail parameters; of #f if no tail exists 173 | (define (find-first-tail-part param-parts) 174 | (define first-colon-index (memf/index (lambda (v) (string-prefix? v ":")) 175 | param-parts)) 176 | (cond [(or first-colon-index (> (length param-parts) 14)) 177 | (min 14 (if first-colon-index first-colon-index 14))] 178 | [else #f])) 179 | 180 | ;; Like memf, but returns the index of the first item to satisfy proc instead of 181 | ;; the list starting at that item. 182 | (define (memf/index proc lst) 183 | (define memf-result (memf proc lst)) 184 | (cond [memf-result (- (length lst) (length memf-result))] 185 | [else #f])) 186 | 187 | ;; Run these via ``raco test main.rkt'' 188 | (module+ test 189 | (define (message-equal? m1 m2) 190 | (and (equal? (irc-message-prefix m1) (irc-message-prefix m2)) 191 | (equal? (irc-message-command m1) (irc-message-command m2)) 192 | (equal? (irc-message-parameters m1) (irc-message-parameters m2)))) 193 | 194 | (define-check (check-parse input expected-prefix expected-command expected-args) 195 | (let ([actual (parse-message input)] 196 | [expected (irc-message expected-prefix 197 | expected-command 198 | expected-args 199 | input)]) 200 | (with-check-info* 201 | (list (make-check-actual actual) 202 | (make-check-expected expected)) 203 | (lambda () 204 | (when (not 205 | (message-equal? 206 | actual 207 | expected)) 208 | (fail-check)))))) 209 | 210 | (check-parse ":my-prefix my-command arg1 arg2 arg3" 211 | "my-prefix" 212 | "my-command" 213 | (list "arg1" "arg2" "arg3")) 214 | (check-parse ":my-prefix my-command arg1 arg2 arg3 :4 5 6 7 8 9 0 1 2 3 4 5 6" 215 | "my-prefix" 216 | "my-command" 217 | (list "arg1" "arg2" "arg3" "4 5 6 7 8 9 0 1 2 3 4 5 6")) 218 | (check-parse ":my-prefix my-command arg1 arg2 arg3 4 5 6 7 8 9 0 1 2 3 4 5" 219 | "my-prefix" 220 | "my-command" 221 | (list "arg1" "arg2" "arg3" "4" "5" "6" "7" "8" "9" "0" "1" "2" "3" "4" "5")) 222 | (check-parse "my-command arg1 arg2 arg3 4 5 6 7 8 9 0 1 2 3 4 5 6" 223 | #f 224 | "my-command" 225 | (list "arg1" "arg2" "arg3" "4" "5" "6" "7" "8" "9" "0" "1" "2" "3" "4" "5 6")) 226 | 227 | (check-parse "my-command arg1 arg2 arg3 4 :5 6 7 8 9 0 1 2 3 4 5 6" 228 | #f 229 | "my-command" 230 | (list "arg1" "arg2" "arg3" "4" "5 6 7 8 9 0 1 2 3 4 5 6"))) 231 | -------------------------------------------------------------------------------- /irc/private/numeric-replies.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide RPL_WELCOME) 4 | 5 | ;; --------------------------------------------------------------------------------------------------- 6 | 7 | (define RPL_WELCOME 1) 8 | --------------------------------------------------------------------------------