[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]
MISOSYS EDAS-4.3 04/19/99 00:01:01 ATTRIB - LS-DOS 6.3 Page 00001
00001 ;LBATTRIB/ASM - ATTRIB Command
00003 ;
000D 00004 CR EQU 13
4296 00005 BLNKMPW EQU 4296H
42E0 00006 PASSWORD EQU 42E0H
00007 ;
0000 00008 *GET BUILDVER/ASM:3
00009 ;
00010 ; Buildver/asm is a bit of a kludge since not all utilities can load
00011 ; equates from LDOS60 and still compile. LOWCORE and everybody else
00012 ; relies on this setting, and it eventually ends up in LDOS60/EQU
00013 ; for programs that can use that.
00014 ;
FFFF 00015 @BLD631 EQU -1 ;<631>Build 631 distribution (LEVEL 1B)
00016 ; These switches activate patches made since the 1B release.
00017 ; It is important that all earlier patches be enabled when a higher
00018 ; patch is enabled.
00019 ; Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
00020 ; patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF 00021 @BLD631C EQU -1 ;<631>Apply 1C patches (SETKI)
FFFF 00022 @BLD631D EQU -1 ;<631>Apply 1D patches (DIR)
FFFF 00023 @BLD631E EQU -1 ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF 00024 @BLD631F EQU -1 ;<631>Apply 1F patches (SPOOL)
00025 ; Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF 00026 @BLD631G EQU -1 ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF 00027 @BLD631H EQU -1 ;<631>Apply 1H patches (MEMORY)
00028 ;
00029 ;End of BUILDVER/ASM
0000 00030 *GET SVCMAC:3 ;SVC Macro equivalents
00031 ;SVCMAC/ASM - LS-DOS Version VI
00032 *LIST OFF
00424 *LIST ON
00426 ;
2400 00427 ORG 2400H
00428 ;
00429 ATTRIB
2400 ED733124 00430 LD (SAVESP+1),SP ;Save stack pointer
2404 CD3724 00431 CALL ATTRIB1 ;Call attrib code
2407 210000 00432 LD HL,0 ;Set no error
240A 1824 00433 JR SAVESP ;P/u stack & return
00434 ;
00435 ; I/O Error Handling
00436 ;
240C FE3F 00437 IOERR CP 63 ;Extended error?
240E 281A 00438 JR Z,EXTERR
2410 6F 00439 LD L,A ;Error # to HL
2411 2600 00440 LD H,0
2413 F6C0 00441 OR 0C0H ;Abbrev & return
2415 4F 00442 LD C,A
2416 00443 @@ERROR
2416+3E1A 00444 LD A,26
2418+EF 00445 RST 40
2419 1815 00446 JR SAVESP ;P/u Stack & RETurn
00447 ;
00448 ; Internal Error Message Handling
00449 ;
241B 21C928 00450 ABORT LD HL,ABORT$ ;"Command aborted
241E DD 00451 DB 0DDH
241F 21D927 00452 SPCREQ LD HL,SPCREQ$ ;"File spec required
2422 DD 00453 DB 0DDH
2423 21EC27 00454 NOTDUN LD HL,NOTDUN$ ;"Specifications req.
2426 DD 00455 DB 0DDH
2427 210428 00456 ATBERR LD HL,ATBERR$ ;"Attr. specification error
242A 00457 EXTERR @@LOGOT
00458 IFEQ 00H,1
00459 LD HL,
00460 ENDIF
242A+3E0C 00461 LD A,12
242C+EF 00462 RST 40
242D 21FFFF 00463 LD HL,-1 ;Set abort error
2430 310000 00464 SAVESP LD SP,$-$ ;Reload stack pointer
2433 00465 @@CKBRKC ;Clean up
2433+3E6A 00466 LD A,106
2435+EF 00467 RST 40
2436 C9 00468 RET
00469 ;
00470 ; ATTRIB1 - Set Attributes of a file/disk
00471 ;
00472 ATTRIB1
2437 110E29 00473 LD DE,FCB ;Check filespec or drive #
243A 00474 @@FSPEC
243A+3E4E 00475 LD A,78
243C+EF 00476 RST 40
243D C2B125 00477 JP NZ,PROT ;Assume drive # if error
2440 1A 00478 LD A,(DE) ;Cannot be a device
2441 FE2A 00479 CP '*'
2443 CA1F24 00480 JP Z,SPCREQ
2446 00481 @@FLAGS ;Get flag table pointer
2446+3E65 00482 LD A,101
2448+EF 00483 RST 40
2449 E5 00484 PUSH HL ;Save cmdline ptr
244A 21002A 00485 LD HL,BUFFER ;Use local buffer
244D 45 00486 LD B,L ;Open the file
244E FDCB12C6 00487 SET 0,(IY+'S'-'A') ;Don't set file open bit
2452 00488 @@OPEN
2452+3E3B 00489 LD A,59
2454+EF 00490 RST 40
2455 E1 00491 POP HL ;Rcvr cmdline ptr
2456 C20C24 00492 JP NZ,IOERR ;Jump if non-existant
2459 3A0F29 00493 LD A,(FCB+1) ;P/u protection
245C E607 00494 AND 7 ;Mask other bits
245E 3E25 00495 LD A,25H ;Init for access denied
2460 C20C24 00496 JP NZ,IOERR ;Jump if no can do
2463 AF 00497 XOR A
2464 328725 00498 LD (PRMCOD+1),A ;Init prot to 0
00499 ;
00500 ; Convert command line to upper case
00501 ;
2467 E5 00502 PUSH HL ;Save cmdline ptr
2468 7E 00503 ATT0 LD A,(HL) ; & cvrt lc to UC
2469 FE0D 00504 CP CR
246B 2811 00505 JR Z,ATT02 ;Done if CR
246D FE03 00506 CP 3 ; ETX
246F 280D 00507 JR Z,ATT02
2471 FE61 00508 CP 'a' ;Not lc?
2473 3806 00509 JR C,ATT01
2475 FE7B 00510 CP 'z'+1
2477 3002 00511 JR NC,ATT01
2479 CBAE 00512 RES 5,(HL) ; to
247B 23 00513 ATT01 INC HL ;Bump to next char
247C 18EA 00514 JR ATT0 ;Loop
00515 ;
247E E1 00516 ATT02 POP HL ;Rcvr orig cmdline ptr
00517 ;
00518 ; Scan command line for parameters
00519 ;
247F 7E 00520 ATT1 LD A,(HL) ;Scan for start of parm
2480 FE28 00521 CP '(' ;There yet?
2482 2807 00522 JR Z,ATT2 ;Jump if so
2484 FE20 00523 CP ' ' ;Ignore spaces
2486 2005 00524 JR NZ,ATT3 ;Assume parm on dif char
2488 23 00525 INC HL
2489 18F4 00526 JR ATT1
248B 23 00527 ATT2 INC HL ;Bump past '('
248C 7E 00528 LD A,(HL)
248D FE49 00529 ATT3 CP 'I' ;Ck for INV
248F 286B 00530 JR Z,DOINV
2491 FE56 00531 CP 'V' ;Ck for VIS
2493 2879 00532 JR Z,DOVIS
2495 FE4F 00533 CP 'O' ;Ck for OWNER
2497 CA2025 00534 JP Z,DOOWN
249A FE50 00535 CP 'P' ;Ck for PROT
249C C22724 00536 JP NZ,ATBERR ;Err if none of the above
00537 ;
00538 ; Process PROT=parm
00539 ;
249F CD4F25 00540 CALL PRSFLD ;Parse field
24A2 CA2724 00541 JP Z,ATBERR ;Error if end of line
24A5 E5 00542 PUSH HL ;Save ptr to next char
24A6 0608 00543 LD B,8 ;Init for 8 prots
24A8 ED5B0229 00544 LD DE,(PSWDBUF) ;P/u 1st 2 chars
24AC 212228 00545 LD HL,PROTS$ ;Pt to various prots
24AF 7E 00546 DOPR01 LD A,(HL) ;P/u 1st prot char
24B0 23 00547 INC HL ;Bump pointer
24B1 BB 00548 CP E ;Does 1st match?
24B2 CCBC24 00549 CALL Z,DOPR02 ;Check 2nd if 1st OK
24B5 23 00550 INC HL ;Bump to next
24B6 10F7 00551 DJNZ DOPR01 ;Loop for all 8
24B8 E1 00552 POP HL ;Stack integrity
24B9 C32724 00553 JP ATBERR ;Abort if no match
00554 ;
00555 ; Check 2nd prot= char for match
00556 ;
24BC 7E 00557 DOPR02 LD A,(HL) ;P/u 2nd table char
24BD BA 00558 CP D ;Match user's entry?
24BE C0 00559 RET NZ ;Go back if not
24BF F1 00560 POP AF ;Pop the ret addr
24C0 78 00561 LD A,B ;Calculate which prot was
24C1 3D 00562 DEC A ; entered by the user
24C2 2814 00563 JR Z,DOPR03 ;Jump on PROT=FU
24C4 FE05 00564 CP 5 ;REname, REad, REmove?
24C6 2010 00565 JR NZ,DOPR03 ;Go if none of the above
24C8 3A0429 00566 LD A,(PSWDBUF+2) ;P/u user's 3rd char
24CB FE4E 00567 CP 'N' ;Was it 'N'?
24CD 3E02 00568 LD A,2 ;Init for REname
24CF 2807 00569 JR Z,DOPR03 ;Go if REName
24D1 3D 00570 DEC A ;Else init to REMove
24D2 FE4D 00571 CP 'M' ; & test entry
24D4 2802 00572 JR Z,DOPR03
24D6 3E05 00573 LD A,5 ; else assume REAd
24D8 328F25 00574 DOPR03 LD (PROTLVL+1),A ;Stuff protection level
24DB E1 00575 POP HL ;Rcvr INBUF$ pointer
24DC 0601 00576 LD B,1 ;Init to show PROT given
24DE 7E 00577 DOPR04 LD A,(HL) ;P/u next parm
24DF FE22 00578 CP '"' ;Closing quote on last?
24E1 2001 00579 JR NZ,DOPR05 ;Go if something else
24E3 23 00580 INC HL ;Ignore closing quote
24E4 3A8725 00581 DOPR05 LD A,(PRMCOD+1) ;P/u parm test bits
24E7 B0 00582 OR B ;Merge PROT entered
24E8 328725 00583 LD (PRMCOD+1),A ;Restuff parm test bits
24EB 7E 00584 LD A,(HL) ;P/u next char
24EC FE0D 00585 CP CR ;End of line?
24EE 2802 00586 JR Z,$+4 ;Go on end-of-line
24F0 FE29 00587 CP ')' ;End of parms?
24F2 CA7B25 00588 JP Z,UPDDIR ;Go on end of parms
24F5 FE2C 00589 CP ',' ;More parms?
24F7 2892 00590 JR Z,ATT2 ;Loop on more parms
24F9 C32724 00591 JP ATBERR ;Exit on wrong char
00592 ;
00593 ; Process INV parm
00594 ;
24FC CD4F25 00595 DOINV CALL PRSFLD ;Parse parm
24FF C22724 00596 JP NZ,ATBERR ;Go on parm error
2502 3A9725 00597 LD A,(IVCOD+1) ;Set bit 3 to indicate
2505 F608 00598 OR 8 ; that INV given
2507 329725 00599 LD (IVCOD+1),A
250A 0608 00600 LD B,8 ;Show vis/inv done
250C 18D6 00601 JR DOPR05 ;Merge w/prev. parms
00602 ;
00603 ; Process VIS parm
00604 ;
250E CD4F25 00605 DOVIS CALL PRSFLD ;Parse parm
2511 C22724 00606 JP NZ,ATBERR ;Quit on parm error
2514 3A9725 00607 LD A,(IVCOD+1) ;Strip bit 3
2517 E6F7 00608 AND 0F7H
2519 329725 00609 LD (IVCOD+1),A
251C 0608 00610 LD B,8 ;Show vis/inv done
251E 18C4 00611 JR DOPR05 ;Merge w/prev. parms
00612 ;
00613 ; Process OWNER parm
00614 ;
2520 CD4F25 00615 DOOWN CALL PRSFLD ;Parse parm
2523 CA2724 00616 JP Z,ATBERR ;Quit on parm error
2526 E5 00617 PUSH HL ;Save cmdline ptr
2527 110229 00618 LD DE,PSWDBUF
252A CD1627 00619 CALL DOHASH ;Hash the password
252D 220A29 00620 LD (HASHBUF),HL
2530 E1 00621 POP HL
2531 0604 00622 LD B,4 ;Show OWNER done
2533 18A9 00623 JR DOPR04 ;Merge w/prev. parms
00624 ;
00625 ; Transfer the field, 1st char alpha
00626 ;
2535 7E 00627 XSPEC8A LD A,(HL) ;P/u a filespec character
2536 23 00628 INC HL ; & 1st test for A-Z
2537 1809 00629 JR XSPEC10
2539 7E 00630 XSPEC9 LD A,(HL) ;P/u a filespec character
253A 23 00631 INC HL ;Advance to next one
253B FE30 00632 CP '0' ;Check for 0-9
253D D8 00633 RET C ;Quit if < 0
253E FE3A 00634 CP '9'+1
2540 3806 00635 JR C,XSPEC11 ;Go if numeric
2542 FE41 00636 XSPEC10 CP 'A' ;Check for A-Z
2544 D8 00637 RET C
2545 FE5B 00638 CP 'Z'+1
2547 D0 00639 RET NC
2548 12 00640 XSPEC11 LD (DE),A ;Character is valid
2549 13 00641 INC DE ;Advance to next one
254A 10ED 00642 DJNZ XSPEC9 ; & loop
254C 7E 00643 LD A,(HL) ;P/u following character
254D 23 00644 INC HL
254E C9 00645 RET ;Go home
00646 ;
00647 ; Parse rest of parm (ignore until separator)
00648 ;
254F 23 00649 PRSFLD INC HL
2550 7E 00650 LD A,(HL) ;Get next char
2551 FE0D 00651 CP CR ;Ret on end of line
2553 C8 00652 RET Z
2554 FE29 00653 CP ')' ;Ret on closing paren
2556 C8 00654 RET Z
2557 FE2C 00655 CP ',' ;Ret on separator
2559 C8 00656 RET Z
255A FE3D 00657 CP '=' ;Assignment operator?
255C 20F1 00658 JR NZ,PRSFLD ;Loop if not
255E 23 00659 INC HL
255F 7E 00660 LD A,(HL)
2560 FE22 00661 CP '"' ;Is quote there?
2562 2001 00662 JR NZ,$+3
2564 23 00663 INC HL ;Bypass the quote
2565 110229 00664 LD DE,PSWDBUF
2568 0608 00665 LD B,8
256A D5 00666 PUSH DE
256B C5 00667 PUSH BC
256C 3E20 00668 LD A,' ' ;Space out the buffer
256E 12 00669 PRSF01 LD (DE),A
256F 13 00670 INC DE
2570 10FC 00671 DJNZ PRSF01
2572 C1 00672 POP BC
2573 D1 00673 POP DE
2574 CD3525 00674 CALL XSPEC8A ;Transfer the spec
2577 2B 00675 DEC HL
2578 F601 00676 OR 1 ;Show got a parm
257A C9 00677 RET
00678 ;
00679 ; Routine updates file's directory data
00680 ;
257B ED4B1429 00681 UPDDIR LD BC,(FCB+6) ;P/u drive & DEC
257F 00682 @@DIRRD ;Read its directory
257F+3E57 00683 LD A,87
2581+EF 00684 RST 40
2582 C20C24 00685 JP NZ,IOERR ;Quit on read error
2585 7E 00686 LD A,(HL) ;P/u attributes byte
2586 1600 00687 PRMCOD LD D,$-$ ;P/u parm test bits
2588 CB42 00688 BIT 0,D ;Was Prot entered?
258A 2804 00689 JR Z,UPDIR1 ;Jump if not
258C E6F8 00690 AND 0F8H ;Rmv prot level
258E F600 00691 PROTLVL OR 0 ;Merge new prot level
2590 CB5A 00692 UPDIR1 BIT 3,D ;Was Inv or Vis entered?
2592 2804 00693 JR Z,UPDIR2 ;Bypass if not
2594 E6F7 00694 AND 0F7H ;Remove any vis/inv
2596 F600 00695 IVCOD OR 0 ;Merge new inv/vis
2598 77 00696 UPDIR2 LD (HL),A ; & update dir rec
2599 7D 00697 LD A,L ;Pt to owner pswd
259A C610 00698 ADD A,16
259C 6F 00699 LD L,A
259D CB52 00700 BIT 2,D ;Was OWN parm entered?
259F 2809 00701 JR Z,UPDIR4 ;Bypass if not
25A1 3A0A29 00702 LD A,(HASHBUF) ;Xfer new hashed pswd
25A4 77 00703 LD (HL),A ; into the directory
25A5 3A0B29 00704 LD A,(HASHBUF+1) ; OWNER psw position
25A8 23 00705 INC HL
25A9 77 00706 LD (HL),A
25AA 00707 UPDIR4 @@DIRWR ;Write dir back to disk
25AA+3E58 00708 LD A,88
25AC+EF 00709 RST 40
25AD C20C24 00710 JP NZ,IOERR ;Abort on write error
25B0 C9 00711 RET ;Done - return
00712 ;
00713 ; Change attributes of entire disk
00714 ;
25B1 0E00 00715 PROT LD C,0 ;Init for drive 0
25B3 2B 00716 DEC HL ;Backup to separator
25B4 7E 00717 LD A,(HL) ;Ck for drive entered
25B5 FE3A 00718 CP ':' ;Colon indicator?
25B7 2015 00719 JR NZ,PROT01 ;Bypass if not
25B9 23 00720 INC HL ;Point to drive #
00721 ;
00722 ; Is the drivespec legal (0-7) ?
00723 ;
25BA 7E 00724 LD A,(HL) ;P/u drive
25BB D630 00725 SUB '0' ;Cvrt to binary
00726 IF @BLD631
25BD FE08 00727 CP 7+1 ;<631>Less than 0, illegal
25BF 4F 00728 LD C,A ;<631>
25C0 3E20 00729 LD A,32 ;<631>Init "Illegal Drive #
25C2 D20C24 00730 JP NC,IOERR ;<631>
00731 ELSE
00732 JR C,ILLDRVN ;Less than 0, illegal
00733 CP 7+1 ;Greater than 7 ?
00734 CCF
00735 LD C,A
00736 ILLDRVN LD A,32 ;Init "Illegal Drive #
00737 JP C,IOERR
00738 ENDIF
00739 ;
00740 ; Drive # is legal - Check it out
00741 ;
25C5 00742 @@CKDRV ;Do a check drive
25C5+3E21 00743 LD A,33
25C7+EF 00744 RST 40
25C8 3E20 00745 LD A,32 ;Init "Illegal drive
25CA C20C24 00746 JP NZ,IOERR ;Go if bad
00747 ;
25CD 23 00748 INC HL ;Bump line pointer
25CE 79 00749 PROT01 LD A,C
25CF 32E326 00750 LD (TSTMPW+1),A ;Stuff drive for later
25D2 00751 @@GTDCT ;Get DCT -> IY
25D2+3E51 00752 LD A,81
25D4+EF 00753 RST 40
25D5 11D928 00754 LD DE,PRMTBL$ ;Get parms
25D8 00755 @@PARAM
25D8+3E11 00756 LD A,17
25DA+EF 00757 RST 40
25DB C20C24 00758 JP NZ,IOERR ;Quit on parm error
25DE 3A3926 00759 LD A,(PPARM+1) ;Make sure a parm
25E1 215C26 00760 LD HL,LPARM+1 ; was entered
25E4 B6 00761 OR (HL)
25E5 216626 00762 LD HL,UPARM+1
25E8 B6 00763 OR (HL)
25E9 21F725 00764 LD HL,NPARM+1
25EC B6 00765 OR (HL)
25ED CA2324 00766 JP Z,NOTDUN ;Quit if none entered
25F0 CDE226 00767 CALL TSTMPW ;Test master password
25F3 C20C24 00768 JP NZ,IOERR ;Quit on error
25F6 110000 00769 NPARM LD DE,0 ;P/U Name parm
25F9 7A 00770 LD A,D
25FA B3 00771 OR E
25FB 283B 00772 JR Z,PPARM ;Jump if name not entered
25FD 215728 00773 LD HL,PACKNM$ ;Get name into buf1
2600 CD1927 00774 CALL GMPW1
2603 C20C24 00775 JP NZ,IOERR ;Quit on error
2606 21002A 00776 LD HL,BUFFER ;HL = new name
2609 11D02B 00777 LD DE,GATBUF+0D0H ;Where new name goes
260C D5 00778 PUSH DE
260D E5 00779 PUSH HL
260E 010800 00780 LD BC,8 ;Name len
2611 EDB0 00781 LDIR ;Xfer new name
2613 E1 00782 POP HL
2614 110200 00783 LD DE,2 ;Trk 0, sect 2
2617 3AE326 00784 LD A,(TSTMPW+1) ;P/u drive
261A 4F 00785 LD C,A
261B 00786 @@RDSEC ;Read SIS
261B+3E31 00787 LD A,49
261D+EF 00788 RST 40
261E E1 00789 POP HL ;Get Name pointer
261F C20C24 00790 JP NZ,IOERR ;Quit if read error
2622 C5 00791 PUSH BC ;Save drive
2623 11102A 00792 LD DE,BUFFER+10H ;Point to where name goes
2626 010800 00793 LD BC,8
2629 EDB0 00794 LDIR ;Xfer new name to SIS
262B C1 00795 POP BC ;Recover drive
262C 110200 00796 LD DE,2
262F 21002A 00797 LD HL,BUFFER
2632 00798 @@WRSEC ;Write new SIS
2632+3E35 00799 LD A,53
2634+EF 00800 RST 40
2635 C20C24 00801 JP NZ,IOERR ;Quit on write error
2638 110000 00802 PPARM LD DE,0 ;Was PW parm used?
263B 7A 00803 LD A,D
263C B3 00804 OR E
263D 280C 00805 JR Z,PROT02 ;Jump if PW not entered
263F 216F28 00806 LD HL,NEWMPW$ ;Buffer for new MPW
2642 CD0927 00807 CALL GETMPW ;Input the new one
2645 C20C24 00808 JP NZ,IOERR ;Quit if bad PW
2648 22CE2B 00809 LD (GATBUF+0CEH),HL ;Stuff PW
264B FD5609 00810 PROT02 LD D,(IY+9) ;Dir cl => reg D
264E 3AE326 00811 LD A,(TSTMPW+1) ;P/u drive
2651 4F 00812 LD C,A
2652 CD9C27 00813 CALL GATWR ;Write sector 0 from buf
2655 C20C24 00814 JP NZ,IOERR ;Jump on write error
2658 2ACE2B 00815 LD HL,(GATBUF+0CEH) ;P/u pack MPW
00816 ;
00817 ; Check on Lock or Unlock
00818 ;
265B 010000 00819 LPARM LD BC,0 ;Lock parm used?
265E 78 00820 LD A,B
265F B1 00821 OR C
2660 119642 00822 LD DE,BLNKMPW ;P/u blank MPW for test
2663 2007 00823 JR NZ,PROT03 ;Jump if LOCK entered
2665 010000 00824 UPARM LD BC,0 ;Unlock parm used?
2668 78 00825 LD A,B
2669 B1 00826 OR C
266A C8 00827 RET Z ;Neither LOCK or UNLOCK
266B EB 00828 EX DE,HL ;Switch New & Test MPW
00829 ;
00830 ; Lock to pack MPW or unlock pswds to blanks
00831 ;
266C 22BD26 00832 PROT03 LD (REVMPW+1),HL ;Stuff New MPW
266F ED53B426 00833 LD (THISPW+1),DE ;Stuff test MPW
2673 3AE326 00834 LD A,(TSTMPW+1) ;P/u drive #
2676 4F 00835 LD C,A
2677 FD5609 00836 LD D,(IY+9) ;Get dir cyl => reg D
267A 1E01 00837 LD E,1 ;Point to HIT
267C 21002C 00838 LD HL,HITBUF ;Point to HIT buffer
267F 00839 @@RDSSC ;Read it into buffer
267F+3E55 00840 LD A,85
2681+EF 00841 RST 40
2682 C20C24 00842 JP NZ,IOERR ;Quit on read error
2685 7E 00843 PROT04 LD A,(HL) ;P/u a DEC
2686 B7 00844 OR A
2687 283E 00845 JR Z,PROT09 ;Loop on spare
2689 45 00846 LD B,L ;Put DEC in reg B
268A C5 00847 PUSH BC ; & save it in stack
268B 7D 00848 LD A,L ;Ck if this DEC points
268C E6E0 00849 AND 0E0H ; to same dir sector as
268E 6F 00850 LD L,A ; the previous DEC
268F A8 00851 XOR B
2690 FEFF 00852 PROT05 CP 0FFH ;1st time, no DEC
2692 280D 00853 JR Z,PROT06 ;Jump if the same
2694 329126 00854 LD (PROT05+1),A ;Save it for testing
2697 00855 @@DIRRD ;Read this dir sector
2697+3E57 00856 LD A,87
2699+EF 00857 RST 40
269A C20C24 00858 JP NZ,IOERR ;Quit on read error
269D 7C 00859 LD A,H ;Set hi-order SBUFF$
269E 32A226 00860 LD (PROT06+1),A
26A1 2600 00861 PROT06 LD H,$-$ ;Point to buf hi-order
26A3 7E 00862 LD A,(HL) ;P/u type code
26A4 E6F8 00863 AND 0F8H ;Remove protection
26A6 FE10 00864 CP 10H ;Jump if INV, SYS, FXDE
26A8 2019 00865 JR NZ,PROT08
26AA 7D 00866 LD A,L ;Point to password fields
26AB C610 00867 ADD A,16
26AD 6F 00868 LD L,A
26AE D5 00869 PUSH DE ;Save reg DE
26AF E5 00870 PROT07 PUSH HL ;Save pointer to OWNER
26B0 5E 00871 LD E,(HL) ;P/u owner MPW
26B1 23 00872 INC HL
26B2 56 00873 LD D,(HL)
26B3 210000 00874 THISPW LD HL,$-$ ;P/u test MPW & see
26B6 AF 00875 XOR A ; if this one matches
26B7 ED52 00876 SBC HL,DE
26B9 E1 00877 POP HL ;Restore ptr to OWN
26BA 2006 00878 JR NZ,PROT07B ;Don't change if diff
26BC 110000 00879 REVMPW LD DE,$-$ ; else p/u new MPW
26BF 73 00880 LD (HL),E ; & insert it
26C0 2C 00881 INC L
26C1 72 00882 LD (HL),D
26C2 D1 00883 PROT07B POP DE ;Restore reg DE
26C3 C1 00884 PROT08 POP BC ;Recover DEC
26C4 262C 00885 LD H,HITBUF<-8 ;Point to HIT hi-order
26C6 68 00886 LD L,B ;Stuff HIT lo-order
26C7 7D 00887 PROT09 LD A,L ;Point to next entry
26C8 C620 00888 ADD A,32 ; for this dir sector
26CA 6F 00889 LD L,A
26CB 30B8 00890 JR NC,PROT04 ;Jump if still in same
26CD 3A9126 00891 LD A,(PROT05+1) ;P/u current DEC
26D0 AD 00892 XOR L
26D1 2008 00893 JR NZ,PROT10 ;Jump if different
26D3 E5 00894 PUSH HL
26D4 00895 @@DIRWR ;Write out this sector
26D4+3E58 00896 LD A,88
26D6+EF 00897 RST 40
26D7 E1 00898 POP HL
26D8 C20C24 00899 JP NZ,IOERR ;Quit on write error
26DB 7D 00900 PROT10 LD A,L ;Advance to the next
26DC 2C 00901 INC L ; directory sector
26DD FE1F 00902 CP 1FH ;At end of disk?
26DF 20A4 00903 JR NZ,PROT04 ;Loop if not
26E1 C9 00904 RET ; else go home
00905 ;
00906 ; Routine to test master password for match
00907 ;
26E2 0E00 00908 TSTMPW LD C,$-$ ;Init to drive requested
26E4 CD9B27 00909 CALL GATRD ;Read GAT into GATBUF
26E7 C0 00910 RET NZ ;Back on error
26E8 2ACE2B 00911 LD HL,(GATBUF+0CEH)
26EB 11E042 00912 LD DE,PASSWORD ;Password=PASSWORD?
26EE AF 00913 XOR A
26EF ED52 00914 SBC HL,DE
26F1 C8 00915 RET Z ;Back if PASSWORD
00916 ;
00917 ; MPW is not "PASSWORD" - check entry match
00918 ;
26F2 110000 00919 MPARM LD DE,0 ;P/u MPW string addr
26F5 218728 00920 LD HL,CURMPW$ ;Init prompt
26F8 CD0927 00921 CALL GETMPW ;Hash parm or entry
26FB C0 00922 RET NZ ;Back on bad PW
26FC EB 00923 EX DE,HL ;Xfer hashed MPW to DE
26FD 2ACE2B 00924 LD HL,(GATBUF+0CEH) ;Grab pack MPW &
2700 AF 00925 XOR A ; check if user entered
2701 ED52 00926 SBC HL,DE ; the pack MPW
2703 219F28 00927 LD HL,BADMPW$ ;Init error pointer
2706 3E3F 00928 LD A,63 ;Set extended error
2708 C9 00929 RET ;Z or NZ
00930 ;
00931 ; Enter SYS2 & hash the password
00932 ;
2709 CD1927 00933 GETMPW CALL GMPW1 ;Get MPW into buffer
270C 2808 00934 JR Z,DOHASH
270E FE3F 00935 CP 63 ;Extended error?
2710 C0 00936 RET NZ
2711 219F28 00937 LD HL,BADMPW$ ;Switch error message
2714 B7 00938 OR A ; to password error
2715 C9 00939 RET
2716 3EE4 00940 DOHASH LD A,0E4H ;Hash password (DE) to HL
2718 EF 00941 RST 28H ;Ret to what called
00942 ;
00943 ; Routine places a password field into buffer
00944 ;
2719 7A 00945 GMPW1 LD A,D ;Test if user entered MPW
271A B3 00946 OR E
271B 281D 00947 JR Z,GMPW3 ;Prompt if not
271D 3C 00948 INC A ; or if no operand
271E 281A 00949 JR Z,GMPW3
00950 ;
00951 ; Place entered password into buffer
00952 ;
2720 21002A 00953 LD HL,BUFFER ;Point to buffer
2723 E5 00954 PUSH HL
2724 0608 00955 LD B,8 ;Init for 8 chars
2726 1A 00956 GMPW2 LD A,(DE) ;P/u a char
2727 FE0D 00957 CP CR ;End of line?
2729 282F 00958 JR Z,GMPW4
272B FE2C 00959 CP ',' ;Comma separator?
272D 282B 00960 JR Z,GMPW4
272F FE22 00961 CP '"' ;Closing quote?
2731 2827 00962 JR Z,GMPW4
2733 13 00963 INC DE ;Bump input pointer
2734 77 00964 LD (HL),A ;Transfer character
2735 23 00965 INC HL ;Bump output pointer
2736 10EE 00966 DJNZ GMPW2 ;Loop until done
2738 1825 00967 JR CKMPW
00968 ;
00969 ; MPW not entered - Prompt & fetch
00970 ;
273A CDC727 00971 GMPW3 CALL CKINDO ;Can't prompt in
273D C0 00972 RET NZ
273E 00973 @@DSPLY ;Display prompt
00974 IFEQ 00H,1
00975 LD HL,
00976 ENDIF
273E+3E0A 00977 LD A,10
2740+EF 00978 RST 40
2741 C0 00979 RET NZ
2742 010008 00980 LD BC,8<8 ;Init for 8 chars
2745 21002A 00981 LD HL,BUFFER ;Point to buffer
2748 E5 00982 PUSH HL
2749 00983 @@KEYIN ;Get parm input
2749+3E09 00984 LD A,9
274B+EF 00985 RST 40
274C DA1B24 00986 JP C,ABORT ;Quit on Break
274F EB 00987 EX DE,HL ;Start pointer to reg DE
2750 2600 00988 LD H,0 ;Calculate trailing
2752 68 00989 LD L,B ; spaces needed for MPW
2753 19 00990 ADD HL,DE
2754 3E08 00991 LD A,8
2756 90 00992 SUB B
2757 2806 00993 JR Z,CKMPW ;Go if 8 chars entered
2759 47 00994 LD B,A ;Set loop count
275A 3620 00995 GMPW4 LD (HL),' ' ; and fill to end
275C 23 00996 INC HL ; with spaces
275D 10FB 00997 DJNZ GMPW4
00998 ;
00999 ; Convert (SP) through (SP)+7 to upper case
01000 ;
275F E1 01001 CKMPW POP HL ;Get buffer start
2760 E5 01002 PUSH HL
2761 0608 01003 LD B,8 ;Init loop 8 chars
2763 7E 01004 LD A,(HL) ;P/u 1st char
2764 180E 01005 JR CKMPW2 ; & check
2766 23 01006 CKMPW1 INC HL
2767 7E 01007 LD A,(HL)
2768 FE20 01008 CP ' ' ;Got to a space?
276A 2823 01009 JR Z,CKMPW7
276C FE30 01010 CP '0' ;Less than '0' is error
276E 3823 01011 JR C,INVNAM
2770 FE3A 01012 CP '9'+1 ;<0-9> is okay for 2-n
2772 3812 01013 JR C,CKMPW3
2774 FE41 01014 CKMPW2 CP 'A' ;Less than "A" is error
2776 381B 01015 JR C,INVNAM
2778 FE5B 01016 CP 'Z'+1 ; is okay
277A 380A 01017 JR C,CKMPW3
277C FE61 01018 CP 'a' ;Ck convert to upper
277E 3813 01019 JR C,INVNAM
2780 FE7B 01020 CP 'z'+1
2782 300F 01021 JR NC,INVNAM
2784 CBAE 01022 RES 5,(HL)
2786 10DE 01023 CKMPW3 DJNZ CKMPW1 ;Loop if more
2788 D1 01024 CKMPW4 POP DE ;Point to buffer start
2789 AF 01025 XOR A ;Set Z = good
278A C9 01026 RET
01027 ;
278B 23 01028 CKMPW5 INC HL
278C BE 01029 CP (HL) ;No imbedded spaces
278D 2004 01030 JR NZ,INVNAM
278F 10FA 01031 CKMPW7 DJNZ CKMPW5 ;A space found, now
2791 18F5 01032 JR CKMPW4 ; must be all spaces
2793 21B728 01033 INVNAM LD HL,BADNAM$ ;Pt to error string
2796 3E3F 01034 LD A,63 ;Init extended error
2798 B7 01035 OR A ;Set NZ
2799 D1 01036 POP DE
279A C9 01037 RET
01038 ;
01039 ; Read or write the granule allocation table
01040 ;
279B F6 01041 GATRD DB 0F6H ;Set NZ for test
279C AF 01042 GATWR XOR A ;Set Z for test
279D D5 01043 PUSH DE
279E E5 01044 PUSH HL
279F F5 01045 PUSH AF
27A0 FDE5 01046 PUSH IY
27A2 01047 @@GTDCT ;DCT to reg IY
27A2+3E51 01048 LD A,81
27A4+EF 01049 RST 40
27A5 FD5609 01050 LD D,(IY+9) ;Get dir track
27A8 FDE1 01051 POP IY
27AA 21002B 01052 LD HL,GATBUF
27AD 5D 01053 LD E,L ;Set to sector 0
27AE F1 01054 POP AF
27AF 2807 01055 JR Z,GATRW1 ;Go if GAT write
27B1 01056 @@RDSSC
27B1+3E55 01057 LD A,85
27B3+EF 01058 RST 40
27B4 3E14 01059 LD A,14H ;Init "GAT read error
27B6 180C 01060 JR GATRW3
27B8 01061 GATRW1 @@WRSSC
27B8+3E36 01062 LD A,54
27BA+EF 01063 RST 40
27BB 2003 01064 JR NZ,GATRW2 ;Skip verify if error
27BD 01065 @@VRSEC ;Verify the write
27BD+3E32 01066 LD A,50
27BF+EF 01067 RST 40
27C0 FE06 01068 GATRW2 CP 6 ;Error 6 expected
27C2 3E15 01069 LD A,15H ;Init "GAT write error
27C4 E1 01070 GATRW3 POP HL
27C5 D1 01071 POP DE
27C6 C9 01072 RET
01073 ;
27C7 FDE5 01074 CKINDO PUSH IY
27C9 01075 @@FLAGS
27C9+3E65 01076 LD A,101
27CB+EF 01077 RST 40
27CC FDCB126E 01078 BIT 5,(IY+'S'-'A') ;Ck on DO in effect
27D0 FDE1 01079 POP IY
27D2 C8 01080 RET Z ;Go back if not in DO
27D3 213228 01081 LD HL,NOINDO$ ; else set error code
27D6 3E3F 01082 LD A,63 ;Set extended error
27D8 C9 01083 RET ; & back with NZ
01084 ;
01085 ; Messages
01086 ;
27D9 46 01087 SPCREQ$ DB 'File spec required',CR
69 6C 65 20 73 70 65 63
20 72 65 71 75 69 72 65
64 0D
27EC 53 01088 NOTDUN$ DB 'Specifications Required',CR
70 65 63 69 66 69 63 61
74 69 6F 6E 73 20 52 65
71 75 69 72 65 64 0D
2804 41 01089 ATBERR$ DB 'Attribute specification error',CR
74 74 72 69 62 75 74 65
20 73 70 65 63 69 66 69
63 61 74 69 6F 6E 20 65
72 72 6F 72 0D
2822 4E 01090 PROTS$ DB 'NOEXREUPWRRNRMFU'
4F 45 58 52 45 55 50 57
52 52 4E 52 4D 46 55
2832 49 01091 NOINDO$ DB 'Invalid command during DO processing',CR
6E 76 61 6C 69 64 20 63
6F 6D 6D 61 6E 64 20 64
75 72 69 6E 67 20 44 4F
20 70 72 6F 63 65 73 73
69 6E 67 0D
2857 4E 01092 PACKNM$ DB 'New disk pack name ? ',3
65 77 20 64 69 73 6B 20
70 61 63 6B 20 6E 61 6D
65 20 3F 20 20 20 03
286F 4E 01093 NEWMPW$ DB 'New master password ? ',3
65 77 20 6D 61 73 74 65
72 20 70 61 73 73 77 6F
72 64 20 3F 20 20 03
2887 4D 01094 CURMPW$ DB 'Master password ? ',3
61 73 74 65 72 20 70 61
73 73 77 6F 72 64 20 3F
20 20 20 20 20 20 03
289F 49 01095 BADMPW$ DB 'Invalid master password',CR
6E 76 61 6C 69 64 20 6D
61 73 74 65 72 20 70 61
73 73 77 6F 72 64 0D
28B7 49 01096 BADNAM$ DB 'Invalid disk name',CR
6E 76 61 6C 69 64 20 64
69 73 6B 20 6E 61 6D 65
0D
28C9 43 01097 ABORT$ DB 'Command aborted',CR
6F 6D 6D 61 6E 64 20 61
62 6F 72 74 65 64 0D
01098 ;
28D9 80 01099 PRMTBL$ DB 80H
01100 ;
0080 01101 VAL EQU 80H
0040 01102 SW EQU 40H
0020 01103 STR EQU 20H
0010 01104 SGL EQU 10H
01105 ;
28DA 62 01106 DB SW!STR!2,'PW',0
50 57 00
28DE 3926 01107 DW PPARM+1
28E0 54 01108 DB SW!SGL!4,'LOCK',0
4C 4F 43 4B 00
28E6 5C26 01109 DW LPARM+1
28E8 56 01110 DB SW!SGL!6,'UNLOCK',0
55 4E 4C 4F 43 4B 00
28F0 6626 01111 DW UPARM+1
28F2 74 01112 DB SW!STR!SGL!4,'NAME',0
4E 41 4D 45 00
28F8 F725 01113 DW NPARM+1
28FA 73 01114 DB SW!STR!SGL!3,'MPW',0
4D 50 57 00
28FF F326 01115 DW MPARM+1
2901 00 01116 NOP
01117 ;
2902 01118 PSWDBUF DS 8 ;Password buffer
290A 01119 HASHBUF DS 4 ;Owner & user hashes
290E 01120 FCB DS 32
01121 ;
2A00 01122 ORG $<-8+1<+8
2A00 01123 BUFFER DS 256
2B00 01124 GATBUF DS 256
2C00 01125 HITBUF DS 256
01126 ;
2400 01127 END ATTRIB
2400 is the transfer address
00000 Total errors
[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]