/
irc.arc
78 lines (66 loc) · 1.92 KB
/
irc.arc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
(def connect (host port)
($ (let-values (((in out) (tcp-connect ,host ,port)))
(list in out))))
(def disconnect (out)
($ (close-output-port ,out)))
(def init-irc ()
(= irc-in* nil
irc-out* nil
irc-user* nil
irc-nick* nil
irc-server* nil
irc-logfile* nil
irc-thread* nil))
(def irc-connect (server user (o password nil))
(let (i o) (connect server 6667)
(= irc-in* i
irc-out* o
irc-server* server)
(irc-login user password)))
(def irc commands
(w/stdout irc-out*
(apply pr commands)
(pr "\r\n"))
(pr ">>>")
(apply pr commands)
(prn))
(def irc-msg (channel msg)
(if (> len.msg 440)
(let (str rest)
(apply (afn (str . rest)
(if (< (len (+ str " " car.rest)) 440)
(apply self (cons (+ str " " car.rest) cdr.rest))
(list str (reduce + (intersperse " " rest)))))
tokens.msg)
(irc "PRIVMSG " channel " :" str)
(irc-msg channel rest))
(irc "PRIVMSG " channel " :" msg)))
(def nick (nick)
(irc "NICK " nick))
(def ident (user realname)
(irc "USER " user " 0 * :" realname))
(def part channels
(irc "PART :" (apply string (intersperse "," channels))))
(def irc-login (user password)
nick.user
(ident user user)
(aif password
(irc-msg "NickServ" (string "identify " it))))
(def irc-pong (line)
(if (headmatch "PING" line)
(irc (subst "PONG" "PING" line))))
(def irc-loop (parse)
(whilet line (readline irc-in*)
prn.line
irc-pong.line
(aif parse it.line)))
(def irc-parse (line)
(if (posmatch "PRIVMSG" line)
(let (nick user host command chan . msg) (tokens line [pos _ ":@! "])
(= msg (apply string (intersperse ":" (cdr:tokens line #\:))))
(list nick user host command chan msg))
nil))
(mac w/irc (chan . body)
`(map [irc-msg ,chan _]
(fromstring (tostring ,@body)
(drain:readline))))