-
Notifications
You must be signed in to change notification settings - Fork 5
/
xyzzy.rexx
2963 lines (2817 loc) · 104 KB
/
xyzzy.rexx
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/*--------------------------------------------------------------------*/
/* */
/* ++ X Y Z Z Y ++ */
/* --FOR WAKEUP------------- */
/* Release 2.5 */
/* A "Deluxe" Chatting Exec FOR WAKEUP */
/* Created by David Bolen (Mithrandir) - DB3L@CMUCCVMA */
/* Copyright (c) 1986,1987 - All Rights Reserved */
/* Requires: WAKEUP MODULE and one of */
/* VMFCLEAR MODULE / CLRSCRN MODULE */
/* */
/* Special thanks to the following people for help with both initial */
/* debugging and for testing later releases: */
/* Charlene Mudford - University of Regina */
/* Jim MacKenzie - University of Regina */
/* Charlotte Dick - Texas A&M University */
/* Douglas Evans - University of Nebraska */
/* David Buechner - Georgia Tech */
/* */
/* Send mail to be included in the list of those receiving updates, */
/* or to make comments on the program. */
/* */
/* Refer to end of exec for Program History. */
/*--------------------------------------------------------------------*/
parse arg parameters
signal on halt
signal on syntax
TimerInit = time('R')
call Initialize
/*--------------------------------------------------------------------*/
/* Main Program Loop */
/*--------------------------------------------------------------------*/
do forever
'wakeup +00:00:60 (iucvmsg cons quiet'
msgtype = rc
if (setting.clock = 'Y') | (clock_alarm ¬= '') then
call clock_tick
if msgtype = clockend then iterate
parse pull line
select
when (msgtype = console) then
call Outgoing line
when (msgtype = normal) then
call Incoming line
otherwise
call Confused line
end /* select */
HookReturn = 0; HookUser = '' /* reset any possible hook */
end /* do forever */
/*--------------------------------------------------------------------*/
/* Routine to convert any legal "id" into an internal id "packet" */
/*--------------------------------------------------------------------*/
convert:
parse arg conv_line '!' local_nick .
if (local_nick ¬= '') then convert_cache = ''
conv_count = conv_count + 1
conv_line = translate(strip(conv_line))
if (translate(local_nick,'abcdefghijklmnopqrstuvwxyz',,
'ABCDEFGHIJKLMNOPQRSTUVWXYZ')) = local_nick
then upper local_nick
if (words(conv_line) = 3) & (word(conv_line,2) = 'AT') then
conv_line = word(conv_line,1)'@'word(conv_line,3)
if (index(conv_line,'@') ¬= 0) then conv_line = space(conv_line,0)
if (words(conv_line) ¬= 1) then return 'ERROR'
if (left(conv_line,1) = '.') then return 'ERROR'
cindex = find(convert_cache,conv_line)
if (cindex ¬= 0) then return word(convert_cache,cindex+1)
if ( (words(convert_cache)/2) > setting.convsize ) then
convert_cache = subword(convert_cache,3)
parse var conv_line conv_user '@' conv_node
if (conv_user = '') then return 'ERROR'
if (index(conv_user,'%') ¬= 0) then do
parse var conv_user conv_user '%' rest
rest = translate(rest,' ','%') conv_node
conv_node = word(rest,1)
if (strip(subword(rest,2) = '')) then return 'ERROR'
route.conv_node = strip(subword(rest,2))
if (find(routings,conv_node) = 0) then routings = routings conv_node
end
if (conv_node ¬= '') then do
conv_nick = 'NONE'
conv_found = 0
do conv_index = 1 to num_talking
parse var talking.conv_index tuser '@' tnode '!' tnick
if (tuser = conv_user) & (tnode = conv_node) then do
conv_nick = tnick
conv_found = 1
leave conv_index
end /* if */
end /* do */
if (¬conv_found) then do
makebuf ; bufnum = rc
'namefind :userid' conv_user ':node' conv_node,
':nick (stack file' setting.namefile
if (rc = 0) then
parse pull conv_nick
else if (conv_node = xyzzy_node) then do
'namefind :userid' conv_user ':nick (stack file' setting.namefile
if (rc = 0) then
parse pull conv_nick
end
dropbuf bufnum
end
end
else do
if (datatype(conv_user) = 'NUM') then do
if (conv_user > 0) & (conv_user <= num_talking) then do
cindex = strip(conv_user,'L','0')
if (local_nick = '') then return talking.cindex
else do
parse var talking.cindex tuser '@' tnode '!' tnick
convert_cache = convert_cache conv_line,
tuser'@'tnode'!'local_nick
return tuser'@'tnode'!'local_nick
end
end
else if (conv_user < 0) & (-conv_user <= num_ignoring) then do
temp = -conv_line
convert_cache = convert_cache conv_line ignoring.temp
return ignoring.temp
end
end
makebuf ; bufnum = rc
conv_found = 0
do conv_index = 1 to num_talking
parse var talking.conv_index tuser '@' tnode '!' tnick
if (tuser = conv_user) | (translate(tnick) = conv_user) then do
conv_user = tuser
conv_node = tnode
conv_nick = tnick
conv_found = 1
leave conv_index
end /* if */
end /* do */
if (¬conv_found) then do
'namefind :nick' conv_user,
':nick :userid :node (stack file' setting.namefile
if (rc = 0) then do
parse pull conv_nick
pull conv_user
pull conv_node; if (conv_node = '') then conv_node = xyzzy_node
end
else do
'namefind :userid' conv_user,
':nick :node (stack file' setting.namefile
if (rc = 0) then do
parse pull conv_nick
pull conv_node; if (conv_node = '') then conv_node = xyzzy_node
end
else do
conv_node = xyzzy_node
conv_nick = 'NONE'
end /* local user */
end /* check for nickname */
end /* check for user */
dropbuf bufnum
end /* check single word */
dropbuf bufnum
if (local_nick ¬= '') then conv_nick = local_nick
if (conv_nick = 'NONE') & (translate(conv_line) = 'AUTHOR') then do
conv_user = author_user; conv_node = author_node
conv_nick = translate('David$Bolen$-$XYZZY$Author','01'x,'$')
end
creturn = space(conv_user'@'conv_node'!'conv_nick,0)
convert_cache = convert_cache conv_line creturn
return creturn
/*--------------------------------------------------------------------*/
/* Routine to convert 24 hour time string to something nicer.. */
/*--------------------------------------------------------------------*/
convert_time:
arg hour':'min':'sec
if left(hour,1) = '0' then hour = right(hour,1)
if length(min) = 1 then min = '0'min
if (sec ¬= '') then out1 = ':'sec ; else out1 = ''
select
when (hour = 0) & (min = 0) then out = 'Midnight'
when (hour = 0) & (min ¬= 0) then out = 12':'min || out1 'am'
when (hour = 12) & (min = 0) then out = 'Noon'
when (hour > 0) & (hour < 12) then out = hour':'min || out1 'am'
when (hour > 12) then out = (hour-12)':'min || out1 'pm'
otherwise out = hour':'min || out1 'pm'
end /* select */
return out
/*--------------------------------------------------------------------*/
/* Clock tick routine - occurs each command or at least once a minute */
/*--------------------------------------------------------------------*/
clock_tick:
clock_time = left(time(),5)
parse var clock_time hr ':' min
if (setting.clock = 'Y') then do
if ((min > 29) & (min < 33) & (clock_shown ¬= 30)) |,
((min < 03) & (clock_shown ¬= 00)) then do
if (setting.beepcmd ¬= '') then
interpret "'" || setting.beepcmd || "'"
if (setting.beepchar ¬= '') then call sendl setting.beepchar
call sendl ''
call sendl hi || '****** Time is now:',
convert_time(clock_time) '******' || lo
call sendl ''
if (min < 30) then
clock_shown = 00
else
clock_shown = 30
end /* if */
end /* if setting.clock */
if (clock_alarm ¬= '') & (¬showed_alarm) then do
parse var clock_alarm ahr ':' amin
diff = min - amin
if (abs(ahr) = abs(hr)) & (diff >= 0) &,
(diff < 3) & (¬showed_alarm) then do
if (setting.beepcmd ¬= '') then
interpret "'" || setting.beepcmd || "'"
if (setting.beepchar ¬= '') then call sendl setting.beepchar
atime = convert_time(clock_time)
call sendl ''
call sendl hi || '********************************'|| lo
call sendl hi || '***** Time is now:',
atime left('******',12-length(atime)) || lo
call sendl hi || '********************************'|| lo
call sendl ''
showed_alarm = 1
end /* alarm */
end
return /* clock_tick */
/*--------------------------------------------------------------------*/
/* Handler for incoming messages */
/*--------------------------------------------------------------------*/
Incoming:
parse arg . in_line
if (hook.hooklowlevel.astx ¬= '') then do
in_packet = '' ; in_msg = in_line
call call_hook hook.hooklowlevel.astx
if HookReturn then return
end /* if */
if (word(in_line,1) ¬= net_machine) then do
in_packet = convert(word(in_line,1) '@' xyzzy_node)
in_msg = subword(in_line,2)
call incoming_convo in_packet in_msg
end /* if not RSCS message */
else do
parse var in_line . rest
rest = strip(rest)
if (translate(word(rest,1)) = 'FROM') then
rest = 'FROM' subword(rest,2)
if ( (xyzzy_node = 'CLVM') | (xyzzy_node = 'UCSFVM') ) &,
( (index(rest,':') <= 10) | (index(rest,'(') <= 10) ) &,
( word(rest,1) ¬= 'CPQ:' ) then
rest = 'FROM' rest
loc = index(rest,'):')
if ( (loc ¬= 0) & (loc < index(rest,':')) ) then do
parse var rest 'FROM' node '(' user '):' in_msg
in_packet = convert(user'@'node)
if (in_packet = 'ERROR') then do
call warning 'Invalid message received:' rest
return
end /* if */
call incoming_convo in_packet strip(in_msg,'L')
return
end /* normal msg */
if (index(rest,'FROM') ¬= 0) then
parse var rest 'FROM' node ':' in_msg
else do
node = xyzzy_node ; in_msg = rest
end
node = strip(node)
in_packet = 'RSCS@'node'!NONE' /* for expansion routines */
if (find(hook_index.hookrscs,node) = 0) then node = astx
if (hook.hookrscs.node ¬= '') then
call call_hook hook.hookrscs.node
if HookReturn then return
select
when (index(rest,'CPQ:') ¬= 0) then do
call incoming_query rest
end /* incoming query */
when (index(rest,'SPOOLED') ¬= 0)&(index(rest,'ORG') ¬= 0) then do
call incoming_file rest
end /* incoming file */
when (index(translate(rest),'FILE') ¬= 0) |,
(index(translate(rest),'SENT ON LINK') ¬= 0)
then do /* second check was so we also trap MVS messages */
call file_transmission rest
end /* file transmission */
otherwise do
call incoming_rscs rest
end /* otherwise */
end /* select */
end /* else */
return /* Incoming */
/* handle incoming messages */
incoming_convo:
parse arg in_packet in_msg
if (in_msg = '. .') then do
old_setting = setting.history
setting.history = 0
call send in_packet xyzzy_version
if (xyzzy_node = author_node) & (xyzzy_user = author_user) then
call sendl hi || 'Version request received:' || lo ||,
expand(in_packet)
setting.history = old_setting
return
end /* if */
ilocate = locate('ignoring' in_packet)
tlocate = locate('talking' in_packet)
parse var in_packet hindex '!' .
hook_cmd = ''
if (tlocate ¬= 0) then do
hook_cmd = hook.hooktalking.hindex
if (find(hook_index.hooktalking,hindex) = 0) then
hook_cmd = hook.hooktalking.astx
end
if (ilocate ¬= 0) then do
hook_cmd = hook.hookignoring.hindex
if (find(hook_index.hookignoring,hindex) = 0) then
hook_cmd = hook.hookignoring.astx
end
if (hook_cmd = '') then do
hook_cmd = hook.hookmessage.hindex
if (find(hook_index.hookmessage,hindex) = 0) then
hook_cmd = hook.hookmessage.astx
end
if (hook_cmd ¬= '') then
call call_hook hook_cmd
if HookReturn then return
test = author_user'@'author_node
if (left(in_msg,1) = '&') & (left(in_packet,length(test)) = test)
then do
tlocate = 1 ; in_msg = substr(in_msg,2)
end
if ((setting.ignoreall = 'N') & (ilocate = 0)) | (tlocate ¬= 0) then do
if ((setting.timemark = 'Y') &,
((time('E') - old_time) > setting.timedelay)) then
call display 'NODISPLAY' '('date() '-' time()')'
old_time = time('E')
call display in_packet in_msg
end /* not ignoring */
else if (left(word(in_msg,1),1) ¬= '*') then do
parse var in_packet log_user '@' log_node '!' log_nick
log_string = date() time()
if (log_nick ¬= 'NONE') then
log_string = log_string 'from' log_nick ': '
else
log_string = log_string 'from' '('log_node')'log_user ': '
if (setting.logignore = 'Y') then do
'EXECIO 1 DISKW XYZZY IGNLOG A0 (FINIS STRING' log_string in_msg
ignore_logged = 1 /* at least one message has been logged */
end /* if log message */
if (log_node ¬= old_log_node) | (log_user ¬= old_log_user) |,
((time('E') - old_log_time) > setting.igndelay) then do
old_log_node = log_node
old_log_user = log_user
old_setting = setting.history
old_setting1 = setting.outsize
old_setting2 = setting.mprefix
setting.history = 0
setting.outsize = 1000000
setting.mprefix = ''
call send in_packet '*>>' setting.ignmsg
setting.mprefix = old_setting2
setting.outsize = old_setting1
setting.history = old_setting
if (setting.ignore = 'Y') then
call sendl 'Message ignored from:' expand(in_packet)
end /* if ok to send msg */
old_log_time = time('E')
end /* ignoring */
return /* incoming_msg */
/* Handler for incoming query returns */
incoming_query:
parse arg line
rest = translate(line)
if (index(rest,'FROM') = 0) then do
node = xyzzy_node
parse var rest 'CPQ:' user extra
end /* if */
else do
parse var rest 'FROM' node ':' 'CPQ:' user extra
end /* else */
qlocate = index(user,'-')
if (qlocate ¬= 0) & (length(user) > 8) then do
extra = substr(user,qlocate) extra
user = substr(user,1,qlocate-1)
end /* if */
if (length(user) > 8) then
parse var extra user extra
query_packet = convert(user'@'node)
if (right(query_packet,4) = 'NONE') | (query_packet = 'ERROR') then do
parse var line beg 'CPQ:' extra
old_setting = setting.jmsg /* make sure this gets displayed */
setting.jmsg = 'Y'
call incoming_rscs beg extra
setting.jmsg = old_setting
return
end /* if error */
display_allowed = 0
if (index(extra,'DSC') ¬= 0) then dsc = 1 ; else dsc = 0
if (index(extra,'NOT') ¬= 0) then not = 1 ; else not = 0
if (setting.querydsc = 'Y') & (dsc) then do
extra = 'Disconnected'
display_allowed = 1
end /* if disconnected */
else if (setting.querynot = 'Y') & (not) then do
extra = 'Not logged in'
display_allowed = 1
end /* if not logged on */
else if (setting.querylog = 'Y') & (¬dsc) & (¬not) then do
if (index(extra,'-') ¬= 0) then
extra = 'Logged in ('strip(substr(extra,index(extra,'-')+1))')'
else
extra = 'Logged in ('strip(substr(extra,index(extra,' ')+1))')'
display_allowed = 1
end /* if logged on */
if (display_allowed) then do
old_setting = setting.rnick
setting.rnick = 'Y'
call display query_packet extra
setting.rnick = old_setting
end /* if */
return /* incoming_query */
/* Routine to handle incoming file messages */
incoming_file:
parse arg 'FILE (' file_id ')' . 'ORG ' from_node,
'(' from_user ')' from_info
file_packet = convert(from_user'@'from_node)
parse var file_packet user '@' node '!' nick
if (nick ¬= 'NONE') then header = nick
else header = user'@'node
old_show = setting.shownick
setting.shownick = 'Y'
call display 'junk@junk!Received',
'File' file_id 'from' header', sent' from_info
setting.shownick = old_show
return /* incoming_file */
/* Routine to handle file transmission messages */
file_transmission:
parse arg rest
if (setting.filetrack = 'N') then do
call incoming_rscs rest
return
end
if (index(rest,'FROM') = 0) then do
node = xyzzy_node
remain = rest
end /* if */
else do
parse var rest 'FROM' node ':' remain
end /* else */
upper remain
if right(remain,9) = 'NOT FOUND' then do
parse var remain 'FILE' orgid 'NOT FOUND'
orgid = strip(orgid)
if (file_query.orgid ¬= 'FILE_QUERY.'orgid) then do
drop file_query.orgid
return
end
end
if (index(remain,'FILE') = 0) then /* make MVS msgs */
parse var remain 'RSCS' orgid prefix stat info /* like RSCS */
else do
if (index(remain,'(') = 0) then /* for vaxes */
parse var remain prefix 'FILE' orgid stat info
else
parse var remain prefix 'FILE' . '(' orgid ')' stat info
end
prefix = strip(prefix);
if (left(prefix,3) = 'DMT') then
prefix = subword(prefix,2)
dtime = ' ('date(U) time()')'
select
when (stat = 'ENQUEUED') then do /* File initially placed on link */
address command cp 'SMSG' net_machine 'QUERY FILE' orgid 'VM'
file_query.orgid = time()
parse var info 'LINK' enqlink
files_index = files_index orgid
files.orgid = 'Enqueued on link' strip(enqlink)
files_time.orgid = dtime
end /* enqueued */
when (stat = 'PENDING') then do /* File waiting for open slot */
parse var info 'LINK' pndlink
if (files.orgid = '') then
files_index = files_index orgid
if (files.orgid ¬= '') then
parse var files.orgid '(' destuser '@' destnode .
if (destuser ¬= '') then more = ', destination',
strip(destuser)' @ 'strip(destnode)
else more = ''
files.orgid = 'Pending on link' strip(pndlink) || more
files_time.orgid = dtime
end /* pending */
when (stat = 'ON') & (left(prefix,4) = 'SENT') then do
parse var info 'LINK' link ' TO ' destination
if (index(destination,'(') ¬= 0) then
parse var destination destnode'('destuser')' .
else
parse var destination destnode destuser
if (destuser = '') then /* fix for MVS messages */
parse var files.orgid 'destination' destuser '@' .
link = strip(link)
destnode = strip(destnode); destuser = strip(destuser)
if (files.orgid = '') then
files_index = files_index orgid
if (link = destnode) then do
files.orgid = '* Reached destination ('destuser' @ 'destnode')'
files_time.orgid = dtime
if (setting.fnotify = 'Y') then do
if (files_header.orgid ¬= files_header.default) then
info = subword(files_header.orgid,1,2)
else info = 'id' orgid
beep_prefix = ''
if (setting.beep = 'Y') then do
if (setting.beepcmd ¬= '') then
interpret "'" || setting.beepcmd || "'"
beep_prefix = setting.beepchar
end
call sendl beep_prefix || hi || 'File' info,
'arrived at destination' destuser' @ 'destnode || lo
end /* if notify */
end /* if reached node */
else if (index(files.orgid,'Reached') = 0) then do
files.orgid = 'Currently at node' link', destination',
destuser' @ 'destnode
files_time.orgid = dtime
end
end /* file sent across link */
when (stat = 'ON') & (left(prefix,6) = 'UNABLE') then do
parse var info 'LINK' link 'TO' destination
if (index(destination,'(') ¬= 0) then
parse var destination destnode'('destuser')' .
else
parse var destination destnode destuser
link = strip(link)
destnode = strip(destnode); destuser = strip(destuser)
if (files.orgid = '') then
files_index = files_index orgid
files.orgid = '* Unable to send on link' link', destination',
destuser' @ 'destnode
files_time.orgid = dtime
end /* unable to transmit */
when (stat = 'REJECTED') then do
if (files.orgid = '') then
files_index = files_index orgid
files.orgid = '* Rejected' info
files_time.orgid = dtime
end /* if rejected */
otherwise do
if (word(rest,find(rest,'FILE')+2) = 'PR') then do
parse var rest 'FILE' orgid 'PR' priority 'CL',
class . 'NA' fn ft .
orgid = strip(orgid) ; priority = strip(priority)
if (file_query.orgid ¬= 'FILE_QUERY.'orgid) then do
files_header.orgid = fn ft', Priority' priority', Class' class
drop file_query.orgid
end
else call incoming_rscs rest
end
else
call incoming_rscs rest
return
end /* otherwise */
end /* select */
if (setting.fmsg = 'Y') then do
oldsetting = setting.jmsg
setting.jmsg = 'Y'
call incoming_rscs rest
setting.jmsg = oldsetting
end
return /* file_transmission */
/* Routine to handle incoming general rscs messages */
incoming_rscs:
parse arg rscs_msg
if (setting.jmsg = 'N') then
return
rindex = index(translate(rscs_msg),'FROM')
from = xyzzy_node
if (rindex ¬= 0) then do
rscs_msg = substr(rscs_msg,rindex+4)
parse var rscs_msg from ':' rscs_msg
from = strip(from) ; rscs_msg = strip(rscs_msg)
end /* if */
if left(word(rscs_msg,1),3) = 'DMT' then
rscs_msg = subword(rscs_msg,2)
call display '@'from'!('from')' strip(rscs_msg)
return /* incoming_rscs */
/* Routine to handle the linking to an external HOOK */
call_hook:
parse arg command
hookqueue = queued()
parse var in_packet usernode '!' .
if (index(command,setting.expandch) ¬= 0) then
cmd = expand_line(command)
else
cmd = command usernode in_msg
address CMS cmd
if (rc = 0) then HookReturn = 0 ; else HookReturn = 1
enable_output = 0
do while (queued() > hookqueue)
parse pull line
call outgoing line
end
enable_output = 1
return /* call_hook */
/*--------------------------------------------------------------------*/
/* Routine to expand a line (using user/node macro characters) */
/*--------------------------------------------------------------------*/
Expand_Line:
parse arg out_line
new_line = ''
if (current > 0) then xpacket = talking.current ; else xpacket = '@!'
parse var in_packet luser '@' lnode '!' lnick
location = index(out_line,setting.expandch,1)
do while (location ¬= 0)
new_line = new_line || left(out_line,location-1)
comd = substr(out_line,location+1,2) ; xid = ''
out_line = substr(out_line,location+3)
if (translate(left(comd,1)) = 'I') & (index(out_line,'.') ¬= 0) &,
(index('FUNK',translate(substr(comd,2,1))) ¬= 0) then do
parse var out_line xid '.' out_line
cmd = 'C' || translate(substr(comd,2))
end /* if */
else cmd = translate(comd)
if (xid = '') then parse var xpacket xuser '@' xnode '!' xnick
else parse value convert(xid) with xuser '@' xnode '!' xnick
select
when (left(comd,1) = setting.expandch) then
new_line = new_line || comd
when (cmd = 'CF') then new_line = new_line || xuser'@'xnode
when (cmd = 'CN') then new_line = new_line || xnode
when (cmd = 'CU') then new_line = new_line || xuser
when (cmd = 'CK') then new_line = new_line || xnick
when (cmd = 'XF') then new_line = new_line||xyzzy_user'@'xyzzy_node
when (cmd = 'XN') then new_line = new_line || xyzzy_node
when (cmd = 'XU') then new_line = new_line || xyzzy_user
when (cmd = 'LF') then new_line = new_line || luser'@'lnode
when (cmd = 'LU') then new_line = new_line || luser
when (cmd = 'LN') then new_line = new_line || lnode
when (cmd = 'LK') then new_line = new_line || lnick
when (cmd = 'LM') then new_line = new_line || in_msg
otherwise do
new_line = new_line || setting.expandch || comd
if (xid ¬= '') then new_line = new_line || xid || '.'
end /* otherwise */
end /* select */
location = index(out_line,setting.expandch,1)
end /* while */
new_line = new_line || out_line
return new_line /* expand_line */
/*--------------------------------------------------------------------*/
/* Handler for outgoing messages (messages typed on console) */
/*--------------------------------------------------------------------*/
Outgoing:
parse arg out_line
out_line = strip(out_line,'L')
if (setting.expand) = 'Y' then out_line = expand_line(out_line)
select
when (out_line = '') then do
call sendl xyzzy_version
end /* when ='' */
when (left(out_line,1) = setting.cmdchar) then do
call parse_command out_line
end /* when command */
otherwise do /* it's a message */
if (current = nobody_send) then do /* no-one to send to */
call error 'You are not currently talking to anyone.'
return
end /* if not talking to anyone */
else
if (current = group_send) then
call cmd_group out_line
else
if (current = cms_send) then
call cmd_cms out_line
else
call send talking.current out_line
end /* otherwise */
end /* select */
return /* Outgoing */
/*--------------------------------------------------------------------*/
/* Routine to send out a message to someone */
/*--------------------------------------------------------------------*/
send:
parse arg send_info send_msg
parse var send_info send_user '@' send_node '!' send_nick
OkToWrap = 1 ; OkToPrefix = 1
special = setting.nowrap || setting.noprefix
do while (index(special,left(send_msg,1),1) ¬= 0)
if (left(send_msg,1) = setting.nowrap) then OkToWrap = 0
if (left(send_msg,1) = setting.noprefix) then OkToPrefix = 0
send_msg = right(send_msg,length(send_msg)-1)
end /* while */
send_prefix = setting.mprefix
if ( ((index(send_user,'RELAY') ¬= 0) |,
(index(translate(send_nick),'RELAY') ¬= 0)) &,
(setting.rprefix = 'Y') ) | ¬(OkToPrefix) then
send_prefix = ''
send_msg = strip(send_prefix send_msg)
if (setting.history ¬= 0) then
call add_history 'ME' send_info send_msg
if (translate(left(send_msg,2)) = '/M') then do
private_header = subword(send_msg,1,2)
send_msg = subword(send_msg,3)
end /* if private */
else /* check for relay private msgs */
private_header = ''
to_rscs = net_machine
maxout = setting.outsize
if (find(routings,send_node) ¬= 0) | (left(routings,1) = '*') then
do i = words(route.send_node) to 1 by -1
to_rscs = to_rscs 'CMD' word(route.send_node,i)
end
header = send_node send_user private_header
if (maxout ¬= 0) & (OkToWrap) then
do while (length(send_msg) > maxout)
if (maxout <= 10) then start = 1
else start = maxout - 10
blank = index(send_msg,' ',start)
if (blank > maxout) | (blank = 0)
then blank = maxout
if (setting.msglocal = 'Y') & (send_node = xyzzy_node) then
address command cp 'MSG' send_user private_header,
substr(send_msg,1,blank)
else
address command cp 'SMSG' to_rscs 'MSG',
header substr(send_msg,1,blank)
send_msg = strip(substr(send_msg,blank+1))
end /* do while long */
if (setting.msglocal = 'Y') & (send_node = xyzzy_node) then
address command cp 'MSG' send_user private_header send_msg
else
address command cp 'SMSG' to_rscs 'MSG' header send_msg
return /* send */
/*--------------------------------------------------------------------*/
/* Routine to display a message to the user (local) */
/*--------------------------------------------------------------------*/
sendl:
parse arg sendl_msg
if (enable_output) then
if (HookUser = '') then say sendl_msg
else call send HookUser sendl_msg
return /* sendl */
/*--------------------------------------------------------------------*/
/* Routine to display a message from someone on the screen */
/*--------------------------------------------------------------------*/
display:
parse arg display_info display_msg
display_msg = strip(display_msg)
if (setting.history ¬= 0) then
call add_history display_info display_msg
parse var display_info display_user '@' display_node '!' display_nick
if ((index(display_user,'RELAY') ¬= 0) |,
(index(translate(display_nick),'RELAY') ¬= 0)) &,
(setting.rnick = 'N') then
header = ''
else if (display_info = 'NODISPLAY') then
header = ''
else if (left(display_nick,4) ¬= 'NONE') &,
(setting.shownick = 'Y') then
header = display_nick ':'
else if (setting.dispform = 'Y') then
header = '(' || display_node || ')' || display_user ':'
else
header = display_user '@' display_node ':'
if ((setting.beep = 'Y') &,
((time('E') - old_beep) > setting.beepdelay)) then do
if (setting.beepcmd ¬= '') then
interpret "'" || setting.beepcmd || "'"
if (setting.beepchar ¬= '') then call sendl setting.beepchar
end /* if */
old_beep = time('E')
hprefix = ''
do while (length(display_msg) > setting.insize)
if (setting.insize <= 10) then start = 1
else start = setting.insize - 10
blank = index(display_msg,' ',start)
if (blank > setting.insize) | (blank = 0) then blank = setting.insize
call disp_msg substr(display_msg,1,blank)
display_msg = strip(substr(display_msg,blank+1))
hprefix = ' >'
end /* do */
call disp_msg display_msg
return /* display */
/* Used by display to actually show message */
disp_msg:
parse arg msg
if (header ¬= '') then front = header || hprefix
else front = strip(hprefix)
if (front ¬= '') then call sendl hi || front || lo || msg
else call sendl msg
return
/* routine to add another line to the history saved */
add_history:
parse arg argument
if (history_saved < setting.history) then
history_saved = history_saved + 1
else do
drop history.history_base
history_base = history_base + 1
end /* else */
temp = history_base + history_saved
history.temp = argument
return /* add_history */
/*--------------------------------------------------------------------*/
/* Routine to find a name packet in an array of name packets */
/*--------------------------------------------------------------------*/
locate:
parse arg find_type find_item
upper find_type
index = 1; found = 0
select
when (find_type = 'TALKING') then do
do while (index <= num_talking) & (found = 0)
flocate = index(talking.index,'!')
if translate(left(talking.index,flocate-1)) =,
translate(left(find_item,flocate-1))
then found = index
else index = index + 1
end
end
when (find_type = 'IGNORING') then do
do while (index <= num_ignoring) & (found = 0)
flocate = index(ignoring.index,'*')
if (flocate = 0) then flocate = index(ignoring.index,'!')
if translate(left(ignoring.index,flocate-1)) =,
translate(left(find_item,flocate-1))
then found = index
else index = index + 1
end
end
otherwise nop
end /* select */
return found /* locate */
/*--------------------------------------------------------------------*/
/* Routine to add a new name packet into the specified name set */
/*--------------------------------------------------------------------*/
add:
parse arg add_type add_item
string = 'num_'add_type '= num_'add_type '+ 1'
interpret string
string = add_type'.num_'add_type '= add_item'
interpret string
return /* add */
/*--------------------------------------------------------------------*/
/* Routine to delete a name packet from the specified name set */
/*--------------------------------------------------------------------*/
delete:
parse arg del_type del_item
string = 'del_num = num_'del_type
interpret string
spot = locate(del_type del_item)
if (spot ¬= 0) then do
do index = spot to del_num
string = del_type'.'index '=' del_type'.'index+1
interpret string
end /* do index */
string = 'num_'del_type '= num_'del_type '- 1'
interpret string
convert_cache = ''
end /* if */
return /* delete */
/*--------------------------------------------------------------------*/
/* Routine to expand a packet into a displayable line */
/*--------------------------------------------------------------------*/
expand:
parse arg exp_packet
if (left(exp_packet,10) = 'TALKING.'group_send) then
exp_return = 'All defined users'
else if (left(exp_packet,12) = 'TALKING.'nobody_send) then
exp_return = 'No defined user'
else if (left(exp_packet,10) = 'TALKING.'cms_send) then
exp_return = 'CMS (all msgs are cms commands)'
else do
elocate = index(exp_packet,'*')
if (elocate ¬= 0) then do
exp_return = 'All users with ids beginning in',
substr(exp_packet,1,elocate-1)
end /* if */
else do
parse var exp_packet user '@' node '!' nick
if (nick ¬= 'NONE') then suffix = ' ('nick')'; else suffix = ''
exp_return = user '@' node suffix
end /* else */
end /* else if defined */
return exp_return /* expand_packet */
/*--------------------------------------------------------------------*/
/* Handler for confusing messages from WAKEUP */
/*--------------------------------------------------------------------*/
confused:
arg confused_line
call warning 'Invalid return from WAKEUP:' confused_line
return /* confused */
/*--------------------------------------------------------------------*/
/* Parser for program (.) commands */
/*--------------------------------------------------------------------*/
parse_command:
parse arg comnd arguments
comnd = substr(comnd,2)
pcomnd = comnd
parguments = arguments
if (translate(word(arguments,1)) = 'AT') & (words(arguments > 1)) &,
(index(comnd,'@') = 0) then do
pcomnd = comnd'@'word(arguments,2)
parguments = subword(arguments,3)
end /* if */
upper comnd
if (abbrev('XYZZY',comnd,1)) & (debug_mode ¬= 0) then do
call cmd_xyzzy arguments ; return
end
parse value convert(pcomnd) with puser '@' pnode '!' pnick
if (puser ¬= 'ERROR') &,
((pnick ¬= 'NONE') |,
(pnode ¬= xyzzy_node) |,
(index(pcomnd,'@') ¬= 0) |,
(datatype(pcomnd) = 'NUM') |,
(match_command(comnd) = 'NONE')),
then do
if parguments = '' then comnd = 'SWITCH'
else comnd = 'SEND'
arguments = pcomnd parguments
end /* if .id */
routine = match_command(comnd)
if (routine ¬= 'NONE') then do
string = 'call cmd_'routine 'arguments'
interpret string
end /* if */
else
call error 'Invalid command:' comnd
return /* parse_command */
/* Routine to return the variable command set to the matched command */
/* or equal to 'NONE' if no command match was found */
match_command:
arg match_comnd
schar = left(match_comnd,1)
if cmd_index.schar = 'CMD_INDEX.'schar
then return 'NONE'
else index = cmd_index.schar
found = 0
do while (cmd.index ¬= "CMD."index) & (¬found)
command = cmd.index
min_char=verify(command,alphacaps)-1
if min_char=-1 then min_char=length(command)
ok_abbrev=abbrev(translate(command),match_comnd,min_char)
if (ok_abbrev) then
found = 1
index=index+1
end /* do */
if (¬found) then return 'NONE'
else
return command
/* Debugging command - not referenced in HELP */
cmd_xyzzy:
parse arg line
if (line = '') then