-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathLOGJS.MAC
1977 lines (1850 loc) · 47 KB
/
LOGJS.MAC
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
;<135-TENEX>LOGJS.MAC;15 12-DEC-75 10:54:44 EDIT BY PLUMMER
; ADD IFN PIESLC AROUND LOGI0B
;<134-TENEX>LOGJS.MAC;14 3-SEP-75 12:54:30 EDIT BY ALLEN
; FIX FOR USE OF NEW LOCK MACRO
;<134-TENEX>LOGJS.MAC;13 29-AUG-75 11:25:18 EDIT BY ALLEN
; FIXES FOR NEW PIE-SLICE CPU MAINTENANCE
;<134-TENEX>LOGJS.MAC;12 28-AUG-75 17:17:11 EDIT BY ALLEN
; UNLOCK DIRLCKS MUST NOW SPECIFICALLY REQUEST RELEASE OF HIQ
;<134-TENEX>LOGJS.MAC;11 19-JUN-75 23:50:05 EDIT BY CLEMENTS
; MOD TO LOGIN TO ALLOW FTPSRV TO SUPPRESS LOGIN DATE UPDATING. FLAG
; B16 IN AC1 DOES THIS.
;<134-TENEX>LOGJS.MAC;10 11-JUN-75 10:22:15 EDIT BY ALLEN
; MINOR FIX TO LOGIN SO SYSLOD WORKS
;<134-TENEX>LOGJS.MAC;9 28-APR-75 15:07:32 EDIT BY CLEMENTS
;<134-TENEX>LOGJS.MAC;8 28-APR-75 12:37:52 EDIT BY CLEMENTS
;<134-TENEX>LOGJS.MAC;7 28-APR-75 11:36:07 EDIT BY CLEMENTS
;<134-TENEX>LOGJS.MAC;6 22-APR-75 11:05:41 EDIT BY TOMLINSON
; Hashed passwords back into mainstream sources
;<134-TENEX>HLOGJS.MAC;9 17-APR-75 16:05:59 EDIT BY CLEMENTS
; MOVE MAKNFE WHICH GOT STUCK IN STRAIGHTLINE CODE BY ACCIDENT
;<134-TENEX>HLOGJS.MAC;8 16-APR-75 20:48:28 EDIT BY CLEMENTS
;<134-TENEX>HLOGJS.MAC;7 15-APR-75 22:04:21 EDIT BY SYSTEM
;<134-TENEX>HLOGJS.MAC;6 15-APR-75 18:23:36 EDIT BY CLEMENTS
; MORE FIXES IN HASHER AND FRIENDS
;<134-TENEX>HLOGJS.MAC;5 14-APR-75 15:42:07 EDIT BY CLEMENTS
; FIXES IN PASS HASHER
;<134-TENEX>HLOGJS.MAC;4 13-APR-75 21:54:40 EDIT BY CLEMENTS
; IMPLEMENT HASHED PASSWORD SYSTEM
;<134-TENEX>LOGJS.MAC;4 13-APR-75 20:01:31 EDIT BY CLEMENTS
; FIX LONGSTANDING TYPO IN FAIL RETURN OF MAKF02+6
;<134-TENEX>LOGJS.MAC;2 10-APR-75 10:53:02 EDIT BY PLUMMER
; SAVE DDB POINTER IN INDEX AROUND CALLS TO CPYDIR SO GC WILL SEE IT
;<134-TENEX>LOGJS.MAC;1 8-APR-75 18:56:15 EDIT BY CLEMENTS
; SEPARATED FROM JSYS.MAC
SEARCH STENEX,PROLOG
TITLE LOGJS
SWAPCD
EXTERNAL MENTR,MRETN,BUGCHK,BUGHLT,BUGNTE,MSTKOV,JOBPT,CAPENB,CAPMSK
; Error macro definitions
DEFINE ERUNLK(ERRORN,EXTRA)<
JRST [ EXTRA
IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
JRST ERUNLD##]>
DEFINE ERR(ERRORN,EXTRA)<
JRST [ EXTRA
IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
JRST ERRD##]>
DEFINE ERABRT(ERRORN,EXTRA)<
JRST [ EXTRA
IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
JRST ERABRD##]>
; Make a new fd
; Call: 1: ;STRING POINTER TO DIRECTORY NAME
; 2: ;FLAGS,,PARAMETER BLOCK ADDR.
; 3: ;DEVICE DESIGNATOR IF B17 OF AC2 IS ON
; 4: ;STRING POINTER OF OLD PASSWORD (FOR UN-ENABLED CHANGE)
; CRDIR
; Return
; +1 ; Error
; +2 ; Success
; In parameter block
; 0 ; Pointer to name string
; 1 ; Pointer to password string, 0 if none
; 2-N ; Copy of ddb image
.CRDIR::JSYS MENTR
UMOVE A,2 ; BIT
UMOVE B,3 ; DEVICE DESIGNATOR
PUSHJ P,SETUNT##
ERR()
UMOVE E,2 ;FLAGS,,PARAMPTR
MOVE A,CAPENB
TRNN A,WHEEL!OPER ;MUST HAVE SPECIAL CAPABILITIES,
TLNN E,577776 ;OR BE CHANGING PASSWORD ONLY
CAIA
ERR(CRDIX1)
UMOVE A,1
PUSHJ P,CPYFUS## ; Copy directory name string
ERR CRDIX3 ; No room in jsb
MOVE B,1(A)
TLNN B,774000
ERR CRDIX5 ; Null name illegal
PUSHJ P,DIRLUU## ; Look up the name in directory
JRST MAKNFD ; Non-existent, must make a new one
TLO E,(1B15) ; NAME EXISTS. DON'T TOUCH MAIL FILE.
PUSH P,A
MOVE B,DIRINP
MOVEI B,-1(B)
MOVEI A,JSBFRE
PUSHJ P,RELFRE## ; Release free storage used for name
TLNE E,(1B16) ; Delete wanted?
JRST DELDIR ; Yes
UNLOCK DIRLCK,,HIQ
POP P,A
TLNE E,(1B6)
XCTUU [CAMN A,6(E)]
JRST CRDIR1
ERR(CRDIX2) ; Directory number disagrees
CRDIR1: PUSHJ P,GETDDB## ; Setup a pointer to the ddb
BUG(HLT,<CRDIR: GETDDB FAILED WHEN DIRLUU DIDN'T.>)
MOVE NUM,A ; Save pointer in num
;BACK HERE AFTER CREATING NEW DIRECTORY, FROM MAKNFD BELOW
MAKFD0: TLNN E,(1B1)
JRST CRDIR3 ; No password change
MOVE B,CAPENB
TRNE B,WHEEL!OPER
JRST MAKF02 ;NO CHECK IF SPEC. CAPS. ENABLED
MAKF01: UMOVE B,4 ;GET OLD PASSWORD PTR
PUSHJ P,CHKPSX ;CHECK PASSWORD
ERR(CRDIX1,<CALL CHKPSU>)
MAKF02: UMOVE A,1(E) ; Get pointer to NEW password
PUSH P,A ;SAVE THE INITIAL POINTER
PUSHJ P,CPYFUS ; Copy new password to free storage
MAKF2F: ERR CRDIX3,<SUB P,BHC+1 ;DISCARD POINTER
UNLOCK DIRLCK,,HIQ>
; A HAS LOOKUP POINTER TO JSB COPY OF NEW PASSWORD.
PUSHJ P,SETMSK## ; Store in directory
; THIS GETS POINTER INTO DIRINP
POP P,A ;GET BACK THE INITIAL POINTER
MOVS C,A ;CHECK THE BYTE SIZE
ANDI C,7700 ; ..
CAIE C,4400 ;IS IT 36 BITS?
JRST MAKFH1 ;NO, OLD 7-BIT, PROBABLY
XCTBU [ILDB C,A] ;36 BITS. GET FIRST HASH WORD
XCTBU [ILDB D,A] ; AND SECOND
JRST MAKFH2 ;GO STORE THE HASH
MAKFH1: HRRO B,DIRINP ;COMPRESS THE NEW PASSWORD
PUSHJ P,HASHPM ;RETURNS HASH IN C,D
JRST MAKF2F ;WASN'T ANY JSB SPACE. FAIL.
MAKFH2: PUSH P,C ;SAVE HASH WDS ON THE STACK FOR A MOMENT
PUSH P,D ; ..
MOVEM NUM,DIRSAV ;SAVE IN CASE GC HAPPENS
MOVEI B,3 ;GET A DIRECTORY BLOCK TO HOLD THE HASH
PUSHJ P,ASGDFR## ; ..
ERR(CRDIX4,<MOVE B,DIRINP
MOVEI B,-1(B)
MOVEI A,JSBFRE
PUSHJ P,RELFRE ; Release job storage
SUB P,BHC##+2 ; DISCARD THE NEW HASH DATA
UNLOCK DIRLCK,,HIQ>)
POP P,2(A) ;PUT THE NEW HASHED PASSWORD IN THE DIR
POP P,1(A) ; ..
MOVE NUM,DIRSAV ;RESTORE DDB POINTER
HLRZ B,DDBNAM(NUM) ; Get old password pointer
HRRZS DDBNAM(NUM) ; Zero old pntr
PUSH P,A
JUMPE B,MAKFD1
ADDI B,DIRORG
PUSHJ P,RELDFR## ; RETURN SPACE OLD PASSWORD WAS IN
MAKFD1: POP P,A
SUBI A,DIRORG
HRLM A,DDBNAM(NUM) ; Store as password
MOVE B,DIRINP
MOVEI B,-1(B)
MOVEI A,JSBFRE
PUSHJ P,RELFRE ; Release jsb storage
CRDIR3:
UMOVE A,3(E) ; Get privilege bits
TLNE E,(1B3)
MOVEM A,DDBPRV(NUM)
UMOVE A,4(E)
TLNE E,(1B4)
MOVEM A,DDBMOD(NUM)
SETZM DDBRES(NUM)
UMOVE A,12(E) ; GET LAST LOGIN
TLNE E,(1B10) ; WANT TO SET IT?
MOVEM A,DDBDAT(NUM) ; YES, SET IT
UMOVE A,13(E)
TLNE E,(1B11)
MOVEM A,DDBGRP(NUM)
MOVE A,DDBNUM(NUM)
UNLOCK DIRLCK,,HIQ
PUSHJ P,SETDIR##
BUG(HLT,<CRDIR: SETDIR FAILED ON DIRECTORY FOUND IN INDEX.>)
UMOVE A,2(E) ; GET MAX ALOCATION
TLNE E,(1B2) ; SET THIS ONE ?
HRLM A,DIRDSK ; YUP
UMOVE A,7(E) ; Default file protection
ANDI A,777777
TLO A,500000
TLNE E,(1B7)
MOVEM A,DIRDPW
UMOVE A,10(E)
ANDI A,777777
TLO A,500000
TLNE E,(1B8)
MOVEM A,DIRPRT
UMOVE A,11(E)
ANDI A,777777
TLO A,500000
TLNE E,(1B9)
MOVEM A,DIRDBK
UMOVE A,14(E)
TLNE E,(1B12)
MOVEM A,DIRGRP
UNLOCK DIRLCK,,HIQ
JUMPG UNIT,CRDIR4 ; NO MESSAGE FILE IF NOT DSK:
CRDI3A: MOVEI B,20
TLNN E,(1B15) ;IF B15 ON, DON'T CREATE MAILBOX.
PUSHJ P,ASGJFR##
JRST CRDIR4
PUSH P,A
HRLI A,(<POINT 7,0,34>)
HRROI B,[ASCIZ /DSK:</]
SETZ C,
SOUT
PUSH P,A ;SAVE BEGINNING OF NAME
MOVE B,DIRNUM
DIRST
JRST CRDIR6
POP P,B ;BEGINNING OF NAME
PUSH P,A ;MESSAGE FILE NAME STRING PARTIAL PTR
SETZ A,
STDIR
JFCL
JRST CRDIR6
TRNE A,777776 ;DIRECTORY 1, SYSTEM, NON-STD. NO MSG
TLNE A,(1B0)
JRST CRDIR6 ;FILES ONLY. NO MSG FILE
POP P,A
HRROI B,[ASCIZ />MESSAGE.TXT;1/]
SETZ C,
SOUT
MOVE B,(P)
HRLI B,(<POINT 7,0,34>)
MOVSI A,400001
GTJFN
JRST CRDIR5
MOVE B,[1,,FDBCTL] ;SEE IF IT'S A FRESH FILE
MOVEI C,C
GTFDB ;CONTROL WORD TO C
TLNN C,FDBNXF!FDBDEL ;IF NON-EXISTENT (NEW) OR DELETED,
JRST CRDI3B ; NO. LEAVE IT ALONE
HRLI A,FDBCTL ;PUT IT IN STANDARD STATE
MOVSI B,FDBPRM!FDBNXF!FDBDEL
MOVSI C,FDBPRM!FDBDEL
CHFDB
HRLI A,FDBPRT ;STANDARD PROTECTION FOR MSG FILES
MOVEI B,777777
MOVEI C,770404 ;IS APPENDABLE BY ALL
CHFDB
CRDI3B: HRRZS A
RLJFN
JFCL
JRST CRDIR5
CRDIR6: SUB P,BHC##+1
CRDIR5: POP P,B
MOVEI A,JSBFRE
PUSHJ P,RELFRE
CRDIR4: SETZM NXTDMP##
JRST SKMRTN##
DELDIR: PUSH P,DIRNUM ; Remember where we are
MOVE JFN,-1(P) ; Get directory number to delete
PUSHJ P,DELALL## ; Try very hard to delete all files
MOVE A,SYMBOT
CAME A,SYMTOP ; Did we succeed?
JRST [ MOVE A,DIRORG(A)
TRNE A,700000
JRST .+1
POP P,A
PUSHJ P,MAPDIR##
UNLOCK(DIRLCK)
ERR(CRDIX7)]
POP P,A
PUSHJ P,MAPDIR ; Return to subindex
MOVE A,DIRLOC ; Get sym tab loc
PUSH P,DIRORG(A) ; Save content
DELDI0: CAMGE A,SYMBOT ; At bottom?
JRST DELDI1 ; Yes
MOVE B,DIRORG-1(A) ; No move symbol table up
MOVEM B,DIRORG+0(A)
SOJA A,DELDI0
DELDI1: AOS SYMBOT ; Point to new bottom
HLRZ B,0(P) ; Get pointer to string
ADDI B,DIRORG
PUSHJ P,RELDFR ; Release free storage
SUB P,[XWD 1,1]
POP P,A ; Get directory number
PUSHJ P,HSHLUK## ; Find it in hash table
BUG(HLT,<CRDIR: HSHLUK FAILURE FOR EXISTENT USER>)
MOVSI A,-1
EXCH A,DIRORG(B) ; Get hash table entry, delete entry
UNLOCK DIRLCK,,HIQ ; Unlock
HLRZS A
PUSH P,A ; Save
LSH A,-^D12 ; Get subindex number
MOVNS A ; Negate
PUSHJ P,MAPDIR ; Back to the subdirectory
MOVEI A,7777
ANDB A,0(P) ; Extract ddb location
HLRZ B,DDBNAM+DIRORG(A) ; Get pointer to password
ADDI B,DIRORG
CAIE B,DIRORG
PUSHJ P,RELDFR ; Release free storage if any
POP P,B
ADDI B,DIRORG
PUSHJ P,RELDFR ; Release free storage for ddb
UNLOCK DIRLCK,,HIQ
JRST SKMRTN
MAKNFD: MOVE A,CAPENB
TRNN A,WHEEL!OPER
ERR(CRDIX1,<UNLOCK DIRLCK,,HIQ
MOVE B,DIRINP
MOVEI B,-1(B)
MOVEI A,JSBFRE
PUSHJ P,RELFRE>)
MOVE A,SYMBOT
SUBI A,2
CAML A,FRETOP
JRST .+3
PUSHJ P,XPAND##
JRST MAKNFF ; FULL
MOVEI B,DDBLEN
PUSHJ P,ASGDFR## ; Assign space for the ddb
JRST MAKNFF ;CLEANUP AND GIVE CRDIX4
MOVEI NUM,(A) ; Point num to the ddb
SETZM DDBNAM(NUM) ; Clear name pointers
SETZM DDBNUM(NUM) ; Clear number
SETZM DDBPRV(NUM) ; Default privileges
SETZM DDBDAT(NUM) ; CLEAR LAST LOGIN
SETZM DDBMOD(NUM) ; Default modes
SETZM DDBGRP(NUM)
SETZM DDBRES(NUM)
MOVEM NUM,DIRSAV ;SAVE IN CASE GC HAPPENS
PUSHJ P,CPYDIR## ; Copy name to directory
JRST MAKNFE ;CLEAN UP AND GIVE CRDIX4
SUBI A,DIRORG ; Convert to relative pointer
MOVE NUM,DIRSAV ;RESTORE DDB POINTER
HRRM A,DDBNAM(NUM) ; Save as name
HRLZ C,A ; Right half yet to be filled in
SOS B,DIRLOC
SOS A,SYMBOT
CAML A,B
JRST MAKNFZ
ADDI A,DIRORG
HRLI A,1(A)
BLT A,DIRORG-1(B)
MAKNFZ: MOVEM C,DIRORG(B)
MOVE B,DIRINP
MOVEI B,-1(B)
MOVEI A,JSBFRE
PUSHJ P,RELFRE
MOVN A,DIRNUM ; Get subindex number
IMULI A,10000 ; Convert to position in file
ADD NUM,A ; Of the ddb
SUBI NUM,DIRORG
MOVEI A,0
PUSHJ P,SETDIR ; Look at block 0
BUG(HLT,<CRDIR: SETDIR FAILED FOR BLOCK 0.>)
UMOVE A,6(E)
TLNE E,(1B6)
JRST FNN01
;FALLS THRU
;FALLS THRU FROM ABOVE
FNN00: MOVE A,LSTDNO ; HIGHEST ASSIGNED NUMBER
AOS A ; PLUS 1
CAIL A,NFDIB*40
JRST FNN05 ; NO ROOM LEFT
UNLOCK DIRLCK,,HIQ
PUSHJ P,HSHLUK ; Is this number available?
JRST FNN2 ; OK TO USE
AOS LSTDNO
JRST FNN00 ; No, try another
FNN2: CAIL A,1
CAIL A,NFDIB*40
BUG(HLT,<CRDIR: HSHLUK RETURN INVALID DIRECTORY NUMBER.>)
CAML A,LSTDNO
MOVEM A,LSTDNO
MOVEM A,DIRORG(B) ; Store directory number in rh
HRLM NUM,DIRORG(B) ; And ddb location in left
MOVE B,NUM
IDIVI B,10000 ; Recover block containing ddb
ADDI B+1,DIRORG
PUSH P,B+1
PUSH P,A
UNLOCK DIRLCK,,HIQ
MOVN A,B
PUSHJ P,MAPDIR ; Return to original subindex
POP P,A
POP P,NUM
HRRM A,DDBNUM(NUM)
MOVE B,DIRLOC
HRRM A,DIRORG(B)
HRRZS A ; Retain only directory number
PUSH P,DIRNUM ; Save current directory number
PUSH P,A ; And new directory number
PUSHJ P,MAPDIR ; Map the new directory
MOVE A,DIRNUM
CAME A,0(P) ; See if directory looks like
JRST CRWIPE ; It already exists
SETO A,
CAMN A,DIRLCK
CAME A,DIRFRE+1
JRST CRWIPE
MOVE A,SYMTOP
TRNN A,777
CAMGE A,SYMBOT
JRST CRWIPE
MOVE A,SYMBOT
CAMGE A,FRETOP
JRST CRWIPE
LOCK DIRLCK,,HIQ ; MATCHES THE LATER UNLOCK
JRST CRNWIP
CRWIPE: MOVEI A,25
MOVEI B,1000
MOVE C,0(P)
PUSHJ P,INIBLK## ; Initialize it
CRNWIP: POP P,DIRNUM ; Set its directory number
MOVEI A,^D250 ; DEFAULT MAX ALOCATION = 250
HRLM A,DIRDSK
MOVE A,[500000,,IDRDPW]
MOVEM A,DIRDPW ; SET DEFAULT PROTECTION
HRRI A,IDRPRT
MOVEM A,DIRPRT ; AND DIRECTORY PROTECTION
MOVEI A,2
MOVEM A,DIRDBK ; AND DEFAULT BACKUP
SETZM DIRGRP ; AND GROUPS
POP P,A
UNLOCK DIRLCK,,HIQ ; Unlock the new directory
PUSHJ P,MAPDIR ; Restore to mapping current di
JRST MAKFD0
FNN01: CAIL A,1
CAIL A,NFDIB*40
JRST FNN05
UNLOCK DIRLCK,,HIQ
PUSHJ P,HSHLUK
JRST FNN2
FNN05: UNLOCK DIRLCK,,HIQ ; Number unavailable, abort
MOVE B,NUM
IDIVI B,10000
MOVEI C,DIRORG(B+1) ; Location in subindex of ddb
PUSH P,C
MOVN A,B ; Subindex number
PUSHJ P,MAPDIR ; Get back to it
POP P,NUM
HRRZ B,DDBNAM(NUM) ; Get location of name string
ADDI B,DIRORG
PUSHJ P,RELDFR ; Release it
MOVE B,NUM ; Location of ddb
PUSHJ P,RELDFR ; Release it
MOVE B,DIRLOC ; Location where symtab entry was put
FNN03: CAMG B,SYMBOT ; Something left to move?
JRST FNN04 ; No
MOVE A,DIRORG-1(B)
MOVEM A,DIRORG(B)
SOJA B,FNN03
FNN04: AOS SYMBOT
UNLOCK DIRLCK,,HIQ
ERR(CRDIX6)
MAKNFE: MOVE B,DIRSAV ;POINTER TO DDB
CALL RELDFR ;RELEASE SPACE FROM INDEX
MAKNFF: UNLOCK DIRLCK,,HIQ
MOVE B,DIRINP
MOVEI B,-1(B)
MOVEI A,JSBFRE
CALL RELFRE ;RELEASE JSB STORAGE USED FOR NAME
ERR (CRDIX4)
; Get directory info
; Call: 1 ; Directory number
; 2 ; Pointer to parameter block
; 3 ; String pointer for password
; GTDIR
.GTDIR::JSYS MENTR
; UMOVE A,1 ; DIRNUM & BIT
UMOVE B,4 ; DEVICE DESIGNATOR
PUSHJ P,SETUNT
ERR()
MOVE B,CAPENB
TRNN B,WHEEL!OPER
ERABRT(GTDIX1) ; Not wheel or opr
XCTUU [HRRZ A,1]
PUSHJ P,GETDDB
ERABRT(GTDIX2)
UMOVE E,2
UMOVE C,3
JUMPGE C,GTDIR1
CAML C,[777777000000]
HRLI C,(<POINT 7,0>)
GTDIR1: HLRZ B,DDBNAM(A)
ADDI B,DIRORG
UMOVEM C,3 ; STORE THE STRING POINTER IN AC 3
MOVEI D,0 ; PUT A NULL THERE
PUSH P,C ; SAVE START OF STRING
XCTBU [IDPB D,C] ; NULL TO USER SPACE
POP P,C ; BACK TO BEGINNING OF STRING
TLZE C,7700 ; BUT CHANGE TO 36-BIT DATA, IF ANY
TLO C,4400 ; ..
UMOVEM C,1(E) ; PUT THAT IN ARG BLOCK
MOVE D,1(B) ; NOW COPY THE PASSWORD TO USER SPACE
XCTBU [IDPB D,C] ; FIRST WORD OF HASH
MOVE D,2(B) ; AND SECOND ONE
XCTBU [IDPB D,C] ; ..
MOVEI D,0 ; PUT A TERMINATING ZERO WORD THERE
XCTBU [IDPB D,C] ; EVEN THOUGH IT'S NOT NEEDED.
MOVE D,DDBPRV(A)
UMOVEM D,3(E)
MOVE D,DDBMOD(A)
UMOVEM D,4(E)
MOVEI D,0
UMOVEM D,5(E)
MOVE D,DDBNUM(A)
UMOVEM D,6(E)
MOVE D,DDBDAT(A)
UMOVEM D,12(E)
GTDIR2: MOVE D,DDBGRP(A)
UMOVEM D,13(E)
MOVE A,DDBNUM(A)
UNLOCK DIRLCK,,HIQ
PUSHJ P,MAPDIR
HLRZ D,DIRDSK ; GIVE USER MAX DISK ALOCATION
UMOVEM D,2(E)
MOVE D,DIRDPW
UMOVEM D,7(E)
MOVE D,DIRPRT
UMOVEM D,10(E)
MOVE D,DIRDBK
UMOVEM D,11(E)
MOVE D,DIRGRP
UMOVEM D,14(E)
JRST MRETN
; Set time and date
; Call: 1 ; Date and time in standard format
; STAD
; Return
; +1 ; Can't set because not wheel or opr
; +2 ; Ok
.STAD:: JSYS MENTR
HRRZ B,JOBNO ; IS THIS USER LOGGED IN?
HRRZ B,JOBDIR##(B) ; ..
JUMPE B,STAD3 ; NO. BETTER RANGE CHECK THE ANSWER
MOVE B,CAPENB
TRNE B,WHEEL!OPER
JRST STAD1 ; OK, BY WHEEL OR OPER
STAD3: SKIPGE TADSEC
JRST STAD2 ; BY ORDINARY USER, BUT NEED DATE/TIME
MOVEI A,STADX1 ; NOT ALLOWED. SET ALREADY.
JRST ERRD
STAD2: CAML 1,STADMN ; ORDINARY USER. RANGE CHECK DATE
CAML 1,STADMX ; MUST BE IN THIS RANGE
SKIPA ; NO GOOD.
JRST STAD1 ; OK.
MOVEI A,STADX2 ; "RIDICULOUS DATE" ERROR MSG
JRST ERRD ; AND FAIL.
STAD1: SETZ C,
MOVE A,TODCLK##
IDIVI A,^D1000 ; Convert to seconds
XCTUU [HRRZ B,1] ; Get time
SUB B,A ; Compute offset
JUMPGE B,.+3
ADDI B,^D24*^D3600 ; If less than 0, augment
AOJA C,.-2
XCTUU [HLRZ A,1]
SUB A,C
MOVEM A,TADDAY
MOVEM B,TADSEC
NOINT ; MAKE SURE IT GETS LOGGED, SINCE IT
PUSH P,CAPENB ; REALLY IS BEING CHANGED
MOVEI A,OPER ; SET CAPABILITY FOR EFACT
IORM A,CAPENB ; ..
MOVE A,JOBNO ; This job
HRRZ B,JOBDIR(A) ; User number
MOVEM B,LOGBUF+1
UMOVE B,1 ; Tad as given
MOVEM B,LOGBUF+2
IORI A,(741B8) ; Tad reset code for fact file
MOVSM A,LOGBUF
MOVE A,CTRLTT
DPB A,[POINT 12,LOGBUF,29] ; Tty
MOVE 1,[XWD -3,LOGBUF] ; Make fact file entry for time set
EFACT
JFCL
POP P,CAPENB ; RESTORE REAL CAPABILITIES, AND NOW
OKINT ; SAFE TO ALLOW INTERRUPTS
JRST SKMRTN
;FOLLOWING IS RANGE OF DATES ACCEPTED IF USER IS NOT A LOGGED-IN WHEEL/OPR
STADMN: 122652,,0 ;MIN NON-WHEEL DATE, 29 DEC 74
STADMX: 135424,,0 ;MAX DATE IF SUSPICIOUS, 1 JAN 1990
; Read time and date
; Call: RTAD
; Return
; +1
; 1 ; Current date and time or -1 if not set
.GTAD:: JSYS MENTR
SKIPGE A+1,TADSEC
IFNDEF RTICLK,< JRST GTAD1 ; Not set>
IFDEF RTICLK,< JRST [ DATAI 600,B
CAML B,STADMN ; RANGE CHECK IN CASE PWR FAIL
CAML B,STADMX
SETO B,
JRST GTAD1] ;RETURN IT FROM CALENDAR CLK>
MOVE A,TODCLK
IDIVI A,^D1000
ADD A,TADSEC
IDIVI A,^D24*^D3600
ADD A,TADDAY
HRL A+1,A
GTAD1: UMOVEM A+1,1
JRST MRETN
LS(TADDAY)
LS(TADSEC)
IFDEF RTISW,<
;READ MICROSECOND INTERVAL TIMER
.USEC:: DATAI 610,1
XCT MJRSTF
>;END IFDEF RTISW
; Set fact switch
;CALL: 1 ; MASK OF BITS TO CHANGE
; 2 ; New setting
; SMON
; Traps if process hasn't log privilege
; CHANGED TO REQUIRE WHEEL/OPR INSTEAD OF LOG UNTIL CAPABILITIES ARE
; MORE COMPLETELY IMPLEMENTED
.SMON::JSYS MENTR
MOVE C,CAPENB
TRNN C,WHEEL!OPER ; TEMP CHANGED FROM TLNN C,LOG
ERABRT(EFCTX1)
ANDCAM 1,FACTSW##
AND 2,1
IORM 2,FACTSW
JRST MRETN
; Read fact switch
; Call: TMON
; Return
; +1 ; Always
; 1 ; The current fact switch setting
.TMON:: JSYS MENTR ;MAKE SLOW JSYS SO AOS CAN'T HURT THE
; RETURN PC BY CARRYING INTO LH
TDNE 1,FACTSW
AOS 0(P) ;SKIP RETURN
JRST MRETN ;RETURN TO USER.
; Enter fact file
; Call: LH(1) ; Minus entry size
; RH(1) ; Location of entry
; EFACT
; Return
; +1 ; Error
; +2 ; Ok
.EFACT::JSYS MENTR
MOVE B,CAPENB
TRNN B,WHEEL!OPER ; TEMP CHANGED FROM TLNN B,LOG
ERR(EFCTX1)
MOVE B,FACTSW
TLNN B,(FACTON)
JRST SKMRTN ; Fact file not on
HLRO B,A ; Get size
CAMG B,[-^D64]
ERR(EFCTX2) ; Too big
NOINT
PUSH P,CAPENB ; Save current caps
MOVEI A,WHEEL!OPER ; Set bits to ensure access to
IORM A,CAPENB ; Accounts directory and fact file
MOVEI C,^D30
EFACT2: HRROI B,[ASCIZ /DSK:<ACCOUNTS>FACT/]
MOVSI A,1
GTJFN
JRST EFACT3
PUSH P,1
MOVE 2,[XWD 440000,20000]
OPENF ; Open for append
JRST EFACT4
EFACT6: POP P,1
UMOVE C,1
UMOVE B,(C)
HLRE D,C
MOVNS D
DPB D,[POINT 6,B,35]
JRST .+2
EFACT1: UMOVE B,(C)
BOUT
AOBJN C,EFACT1
CLOSF
BUG(CHK,<EFACT: CLOSF FAILED TO CLOSE FACT FILE.>)
POP P,CAPENB ; Restore caps
JRST SKMRTN
EFACT4: CAIE A,OPNX9
SETZ C,
POP P,1
RLJFN
JFCL
SOJLE C,EFACT3
MOVEI A,^D4000
DISMS
JRST EFACT2
EFACT3: HRROI 2,[ASCIZ /DSK:<ACCOUNTS>FACT/]
MOVSI 1,400001
GTJFN
JRST EFACT9
MOVEI C,^D30
EFACT8: PUSH P,1
MOVE 2,[XWD 440000,20000]
JSYS 21
JRST EFACT5
JRST EFACT6
EFACT5: CAIE A,OPNX9
JRST EFACT7
SOJLE C,EFACT7
MOVEI A,^D4000
DISMS
POP P,1
JRST EFACT8
EFACT7: POP P,1
RLJFN
JFCL
EFACT9: POP P,CAPENB ; Restore caps
ERR(EFCTX3)
; Set account for file
; Call: 1 ; Jfn
; 2 ; String pointer OR 500000000000+account number
; SACTF
; Return
; +1 ; Error
; +2 ; Ok
.SACTF::JSYS MENTR
MOVE JFN,1
PUSHJ P,CHKJFN##
ERR()
JFCL
ERR(DESX4)
TEST(NE,ASTF)
ERUNLK(DESX7)
HRRZ A,NLUKD(DEV)
CAIE A,MDDNAM##
ERUNLK(SACTX1)
PUSHJ P,GETFDB##
ERUNLK(SACTX4)
HRLI A,40000
PUSHJ P,DIRCHK##
ERUNLK(SACTX4,<UNLOCK DIRLCK,,HIQ>)
UNLOCK DIRLCK,,HIQ
PUSH P,FILACT(JFN) ; Save current contents of this cell
UMOVE A,2
TLNN A,777777
HRLI A,440700
SACTF1: CAMG A,[577777777777]
CAMGE A,[500000000000]
JRST SACTF2 ; Pointer
MOVEM A,FILACT(JFN)
PUSHJ P,INSACT##
JRST SACTF3
SACTF2: MOVE B,MODES##
HRR B,CAPENB
TDNN B,[1B1!WHEEL!OPER]
ERUNLK(SACTX3) ; Alphanumeric accounts not allowed
PUSHJ P,CPYFUS ; Copy from the user
ERUNLK(SACTX2) ; Cannot copy
HRRZM A,FILACT(JFN)
PUSHJ P,INSACT
HRRZ B,FILACT(JFN)
MOVEI A,JSBFRE
PUSHJ P,RELFRE
SACTF3: POP P,FILACT(JFN)
PUSHJ P,UNLCKF##
JRST SKMRTN
; Get account of file
; Call: 1 ; Jfn
; 2 ; Core location to put string if any
; GACTF
; Return
; +1 ; Error
; +2
; 2 ; 500000000000+number of string pointer
.GACTF::JSYS MENTR
MOVE JFN,1
PUSHJ P,CHKJFN
ERR()
JFCL
ERR(DESX4)
TEST(NE,ASTF)
ERUNLK(DESX7)
HRRZ A,NLUKD(DEV)
CAIE A,MDDNAM
ERR(GACTX1)
PUSHJ P,GETFDB
ERUNLK(GACTX2)
SKIPLE B,FDBACT(A)
JRST GACTF1
UMOVEM B,2
UNLOCK DIRLCK,,HIQ
PUSHJ P,UNLCKF
AOS (P)
JRST SKMRTN
GACTF1: UMOVE E,2
HRLI E,440700
UMOVEM E,2
HRLI E,DIRORG+2(B)
HRRZ B,DIRORG(B)
ADDI B,-3(E)
XCTMU [BLT E,(B)]
UNLOCK DIRLCK,,HIQ
PUSHJ P,UNLCKF
JRST SKMRTN
; Login
; Accepts: 1/ flags,,directory #
; ;flags - b16 means don't update login date
; 2/ string pointer to password
; 3/ account designator
; Returns:
; +1 failed, error # in 1
; +2 success
JS LGNPAR,2 ;A PARAMETER FOR EXEC0 TO FEED LOGIN
; SECOND WORD IS LAST LOGIN DATE.
; IF B0 OF LGNPAR=1, THIS IS A CRJOB
; LOGIN, AND REST MAY BE FLAGS.
.LOGIN::JSYS MENTR
SKIPLE 1,LGNPAR ;DID EXEC0 SAY WE SHOULD FAIL?
JRST ERRD ;YES. SO FAIL, WITH THAT CODE.
MOVE A,JOBNO
MOVEI B,777777
TDNE B,JOBDIR(A) ; Is this job currently logged in?
ERR(LGINX5)
UMOVE A,1
HLRZ B,A ; Get the flags in LH
ANDI B,1B34 ; Mask to ones allowed at login time
SKIPL LGNPAR ; CRJOB or ordinary login?
HRRM B,LGNPAR ; Ordinary. Set up flags
HRRZS A ; Just the Directory Number
PUSH P,A ; Save the dir #
ADD P,BHC+11 ; Allocate string space
UMOVE B,3 ; Get account descriptor
PUSH P,B ; Save it
CAML B,[500000,,0] ; Check for string or numeric
CAMLE B,[577777,,-1]
JRST .+2 ; Is a string
JRST LOGIN3
MOVEI A,-12(P) ; Where to put account string
HRLI A,(<POINT 7,0,35>) ; As per CPYFU1
MOVEM A,0(P) ; Update designator
CALL CPYFU1## ; Move from user space
BUG(HLT,<LOGIN: Impossible failure of CPYFU1>)
MOVE B,0(P) ; Account designator
MOVE A,-12(P) ; Directory #
LOGIN3: VACCT ; Check validity
ERR(LGINX1) ; Nope, doesn't make it
MOVE A,0(P) ; Designator
IFN PIESLC,<
ATGRP ; Get pie-slice group name
JRST [
CAIN 1,ACCTX1 ; NO WAY TO CHECK?
JRST .+1 ; ALLOW THE LOGIN
JRST ERRD] ; FAIL SOME OTHER WAY
>; END OF IFN PIESLC
EXCH B,-12(P) ; Swap for directory #
MOVE A,B ; For GETDDB
PUSHJ P,GETDDB ; Get directory descriptor block
ERR(LGINX2)
MOVE B,DDBGRP(A)
HLRZ C,FORKN ; C=index of top job fork
HRRZ C,SYSFK(C) ; Get sys index
MOVEM B,FKGRPS##(C) ; Set user groups - assumes single fork
; group in job when LOGIN executed
MOVE B,DDBMOD(A) ; Get mode bits
MOVEM B,MODES
TLNE B,(1B0)
ERR(LGINX2,<UNLOCK DIRLCK,,HIQ>)
SKIPGE B,LGNPAR ;CRJOB SAY SKIP PASSWORD CHECK?
TRNN B,1 ; IT'S CRJOB. SKIP PASSW CHECK?
SKIPA ;NOT CRJOB, OR CRJOB NEEDS PASSWORD.
JRST LOGI0A ;YES, LOGGING IN AS CREATOR
PUSHJ P,CHKPSW
JRST LOGINE ;PASSWORD WRONG
LOGI0A: MOVE B,DDBPRV(A)
HRRM B,CAPMSK
HLLOS CAPENB
PUSH P,A ; Save DDB index
IFN PIESLC,<
SKIPN A,PIEFLG## ;PIE-SLICE DATA FILE MAPPED?
JRST LOGIN2 ;NO
MOVE A,-13(P) ; Get pie-slice name off stack
CALL GRPLUK## ;LOOK IT UP
JRST LOGI0B ; FAILED TO FIND GROUP NAME
LOGIN2: PUSH P,A ;SAVE GROUP INDEX
MOVE A,-2(P) ; Get account designator
> ;END PIE-SLICE SCHEDULER CONDITIONAL
IFE PIESLC,<
MOVE A,-1(P) ; Account designator
> ; END OF IFE PIESLC
PUSHJ P,SETACT ; Set account number/string
ERR(LGINX1,<UNLOCK DIRLCK,,HIQ>) ; Bad account number
IFN PIESLC,<
POP P,A
CALL CHGGRP## ;PUT JOB INTO CORRECT GROUP
NOINT
LOCK GRPLOK## ;PREVENT UPDATE OF GROUP CPU TIME
MOVE A,JOBNO
SETZM JOBRT##(A)
SETZM JOBORT##(A) ;RESET RUNTIME
UNLOCK GRPLOK
OKINT
CALL ASGDSH## ;RECOMPUTE DSHARE ENTRIES
> ;END PIE-SLICE SCHEDULER CONDITIONAL
IFE PIESLC,<
MOVE A,JOBNO
SETZM JOBRT##(A)
> ;END NON-PIE-SLICE SCHED CONDITIONAL
POP P,B ; DDB index
SUB P,BHC+13 ; account desig+string+group
GTAD
MOVE C,DDBDAT(B) ; GET LAST LOGIN DATE
MOVEM C,LGNPAR+1 ; SET LAST LOGIN DATE IN GETAB FOR USER
PUSH P,C ; SAVE PREVIOUS TAD
JUMPL A,LOGIN5 ; DON'T UPDATE DDB DATE IF NOT NOW KNOWN
HRRZ C,LGNPAR ; GET FLAGS
TRNE C,2 ; ASKED NOT TO UPDATE LOGIN DATE?
JRST LOGIN5 ; YES. BYPASS UPDATING THE DDB
MOVEM A,DDBDAT(B) ; OK, UPDATE "LAST LOGIN DATE" IN DDB
LOGIN5: POP P,A ; GET BACK PREVIOUS LOGIN TAD
XCTUU [EXCH A,1] ; RETURN LAST LOGIN DATE TO USER AC 1,
HRLS A ; GET LOGIN DIR,,LOGIN DIR
MOVE B,JOBNO
MOVEM A,JOBDIR(B) ; STORE AS CURRENT LOGGED IN USER
HLRZ C,FORKN ; Top job fork
HRRZ B,SYSFK(C) ; B=its sys fork index
MOVEM A,FKDIR##(B) ; Set fork directories.
TLO B,-1 ; B=FKDIR entry for inferiors
MOVEI A,0(C) ; A=job index top job fork
PUSHJ P,MAPINF##
CALL LOGIN1 ; Set FKDIR for inferiors, if any.
UNLOCK DIRLCK,,HIQ
PUSHJ P,LOGONM## ; Type logon message
TIME
MOVEM A,CONSTO
SETZM CAPENB
JRST SKMRTN
LOGIN1: HRRZ C,SYSFK(A)
MOVEM B,FKDIR(C) ; Set FKDIR of fork
HRLM A,0(P)
PUSHJ P, MAPINF
CALL LOGIN1
HLRZ A,0(P)
POPJ P,