mirror of
https://github.com/GeorgeMcMullen/rxIRC.git
synced 2026-01-29 21:40:48 +00:00
462 lines
15 KiB
Plaintext
462 lines
15 KiB
Plaintext
/* rxIRC
|
|
* Internet Relay Chat client program for VM/CMS systems
|
|
* created by Lynx (244661 at DOLUNI1) on Thursday, 14 Feb 1991
|
|
* last change by Lynx (244661 at DOLUNI1) on Friday, 10 Jan 1992
|
|
* Version 1.3 (using PREXX)
|
|
* Code contributions/suggestions by: Doug Sewell
|
|
*
|
|
* requires REXTCPIP MODULE by Ken Hornstein (kxh105@psuvm.bitnet)
|
|
* available from LISTSERVs carrying the VM-UTIL list
|
|
*
|
|
* Copyright (C)1991 by Carlo v. Loesch and Uni Oldenburg, Germany
|
|
* All rights reserved. No guarantees implied. ("AS IS" etc.)
|
|
* No distribution of modified copies permitted, pls send changes to me.
|
|
*/ vers='1.3'
|
|
cmds='AWAY AWAIT ADMIN CHANNEL CONNECT DEOPER DIE GRPH HASH INVITE',
|
|
'INFO ISON JOIN NICK KILL LIST LINKS LUSERS MODE MAIL MOTD NAMES',
|
|
'NICK NOTICE NOTE OPER PASS PART REHASH RESTART QUIT SERVICE SQUIT',
|
|
'SUMMON STATS TOPIC TIME TRACE USERS USERHOST VOICE VERSION WHOIS',
|
|
'WHOWAS WALLOPS WALL XTRA'
|
|
log=0; query=; ignore=; lastsender=; onoff.1="on"; onoff.0="off"
|
|
cmdchar=; userinfo=; profile="IRC PROFILE *"; target=time('R')
|
|
invitation=; writelog = "EXECIO 1 DISKW IRC LOG A0 (STRI"
|
|
tcprc=0; msa=d2c(1); realname=; c=0
|
|
ignore_reply = "Your messages are not being received."
|
|
address "COMMAND"; trace 'O'
|
|
"IDENTIFY (LIFO"
|
|
pull me . mynode . via .
|
|
|
|
"REXTCPIP" /* oh how i still love this command */
|
|
if rc^=0 then call BYE "REXTCPIP MODULE returning" rc
|
|
|
|
"NAMEF :NICK RXIRC :SERVER :PORT :TIMEOUT :LOGGING :QUIET_IGNORE",
|
|
":HILIGHTCHAR :BEEPCHAR :LOUD_BEEPS :SHOW_NUMBERS :LIST_ALL",
|
|
"(LIFO FILE RXIRC"
|
|
if rc^=0 then call BYE "missing or unreadable RXIRC NAMES file"
|
|
pull def_listall; pull def_numb; pull def_loud; parse pull beep
|
|
parse pull hilight; pull def_quiet; pull def_log
|
|
parse pull timeout; parse pull def_port; parse pull def_server
|
|
"GLOBALV SELECT CENV GET IRCNICK IRCSERVER IRCNAME IRCPORT"
|
|
|
|
"NAMEFIND :USERID" me ":NICK :NAME :MOTTO :CMDCHAR :IRCNICK :IRCNAME",
|
|
"(LIFO"
|
|
if rc=0 then do
|
|
parse pull name; parse pull nick
|
|
if ircnick="" then ircnick=nick
|
|
if ircname="" then ircname=name
|
|
parse pull cmdchar; parse pull userinfo
|
|
parse pull realname; parse pull nick
|
|
if ircnick="" then ircnick=nick
|
|
if ircname="" then ircname=realname
|
|
end
|
|
|
|
parse arg nick server name '('o; upper o
|
|
if nick^='' then ircnick = nick
|
|
if ircnick='' then ircnick=me
|
|
capnick = translate(ircnick)
|
|
if server^='' then ircserver=server
|
|
else if ircserver='' then ircserver=def_server
|
|
if name^='' then ircname = name
|
|
if ircname='' then ircname=me "at" mynode".bitnet"
|
|
if cmdchar="" then cmdchar="/"
|
|
do while o^=""
|
|
parse var o opt o
|
|
select
|
|
when abbrev("PORT", opt, 1) then parse var o ircport o
|
|
when abbrev("LIST_ALL", opt, 2) then parse var o def_listall o
|
|
when abbrev("LOGGING", opt, 1) then parse var o def_log o
|
|
when abbrev("LOUD_BEEPS", opt, 3) then parse var o def_loud o
|
|
when abbrev("NUMBERS", opt, 1) then parse var o def_numb o
|
|
when abbrev("QUIET_IGNORE", opt, 1) then parse var o def_quiet o
|
|
when abbrev("TIMEOUT", opt, 1) then parse var o timeout o
|
|
otherwise call BYE "Unknown option" opt
|
|
end
|
|
end
|
|
if ircport='' then ircport=def_port
|
|
if timeout="" then timeout=25
|
|
if def_listall="ON" then listall=1; else listall=0
|
|
if def_log="ON" then log=1; else log=0
|
|
if def_loud="ON" then loud=1; else loud=0
|
|
if def_numb="ON" then numb=1; else numb=0
|
|
if def_quiet="ON" then quiet=1; else quiet=0
|
|
if log then writelog "* IRC Session started on" date() "at" time()
|
|
if datatype(left(ircnick,1))='NUM' then ircnick='u'ircnick
|
|
"IMMCMD SET HI"
|
|
if userinfo="" then userinfo="- no info given by user -"
|
|
|
|
"VMFCLEAR"
|
|
call OUT "rxIRC v"vers "- You are" ircnick "("ircname")"
|
|
call OUT "Logging is" onoff.log"; Loud beeps are",
|
|
onoff.loud"; Quiet ignore is" onoff.quiet
|
|
call CONNECT ircserver
|
|
say copies("-",79)
|
|
"CP TERM LINEND OFF"
|
|
"CP TERM CHARDEL OFF"
|
|
|
|
do forever
|
|
"IMMCMD STATUS HI"
|
|
if rc^=0 then call EDIT "hi"
|
|
if c^=0 then do
|
|
TCPRECEIVE(c, "WAITKB", "EXPAND")
|
|
select
|
|
when tcprc=0 then do i=1 to tcpline.0
|
|
call OUT PARSE(tcpline.i)
|
|
end
|
|
when tcprc=25 then do externals()
|
|
parse external ext; call CONS ext; ext=time('R')
|
|
end
|
|
when tcprc=12 then do; c=0; call CLOSE "Oops"; end
|
|
when tcprc=18|tcprc=20 then call CLOSE
|
|
when tcprc=0|tcprc=8|tcprc=9 then nop
|
|
otherwise
|
|
call CLOSE "Unknown error" tcprc "from REXTCPIP"
|
|
end
|
|
end
|
|
end
|
|
call BYE "Murphy's Law"
|
|
|
|
CONS:
|
|
parse arg keys
|
|
call EDIT keys
|
|
if out^="" then TCPSEND(c, out)
|
|
return
|
|
|
|
PARSE:
|
|
parse arg a
|
|
if loud & pos(x2c(2f),a)^=0 then "BEEP"
|
|
b=; a=translate(a,hilight||beep||"_",d2c(2)x2c(2f)x2c(32))
|
|
if left(a,1)=':' then do
|
|
parse var a ':'s m e f ':'g
|
|
parse var s s'!'sad
|
|
end
|
|
else do; s=''; parse var a m e f ':'g; end
|
|
f=strip(f)
|
|
select
|
|
when m='CHANNEL' then if e="0"
|
|
then b='***' s 'leaves this channel'
|
|
else b='***' s 'joins this channel'
|
|
when m='INVITE' then do
|
|
invitation = f
|
|
b='***' s 'invites you to channel' f; end
|
|
when m='JOIN' then do
|
|
b='***' s 'joins channel' e
|
|
if s=ircnick then target=word(e,1)
|
|
end
|
|
when m='KICK' then b='***' s 'kicks' f 'off channel' e
|
|
when m='KILL' then b='*** You were killed by' s subword(g,2)
|
|
when m='MODE' then b='*** Mode change:' s 'sets' e f
|
|
when m='MSG' then b='<'s'>' g
|
|
when m='NICK' then b='***' s 'is now known as' e
|
|
when m='NOTICE' then select
|
|
when s='' then b=g
|
|
when translate(e)=capnick then do
|
|
if find(ignore,translate(s))^=0 then do
|
|
return ''; end
|
|
else do; b='-'s'-' g
|
|
lastsender=s
|
|
end
|
|
end
|
|
when left(e,1)='+'|left(e,1)='-'|datatype(left(e,1))='NUM' then b=s g
|
|
otherwise b='-'s':'e'-' g; end
|
|
when m='PART' then b='***' s 'parts channel' e
|
|
when m='PING' then TCPSEND(c, "PONG :"ircnick)
|
|
when m='PRIVMSG' then select
|
|
when translate(e)=capnick then do
|
|
if find(ignore,translate(s))^=0 then do
|
|
if ^quiet then TCPSEND(c, 'NOTICE' s ':'ignore_reply)
|
|
return ''; end
|
|
else do
|
|
if CTCP(1 g) then b='*'s'*' g
|
|
lastsender=s
|
|
end
|
|
end
|
|
when e=target|left(e,1)='+'|left(e,1)='-'|datatype(left(e,1))='NUM'
|
|
then if CTCP(0 g) then b='<'s'>' g
|
|
otherwise if CTCP(0 g) then b='<'s':'e'>' g; end
|
|
when m='QUIT' then b='*** Signoff:' s '('g')'
|
|
when m='TOPIC' then b='***' s 'sets the topic to:' g
|
|
when m='WALLOPS' then b='*** Wallops from' s':' g
|
|
when m='WALL' then b='*** Broadcast from' s':' g
|
|
when m='301' then b=f 'is away:' g
|
|
when m='311' then do
|
|
parse var f ni ui no .
|
|
b=ni 'is' ui'@'no '('g')'
|
|
end
|
|
when m='314' then do; parse var f ni ui no .
|
|
b=ni 'was' ui'@'no '('g')'; end
|
|
when m='312' then b='via server' f '('g')'
|
|
when m='319' then b='on channels:' g
|
|
when m='317' then b='and has been idle' word(f,2) 'seconds'
|
|
when m='322' then do
|
|
parse var f ch n
|
|
if listall | g^="" | n>2 then
|
|
b=left(ch,13) left(n,4)g
|
|
else return ''
|
|
end
|
|
when m='324' then b='*** The mode on channel' word(f,1) 'is' word(f,2)
|
|
when m='332' then b='*** The topic is:' g
|
|
when m='341' then b='*** Inviting' word(f,1) 'to channel' word(f,2)
|
|
when m='353' then b=left(word(f,2),10) g
|
|
when m='NAMREPLY' then do
|
|
parse var f na ni; b=left(na,10) ni; end
|
|
when m='WHOREPLY'|m='352' then do
|
|
if m='352' then parse var f . us no . ni st .
|
|
else parse var f us no . ni st .
|
|
b=left(st,3)left(ni,10)left(us"@"no,31) g
|
|
end
|
|
when m='313'|m='364'|m='LINREPLY' then b=f g
|
|
when m='315'|m='318'|m='321'|m='323'|m='365'|m='366'|m='406'
|
|
then nop
|
|
otherwise select
|
|
when g="" then b=f
|
|
when f=""|f=s then b=g
|
|
otherwise b=f":" g
|
|
end
|
|
if s^="" then b='('s')' b
|
|
if numb then b=m b
|
|
end
|
|
return translate(b,"@",msa)
|
|
|
|
EDIT:
|
|
out=; parse arg in
|
|
if in='' then nop
|
|
else if left(in,1)="!" then do
|
|
address CMS substr(in,2); say "rxIRC ready("rc");"; end
|
|
else if left(in,1)^=cmdchar then do
|
|
if query='' then out='PRIVMSG' target ':'in
|
|
else out='PRIVMSG' query ':'in
|
|
end
|
|
else if left(in,2)=cmdchar' ' then do
|
|
parse var in 3 r; out='MSG :'r
|
|
end
|
|
else do; parse var in 2 q r; upper q
|
|
select
|
|
when q=''|q='SAY' then out='PRIVMSG' target ':'r
|
|
when left(q,1)='*' then return
|
|
when abbrev('ABORT',q,2) then call BYE "user abort request"
|
|
when abbrev('BYE',q,1)|abbrev('SIGNOFF',q,1) then
|
|
do; TCPSEND(c, 'QUIT'); TCPCLOSE(c); call BYE; end
|
|
when abbrev('CHANNEL',q,1) then do
|
|
if r="" then do; call OUT "* Talking to" target; return; end
|
|
if target^="" then TCPSEND(c, "PART" target);
|
|
out="JOIN" r
|
|
end
|
|
when abbrev('CLEAR',q,2) then "VMFCLEAR"
|
|
when abbrev('CMDCHARACTER',q,2) then cmdchar=left(r,1)
|
|
when abbrev('EXECUTE',q,1) then do
|
|
address 'CMS' r; say "rxIRC ready("rc");"; end
|
|
when abbrev('FOLLOW',q,1) then out='JOIN' invitation
|
|
when abbrev('HELP',q,1) then do
|
|
address CMS "HELP RXIRC"; say; end
|
|
when abbrev('LOGGING',q,2) then call LOGGING r
|
|
when abbrev('NICKNAME',q,2) then if r='' then out='WHOIS' nick
|
|
else do; out='NICK' r; ircnick=r; capnick=translate(r); end
|
|
when abbrev('REPLY',q,1) then call QUERY lastsender
|
|
when abbrev('SERVER',q,3) then call CONNECT r
|
|
when abbrev('STATUS',q,2) then do; out='WHOIS' ircnick
|
|
call OUT '* Target:' target'; Query:' query'; Invitation:' invitation'; Last sender:' lastsender
|
|
end
|
|
when abbrev('TALKTO',q,2) then do
|
|
if r^="" then target=word(r,1)
|
|
call OUT '* Now talking to' target
|
|
end
|
|
when abbrev('VERSION',q,3) then do; out='VERSION'
|
|
call OUT '* rxIRC v'vers 'written by the lynx (lynx@dm.unirm1.it)'
|
|
end
|
|
when abbrev('XAMINE',q,1) then out='WHOIS' lastsender
|
|
when abbrev('DATE',q,1) then out="TIME" r
|
|
when abbrev('DESCRIBE',q,2) then do; parse var r whom desc
|
|
out='PRIVMSG' whom ':'msa'ACTION' desc||msa; end
|
|
when abbrev('IGNORE',q,2) then call IGNORE r
|
|
when abbrev('MSG',q,1)|abbrev('MESSAGE',q,3) then out='PRIVMSG' r
|
|
when abbrev('QUERY',q,1) then call QUERY r
|
|
when abbrev('REQUEST',q,3)|q='CTCP' then do
|
|
parse var r ni rq .; upper rq
|
|
if ni="" then ni=capnick
|
|
if rq="" then rq="VERSION"
|
|
out='PRIVMSG' ni ':'msa||rq||msa
|
|
end
|
|
when q='WHO' then if r="" then out='WHO' target
|
|
else out='WHO' r
|
|
when abbrev('TCPIPSTATUS',q,3) then do; CONNSTAT(c)
|
|
call OUT '*' local_addr'!'local_port '->' foreign_addr'!'foreign_port,
|
|
conn_stat '(BU:'bytes_to_read', UB:'unacked_bytes')'
|
|
end
|
|
otherwise if ACTION(q r) then do
|
|
call OUT ircnick r
|
|
if query="" then out='PRIVMSG' target ':'msa'ACTION' r||msa
|
|
else out='PRIVMSG' query ':'msa'ACTION' r||msa
|
|
end
|
|
else do
|
|
li=cmds; out=q r
|
|
do while li^=''; parse var li el li
|
|
if abbrev(el,q,1) then do; out=el r; leave; end
|
|
end
|
|
end
|
|
end
|
|
end
|
|
out=translate(out,x2c(2f),beep)
|
|
return out
|
|
|
|
IGNORE:
|
|
arg a
|
|
do words(a)
|
|
parse var a ig a
|
|
z=find(ignore,ig); if z^=0 then
|
|
ignore=strip(delword(ignore,z,1))
|
|
else ignore=ig ignore
|
|
end
|
|
call OUT 'You are ignoring:' ignore
|
|
if quiet then say "And you don't send notices about it (quiet ignore)."
|
|
return
|
|
|
|
QUERY:
|
|
parse arg qq
|
|
if query^='' then call OUT '* Terminating query with' query
|
|
query=qq
|
|
if qq^='' then call OUT '* Starting a query with' qq
|
|
else call OUT '* Talking to' target
|
|
return
|
|
|
|
|
|
LOGGING:
|
|
arg a
|
|
if a='ON' & log=0 then do
|
|
writelog "IRC Log started on" date() "at" time()
|
|
say '* Logging started.'; log=1; end
|
|
else if a='OFF' & log=1 then do
|
|
writelog "IRC Log ended on" date() "at" time()
|
|
say '* Logging ended.'; log=0; end
|
|
else say '* Logging is' onoff.log
|
|
return
|
|
|
|
OUT:
|
|
parse arg x
|
|
if x="" then return
|
|
if length(x) < 81 then q=0
|
|
else do 1
|
|
q=pos(word(x,2),x)-1; if q>30 then q=0
|
|
p=lastpos(" ",x,80)
|
|
if p<40 then do; q=0; leave; end
|
|
b=left(x,p); x=substr(x,p+1)
|
|
say b; if log then writelog b
|
|
do while length(x)+q > 80
|
|
p=lastpos(" ",x,80-q); if p<40 then leave
|
|
b=copies(" ",q)left(x,p); x=substr(x,p+1)
|
|
say b; if log then writelog b
|
|
end
|
|
end
|
|
x=copies(" ",q)x; say x; if log then writelog x
|
|
return
|
|
|
|
CONNECT:
|
|
parse arg ircserver port time .
|
|
if ircserver="" then do
|
|
call OUT "* Provide an internet server address as arguement"
|
|
return
|
|
end
|
|
if datatype(port)="NUM" then ircport = port
|
|
if datatype(time)="NUM" then timeout = time
|
|
if c ^= 0 then do
|
|
TCPSEND(c, "QUIT"); TCPCLOSE(c); "CP SLEEP 3 SEC"; end
|
|
if (datatype(left(ircserver,1))^="NUM") then do
|
|
say "Resolving domain name address" ircserver
|
|
ircserver = GETIPADDR(ircserver)
|
|
if tcprc^=0 then call BYE "unresolvable address" ircserver
|
|
end
|
|
say "Connecting to" ircserver "on port" ircport", timeout after" timeout "seconds"
|
|
c = TCPOPEN(ircserver, ircport, timeout)
|
|
select
|
|
when tcprc=6 then call CLOSE "Host not responding within time"
|
|
when tcprc=8 then call CLOSE "No server running on port" ircport
|
|
when tcprc^=0 & tcprc^=2004 then
|
|
call CLOSE "Unknown error" tcprc "while trying to connect"
|
|
when c=0 then call CLOSE "Have no connection!"
|
|
otherwise
|
|
TCPSEND(c, "NICK" ircnick)
|
|
TCPSEND(c, "USER" me mynode "." ircname)
|
|
"STATE" profile
|
|
if rc=0 then do
|
|
"EXECIO * DISKR" profile "(FINIS STEM IN."
|
|
do i=1 to in.0
|
|
call EDIT in.i
|
|
if out^="" then TCPSEND(c, out)
|
|
end
|
|
end
|
|
end
|
|
return
|
|
|
|
|
|
CTCP:
|
|
parse arg fla bla
|
|
if pos(msa,bla)=0 then return 1
|
|
bla=translate(bla,'\',d2c(1))
|
|
parse var bla . '\' ctcp bla '\' .
|
|
select
|
|
when ctcp="ACTION" then call OUT s bla
|
|
when ctcp="CLIENTINFO" then
|
|
call MSAREPLY "CLIENTINFO ACTION CLIENTINFO FINGER VERSION USERINFO"
|
|
when ctcp="FINGER" then
|
|
call MSAREPLY "FINGER" realname '('me'@'mynode'.bitnet) - Idle time is',
|
|
time('E')
|
|
when ctcp="VERSION" then
|
|
call MSAREPLY "VERSION rxIRC v"vers "VM/CMS",
|
|
":The best you can get for VM/CMS systems..."
|
|
when ctcp="USERINFO" then
|
|
call MSAREPLY "USERINFO" userinfo
|
|
otherwise if fla=1 then
|
|
call MSAREPLY "ERRMSG Huh? Can't do" ctcp
|
|
end
|
|
return 0
|
|
|
|
MSAREPLY:
|
|
parse arg lyrics
|
|
TCPSEND(c, "NOTICE" s ":"msa||lyrics||msa)
|
|
return
|
|
|
|
CLOSE:
|
|
parse arg culprit
|
|
if c^=0 then do
|
|
TCPCLOSE(c); c=0
|
|
end
|
|
call BYE culprit
|
|
return
|
|
|
|
BYE:
|
|
parse arg culprit
|
|
if culprit^= "" then say "Terminating:" culprit" (tcprc:" tcprc")"
|
|
if log then do
|
|
writelog "IRC Session ended on" date() "at" time()
|
|
"FINIS * * *"
|
|
end
|
|
"IMMCMD CLEAR HI"
|
|
"NUCXDROP REXTCPIP"
|
|
/* "CP TERM CHARDEL @" -- do you need this one? let me know */
|
|
"CP TERM LINEND #"
|
|
exit tcprc
|
|
|
|
ACTION:
|
|
parse arg q r
|
|
select
|
|
when q="BOW" then a="bows gracefully"
|
|
when q="COMFORT" then a="comforts you"
|
|
when q="CUDDLE" then a="cuddles you"
|
|
when q="DANCE" then a="dances a waltz with you"
|
|
when q="GIGGLE" then a="giggles inanely"
|
|
when q="GRIN" then a="grins evilly"
|
|
when q="HUG" then a="hugs you"
|
|
when q="LAUGH" then a="falls down laughing"
|
|
when q="ME"|abbrev("EMOTE",q,1) then return 1
|
|
when q="NOD" then a="nods solemnly"
|
|
when q="SHRUG" then a="shrugs helplessly"
|
|
when q="SIGH" then a="sighs deeply"
|
|
when abbrev("SMILE",q,2) then a="smiles happily"
|
|
when abbrev("THANK",q,2) then a="thanks you from the bottom of the heart"
|
|
when q="WAVE" then a="waves goodbye to you"
|
|
when q="WINK" then a="winks suggestively"
|
|
when q="YAWN" then a="yawns tiredly"
|
|
otherwise return 0; end
|
|
if r="" then r=a'.'
|
|
else r=word(a,1) r'.'
|
|
return 1
|