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"