|
|
|
It is in REXX EXEC for VM/CMS. The original CHATDISC EXEC was written by Eric Thomas of the Ecole Centrale de Paris and of CERN, also the inventor of LISTSERV, and now of L-Soft.
Some functionality which is irrelevant to the MGonz story has been removed here.
/*
------------------------------------------------------------------------
The MGonzNet
System Source Code
Mark Humphrys Jun 17, 1989
------------------------------------------------------------------------
*/
quote = d2c(125) /* the ' character */
lowcasechars = 'abcdefghijklmnopqrstuvwxyz'
upcasechars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
digits = '0123456789'
true = 1
false = 0
Address 'COMMAND' /* So that msgs don't get upcased */
Parse arg userid nodeid message /* Retrieve arguments from Chat */
message = Strip(message) /* Strip blanks from msg
Crucial */
lowmessage = Lowcase(message)
upmessage = Upcase(message)
goodmessage = removebadchars(message,'dont remove digits')
Parse pull discmsg /* Retrieve standard disc msg */
discmsg = Strip(discmsg)
discmsg = substr(discmsg,19) /* get rid of Disconnected -- .. */
nickname = '' /* Default values */
virtualuser = ''
'FINIS * * *' /* Close all files to prevent
possible loss of data if system
crashes or suchlike... */
/* Try to find person in NAMES file */
'NAMEFIND :userid' userid ':node' nodeid ':nick (LIFO'
If rc == 0 Then
Parse pull nickname
If nickname ^= '' Then nickname = Capitalise(nickname)
userid = Lowcase(userid)
nodeid = Lowcase(nodeid)
If nodeid = 'irlearn'
Then msgcmd = 'MSG' Upcase(userid)
Else msgcmd = 'SMSG RSCS MSG' Upcase(nodeid) Upcase(userid)
/* --- Copy message to Vax --------------------------------- */
/* Tell my Vax a/c about incoming message
Care to avoid message war with rscs
*/
dontcopy = 'Ccvax Irlearn Printers Vax'
Select
When Find(dontcopy,nickname) ^== 0 Then Nop
When userid = 'vmutil' & nodeid = 'irlearn' Then Nop
When nickname = 'Relay' Then Call Vax message /* forget nasty header */
When nodeid = 'irlearn' & left(userid,3) = 'log' & ,
left(lowmessage,8) = 'vax sys '
Then Nop /* Vax will receive msg anyway */
Otherwise
Do
'GLOBALV SELECT CHATDISC STACK LOGGEDON'
Parse pull loggedon
If loggedon ^= false Then Do
/* Copy to Vax unless explicitly told loggedon = false */
If nickname ^= ''
Then Call Vax '* Message from' nickname '('userid 'at' nodeid') ...'
Else Call Vax '* Message from' userid 'at' nodeid '...'
Call Vax message
End
End
End
/* --- Process message ------------------------------------- */
/* Local users from whom messages must be ignored */
dontreply = 'mhumph89 operator vmutil dirmaint'
/* Centre people - give standard disc msg
don't let them stumble across MGonzNet
*/
centre = ' adillon adviser annmarie bernie bonnie brianm'
centre = centre || ' carrick cecily deirdre dobeirne ebairead emcgrath'
centre = centre || ' eoin guest1 guest2'
centre = centre || ' harringt helen jacklowe jchester jennings joanc'
centre = centre || ' larry listserv maevem mailmnt mailr2 maint'
centre = centre || ' mallen mbreslin mcgrath mnorris'
centre = centre || ' mokeeffe mokelly molooney moriarty msexton'
centre = centre || ' noreilly odonnel'
centre = centre || ' oneillu pdoyle rosemary sinead tinac tmcgrath'
centre = centre || ' twade t_wade vmaccnt walter walsh'
/* ^ don't forget spaces between names at end of
one line and start of next */
Select
When nickname = 'Printers' Then /* Divert msgs to the pmsguser */
Do
Call divert 'P'
Exit 0
End
When nickname = 'Irlearn' & left(upmessage,10) = 'LINK CCVAX' Then
Do
Call divert 'VAX' /* Divert msgs to the vaxmsguser */
'GLOBALV SELECT CHATDISC SET LOGGEDON' false /* beautiful */
Exit 0
End
When nickname = 'Ccvax' Then
Do
Call divert 'VAX' /* Divert msgs to the vaxmsguser */
If left(upcase(goodmessage),12) == 'H236 007 NOT' Then
'GLOBALV SELECT CHATDISC SET LOGGEDON' false
/* some nasty char in there */
Exit 0
End
When userid = 'rscs' Then Exit 0 /* Don't reply to RSCS please! */
When userid = 'mailer' Then Exit 0 /* Ditto for MAILER */
When userid = 'relay' Then Exit 0
When Left(message,1) == '*' Then Exit 0
/* Ignore starred messages */
When nodeid = 'irlearn' & Find(dontreply,userid) ^== 0 Then Exit 0
When Find(centre,userid) ^== 0 Then
Do
Call Tellback '* Disconnected -- message is recorded'
Exit 0
End
When nodeid = 'irlearn' & left(userid,3) = 'log' Then
Do
Call Log /* Divert virtual users here */
Exit 0
End
When lowmessage = 'help'
Then Do
Call Tellback '* MGonzNet '
Call Tellback '* --------------------------------------------------'
Call Tellback '* help Help '
Call Tellback '* dir Directory of available files '
Call Tellback '* get :fn :ft: Get a file '
Call Tellback '* who Nice VM Who '
Call Tellback '* p Query VM/SCS printer queues '
Call Tellback '* p :printer: Query specific printer '
if nickname = 'Vax' then do
Call Tellback '* q Query reader '
Call Tellback '* q files Receive all files '
Call Tellback '* q mail :nb: Receive all mail into :nb: '
Call Tellback '* q all :nb: Receive everything '
Call Tellback '* tell :mgonznetuser: :msg: '
Call Tellback '* cms tell :realuser: :msg: '
end
Call Tellback '* :msg: Talk to the Gonz '
Call Tellback '* * :msg: Talk to the Gonzkeeper '
Call Tellback '* --------------------------------------------------'
Exit 0
End
When lowmessage = 'who' Then
Do
Call Who
Exit 0
End
When lowmessage = 'dir' Then
Do
Call Dir
Exit 0
End
When left(lowmessage,4) = 'get ' Then
Do
Call Get substr(message,5)
Exit 0
End
When Find(lowmessage, 'hi') ^== 0 |,
Find(lowmessage,'hello') ^== 0 |,
Find(lowmessage, 'yo') ^== 0 Then
Do
Call ID /* standard discmsg */
Exit 0
End
When nodeid ^= 'irlearn' & nodeid ^= 'ccvax' Then
Do
Call MGonz /* Divert non-UCD users here */
Exit 0
End
When lowmessage = 'p'
Then Do
Call P /* call with no parameters */
Exit 0
End
When left(lowmessage,2) = 'p '
Then Do
Call P substr(message,3)
Exit 0
End
When nickname = 'Vax' Then
Do
Call Sys
Exit 0
End
Otherwise
Do
Call MGonz
Exit 0
End
End
Exit 0 /* Just in case instructions are added to the SELECT without an
Exit statement */
ID:
If nickname ^= '' Then
Call Tellback '* Yo 'nickname'! What'quote's happenin?'
Else
Call Tellback '* Yo dude! Please introduce yourself!'
Call Tellback '* 'discmsg
Return
MGonz:
Address 'CMS' 'COPYFILE MGONZ SOURCE A MGONZ LSP A (REPLACE'
'GLOBALV SELECT CHATDISC STACK NUM'
parse pull num
if num = '' | ^DataType(num,'W') then num = 0
num = num + 1
if (num < 1) | (100 < num) then num = 1
'GLOBALV SELECT CHATDISC SETP NUM' num
/* write to LASTING GLOBALV */
index = num /* cycles 1 to 100 */
select
when nickname ^= '' then name = nickname
when virtualuser ^= '' then name = virtualuser
otherwise name = userid /* pass originid into lisp program */
end
arg = removebadchars(message) /* bad chars will crash LISP */
arg = strip(arg)
arg = left(arg,50) /* else lisp truncates, thus losing brackets */
'EXECIO 1 DISKW MGONZ LSP A (FINIS STRING (setq index' index ')'
'EXECIO 1 DISKW MGONZ LSP A (FINIS STRING (setq index2' index ')'
'EXECIO 1 DISKW MGONZ LSP A (FINIS STRING (setq name 'quote''name ')'
'EXECIO 1 DISKW MGONZ LSP A (FINIS STRING (response 'quote'(' arg '))'
Address 'CMS' 'LISP MGONZ LSP'
'EXECIO 1 DISKR MGONZ LISTING A 441'
'EXECIO * DISKR MGONZ LISTING A (LOCATE /VALUE IS/'
'EXECIO 1 DISKR MGONZ LISTING A (LIFO'
parse pull line
line = lowcase(line) /* MGONZ LISTING will be all upper case */
do until queued()=0
pull rubbish
end
line = strip(line)
line = strip(line,'L','(')
line = strip(line,'T',')') /* discard enclosing brackets */
replymsg = '* 'line
If nickname ^= 'Vax' Then /* get both sides of the conversation */
Address 'CMS' 'TELL ME' replymsg
Call Tellback replymsg
Return
Dir:
Call Tellback '*--------------------------------------------------------- '
Call Tellback '* P EXEC printing utility for UCD'quote's VM service '
Call Tellback '* P COM printing utility for UCD'quote's CCVAX service '
Call Tellback '* P SH printing utility for UCD'quote's UTS service '
Call Tellback '* QR EXEC query reader utility for VM/CMS '
Call Tellback '* TITLE EXEC printing utility for VM/CMS '
Call Tellback '* THE TRUTH the truth about MGonz '
Call Tellback '* THE BIBLE the Bible of the Church of MGonz '
Call Tellback '*--------------------------------------------------------- '
Return
Get:
thing = arg(1)
parse var thing fn ft
filename = upcase(strip(fn)' 'strip(ft))
filename = strip(filename)
Select
When filename == '' Then Do
Call Tellback '* Syntax is GET FN FT '
Call Tellback '* available files : '
Call Dir
End
When filename == 'P EXEC' Then
If nodeid == 'irlearn' then do
Call Tellback '* P EXEC on its way ...'
Call Tellback '* type RECEIVE = to receive it and P to run it'
Address 'CMS' 'SF' filename userid
end
Else do
Call Tellback '* ----------- Warning !!! ---------------------'
Call Tellback '* P EXEC will only run on UCD'quote's VM service'
Call Tellback '* ---------------------------------------------'
Call Tellback '* here it is anyway ...'
Address 'CMS' 'SF' filename userid 'AT' nodeid
end
When filename == 'P COM' Then
If nodeid == 'ccvax' then do
Call Tellback '* P.COM on its way ...'
Call Tellback '* type RECEIVE * to receive it and @P to run it'
Address 'CMS' 'SF' filename userid 'AT CCVAX'
end
Else do
Call Tellback '* ----------- Warning !!! ---------------------'
Call Tellback '* P.COM will only run on UCD'quote's CCVAX service'
Call Tellback '* ---------------------------------------------'
Call Tellback '* here it is anyway ...'
Address 'CMS' 'SF' filename userid 'AT' nodeid
end
When filename == 'P SH' Then Do
Call Tellback '* ----------- Warning !!! ---------------------'
Call Tellback '* P SH will only run on UCD'quote's UTS service'
Call Tellback '* ---------------------------------------------'
Call Tellback '* here it is anyway ...'
Address 'CMS' 'SF' filename userid 'AT' nodeid
End
When filename == 'QR EXEC' | filename == 'TITLE EXEC' Then Do
Call Tellback '* file' filename 'on its way ...'
Call Tellback '* note this program only runs on VM/CMS systems'
Address 'CMS' 'SF' filename userid 'AT' nodeid
End
When filename == 'THE TRUTH' | filename == 'THE BIBLE' Then Do
Call Tellback '* file sent via mail ...'
subject = filename', (C) MGonzNet Publications Inc.'
argstring = '(NOEDIT NOLOG NOPROMPT FILE' filename 'SUBJECT' subject
Address 'CMS' 'MAIL' userid'@'nodeid argstring
End
Otherwise Do
Call Tellback '* Error - file' filename 'does not exist'
Call Tellback '* Use DIR to get list of available files'
End
End
Return
P:
/* Set pmsguser to this user
( in fact, this user will receive all msgs from Printers
until someone else sends a p request )
*/
If nodeid = 'irlearn' Then Do
Call Tellback '* Well, I'quote'll give you the info, but in future '
Call Tellback '* use the program P EXEC, which I have just sent you '
Address 'CMS' 'SENDFILE P EXEC' userid
End
'GLOBALV SELECT CHATDISC SET PMSGUSER' userid
'GLOBALV SELECT CHATDISC SET PMSGNODE' nodeid
If Arg(1) = ''
Then Do
Call Tellback '* VM and SCS printer queues : '
Call Tellback '* S=file being printed, Q=files queued'
printermsg = 'SMSG RSCS CMD PRTRSCS Q SY Q'
End
Else Do
printer = Arg(1)
Call Tellback '* Queue for printer' printer ': '
Call Tellback '* S=file being printed, Q=files queued'
printermsg = 'SMSG RSCS CMD PRTRSCS Q' Upcase(printer) 'F'
End
Call Diag 8,printermsg
Return
divert:
/* Incoming message from someone
Pass it to to the Arg(1)msguser, if found
*/
'GLOBALV SELECT CHATDISC STACK' Arg(1)'MSGUSER'
Parse pull msguser
If msguser ^= '' Then Do
'GLOBALV SELECT CHATDISC STACK' Arg(1)'MSGNODE'
Parse pull msgnode
If msgnode ^= '' Then Do
If Lowcase(msgnode) = 'irlearn'
Then thiscmd = 'MSG' Upcase(msguser)
Else thiscmd = 'SMSG RSCS MSG' Upcase(msgnode) Upcase(msguser)
Call Diag 8,thiscmd message
End
End
/* else no Arg(1)msguser set, so do nothing */
Return
Sys: /* My vax a/c has sweeping powers to do things on VM */
Select
When left(lowmessage,5) = 'tell ' Then Do
virtualuser = 'Sys on Vax'
Call MSG false,substr(message,6)
End
When lowmessage = 'on' Then Do
'GLOBALV SELECT CHATDISC SET LOGGEDON' true
Call Vax '* Message copy to Vax is ON'
End
When lowmessage = 'off' Then Do
'GLOBALV SELECT CHATDISC SET LOGGEDON' false
Call Vax '* Message copy to Vax is OFF'
End
/* I can tell VM myself when to copy msgs to me */
When lowmessage = 'status' Then Do
'GLOBALV SELECT CHATDISC STACK LOGGEDON'
Parse pull loggedon
If loggedon ^= false Then
Call Vax '* Message copy to Vax is ON'
Else
Call Vax '* Message copy to Vax is OFF'
End
When left(upmessage,3) = 'CMS' Then
Do
cmd = lowcase(substr(message,5))
cmd = strip(cmd)
Address 'CMS' cmd
If rc ^= 0 Then
Call Vax '* Command failed, return code' rc
Else
Call Vax '* Command returned ok'
End
When left(upmessage,2) = 'CP' Then
Do
cmd = upcase(substr(message,4))
cmd = strip(cmd)
Call Diag 8,cmd
If rc ^= 0 Then
Call Vax '* Command failed, return code' rc
Else
Call Vax '* Command returned ok'
End
When lowmessage = 'q' Then
Call q /* query reader, Call Vax the result */
Otherwise
Call MGonz
End
Return
Tellback:
Call Diag 8,msgcmd Arg(1)
Return
Vax:
vaxmsgcmd = 'SMSG RSCS MSG CCVAX H236_007'
Call Diag 8,vaxmsgcmd Arg(1)
Return
Lowcase: procedure expose lowcasechars upcasechars
Return translate(Arg(1),lowcasechars,upcasechars)
Upcase: procedure expose lowcasechars upcasechars
Return translate(Arg(1),upcasechars,lowcasechars)
Capitalise: procedure expose lowcasechars upcasechars
firstchar = substr(Arg(1),1,1)
rest = substr(Arg(1),2)
Return Upcase(firstchar)''Lowcase(rest)
Mytime: procedure
timenow = left(time(),5)
hr = left(timenow,2)
min = right(timenow,2)
if hr > 12 then timenow = (hr - 12)'.'min' pm'
else if hr = 12 then timenow = hr'.'min' pm'
else timenow = hr'.'min' am'
if left(timenow,1) = '0' then timenow = substr(timenow,2)
dow = left(date('weekday'),3)
day = right(date('sorted'),2)
if left(day,1) = '0' then day = substr(day,2)
month = left(date('month'),3)
year = left(date('sorted'),4)
Return timenow',' dow day month year
fileexists: procedure expose true false
filename = arg(1)
upper filename
'ESTATE' filename
if rc = 0 then return true
else return false
removebadchars: procedure expose lowcasechars upcasechars digits
/* substitutes spaces for non-alphabetic chars
in arg(1)
*/
goodchars = lowcasechars || upcasechars
if arg(2) ^= '' then
goodchars = goodchars || digits
string = arg(1)
do i = 1 to length(string)
char = substr(string,i,1)
if pos(char,goodchars) = 0 /* not one of the goodchars */
then string = left(string,i-1)' 'substr(string,i+1)
end
return string
On Internet since 1987.