REBOL [
Title: "IRC Core client"
Date: 6-Dec-2002/20:00:39+1:00
Version: 0.1.2
File: %irc-core.r
Author: "Oldes"
Purpose: {There already are some Rebol IRC clients, but what I know, there was no clients running only in the console... so there is one...}
Comment: {
^-Thanks to Paul Tretter for inspiration (some parts of this script as the
^-IRC identification are based on his work [REBBOT])
^-
^-I'm not regular IRC user so it's not well tested yet!}
Email: oliva.david@seznam.cz
Category: [net tcp]
e-mail: oliva.david@seznam.cz
note: {IRC documentations:
^-http://www.faqs.org/rfc/rfc1459.txt - "Internet Relay Chat Protocol"
^-http://www.faqs.org/rfc/rfc2810.txt - "Internet Relay Chat: Architecture"
^-http://www.faqs.org/rfc/rfc2811.txt - "Internet Relay Chat: Channel Management"
^-http://www.faqs.org/rfc/rfc2812.txt - "Internet Relay Chat: Client Protocol"
^-http://www.faqs.org/rfc/rfc2813.txt - "Internet Relay Chat: Server Protocol"}
]
system/console/busy
botname: "RebLeda"
ident-name: botuser: "Reb"
joinchannel: "#rebol"
;channels: make block! 5
tchannel: make object! [
name: none
topic: none
mode: none
users: make block! 10
]
cprint?: true
debug?: off ;off
remove-colors?: either system/version/4 = 3 [true][false]
;it's not possible to see colors in the Windows console:(
escapechar: charset "^Q^C^A" ;there are probably more of them
normalchar: complement escapechar
digits: charset "0123456789"
space: charset [#" "]
non-space: complement space
to-space: [some non-space | end]
idents: none
params: prefix: nick: user: host: servername: none
preptxt: func[txt /local tmp][
if not remove-colors? [return txt]
tmp: make string! 512
parse/all txt [any [
#"^Q"
| #"^A" ;action
| #"^C" some digits #"," some digits
| copy t some normalchar (insert tail tmp t)
]]
tmp
]
pad: func[txt c][head insert/dup tail txt " " c - length? txt]
cprint: func[msg /err /inf][
if cprint? [
if block? msg [msg: rejoin msg]
either err [insert msg "!!! "][if inf [insert msg "*** "]]
if not empty? console/buffer [console/clear-line]
print preptxt msg
if not empty? console/buffer [prin console/buffer]
]
]
dprint: func[msg][
if debug? [
if not empty? console/buffer [console/clear-line]
print msg
if not empty? console/buffer [prin console/buffer]
]
]
console: make object! [
buffer: make string! 512
history: make block! 1000
port: open/binary [scheme: 'console]
clear-line: func[][ loop length? buffer [prin "^(back) ^(back)"] ]
process: func/local ch c tmp spec-char err][
ch: to-char pick port 1
either (ch = newline) or (ch = #"^M") [;ENTER
tmp: copy buffer
if empty? tmp [return none]
history: head history
if any [empty? history tmp <> first history ] [
insert history tmp
]
clear-line
clear buffer
switch/default c: first tmp [
#"[" [ if error? err: try [do next tmp][bot-error disarm err] ]
#"/" [
either find/part tmp "/me" 3 [
;action (emotions)
say/action skip tmp 4
][ irc-port-send next tmp ]
]
][ say tmp ]
][
switch/default to-binary ch [
#{08} [;BACK
if 0 < length? buffer [
prin "^(back) ^(back)"
remove back tail buffer
]
]
#{1B} [;ESCAPE
switch spec-char: copy/part port 2 [
#{5B41} [;ARROW UP
if not tail? history [
clear-line
prin buffer: copy history/1
history: next history
]
]
#{5B42} [;ARROW DOWN
if not error? try [history: back history][
clear-line
prin buffer: copy history/1
]
]
#{5B44} [;ARROW LEFT
clear-line
clear buffer
]
]
]
;#{09} [ prin ""];TAB
][
prin ch ;either local-echo [ch]["*"]
append buffer ch
]
]
]
]
bot-error: func[err /local type id arg1 arg2 arg3][
set [type id arg1 arg2 arg3] reduce [err/type err/id err/arg1 err/arg2 err/arg3]
cprint/err [
"Bot-" system/error/:type/type ": "
reduce bind system/error/:type/:id 'arg1
]
cprint/err ["** Where: " mold err/where]
cprint/err ["** Near: " mold err/near]
]
irc-port-send: func[msg [block! string!]][
msg: either string? msg [msg][rejoin msg]
dprint ["IRCOUT: " msg]
insert irc-open-port msg
]
say: func[txt /to whom /action][
if not to [whom: tchannel/name]
if block? txt [txt: rejoin txt]
txt: parse/all txt "^/"
forall txt [
irc-port-send either action [
cprint ["* " botname " " txt/1]
["PRIVMSG " whom " :^AACTION " txt/1 #"^A" ]
][
cprint ["> " txt/1]
["PRIVMSG " whom " :" txt/1 ]
]
]
]
reply: func[txt /action /local whom][
whom: either params/1 = botname [nick][params/1]
either action [say/action/to txt whom][say/to txt whom]
]
chat-rules: [
;add your own rules here:
[thru "Rebol" to end][
reply "Check out http://www.rebol.com for Rebol related informations"
]
]
chat-parser: func[msg /local err tmp][
foreach [rule action] chat-rules [
if parse/all msg rule [
if error? err: try [do action][ bot-error disarm err]
]
]
]
irc-parser: func[msg /local tmp][
params: make block! 10
prefix: none
parse/all msg [
opt [#":" copy prefix some non-space some space ]
copy command some non-space
any [
some space #":" copy tmp to end (append params tmp)
| some space copy tmp to-space (append params tmp)
]
]
nick: user: host: servername: none
if not none? prefix [
either found? find prefix "@" [
set [nick user host] parse prefix "!@"
][ servername: copy prefix]
]
dprint msg
dprint reform ["PARSED: " mold prefix mold command mold params]
switch/default command [
"PING" [irc-port-send ["PONG " params]]
"JOIN" [
tchannel/name: copy first params
cprint/inf either user = botuser [
["You have joined channel " tchannel/name]
][
insert tchannel/users nick
[nick " (" user "@" host ") has joined channel " tchannel/name]
]
]
"PART" [
cprint/inf rejoin [nick " has left channel " params/1]
]
"PRIVMSG" [
cprint rejoin either params/1 = tchannel/name [
either "^AACTION" = copy/part params/2 7 [
["* " nick skip params/2 7]
][ ["<" nick "> " params/2] ]
][ ["*" nick "* " params/2] ]
chat-parser params/2
]
"NOTICE" [
either none? nick [cprint/inf params/2][
cprint either #"#" = params/1/1 [
["-" nick ":" params/1 "- " params/2]
][ ["-" nick "- " params/2]]
]
]
"MODE" [
cprint/inf [
{Mode change "} next params {" }
either params/1/1 = #"#" ["on channel "]["for user "] params/1 { by } nick
]
if tchannel/name = params/1 [tchannel/mode: copy next params]
]
"NICK" [
cprint/inf either nick = botname [
["You are now known as " params/1]
][ [nick " is now known as " params/1] ]
botname: copy params/1
]
"QUIT" [
cprint/inf [
"Signoff: " nick " (" user ") "
either find/part params/1 "WinSock error" 13 [params/2][""]
]
error? try [remove find tchannel/users nick]
]
"INVITE" [
cprint/inf [nick " invites you to channel " last params]
]
"TOPIC" [
cprint/inf either nick = botname [
["You have changed the topic on channel " params/1 " to " params/2]
][ [nick " has changed the topic on channel " params/1 " to " params/2] ]
]
"KICK" [
cprint/inf [
either botname = params/2 ["You have"][rejoin [params/2 " has"]]
" been kicked off channel " params/1 " by " nick " (" params/3 ")"
]
]
;errors:
"401" [cprint/err [ params/2 " - " params/3]] ;ERR_NOSUCHNICK
"402" [cprint/err [ params/2 " - " params/3]] ;ERR_NOSUCHSERVER
"403" [cprint/err [ params/2 " - " params/3]] ;ERR_NOSUCHCHANNEL
"404" [cprint/err [ params/2 " - " params/3]] ;ERR_CANNOTSENDTOCHAN
"405" [cprint/err [ params/2 " - " params/3]] ;ERR_TOOMANYCHANNELS
"406" [cprint/err [ params/2 " - " params/3]] ;ERR_WASNOSUCHNICK
"407" [cprint/err [ params/2 " - " params/3]] ;ERR_TOOMANYTARGETS
"409" [cprint/err [ params/2]] ;ERR_NOORIGIN
"411" [cprint/err [ params/2]] ;ERR_NORECIPIENT
"412" [cprint/err [ params/2]] ;ERR_NOTEXTTOSEND
"413" [cprint/err [ params/2 " - " params/3]] ;ERR_NOTOPLEVEL
"414" [cprint/err [ params/2 " - " params/3]] ;ERR_WILDTOPLEVEL
"421" [cprint/err [ params/2 " - " params/3]] ;ERR_UNKNOWNCOMMAND
"422" [cprint/err [ params/2]] ;ERR_NOMOTD
"423" [cprint/err [ params/2 " - " params/3]] ;ERR_NOADMININFO
"424" [cprint/err [ params/2]] ;ERR_FILEERROR
"431" [cprint/err [ params/2]] ;ERR_NONICKNAMEGIVEN
"432" [cprint/err [ params/2 " - " params/3]] ;ERR_ERRONEUSNICKNAME
"433" [cprint/err [ params/1 " - " params/2]] ;ERR_NICKNAMEINUSE
"436" [cprint/err [ params/2 " - " params/3]] ;ERR_NICKCOLLISION
"441" [cprint/err [ params/2 " " params/3 " - " params/4]] ;ERR_USERNOTINCHANNEL
"442" [cprint/err [ params/2 " - " params/3]] ;ERR_NOTONCHANNEL
"443" [cprint/err [ params/2 " " params/3 " - " params/4]] ;ERR_USERONCHANNEL
"444" [cprint/err [ params/2 " - " params/3]] ;ERR_NOLOGIN
"445" [cprint/err [ params/2]] ;ERR_SUMMONDISABLED
"446" [cprint/err [ params/2]] ;ERR_USERSDISABLED
"451" [cprint/err [ params/2]] ;ERR_NOTREGISTERED
"461" [cprint/err [ params/2 " - " params/3]] ;ERR_NEEDMOREPARAMS
"462" [cprint/err [ params/2]] ;ERR_ALREADYREGISTRED
"463" [cprint/err [ params/2]] ;ERR_NOPERMFORHOST
"464" [cprint/err [ params/2]] ;ERR_PASSWDMISMATCH
"465" [cprint/err [ params/2]] ;ERR_YOUREBANNEDCREEP
"467" [cprint/err [ params/2 " - " params/3]] ;ERR_KEYSET
"471" [cprint/err [ params/2 " - " params/3]] ;ERR_CHANNELISFULL
"472" [cprint/err [ params/2 " - " params/3]] ;ERR_UNKNOWNMODE
"473" [cprint/err [ params/2 " - " params/3]] ;ERR_INVITEONLYCHAN
"474" [cprint/err [ params/2 " - " params/3]] ;ERR_BANNEDFROMCHAN
"475" [cprint/err [ params/2 " - " params/3]] ;ERR_BADCHANNELKEY
"481" [cprint/err [ params/2]] ;ERR_NOPRIVILEGES
"482" [cprint/err [ params/2 " - " params/3]] ;ERR_CHANOPRIVSNEEDED
"483" [cprint/err [ params/2]] ;ERR_CANTKILLSERVER
"491" [cprint/err [ params/2]] ;ERR_NOOPERHOST
"501" [cprint/err [ params/2]] ;ERR_UMODEUNKNOWNFLAG
"502" [cprint/err [ params/2]] ;ERR_USERSDONTMATCH
"999" [cprint/err [ params/2]] ;ERR_COMMNOTFOUND
;Command responses:
"300" [];RPL_NONE
"204" [cprint/inf ["Oper [" params/3 "] ==> " params/4]];RPL_TRACEOPERATOR
"211" [cprint/inf next params];RPL_STATSLINKINFO
"212" [cprint/inf next params];RPL_STATSCOMMANDS
"213" [cprint/inf next params];RPL_STATSCLINE
"214" [cprint/inf next params];RPL_STATSNLINE
"215" [cprint/inf next params];RPL_STATSILINE
"216" [cprint/inf next params];RPL_STATSKLINE
"218" [cprint/inf next params];RPL_STATSYLINE
"219" [];RPL_ENDOFSTATS
"221" [cprint/inf next params];RPL_UMODEIS
"205" [cprint/inf ["User [" params/3 "] ==>"]];RPL_TRACEUSER
"242" [cprint/inf next params];RPL_STATSUPTIME
"243" [cprint/inf next params];RPL_STATSOLINE
"244" [cprint/inf next params];RPL_STATSHLINE
"250" [cprint/inf params/2] ;RPL_STATSDLINE
"251" [cprint/inf params/2 irc-port-send ["JOIN " joinchannel]];RPL_LUSERCLIENT
"252" [cprint/inf [params/2 " " params/3]] ;RPL_LUSEROP
"253" [cprint/inf [params/2 " " params/3]] ;RPL_LUSERUNKNOWN
"254" [cprint/inf [params/2 " " params/3]] ;RPL_LUSERCHANNELS
"255" [cprint/inf params/2] ;RPL_LUSERME
"256" [cprint/inf [params/2 " - " params/3]] ;RPL_ADMINME
"257" [cprint/inf params/2] ;RPL_ADMINLOC1
"258" [cprint/inf params/2] ;RPL_ADMINLOC2
"259" [cprint/inf params/2] ;RPL_ADMINEMAIL
"301" [cprint/inf [params/2 " is away (" params/3 ")"]];RPL_AWAY
"303" [cprint/inf either 1 < length? params [["Currently online: " next params]]["Nobody is online"]];RPL_ISON
"305" [cprint/inf reform next params]
"306" [cprint/inf reform next params]
"311" [cprint/inf [params/2 " is " params/3 "@" params/4 " (" last params ")"]];RPL_WHOISUSER
"312" [cprint/inf ["on irc via server " params/3 " (" params/4 ")"]];RPL_WHOISSERVER
"313" [cprint/inf [params/2 " is " params/3]];RPL_WHOISOPERATOR
"315" [];RPL_ENDOFWHO
"317" [;use [t][
;t: to-time params/3
cprint/inf [params/2 " has been idle: " to-time to-integer params/3]
cprint/inf [params/2 " is online since: " 1-1-1970/0:0:0 + to-time to-integer params/4]
];];RPL_WHOISIDLE
"318" [];RPL_ENDOFWHOIS
"319" [cprint/inf rejoin ["on channels: " mold parse last params ""]] ;RPL_WHOISCHANNELS
"321" [cprint/inf "Channel Users Topic" ];RPL_LISTSTART
"322" [cprint/inf [pad params/2 11 pad params/3 7 params/4]];RPL_LIST
"323" [];RPL_LISTEND
"331" [cprint/inf reform next params];RPL_NOTOPIC
"332" [cprint/inf ["Topic for " params/2 ": " params/3]];RPL_TOPIC
"341" [cprint/inf ["Inviting " params/2 " to channel " params/3]];RPL_INVITING
"351" [cprint/inf ["Server " params/3 ": " params/2 " " params/4]];RPL_VERSION
"352" [cprint/inf [
pad params/2 11
pad params/3 10
pad params/7 4
params/6 "@" params/4
" (" find/tail params/8 " " ")"
]];RPL_WHOREPLY
"353" [
params/4: sort parse params/4 ""
if tchannel/name = params/3 [tchannel/users: copy params/4]
cprint/inf ["Users at " pad params/3 10 mold params/4]
]
"366" [];RPL_ENDOFNAMES
"375" [cprint/inf params/2] ;RPL_MOTDSTART
"372" [cprint/inf reform next params] ;RPL_MOTD
"376" [];RPL_ENDOFMOTD
"371" [cprint/inf params/2] ;RPL_INFO
"374" [];RPL_ENDOFINFO
"381" [cprint/inf last params];RPL_YOUREOPER
"391" [cprint/inf ["Server (" params/2 ") time: " params/3]]
"392" [cprint/inf params/2];RPL_USERSSTART
"393" [cprint/inf params/2];RPL_USERS
"394" [];RPL_ENDOFUSERS
;Other responses:
"001" [cprint/inf params/2 error? try [close idents] ]
"002" [cprint/inf params/2]
"003" [cprint/inf params/2]
"004" [cprint/inf reform next params]
][
cprint msg
]
]
getirc-port-data: does [
either error? getirc-port-data-error: try [irc-input-buffer: copy/part irc-open-port 1] [
getirc-port-data-error: disarm getirc-port-data-error
error-proc getirc-port-data-error
cprint "Error Generated at GETIRC-PORT-DATA function!"
return ""
][
if type? irc-input-buffer = block! [irc-input-buffer: to-string irc-input-buffer]
if irc-input-buffer = "none" [
;disconnected
cprint/inf "Connection closed"
close irc-open-port
close console/port
halt
]
]
return irc-input-buffer
]
handshake: does [
irc-port-send ["NICK " botname] cprint ["Bot is sending " botname]
irc-port-send ["USER " botuser " " system/network/host-address " ircserv :" system/user/name]
cprint "Bot is sending USER data"
;irc-port-send ["JOIN " joinchannel] cprint ["Bot is joining " joinchannel]
]
start-ident: does [
cprint "IDENT SERVER IS NOW ON"
idents: open/direct/lines tcp://:113
]
connect-to-irc: func[host /port p /channel ch][
if channel [joinchannel: ch unset 'ch]
irc-port: compose [
scheme: 'tcp
host: (host)
port-id: (either port [p][6667])
user-data: 'irc
]
start-ident
irc-open-port: open/lines/direct/no-wait irc-port
error? try [console/port: open/binary [scheme: 'console]]
handshake
forever [
ready: wait/all waitports: [irc-open-port console/port idents 120]
if ready [
foreach port ready [
if port = console/port [console/process]
if port = irc-open-port [irc-parser getirc-port-data]
if port = idents [
cprint/inf "Ident request!"
ident-connection: first idents
ident-buffer: first ident-connection
if find/any reform ident-buffer "* , *" [
insert ident-connection rejoin [ident-buffer " : USERID : REBOL : " ident-name]
]
]
]
]
]
]
connect-to-irc/channel "irc.sh.cvut.cz" "#lebeda"