mirror of
https://github.com/GeorgeMcMullen/rxIRC.git
synced 2026-01-27 04:33:01 +00:00
1084 lines
32 KiB
Plaintext
1084 lines
32 KiB
Plaintext
/*
|
|
Local changes for VM/ESA 1.2.1 (REXX370 Vers. 4.00) or greater
|
|
-> The variable "b" in the routine "NICE" (around line 802-815)
|
|
was changed to "bb" because of the following change:
|
|
|
|
(c) Copyright IBM Corporation 1990, 1993
|
|
|
|
"462E Error 15 running fn ft, line nn: Invalid hexadecimal or binary
|
|
string
|
|
|
|
Explanation: Binary strings were new in VM/ESA Release 2, and the
|
|
language processor may now be considering the string in your statement
|
|
to be binary when that was not your intention.
|
|
|
|
... Or you may have put the 1-character symbol X, x, B, or b (the name
|
|
of the variable X or B, respectively) after a literal string, when the
|
|
string is not intended as a hexadecimal or binary specification."
|
|
*/
|
|
|
|
/* rxIRC
|
|
* Internet Relay Chat client program for VM/CMS systems
|
|
* written by Carl 'LynX' v. Loesch (loesch@informatik.uni-oldenburg.de)
|
|
* created by Lynx (244661 at DOLUNI1) on Thursday, 14 Feb 1991
|
|
* Credits for suggestions, code contribution, miscellaneous help go to:
|
|
* Jose Maria Blasco, Doug Sewell, Martin Ahlborn, Jim McMaster,
|
|
* Scott Maxell, Juan Courcoul, Rob Blais, Mike Letourneau, Grant Pair
|
|
* (in historical order mostly). Thank y'all very much!
|
|
*
|
|
* Extras (Pluses) written by George McMullen
|
|
* Thanks to Carl 'LynX' v. Loesch for his suggestions, ideas, and
|
|
* explanations of code, which made much of the additions possible.
|
|
*
|
|
* requires RXSOCKET MODULE version 2 by Arty Ecock (eckcu@cunyvm.bitnet)
|
|
*
|
|
* Copyright (C)1991,2,3 by Lynx & CvO University Oldenburg, Germany
|
|
* You may freely use this software at your own risk.
|
|
* No distribution of modified copies permitted, pls send changes to me.
|
|
*
|
|
* By the way, this is _not_ the source code of rxIRC. There exists a
|
|
* special file IRC PREXX which when run through a preprocessor produces
|
|
* the actual RXIRC EXEC. That file is commented. This one is not.
|
|
*/ vers='2.0.Plus (G)'; trace 'O'
|
|
address "COMMAND"; signal on HALT; "VMFCLEAR"
|
|
cmds='AWAY AWAIT ADMIN CHANNEL CONNECT DEOP DIE HASH INFO ISON JOIN KICK',
|
|
'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 WHOWAS WALLOPS WALL XTRA'
|
|
log=0; query=; ignore=; lastjoin=; lastsender=; onoff.1="on"; onoff.0="off"
|
|
invitation=; away=; ll.=; curll=1; logevent=0; target=time('R')
|
|
v.=; al.=; varnames=; aliasnames=; cmdchar=; userinfo=; sourcing=0
|
|
have_rxwt=0; who_empty=0; catmode=0; catlist=; abortsource=0; skiplines=0
|
|
jumpcoms=0;sourcenum=0;numons=0;display='display'
|
|
call SET 'display On'
|
|
|
|
"EXECIO * CP (STEM PF. STRING QUERY PF"
|
|
do i=1 to pf.0
|
|
a=word(pf.i,2)
|
|
if a/='UNDEFINED' & a/='RETRIEVE' then,
|
|
"CP SET" subword(pf.i,1,2) '!'subword(pf.i,3)
|
|
end
|
|
"EXECIO * CP (STEM QT. STRING QUERY TERM"
|
|
"CP TERM LINEND OFF"
|
|
"CP TERM CHARDEL OFF"
|
|
"CP TERM LINESIZE 130"
|
|
sock=; buffer=; alphalo=xrange('a','z'); alphahi=xrange('A','Z')
|
|
lf='25'x; cr='0d'x; msa='01'x; rev='02'x; beep='2fx; undl='32'x
|
|
bold='1f'x; hi='1de8'x; lo='1d60'x; yo='1d44'x
|
|
nice.=""; u@n.=; via.=;
|
|
realname=; servername=;
|
|
ignore_reply = "Your messages are not being received."
|
|
"IDENTIFY (LIFO"; pull me . mynode . rscs a .
|
|
logfile=translate(a,'_','/') "IRCLOG A0"
|
|
writelog="EXECIO 1 DISKW" logfile "(STRI"
|
|
'STATE RXSOCKET MODULE *'
|
|
if rc=0 then do
|
|
parse value SOCKET('version') with . . rc .
|
|
if rc >= 2.0 then rc=0
|
|
else rc=28
|
|
end
|
|
if rc/=0 then call BYE "RXSOCKET version 2 required"
|
|
do 3
|
|
parse value SOCKET('INITIALIZE', 'rxIRC', 1) with rc . etc
|
|
if rc=2004 then do
|
|
say '<cleaning up a zombie rxsocket nucext>'
|
|
'NUCXDROP RXSOCKET'
|
|
end
|
|
else leave
|
|
end
|
|
if rc/=0 then call BYE "initialize error:" etc
|
|
parse value SOCKET('GETHOSTNAME') with . hostname
|
|
parse value SOCKET('GETDOMAINNAME') with . domain
|
|
'REXXWAIT TEST'
|
|
select
|
|
when rc=0 then nop
|
|
when rc=1 then do
|
|
'REXXWAIT LOAD'
|
|
if rc/=0 then call BYE "REXXWAIT can't be loaded"
|
|
end
|
|
otherwise call BYE "REXXWAIT MODULE required"
|
|
end
|
|
have_rxwt=1
|
|
'IMMCMD SET HI'
|
|
"NAMEF :NICK RXIRC :SERVER :PORT :LOGGING :QUIET_IGNORE :SHOW_TIME ",
|
|
":BOLD_CHAR :BEEP_CHAR :LOUD_BEEPS :SHOW_NUMBERS :LIST_ALL :BROWSER",
|
|
"(LIFO FILE RXIRC"
|
|
if rc/=0 then call BYE "missing or unreadable RXIRC NAMES file"
|
|
pull viewcmd; pull def_listall; pull def_numb; pull def_loud
|
|
parse pull beepch; parse pull boldch; parse pull showtime; pull def_quiet
|
|
pull def_log; parse pull def_port; parse pull def_server
|
|
if viewcmd='' then call BYE 'no ":browser" tag defined in RXIRC NAMES'
|
|
if beepch='' then beepch=d2c(0)
|
|
if boldch='' then boldch=d2c(0)
|
|
"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
|
|
otherwise call BYE "unknown option" opt
|
|
end
|
|
end
|
|
if ircport='' then ircport=def_port
|
|
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
|
|
if ^datatype(showtime,'w') then showtime=80
|
|
if userinfo="" then userinfo="- no info given by user -"
|
|
|
|
parse value RESETVALUE('ALL') with rc .
|
|
if rc/=0 then call BYE "problem w/RESETVALUE"
|
|
parse value SETVALUE('TIME ==:=0:00') with rc .
|
|
if rc/=0 then call BYE "problem w/SETVALUE TIME"
|
|
parse value SETVALUE('MSG IUCV') with rc .
|
|
if rc/=0 then call BYE "problem w/SETVALUE MSG IUCV"
|
|
call S "rxIRC"hi||vers||yo"- You are" ircnick "("ircname")"
|
|
call S "Logging is" onoff.log"; Audible bells are",
|
|
onoff.loud"; Quiet ignore is" onoff.quiet
|
|
if showtime=80 then say "Time display is off"
|
|
else say "Time is displayed every" showtime "minutes"
|
|
call CONNECT ircserver
|
|
call S copies("-",79)lo
|
|
do forever
|
|
"IMMCMD STATUS HI"
|
|
if rc/=0 then call S,
|
|
'Sorry, "hi" is a system reserved word. Try an other operating system.'
|
|
parse value WAIT('TIME','CONS','MSG','SOCKET READ' sock) with rc type data
|
|
select
|
|
when rc/=0 then call BYE "REXXWAIT returning code" rc
|
|
when type='SOCKET' then do
|
|
parse value SOCKET('READ', sock) with rc . data
|
|
if rc=54 then call BYE
|
|
if rc/=0 then call BYE 'socket read error' rc
|
|
buffer = buffer || data
|
|
do forever
|
|
if index(buffer, lf)=0 then leave
|
|
parse var buffer in (lf) buffer
|
|
see=PARSE(strip(in,,cr))
|
|
parse var see com sndr' ### 'eye
|
|
call OUT eye
|
|
if sndr/='' & sndr/=servername & pos(sndr,v.0)^=0 then
|
|
call SET 0 sndr
|
|
see=com
|
|
do i= 0 to 9
|
|
see=see v.i
|
|
end
|
|
upper see
|
|
if numons>0 then do test=1 to numons
|
|
parse var on.test look '::' com
|
|
upper look
|
|
do exam=1 to words(look)
|
|
single=word(look,exam)
|
|
if single=word(see,exam)|single="*" then iterate
|
|
if right(single,1)="*" then
|
|
if pos(left(single,length(single)-1),word(see,exam))=1 then
|
|
iterate
|
|
if left(single,1)="*" then
|
|
if right(single,1)="*" then
|
|
if pos(substr(single,2,length(single)-2),word(see,exam)),
|
|
>=1 then iterate
|
|
else nop
|
|
else
|
|
if lastpos(right(single,length(single)-1),word(see,exam)),
|
|
= length(word(see,exam))-(length(single)-2)&,
|
|
length(word(see,exam))-(length(single)-2)^=0 then iterate
|
|
leave
|
|
end
|
|
if exam=words(look)+1 then call SHELL com
|
|
end
|
|
end
|
|
end
|
|
when type = 'CONS' then if data/='' then do
|
|
rc=time('R')
|
|
call EDIT data
|
|
curll=curll+1; ll.curll=hi||data||lo; k=curll-50; ll.k=;
|
|
if log then writelog ' 'data
|
|
end
|
|
when type = 'MSG' then do
|
|
parse var data . . no'('id'): 'data
|
|
if id='' then id='RSCS'
|
|
origin=id'@'no
|
|
ni=NICE(origin)
|
|
if FINDM(ignore,origin) | FINDM(ignore,ni) then do
|
|
if ^quiet & left(data,1)/='*' then call TELL origin '*' ignore_reply
|
|
end; else do
|
|
call OUT hi||ni':'lo||data
|
|
if away/='' & left(data,1)/='*' then call TELL origin '* away:' away
|
|
end
|
|
end
|
|
when type = 'TIME' then do
|
|
parse var data . hh':'mm':' .
|
|
if datatype(mm/showtime,'w') then call S 'It is now' hh':'mm
|
|
'EXECIO 1 CP(VAR A STR Q' me
|
|
parse var a . '-' a .
|
|
if a='DSC' then do
|
|
data='virtual machine runs disconnected'
|
|
call SEND 'QUIT :'data
|
|
call BYE data
|
|
end
|
|
end
|
|
otherwise
|
|
call S 'Unexpected event:' type data
|
|
end
|
|
end
|
|
call BYE "a rexx oddity"
|
|
|
|
PARSE:
|
|
parse arg a
|
|
if loud & pos(beep,a)/=0 then "BEEP"
|
|
b=; a=translate(a,"%"||beepch||"_",rev||beep||undl); bm=;
|
|
i=1; j=0; do forever; i=index(a,bold,i)
|
|
if i=0 then leave
|
|
if j=0 then a=insert(hi,a,i)
|
|
else a=insert(lo,a,i)
|
|
a=delstr(a,i,1)
|
|
j=1-j
|
|
end
|
|
if j=1 then a=a||lo
|
|
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)
|
|
logevent = 1
|
|
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
|
|
f=strip(word(f g,1))
|
|
invitation = f
|
|
lastsender = s
|
|
b='***' s '('sad') invites you to channel' f; end
|
|
when m='JOIN' then do
|
|
e=strip(word(e g,1))
|
|
b='***' s '('sad') joins channel' e
|
|
if s=ircnick then target=translate(e)
|
|
else lastjoin=s
|
|
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' f 'on' e
|
|
when m='MSG' then do
|
|
b='<'s'>' g
|
|
m='PUBLIC'
|
|
end
|
|
when m='NICK' then b='***' s 'is now known as' e||g
|
|
when m='NOTICE' then select
|
|
when s='' | s=servername then do
|
|
if word(g,1)="***" then b=subword(g,2)
|
|
else b=g
|
|
a=; parse var b 'Your host is 'g'['a .
|
|
if a/='' then servername=g
|
|
end
|
|
when translate(e)=capnick then do
|
|
if FINDM(ignore,s) | FINDM(ignore,sad) then do
|
|
return ''; end
|
|
else do; b='-'s'-' g
|
|
lastsender=s
|
|
end
|
|
end
|
|
otherwise b='-'s':'e'-' g; end
|
|
when m='PART' then b='***' s 'parts channel' e
|
|
when m='PING' then call SEND("PONG :"ircnick)
|
|
when m='PRIVMSG' then select
|
|
when translate(e)=capnick then do
|
|
if FINDM(ignore,s) | FINDM(ignore,sad) then do
|
|
if ^quiet then call SEND('NOTICE' s ':'ignore_reply)
|
|
return ''; end
|
|
else do
|
|
if CTCP(1 g) then do
|
|
b='*'s'*' g
|
|
m='MSG'
|
|
end
|
|
else do
|
|
m='CTCP'
|
|
parse var g . (msa) bm g (msa) .
|
|
bm=s bm g
|
|
end
|
|
lastsender=s
|
|
end
|
|
end
|
|
when ^CTCP(0 g) then do
|
|
m='CTCP'
|
|
parse var g . (msa) bm g (msa) .
|
|
bm=s bm g
|
|
end
|
|
when translate(e)=target then if CTCP(0 g) then do
|
|
b='<'s'>' g
|
|
m='PUBLIC'
|
|
end
|
|
otherwise if CTCP(0 g) then do
|
|
b='<'s':'e'>' g
|
|
m='PUBLIC'
|
|
end
|
|
end
|
|
when m='QUIT' then b='Signoff by' 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='221' then b='Your mode is' 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' word(f,2) '('g')'
|
|
when m='315' then if who_empty then do
|
|
bm='No matches for /who'
|
|
call S bm
|
|
end
|
|
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 ch/='*' & substr(ch,2,1)/='27'x then do
|
|
if catmode then do; if n>4 then catlist=ch catlist; end
|
|
else if listall | n>7 then do
|
|
bm=left(ch,13) left(n,4)g
|
|
call OUT left(ch,13) left(n,4)g
|
|
end
|
|
end; end
|
|
when m='323' then do
|
|
if catmode then do
|
|
call OUT 'Channels:' catlist; catlist=; catmode=0; end; 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='352' then do
|
|
parse var f ch us no . ni st .
|
|
if st="S" then return ''
|
|
who_empty=0; n=subword(g,2)
|
|
do forever; a=64-(length(n)+length(us)+length(no))
|
|
if (length(no)+a > 13) then leave
|
|
n=subword(n, 1, words(n)-1)'..'; end
|
|
if (a < 0) then k=hi||n||lo||us"@*"right(no,length(no)+a-1)
|
|
else if (ch/='*' & a>length(ch)) then
|
|
k=lo||ch||hi||n||lo||copies(' ',a-length(ch)-1)us"@"no
|
|
else k=hi||n||lo||copies(' ',a)us"@"no
|
|
bm=st ni ch us no n
|
|
call S left(st,3)yo||left(ni,9)k
|
|
end
|
|
when m='353' then do; ch=word(f,2); a=words(g)
|
|
if ch/='*' & (a>6 | translate(ch)=target) then do
|
|
bm=left(ch,15)||g
|
|
call OUT hi||left(ch,15)yo||g
|
|
end
|
|
end
|
|
when m='313'|m='364' then b=f g
|
|
when m='004'|m='318'|m='321'|m='365'|m='366'|m='406' then nop
|
|
when m='001' then do; servername=s; b=subword(g,1,words(g)-1); end
|
|
when m='252'|m='254' then b=f g
|
|
otherwise select
|
|
when g="" then b=f
|
|
when f=""|f=s then b=g
|
|
otherwise b=f":" g
|
|
end
|
|
if s/="" & s/=servername then b='('s')' b
|
|
if numb then b='{'m'}' b
|
|
end
|
|
if bm=''&b/='' then bm=b
|
|
do jjj=1 to 10
|
|
if word(bm,jjj)^='' then call SET jjj-1 word(bm,jjj)
|
|
else call UNSET jjj-1
|
|
if jjj>=10 then leave
|
|
end
|
|
return m s '###' translate(b,"@",msa)
|
|
|
|
VAR:
|
|
parse arg x
|
|
select
|
|
when x=',' then return lastsender
|
|
when x=':' then return lastjoin
|
|
when x='A' then return away
|
|
when x='C' then return target
|
|
when x='H' then return m
|
|
when x='I' then return invitation
|
|
when x='K' then return cmdchar
|
|
when x='N' then return ircnick
|
|
when x='Q' then return query
|
|
when x='S' then return servername
|
|
when x='T' then do
|
|
if query='' then return target
|
|
else return query
|
|
end
|
|
when x='V' then return vers
|
|
when x='Z' then return left(time(),5)
|
|
when x='$' then return '$'
|
|
otherwise return v.x
|
|
end
|
|
return '<error>'
|
|
|
|
SET:
|
|
parse arg r
|
|
if r='' then do i=1 to words(varnames)
|
|
r=word(varnames,i); call S '$('r') is "'v.r'"'
|
|
end
|
|
else do
|
|
parse var r vn vv
|
|
if b='' then call S 'Variable' vn 'has the value "'v.vv'"'
|
|
else do; v.vn=vv; if find(varnames,vn)=0 then varnames=vn varnames; end
|
|
end
|
|
return
|
|
|
|
UNSET:
|
|
parse arg r etc
|
|
if r='' then do;call S "Deleting all set variables..."
|
|
do i=1 to words(varnames)
|
|
r=word(varnames,i); v.r=;
|
|
end;varnames=;end
|
|
else do
|
|
nvn=' '
|
|
do i=1 to words(varnames)
|
|
if r=word(varnames,i) then nop
|
|
else nvn=nvn word(varnames,i);end
|
|
v.r=;varnames=nvn
|
|
end
|
|
return
|
|
|
|
EDIT:
|
|
parse arg in
|
|
if left(in,1)="!" then call EXECUTE substr(in,2)
|
|
else if left(in,1)/=cmdchar then do
|
|
if query/='' then call SEND 'PRIVMSG' query ':'in
|
|
else if target/=0 then call SEND 'PRIVMSG' target ':'in
|
|
else call S 'You should join a channel or query a user first'
|
|
end
|
|
else if left(in,2)=cmdchar' ' then call SEND 'PRIVMSG' target ':'substr(in,3)
|
|
else call SHELL substr(in,2)
|
|
return
|
|
|
|
SHELL:
|
|
parse arg lin
|
|
if abbrev('ALIAS', translate(word(lin,1)), 2) then do
|
|
lin=strip(lin)
|
|
parse var lin . name lin
|
|
if name='' then do i=1 to words(aliasnames)
|
|
name=word(aliasnames,i); call S name': "'al.name'"'
|
|
end
|
|
else do
|
|
upper name
|
|
if lin='' then call S name': "'al.name'"'
|
|
else do; al.name=lin
|
|
if find(aliasnames,name)=0 then aliasnames=name aliasnames; end
|
|
end
|
|
return
|
|
end
|
|
if abbrev('ON', translate(word(lin,1)), 2) then do
|
|
lin=strip(lin)
|
|
parse var lin . lin
|
|
if lin=''&numons>0 then do i=1 to numons
|
|
call S i'- ON: "'on.i'"'
|
|
end
|
|
else if lin\='' then do
|
|
numons=numons+1
|
|
on.numons=lin
|
|
end
|
|
return
|
|
end
|
|
do while lin^=''
|
|
if left(lin,1)='*' then return
|
|
parse var lin one '15'x lin
|
|
par=; lc=; com='$'; al.com = one
|
|
do while al.com^=''; a=al.com
|
|
do while left(a,1)='%'
|
|
parse var a '%'var a
|
|
parse var par b par
|
|
v.var=b
|
|
end
|
|
if par^='' then do; a=a par; par=''; end
|
|
b=; do while a^=''
|
|
parse var a k'$'y a
|
|
if y='' then do; b=b||k; leave; end
|
|
if left(y,1)='(' then do; parse var y 2 x')'y; a=y a; end
|
|
else do; x=left(y,1); a=substr(y,2) a; end
|
|
b=b||k||VAR(x)
|
|
end
|
|
parse var b com par '::' next
|
|
do while jumpcoms>0 & next ^=''
|
|
parse var next com par '::' next
|
|
jumpcoms = jumpcoms-1
|
|
end
|
|
jumpcoms=0
|
|
upper com
|
|
if next^='' then lin=next||'15'x||lin
|
|
if find(lc, com)=0 then lc=com lc
|
|
else do; call S 'Alias loop of "'com'" encountered'; return; end
|
|
end
|
|
call COMMAND com par
|
|
end
|
|
return
|
|
|
|
COMMAND:
|
|
parse arg q r; out=; upper q
|
|
select
|
|
when abbrev('ABORT',q,2) then call BYE "your abort request"
|
|
when abbrev('AWAY',q,2) then do; away=r; out="AWAY" r; end
|
|
when abbrev('BYE',q,1)|abbrev('SIGNOFF',q,6)|abbrev('QUIT',q,3) then do
|
|
call SEND('QUIT' r); call BYE; end
|
|
when abbrev('CATALOG',q,2) then do; catmode=1; out='LIST' r; end
|
|
when abbrev('CHANNEL',q,1) then do
|
|
if r="" then do; call S "Talking to" target; return; end
|
|
if target/="" & target/=0 then call SEND("PART" target);
|
|
out="JOIN" r
|
|
end
|
|
when abbrev('CLEAR',q,2) then "VMFCLEAR"
|
|
when abbrev('CMDCHARACTER',q,2) then cmdchar=left(r,1)
|
|
when q='ECHO' then call OUT r
|
|
when abbrev('EXECUTE',q,1) then call EXECUTE r
|
|
when abbrev('EXPRESSION',q,4) then call SET word(r,1) EXPR(subword(r,2))
|
|
when abbrev('FOLLOW',q,1) then out='JOIN' invitation
|
|
when abbrev('HELP',q,1) then do
|
|
address 'CMS' "HELP RXIRC"; say; end
|
|
when q='IF' then do
|
|
parse var r cond a r
|
|
if translate(a)^='THEN' then call S "IF" cond": THEN is missing"
|
|
else do
|
|
rc = INTERP("if ("cond") then rc=0; else rc=1")
|
|
if rc=0 then call COMMAND r
|
|
end
|
|
end
|
|
when abbrev('INTERPRET',q,3) then call INTERP r
|
|
when abbrev('ASSIGN',q,3) then call ASSIGN r
|
|
when abbrev('INVITE',q,1) then do
|
|
if words(r)=1 & target/=0 then out='INVITE' r target
|
|
else out='INVITE' r
|
|
end
|
|
when abbrev('LASTLOG',q,2) then call LASTLOG r
|
|
when abbrev('LOGGING',q,2) then call LOGGING r
|
|
when abbrev('NICKNAME',q,1) then if r='' then out='WHOIS' ircnick
|
|
else do; out='NICK' r; ircnick=r; capnick=translate(r); end
|
|
when abbrev('SEND',q,4) then if r='' then do
|
|
call S "Send what?"
|
|
end
|
|
else do
|
|
call S "Sent command ("r")."
|
|
call SEND(r)
|
|
end
|
|
when abbrev('QUOTE',q,4) then if r='' then do
|
|
call S "Quote what?"
|
|
end
|
|
else do
|
|
call SEND(r)
|
|
end
|
|
when left(q,2)='PF' then 'CP SET' q r
|
|
when abbrev('REPLY',q,1) then call QUERY lastsender
|
|
when abbrev('SERVER',q,1) then call CONNECT r
|
|
when q='SET' then call SET r
|
|
when abbrev('UNSET',q,3) then call UNSET r
|
|
when q='SKIP' & sourcing then if datatype(r,'w') then skiplines=r
|
|
when q='JUMP' then if datatype(r,'w') then jumpcoms=r
|
|
when abbrev('SOURCE',q,2) then call SOURCE r
|
|
when abbrev('STATUS',q,1) then do; out='WHOIS' ircnick
|
|
call OUT 'Target:' target'; Query:' query'; Invitation:' invitation'; Last sender:' lastsender'; Last joined:' lastjoin
|
|
end
|
|
when q='STOP' & sourcing then abortsource=1
|
|
when abbrev('TALKTO',q,2) then do
|
|
if r/="" then target=translate(word(r,1))
|
|
call S 'Now talking to' target
|
|
end
|
|
when abbrev('TELL',q,2) then call TELL r
|
|
when abbrev('TOGGLE',q,3) then call TOGGLE r
|
|
when abbrev('VERSION',q,3) then do; out='VERSION' r
|
|
if r='' then call S 'rxIRC' vers
|
|
end
|
|
when abbrev('VIEWLOG',q,2) & viewcmd/='' then do
|
|
address 'CMS' viewcmd logfile; say; end
|
|
when abbrev('XAMINE',q,1) then out='WHOIS' lastsender
|
|
when abbrev('YELL',q,1) then call TELL word(r,1) '<'ircnick'>' subword(r,2)
|
|
when q='CHOP' then out="MODE" target "+ooo" r
|
|
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 q='K' then out="KICK" target r
|
|
when abbrev('LOCALWHO',q,1)|q="LCL" then do
|
|
who_empty=1; out="WHO *"right(domain,trunc(length(domain)/2)); end
|
|
when q='M'|q='MSG'|abbrev('MESSAGE',q,3) then do
|
|
parse var r ni r; out='PRIVMSG' ni ':'r; end
|
|
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='SAY' then out='PRIVMSG' target ':'r
|
|
when q='SWHO' then out='NAMES'
|
|
when q='T' then out='TOPIC' target ':'r
|
|
when q='WHO' then do
|
|
who_empty=1
|
|
if r="" then out='WHO' target
|
|
else out='WHO' r
|
|
end
|
|
when abbrev('TCPIPSTATUS',q,3) then do
|
|
parse value SOCKET('SOCKETSETSTATUS') with rc . q etc
|
|
call S 'Status' q '('rc');' etc'; Input buffer length is' length(buffer)
|
|
end
|
|
when abbrev('WHOIS',q,1) then if r="" then out='WHOIS' ircnick
|
|
else out='WHOIS' r
|
|
when abbrev('UMODE',q,1) then out='MODE' ircnick r
|
|
when q='UNCHOP' then out="MODE" target "-ooo" r
|
|
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
|
|
call SEND out
|
|
out=; return
|
|
|
|
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 call S "And you don't send notices about it (quiet ignore)."
|
|
return
|
|
|
|
QUERY:
|
|
parse arg qq
|
|
if query/='' then call S 'Terminating query with' query
|
|
query=qq
|
|
if qq/='' then call S 'Starting a query with' qq
|
|
else call S 'Talking to' target
|
|
return
|
|
|
|
LASTLOG:
|
|
arg a
|
|
if ^datatype(a,"W") | a<1 | a>80 then a=20
|
|
else a=a-1
|
|
'VMFCLEAR'; call S lo'Messages received last:'
|
|
do i=curll-a to curll; if ll.i/='' then call OUT hi'|'yo||ll.i; end
|
|
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 call S 'Logging is' onoff.log
|
|
return
|
|
|
|
S:
|
|
parse arg k
|
|
if translate(v.display)\='OFF' then say k
|
|
if logevent/=0 then do
|
|
curll=curll+1; ll.curll=x; logevent=0; k=curll-50; ll.k=; end
|
|
if log then writelog k
|
|
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 | q<0 then q=3
|
|
p=lastpos(" ",x,80)
|
|
if p<30 then do; q=3; p=77; end
|
|
call S left(x,p); x=substr(x,p+1)
|
|
do while length(x)+q > 80
|
|
p=lastpos(" ",x,80-q); if p<30 then do; q=3; p=77; end
|
|
call S copies(" ",q)left(x,p); x=substr(x,p+1)
|
|
end
|
|
end
|
|
call S copies(" ",q)x
|
|
return
|
|
|
|
CONNECT:
|
|
parse arg ircserver port .
|
|
if ircserver="" then do
|
|
call S "Tell me the internet address of an IRC server"
|
|
return
|
|
end
|
|
if datatype(port)="NUM" then ircport = port
|
|
if sock/='' then do; call SEND("QUIT"); call SHUT; "CP SLEEP 3 SEC"; end
|
|
in.2=me x2c('4b404b') ':'ircname
|
|
parse value SOCKET('SOCKET', 'AF_INET', 'SOCK_STREAM') with rc sock etc
|
|
if rc/=0 then do; sock=; call BYE "socket error:" etc; end
|
|
parse value SOCKET('SETSOCKOPT', sock,'SOL_SOCKET','SO_ASCII','ON') with rc . etc
|
|
if rc/=0 then call BYE "SetSockOpt error:" etc
|
|
call S "Connecting to" ircserver "on port" ircport"." etc
|
|
parse value SOCKET('CONNECT', sock, 'AF_INET' ircport ircserver) with rc . etc
|
|
if rc/=0 then call BYE "connect error:" etc
|
|
parse value SOCKET('IOCTL', sock, 'FIONBIO', 1) with rc . etc
|
|
if rc/=0 then call BYE "nonblocking I/O:" etc
|
|
call SEND(x2c('D5C9C3D2') ircnick)
|
|
call SEND(x2c('E4E2C5D9') in.2)
|
|
call SOURCE "PROFILE", 1
|
|
return
|
|
|
|
CTCP:
|
|
parse arg fla bla
|
|
if pos(msa,bla)=0 then return 1
|
|
parse var bla . (msa) ctcp bla (msa) .
|
|
select
|
|
when ctcp="ACTION" then call OUT '*' s bla
|
|
when ctcp="CLIENTINFO" then
|
|
call MSAREPLY "CLIENTINFO ACTION CLIENTINFO FINGER TIME USERINFO VERSION"
|
|
when ctcp="FINGER" then
|
|
call MSAREPLY "FINGER" realname '('me'@'hostname'.'domain',',
|
|
me'@'mynode') - Idle' trunc(time('E'),2) 'seconds'
|
|
when ctcp="TIME" then call MSAREPLY "TIME" left(time(),5)
|
|
when ctcp="USERINFO" then call MSAREPLY "USERINFO" userinfo
|
|
when ctcp="VERSION" then
|
|
call MSAREPLY "VERSION rxIRC" vers "VM/CMS",
|
|
":Beta Version of Improved rxIRC - The Survival package for VM-struck humans"
|
|
otherwise if fla=1 then call MSAREPLY "ERRMSG Huh? Can't do" ctcp
|
|
end
|
|
return 0
|
|
|
|
MSAREPLY:
|
|
parse arg lyrics
|
|
call SEND("NOTICE" s ":"msa||lyrics||msa)
|
|
return
|
|
|
|
SYNTAX:
|
|
say errortext(rc)
|
|
return
|
|
|
|
HALT:
|
|
call BYE "halt request"
|
|
BYE:
|
|
parse arg reason
|
|
save_rc = rc
|
|
if reason/="" then call S "Terminating because of" reason '('rc')'
|
|
if log then do
|
|
writelog "<--> IRC session ended on" date() "at" time()
|
|
"FINIS * * *"
|
|
end
|
|
do i=1 to pf.0
|
|
a=word(pf.i,2)
|
|
if a='RETRIEVE' then iterate
|
|
if a='UNDEFINED' then "CP SET" word(pf.i,1)
|
|
else "CP SET" pf.i
|
|
end
|
|
i=1; parse var qt.i 'LINEND' a',' . 'CHARDEL' k',' .
|
|
'CP TERM LINEND' a 'CHARDEL' k
|
|
i=2; parse var qt.i 'LINESIZE' a',' .
|
|
'CP TERM LINESIZE' a
|
|
if sock/='' then do
|
|
call SHUT
|
|
parse value SOCKET('TERMINATE') with .
|
|
"NUCXDROP RXSOCKET"
|
|
end
|
|
if have_rxwt then RESETVALUE('ALL')
|
|
exit save_rc
|
|
|
|
ACTION:
|
|
parse arg q r
|
|
select
|
|
when abbrev("APPLAUD",q,3) then a="applauds wholeheartedly"
|
|
when q="BOW" then a="bows gracefully"
|
|
when abbrev("COMFORT",q,3) then a="comforts you"
|
|
when abbrev("CUDDLE",q,3) then a="cuddles you"
|
|
when abbrev("DANCE",q,3) then a="dances a waltz with you"
|
|
when abbrev("GIGGLE",q,3) then a="giggles inanely"
|
|
when abbrev("GRIN",q,2) then a="grins"
|
|
when q="HUG" then a="hugs you"
|
|
when abbrev("LAUGH",q,2) then a="laughs wholeheartedly"
|
|
when q="ME"|abbrev("EMOTE",q,1) then return 1
|
|
when q="NOD" then a="nods solemnly"
|
|
when abbrev("SHRUG",q,2) then a="shrugs"
|
|
when abbrev("SIGH",q,2) then a="sighs deeply"
|
|
when abbrev("SMILE",q,2) then a="smiles"
|
|
when abbrev("THANK",q,2) then a="thanks you from the bottom of the heart"
|
|
when abbrev("WAVE",q,2) then a="waves goodbye to you"
|
|
when abbrev("WINK",q,2) then a="winks suggestively"
|
|
when abbrev("YAWN",q,2) then a="yawns tiredly"
|
|
otherwise return 0; end
|
|
if r="" then r=a'.'
|
|
else r=word(a,1) r'.'
|
|
return 1
|
|
|
|
FINDM: procedure
|
|
arg patlist, token
|
|
do words(patlist)
|
|
parse var patlist a patlist
|
|
if MATCH(a,token) then return 1
|
|
end
|
|
return 0
|
|
|
|
MATCH: procedure
|
|
arg pattern, token
|
|
do i = 1 by 1 while i < length(pattern)
|
|
ss = substr(pattern,i,2)
|
|
select
|
|
when ss = '**' then do
|
|
pattern = delstr(pattern,i,1)
|
|
i = i - 1
|
|
end
|
|
when ss = '*?' then pattern = overlay('?*',pattern,i,2)
|
|
otherwise nop
|
|
end
|
|
end
|
|
return MATCHINT(pattern,token)
|
|
|
|
MATCHINT: procedure
|
|
arg pattern, token
|
|
if pattern == token then return 1
|
|
if pattern == '*' then return 1
|
|
if verify(pattern,'*?','M') = 0 then return 0
|
|
ptrp = 1
|
|
ptrt = 1
|
|
lenp = length(pattern)
|
|
lent = length(token)
|
|
do search = 1 by 1
|
|
select
|
|
when ptrp > lenp & ptrt > lent
|
|
then return 1
|
|
when ptrp > lenp then return 0
|
|
when ptrt > lent then return 0
|
|
otherwise nop
|
|
end
|
|
pchar = substr(pattern,ptrp,1)
|
|
tchar = substr(token,ptrt,1)
|
|
select
|
|
when pchar = tchar | pchar = '?'
|
|
then do
|
|
ptrp = ptrp + 1
|
|
ptrt = ptrt + 1
|
|
iterate search
|
|
end
|
|
when pchar = '*' & ptrp = lenp
|
|
then return 1
|
|
when pchar = '*' then do
|
|
ptrp = ptrp + 1
|
|
pchar = substr(pattern,ptrp,1)
|
|
do ptrt = ptrt to lent
|
|
tchar = substr(token,ptrt,1)
|
|
if pchar = tchar then do
|
|
if ptrp = lenp & ptrt = lent
|
|
then return 1
|
|
if MATCHINT(substr(pattern,ptrp+1),substr(token,ptrt+1)) then return 1
|
|
end
|
|
end
|
|
return 0
|
|
end
|
|
otherwise return 0
|
|
end
|
|
end
|
|
call BYE 'a mistake'
|
|
|
|
SEND:
|
|
parse arg qp
|
|
if qp='' then return
|
|
if left(qp, 9)='PRIVMSG +' then do
|
|
parse var qp . '+'ni' :'tx
|
|
call TELL ni tx
|
|
end
|
|
else do
|
|
qp=translate(qp,beep||bold,beepch||boldch)
|
|
parse value SOCKET('WRITE', sock, qp||cr||lf) with rc . etc
|
|
if rc/=0 then call BYE "socket write error:" etc
|
|
end
|
|
return
|
|
|
|
SHUT:
|
|
a=sock; sock=; servername=;
|
|
parse value SOCKET('SHUTDOWN', a,'BOTH') with rc . etc
|
|
if rc/=0 then call BYE "socket shut error:" etc
|
|
parse value SOCKET('CLOSE', a) with rc . etc
|
|
if rc/=0 then call BYE "socket close error:" etc
|
|
return
|
|
|
|
NICE:
|
|
parse arg a"@"bb; if bb="" then bb=mynode
|
|
if nice.a.bb^='*' then do
|
|
if nice.a.bb^='' then return nice.a.bb
|
|
'NAMEF :userid' a ':node' bb ':nick (LIFO'
|
|
if rc=0 then do;parse pull nice.a.bb .
|
|
return nice.a.bb;end
|
|
if bb=mynode then do; 'NAMEF :userid' a ':node :nick (LIFO'
|
|
if rc=0 then do;parse pull nice.a.bb .
|
|
pull ln .;if ln='' then return nice.a.bb;end
|
|
end
|
|
nice.a.bb='*';end
|
|
if a='RSCS' then return bb
|
|
return a
|
|
|
|
U@N:
|
|
parse arg q p; if q='' then return 0 'missing args'
|
|
upper q; parse var q q'@'r
|
|
if r^='' then return q r p
|
|
if word(p,1)='AT' then do
|
|
parse var p . r p; upper r
|
|
if r='' then return 0 'missing node'
|
|
return q r p;end
|
|
if u@n.q^='' then return u@n.q p
|
|
'NAMEF :nick' q ':userid :node :via (LIFO'
|
|
if rc=0 then do 1
|
|
pull la; pull ln; pull li
|
|
if li='' then leave
|
|
parse value li ln mynode with a r .
|
|
u@n.q=a r; if via.a.r='' then via.a.r=la
|
|
return a r p
|
|
end
|
|
u@n.q = q mynode;return q mynode p
|
|
|
|
TELL:
|
|
parse arg tea
|
|
parse value U@N(tea) with xid xnod tea
|
|
if xid=0 then do
|
|
call OUT xnod tea
|
|
return
|
|
end
|
|
err=; if translate(left(tea,4))='VIA ' then do
|
|
parse var tea . via tea
|
|
upper via
|
|
if via='NONE' then via=;
|
|
via.xid.xnod = via
|
|
end
|
|
else via=via.xid.xnod
|
|
select
|
|
when via='SMSG'|via='SEND' then do
|
|
if xnod^=mynode then err='SEND & SMSG only local'
|
|
else do
|
|
if via='SMSG' then parse value diagrc(8,'SMSG' xid tea) with rc . err
|
|
else do
|
|
parse var tea cp? tea?
|
|
if translate(cp?)='CP' then
|
|
parse value diagrc(8,'SEND CP' xid translate(tea?)) with rc . err
|
|
else parse value diagrc(8,'SEND' xid tea) with rc . err
|
|
end; end; end
|
|
when via=''|left(via,1)^="'" then do
|
|
if via='RSCS' then do;viar=1;via='';end;else viar=0
|
|
if via^='' then via='CMD' via
|
|
if xid='RSCS'|(xid=rscs&xnod=mynode) then do
|
|
if xnod=mynode&^viar then parse value diagrc(8,'SM' rscs tea) with rc . err
|
|
else parse value diagrc(8,'SM' rscs via 'CMD' xnod tea) with rc . err
|
|
end
|
|
else do
|
|
if xnod=mynode&^viar then parse value diagrc(8,'M' xid tea) with rc . err
|
|
else parse value diagrc(8,'SM' rscs via 'MSG' xnod xid tea) with rc . err
|
|
end
|
|
end
|
|
otherwise
|
|
parse var via "'"via"'"
|
|
if word(via,1)='CP' then do
|
|
parse value diagrc(8,subword(via,2) tea) with rc . err
|
|
if rc=1 then err=via "unknown."
|
|
end
|
|
else do
|
|
if xnod=mynode|xnod='' then address cms via xid tea
|
|
else address cms via NICE(xid'@'xnod) tea
|
|
if rc>0 then err='Rc' rc 'from' via'.'
|
|
if rc<0 then do;rc=24;err='Invalid VIA'; end
|
|
end; end
|
|
if err/='' then call OUT strip(translate(err,' ','15'x))
|
|
return
|
|
|
|
SOURCE:
|
|
arg a, b
|
|
sourcenum=sourcenum+1
|
|
if a='' then do
|
|
call S "You must specify a file to /source"
|
|
return -1
|
|
end
|
|
a=a 'RXIRC *'
|
|
"STATE" a
|
|
if rc/=0 then do
|
|
if b/=1 then call S 'Could not access' a
|
|
end
|
|
else do
|
|
'MAKEBUF'; 'EXECIO * DISKR' a '(FIFO FINIS'; skiplines=0;
|
|
do queued(); sourcing=1
|
|
parse pull l; if abortsource then iterate
|
|
if right(strip(l),2)='::' then
|
|
ll=ll||l
|
|
else do
|
|
ll=ll||l
|
|
call SHELL strip(ll)
|
|
ll=''
|
|
end
|
|
if skiplines=0 then call SHELL strip(l)
|
|
else skiplines=skiplines-1
|
|
end
|
|
abortsource=0; sourcing=0; 'DROPBUF'
|
|
end
|
|
return
|
|
|
|
TOGGLE:
|
|
parse arg n o
|
|
if ^datatype(n,'W')|n<1|n>24 then do
|
|
call S 'Invalid PF key "'n'".'; return; end
|
|
o = strip(o); sep = left(o,1)
|
|
parse var o (sep) com (sep) o
|
|
'CP SET PF'n 'IMM /TOGGLE' n sep||o||sep||com
|
|
call SHELL strip(com)
|
|
drop sep
|
|
return
|
|
|
|
EXPR:
|
|
procedure
|
|
parse arg expr
|
|
signal on SYNTAX
|
|
INTERPRET("expr = ("expr")")
|
|
signal off SYNTAX
|
|
return expr
|
|
|
|
INTERP:
|
|
procedure
|
|
arg statement
|
|
signal on SYNTAX; INTERPRET(statement); signal off SYNTAX
|
|
return rc
|
|
|
|
ASSIGN:
|
|
parse arg asto asfrom
|
|
signal on SYNTAX; INTERPRET(statement); signal off SYNTAX
|
|
return rc
|
|
|
|
EXECUTE:
|
|
parse arg r
|
|
if r='' then do
|
|
say 'Suspending rxIRC; Enter "return" to return'
|
|
r='SUBSET'
|
|
end
|
|
address 'CMS' r
|
|
if rc=0 then say "rxIRC ready"
|
|
else say "rxIRC ready("rc")"
|
|
return
|