/* 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! * * requires RXSOCKET MODULE version 2 by Arty Ecock (eckcu@cunyvm.bitnet) * * Copyright (C)1991,2,3,4 by LynX & CvO University Oldenburg, Germany * You may freely use this software at your own risk. * * Warning: Changing the code to display fake user information is * considered an offense by many IRC administrators! * */ progname='rxIRC'; vers='2.1pre4'; 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 TIME TRACE', 'USERS USERHOST VOICE WHOWAS WALLOPS WALL XTRA' log=0; query=; ignore=; omit=; lastjoin=; lastsender=; lastorigin=; export=; 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 nflist=; nfhere=; nfcatch=0 "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='2f'x; 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", 7) with rc . etc if rc=2004 then do say '' 'NUCXDROP RXSOCKET' end else leave end if rc/=0 then call BYE "socket init 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", ":PASS (LIFO FILE RXIRC" if rc/=0 then call BYE "missing or unreadable RXIRC NAMES file" parse pull server_pass 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 ", ":WWWPORT (LIFO" if rc=0 then do parse pull wwwport; if wwwport/='' & ^datatype(wwwport,'W') then do wwwport=; call BYE "WWW port must be numeric"; end 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 ==:==: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" if wwwport<1024 then wwwport='' else do parse value SOCKET('SOCKET') with rc www etc if rc/=0 then call BYE "socket:" etc parse value SOCKET('SETSOCKOPT',www,'SOL_SOCKET','SO_ASCII','ON'), with rc . etc if rc/=0 then call BYE "setsockopt:" etc parse value SOCKET('BIND', www, 'AF_INET' wwwport SOCKET('GETHOSTID')), with rc . etc if rc/=0 then call BYE "bind:" etc parse value SOCKET('LISTEN', www, 9) with rc . etc if rc/=0 then call BYE "listen:" etc parse value SOCKET('IOCTL', www, 'FIONBIO', 1) with rc . etc if rc/=0 then call BYE "nonblocking i/o:" etc myURL="http://"hostname"."domain":"wwwport"/" end call S progname||hi||vers||yo"- You are" ircnick "("ircname")" call S "Logging is" onoff.log"; Audible bells are", onoff.loud"; Quiet ignore is" onoff.quiet if www/='' then call S "Builtin httpd active as"hi||myURL||yo call CONNECT ircserver call SOURCE "PROFILE", 1 if nflist/='' then do; nfcatch=1; call SEND "ISON" nflist; end 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 *') with rc type data select when rc/=0 then call BYE "REXXWAIT returning" rc when type='SOCKET' & data='READ' sock 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 call OUT PARSE(strip(in,,cr)) 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)/='*' & origin/=lastorigin then do call TELL origin '* away:' away lastorigin = origin end 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 if nflist/='' then do; nfcatch=1; call SEND "ISON" nflist; end '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 when type='SOCKET' then do parse var data . gsock if gsock=www then do parse value SOCKET('ACCEPT', www) with rc gsock . gport gipnum end; else do parse value SOCKET('READ', gsock) with rc . data if rc=54 then iterate if rc/=0 then call S 'Read error on http connection' gsock '('rc')' else do if data='' then do; SOCKET('CLOSE', gsock); iterate; end parse var data cmd url . parse var url url(lf) . if url='/' then url='/index.html' parse var url '/'fn'.'ft'/' x; upper fn ft if x='' & fn/='' & fn/='*' & ft/='' & ft/='*' &, (cmd='GET'|cmd='HEAD') & FINDM(export,fn'.'ft) then do call S 'httpd: request from' gipnum':' cmd url /* 'MAKEBUF'; 'LISTFILE' fn ft '(STACK'; t=rc; 'DROPBUF' */ 'STATE' fn ft if rc=0 then do call WRITE gsock "HTTP/1.0 200 Sure" call WRITE gsock "Server:" progname"/"vers if ft='HTML' then ct='html'; else ct='plain' call WRITE gsock "Content-type: text/"ct call WRITE gsock '' if cmd='GET' then call WRITEFILE gsock fn ft pubmode end end; else call S 'httpd: invalid request ('cmd url') from' gipnum SOCKET('SHUTDOWN', gsock) end end end otherwise call S 'Unexpected event:' type data end end PARSE: parse arg a if loud & pos(beep,a)/=0 then "BEEP" b=; a=translate(a,"%"||beepch||"_",rev||beep||undl) 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 g; 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 '('g')' 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||g when m='MSG' then b='<'s'>' g 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 b='-'s'-' g; lastsender=s end end otherwise if ^FINDM(omit,s) & ^FINDM(omit,sad) then b='-'s':'e'-' g end when m='PART' then b='***' s 'leaves channel' e when m='PING' then call SEND("PONG :"ircnick) when m='PRIVMSG' then do if 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 b='*'s'*' g lastsender=s end end else if ^FINDM(omit,s) & ^FINDM(omit,sad) then if CTCP(0 g) then do if translate(e)=target then b='<'s'>' g else b='<'s':'e'>' g 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='302' then do parse var g ni'='uh if left(uh,1)='+' then aw='here' else aw='away' b=ni 'is' aw '('substr(uh,2)')' end when m='303' & nfcatch then call ISON 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 call S 'No matches for /who' when m='319' then b='on channels:' g when m='317' then b='apparently idle' word(f,2)/60 'minutes' 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 call OUT left(ch,13) left(n,4)g 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 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 call OUT hi||left(ch,15)yo||g 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='376' then call SOURCE "CONNECT", 1 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 return translate(b,"@",msa) VAR: parse arg x select when datatype(x,'w') then return '$'||x 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='U' then return myURL when x='V' then return vers when x='Z' then return left(time(),5) when x='$' then return '$' otherwise return v.x end return '' 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 a b if b='' then call S 'Variable' a 'has the value "'v.a'"' else do; v.a=b; if find(varnames,a)=0 then varnames=a varnames; end 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 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 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/=''; sa=al.com do while left(sa,1)='%' parse var sa '%'var sa parse var par sb par v.var=sb end if par/='' then do; sa=sa par; par=''; end sb=; do while sa/='' parse var sa k'$'y sa if y='' then do; sb=sb||k; leave; end if left(y,1)='(' then do; parse var y 2 x')'y; sa=y sa; end else do; x=left(y,1); sa=substr(y,2) a; end sb=sb||k||VAR(x) end parse var sb com par '::' next 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 if abbrev('LEAVE',q,2) then q='PART' select when abbrev('ABORT',q,2) then call BYE "your abort request" when abbrev('AWAY',q,2) then do; lastorigin=; 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('EXPORT',q,4) then call EXPORT 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('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 q='NF'|abbrev('NOTIFY',q,4) then call NOTIFY r 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 q='SKIP' & sourcing then if datatype(r,'w') then skiplines=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 progname 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('OMIT',q,2) then call OMIT 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='SAY' then out='PRIVMSG' target ':'r when q='SWHO' then out='NAMES' when q='T' then out='TOPIC' target ':'r when abbrev('TOPIC',q,2) then out='TOPIC' word(r,1) ':'subword(r,2) 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 x a z=find(ignore,x); if z/=0 then ignore=strip(delword(ignore,z,1)) else ignore=x ignore end call OUT 'You are ignoring:' ignore if quiet then call S "And you don't send notices about it (quiet ignore)." return EXPORT: arg a do words(a) parse var a x a z=find(export,x); if z/=0 then export=strip(delword(export,z,1)) else export=x export end call OUT 'You are exporting:' export return OMIT: arg a do words(a) parse var a x a z=find(omit,x); if z/=0 then omit=strip(delword(omit,z,1)) else omit=x omit end call OUT 'You are omitting:' omit 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 say k if log then writelog k if logevent/=0 then do curll=curll+1; ll.curll=x; logevent=0; k=curll-50; ll.k=; end 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:" 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:" etc parse value SOCKET('IOCTL', sock, 'FIONBIO', 1) with rc . etc if rc/=0 then call BYE "nonblocking i/o:" etc if server_pass/='' then do; call SEND("PASS" server_pass); server_pass=; end call SEND(x2c('D5C9C3D2') ircnick) call SEND(x2c('E4E2C5D9') in.2) 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 URL 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="URL" then do if wwwport='' then call MSAREPLY "ERRMSG No http port set up by user" else call MSAREPLY "URL" myURL end when ctcp="USERINFO" then call MSAREPLY "USERINFO" userinfo when ctcp="VERSION" then call MSAREPLY "VERSION" progname vers "VM/CMS", ":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 0 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 www/='' then do SOCKET('SHUTDOWN',www); SOCKET('CLOSE',www); www=; end 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: arg u'@'v;if v='' then v=mynode if nice.u.v/='' then return nice.u.v 'NAMEF :userid' u ':node' v ':nick (LIFO' if rc=0 then parse pull nice.u.v . else if v=mynode then do 'NAMEF :userid' u ':node :nick (LIFO' if rc=0 then do parse pull nice.u.v . pull ln . if ln='' then return nice.u.v end nice.u.v=u end else if u='RSCS' then nice.u.v=v else nice.u.v=u'@'v return nice.u.v 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 sfn, sfl if sfn='' then do call S "You must specify a file to /source" return -1 end sfn = sfn 'RXIRC *' "STATE" sfn if rc/=0 then do if sfl/=1 then call S 'Could not access' sfn end else do 'MAKEBUF'; 'EXECIO * DISKR' sfn '(FIFO FINIS'; skiplines=0; do queued(); sourcing=1 parse pull l; if abortsource then iterate 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 NOTIFY: arg a do i=1 to words(a) x=word(a,i); y=find(nflist,x); z=find(translate(nfhere),a) if z/=0 then nfhere=strip(delword(nfhere,z,1)) if y/=0 then nflist=strip(delword(nflist,y,1)) else nflist=nflist x end call OUT 'Observing:' nflist if a='' then call OUT 'Present:' nfhere return ISON: parse arg g i=1; do words(nfhere) a=word(nfhere,i) if find(g,a)=0 then do nfhere = strip(delword(nfhere,i,1)) call OUT a "has gone" end else i=i+1 end do i=1 to words(g) a=word(g,i) if find(nfhere,a)=0 then do call SEND "USERHOST" a nfhere = a nfhere end end nfcatch=0 return 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 WRITE: parse arg qp tx parse value SOCKET('WRITE', qp, tx||cr||lf) with rc . etc if rc/=0 then call S "Socket write error:" etc return WRITEFILE: parse arg qp fn ft . 'MAKEBUF' 'EXECIO * DISKR' fn ft '(FINIS FIFO' if rc=0 then do do queued() parse pull l call WRITE qp l if rc/=0 then do call S 'httpd: File transmission interrupted (by caller probably)' signal DROPIT end end call S 'httpd: Sent' fn ft end DROPIT: 'DROPBUF' return