/servers.rkt
Shell | 285 lines | 257 code | 21 blank | 7 comment | 5 complexity | 3cdc4d53fc478d9a98001f09dc3caa54 MD5 | raw file
1#! /bin/sh 2#| Hey Emacs, this is -*-scheme-*- code! 3if [ "x$BOTDEBUG" != "xno" ]; then 4 exec racket -l errortrace --require $0 --main -- ${1+"$@"} 5else 6 exec racket --require $0 --main -- ${1+"$@"} 7fi 8|# 9 10#lang racket 11 12(require "loop.rkt" 13 (except-in "vars.rkt" log) 14 "git-version.rkt" 15 (except-in "quotes.rkt" main) 16 (except-in "clearenv.rkt" main) 17 (only-in "incubot.rkt" make-test-corpus) 18 (only-in "iserver.rkt" make-incubot-server) 19 scheme/port) 20 21(define (real-server) 22 (let-values ([(ip op) (tcp-connect (*irc-server-hostname*) 23 (*irc-server-port*))]) 24 (file-stream-buffer-mode op 'line) 25 (values ip op))) 26 27(define (make-preloaded-server op) 28 (lambda () 29 (values (let-values ([(ip op) (make-pipe)]) 30 (thread 31 (lambda () 32 (define (meh str) 33 (format ":n!n@n PRIVMSG #c :~a" 34 str)) 35 (define (c str) 36 (format ":n!n@n PRIVMSG #c :~a: ~a" 37 (unbox *my-nick*) 38 str)) 39 (define (p str) 40 (format ":n!n@n PRIVMSG ~a :~a" 41 (unbox *my-nick*) 42 str)) 43 (for-each 44 (lambda (line) 45 (display line op) 46 (display "\r\n" op)) 47 (cond 48 (#f 49 (list 50 (meh "Hey everyone! What's happening?") 51 (c "uptime") 52 (c "settle") 53 (meh "frotz: plotz.") 54 (c "everyone") 55 (c "plotz") 56 (meh "\1ACTION fred eats salami\1") 57 (c "salami"))) 58 (#f 59 ;; Typical stuff from ircd-seven 60 `(":bartol.freenode.net NOTICE * :*** No Ident response" 61 ":notice!NickServ@services. NOTICE rudybot :This nickname is registered. Please choose a different nickname, or identify via \u0002/msg NickServ identify <password>\u0002.") 62 ) 63 (#f 64 `( 65 ":t8!n=foo@bar PRIVMSG #ch :,t8" 66 ":t8!n=foo@bar PRIVMSG #ch :,t8 fr" 67 ":t8!n=foo@bar PRIVMSG #ch :,t8 fr de" 68 ,(format ":t8!n=foo@bar PRIVMSG #ch :~a: t8 en it kits, cats, sacks, wives: how many were going to St Ives?" (unbox *my-nick*)) 69 ":t8!n=foo@bar PRIVMSG #ch :,t8 en hu I will not buy this record, it is scratched" 70 ":t8!n=foo@bar PRIVMSG #ch : ,t8 en hu I will not buy this translation; it contains leading whitespace")) 71 (else 72 `( 73 ,(c (format "eval (error \"foo\\r\\nQUIT bar\")")) 74 ":freenode-connect!freenode@freenode/bot/connect PRIVMSG upstartbot :\u0001VERSION\u0001" 75 "foO!" 76 "PING :localhost." 77 ":sykopomp!n=user@host-70-45-40-165.onelinkpr.net PRIVMSG #emacs :\u0001ACTION is wondering if it's easy to save any logs from bitlbee to a different folder than all the irc logs.\u0001" 78 ":arcfide!n=arcfide@VPNBG165-7.umsl.edu PRIVMSG #scheme :\u0001ACTION sighs. \u0001" 79 80 ":action!n=No@unaffiliated/clue PRIVMSG #ch :\u0001ACTION does an action!\u0001" 81 ":invite!n=No@unaffiliated/clue INVITE upstartbot :##mircscripts" 82 ":join!n=Aaron@b415.adsl.ecomtel.com.au JOIN :#scheme" 83 ":duncanm!n=duncanm@b415.adsl.ecomtel.com.au JOIN :#scheme" 84 ":kick!n=chandler@opendarwin/developer/chandler KICK #scheme lumon :http://www.penny-arcade.com/comic/2003/11/07/" 85 ":kick2!n=asc@pdpc/supporter/active/kensanata KICK #emacs jordanb :you too" 86 ":mode!ChanServ@services. MODE #emacs +o alephnull " 87 ":nick!n=Aaron@b415.adsl.ecomtel.com.au NICK :AshyIsMe" 88 ":nick2!n=Aaron@b415.adsl.ecomtel.com.au NICK :AshyIsMe" 89 ":notice!NickServ@services. NOTICE rudybot :This nickname is registered. Please choose a different nickname, or identify via \u0002/msg NickServ identify <password>\u0002." 90 ":notice2!i=christel@freenode/staff/exherbo.christel NOTICE $* :[Global Notice] Aaaaand we make contact! A small step for manki..oh wai-! Sorry about the delay there and thank you for your patience. Services are now back up!" 91 ":part!n=Akaleb@bl6-112-187.dsl.telepac.pt PART #emacs :\"Changed major mode\"" 92 ":quit!n=adam@yax.org.uk PRIVMSG #ch :This is my last utterance before quitting." 93 ":quit!n=adam@yax.org.uk QUIT :Client Quit" 94 ":topic!n=javachat@cpe-74-71-143-65.twcny.res.rr.com TOPIC #emacs :-=[ www.WHAK.com ]=- Make Free/Fun Graphics Online At http://www.ImageGenerator.org =)" 95 96 ,(c "version") 97 ,(c "SOURCE") 98 ,(c "quote") 99 ,(format ":t8!n=foo@bar PRIVMSG #ch :~a: t8 en it kits, cats, sacks, wives: how many were going to St Ives?" (unbox *my-nick*)) 100 ":t8!n=foo@bar PRIVMSG #ch :,t8 en hu I will not buy this record, it is scratched" 101 ":t8!n=foo@bar PRIVMSG #ch : ,t8 en hu I will not buy this translation; it contains leading whitespace" 102 103 ,(format ":t8!n=foo@bar PRIVMSG #ch :~a: t8 snord horde" (unbox *my-nick*)) 104 105 ,(format ":jordanb!n@n PRIVMSG #c :~a: quote" (unbox *my-nick*)) 106 ,(format ":jordanb!n@n PRIVMSG #c :Let's say something memorable") 107 ,(format ":n!n@n PRIVMSG #emacs :,...") 108 ,(format ":n!n@n PRIVMSG #not-emacs :,...") 109 ,(format ":n!n@n PRIVMSG #c :~a:~a" (unbox *my-nick*) "lookboynospaces") 110 ,(format ":n!n@n PRIVMSG #c :~a:" (unbox *my-nick*) ) 111 ,@(for/list ([action (in-list (list "action" "invite" "join" "kick" "kick2" "mode" "nick" "nick2" "notice" "notice2" "part" "quit" "topic"))]) 112 (c (format "seen ~a" action))) 113 114 ":niven.freenode.net 001 rudybot :Welcome to the freenode IRC Network rudybot" 115 ,(format 116 ":NickServ!NickServ@services. NOTICE ~a :If this is your nickname, type /msg NickServ \0002IDENTIFY\0002 <password>" 117 (unbox *my-nick*)) 118 119 ,@(apply 120 append 121 (for/list ([expr (in-list '((+ 2 1) 122 (begin (display (+ 2 1)) (newline)) 123 (let loop () 124 (printf "Yaa!!") 125 (loop)) 126 (require srfi/1) 127 (make-list 100000) 128 (apply values (make-list 100000))))]) 129 (list 130 (c (format "eval ~s" expr)) 131 (p (format "eval ~s" expr))))) 132 133 ,@(map c (list "quote" "uptime")) 134 ,@(map p (list "This is a private utterance, and I certainly hope you don't divulge it!!")) 135 ,(c "seen n") 136 ;; This should work, if you set BOTMASTER in the 137 ;; environment before running this test. 138 ,(c "system ls /") 139 140 ;; This should yield an empty string. 141 ,(c "eval (getenv \"PATH\")") 142 143 ;; This should simply not blow up. 144 ,(p "eval (number->string #d10000000000000000000000000000000000000000000000000000000000 16)") 145 )))) 146 (close-output-port op))) 147 ip) 148 op))) 149 150(define (make-log-replaying-ip-port log-file-name (max-lines 'all)) 151 (let-values ([(ip op) (make-pipe)]) 152 (thread 153 (lambda () 154 (call-with-input-file log-file-name 155 (lambda (ip) 156 (let/ec return 157 (for ([line (in-lines ip)] 158 [lines-handled (in-naturals)]) 159 (when (equal? lines-handled max-lines) 160 (return)) 161 (match line 162 [(regexp #px"<= (\".*\")" (list _ datum)) 163 (display (read (open-input-string datum)) op) 164 (display #\return op) 165 (newline op)] 166 [_ #f]))) 167 (close-output-port op))))) 168 ip)) 169 170(define (make-flaky-server log-file-name) 171 (lambda () 172 (when (zero? (random 3)) 173 (raise (make-exn:fail:network 174 "de network, she be broke" 175 (current-continuation-marks)))) 176 177 (values (make-log-replaying-ip-port log-file-name 20) 178 (open-output-nowhere)))) 179 180(define (make-log-replaying-server log-file-name) 181 (lambda () 182 (values (make-log-replaying-ip-port log-file-name) 183 (relocate-output-port 184 (current-output-port) 185 #f #f 1 #f)))) 186 187(define (make-random-server) 188 189 (define (random-bytes [length 200]) 190 (let ([r (make-bytes length)]) 191 (for ([i (in-range length)]) 192 (let new-byte () 193 (let ([b (random 256)]) 194 (case b 195 [(10 13) (new-byte)] 196 [else (bytes-set! r i b)])))) 197 r)) 198 199 (let-values ([(ip op) (make-pipe)]) 200 (thread 201 (lambda () 202 (let loop ([lines-emitted 0]) 203 (when (< lines-emitted 200) 204 (display #":ow!ow@ow PRIVMSG #ow :" op) 205 (display (random-bytes) op) 206 (display #"\r\n" op) 207 (loop (add1 lines-emitted)))) 208 (close-output-port op))) 209 210 (values ip (open-output-nowhere)))) 211 212(define (make-hanging-up-server) 213 (lambda () 214 (let-values ([(ip op) (make-pipe)]) 215 (thread 216 (lambda () 217 (for ([line (in-list '("NOTICE AUTH :*** Looking up your hostname..." 218 "NOTICE AUTH :*** Found your hostname, welcome back" 219 "NOTICE AUTH :*** Checking ident" 220 "NOTICE AUTH :*** No identd (auth) response" 221 "ERROR :Closing Link: 127.0.0.1 (Connection Timed Out)"))]) 222 (fprintf op "~a\r~%" line)) 223 224 (sleep 1) 225 (close-output-port op))) 226 227 (values ip (open-output-nowhere))))) 228 229 230(define (replay-main . args) 231 (parameterize ([*bot-gives-up-after-this-many-silent-seconds* 1/4] 232 [*log-ports* (list (current-error-port))]) 233 (log "Main starting.") 234 (connect-and-run 235 (make-log-replaying-server "big-log") 236 #:retry-on-hangup? #f))) 237 238(define (preload-main . args) 239 (log "Main starting.") 240 (parameterize ([*bot-gives-up-after-this-many-silent-seconds* 1/4] 241 [*log-ports* (list (current-error-port))] 242 [*incubot-server* (make-incubot-server (make-test-corpus))] 243 [*incubot-logger* log]) 244 (connect-and-run 245 (make-preloaded-server (open-output-nowhere)) 246 #:retry-on-hangup? #f))) 247 248(define (localhost-main . args) 249 (log "Main starting: ~a" (git-version)) 250 (parameterize ([*irc-server-hostname* "localhost"]) 251 (connect-and-run real-server))) 252 253(define (flaky-main . args) 254 (parameterize ([*bot-gives-up-after-this-many-silent-seconds* 1/4] 255 [*log-ports* (list (current-error-port))]) 256 (random-seed 0) 257 (connect-and-run 258 (make-flaky-server "big-log") 259 #:retry-on-hangup? #t))) 260 261(define (random-main . args) 262 (parameterize ([*bot-gives-up-after-this-many-silent-seconds* 1/4] 263 [*log-ports* (list (current-error-port))]) 264 (random-seed 0) 265 (connect-and-run 266 make-random-server 267 #:retry-on-hangup? #f))) 268 269(define (hanging-up-main . args) 270 (parameterize ([*log-ports* (list (current-error-port))]) 271 (connect-and-run 272 (make-hanging-up-server)))) 273 274(define (main . args) 275 (fprintf (current-error-port) "Say goodbye to your environment ...") 276 (clearenv) 277 (fprintf (current-error-port) " poof~%") 278;; flaky-main 279;;; hanging-up-main 280;;; (localhost-main) 281 (preload-main) 282;;; random-main 283;;; replay-main 284 ) 285(provide (all-defined-out))