PWCode.s

10 REM > PWCode/s 1.10

20 REM Encrypted logon code

30 REM Fully position independent

40 :

50 DIM mc% &100

60 txt=&100:blk=&120:zp=&A8

70 FOR P=0 TO 1

80 P%=mc%

90 [OPT P*3

100 .code

110 \ On entry:

120 \ A = num. of strings to encode

130 \ ie, 1 for *I AM, 2 for *PASS

140 \ XY=>strings to encode, and

150 \ returned encoded strings

160 \ On exit:

170 \ A =0, ok with XY=>encrypted string

180 \ A<>0, error with XY=>error string

190 \

200 PHA:STX zp:STY zp+1:LDY #0 :\ Point zp to input string

210 .Lp0

220 LDA (zp),Y:STA txt,Y:INY :\ Copy input string to text buffer

230 CMP #13:BNE Lp0

240 :

250 LDA #0:LDX #6

260 .Lp1

270 STA blk,X:DEX:BPL Lp1 :\ Clear FSOp control block

280 LDA #7:STA blk+1 :\ Length=7

290 LDA #&42:STA blk+3 :\ FSOp=&42 - Get Encryption Key

300 LDX #blk AND255:LDY #blk DIV256:\ Point to FSOp control block

310 LDA #&14:JSR &FFF1 :\ Fetch key to blk!4

320 LDX #(blk+4)AND255:LDY #(blk+4)DIV 256 :\ Point to any error

330 LDA blk+3:BEQ noerror:RTS :\ Exit if error returned

340 :

350 .noerror

360 LDY #0 :\ Point to start of text buffer

370 .Lp2

380 LDA txt,Y :\ Get character from text buffer

390 LDX #0

400 .Lp3

410 ROR A:PHA:ROR A:EOR blk+6 :\ Encrypt this character into

420 ROL A:ROL A:ROL A:ROL A :\ encryption key

430 EOR blk+6:ROR A:ROR A:ROR A

440 ROL blk+4:ROL blk+5:ROL blk+6

450 PLA:INX:CPX #5:BCC Lp3

460 ROR A:CPX #5:BEQ Lp3

470 INY:CPY #10:BNE Lp2 :\ Loop for ten characters

480 :

490 LDY #0:LDX #0

500 LDA #ASC"$":STA (zp),Y:INY :\ Put '$' prefix into output buffer

510 .Lp5

520 LDA blk+4,X:PHA:AND #&F

530 CLC:ADC #&41:STA (zp),Y:INY :\ Store low nybble as 'A'-'P'

540 PLA:LSR A:LSR A:LSR A:LSR A

550 CLC:ADC #&41:STA (zp),Y:INY :\ Store high nybble as 'A'-'P'

560 INX:CPX #3:BNE Lp5 :\ Loop for three bytes of key

570 PLA:LSR A:BCS exit :\ Exit if only one string to encrypt

580 :

590 LDA #ASC" ":STA (zp),Y:INY :\ Put ' ' seperator into output buffer

600 LDA #ASC"$":STA (zp),Y:INY :\ Put another '$' prefix into buffer

610 LDX #0

620 .Lp6

630 LDA txt,X:CMP #ASC"a":BCC Up :\ Get character from <oldpass>

640 CMP #ASC"{":BCS Up:AND #&5F :\ Force to upper case

650 .Up

660 EOR txt+11,X:EOR #&A5 :\ Encrypt with character from <newpass>

670 PHA:AND #&F

680 CLC:ADC #&41:STA (zp),Y:INY :\ Store low nybble as 'A'-'P'

690 PLA:LSR A:LSR A:LSR A:LSR A

700 CLC:ADC #&41:STA (zp),Y:INY :\ Store high nybble as 'A'-'P'

710 INX:CPX #10:BNE Lp6 :\ Loop for ten characters of <newpass>

720 :

730 .exit

740 LDA #13:STA (zp),Y:LDX #20 :\ Put terminating <cr> at end of output

750 .Lp7

760 STA txt,X:DEX:BPL Lp7 :\ Overwrite plaintext input string

770 LDX zp:LDY zp+1:LDA #0:RTS :\ Return A=0, XY=string

780 :

790 .end

800 EQUS "08Oct96-JGH"

810 :

820 ]NEXT

830 :

840 PRINT"*SAVE PWCode ";~mc%;" ";~end;" 0 0"

850 END

860 :

870 :

880 :

890 :

900 REM Demo of use with *I AM

910 REM ----------------------

920 :

930 DIM code% &FF,pw% 11 :REM Space for 10 characters plus <cr>

940 OSCLI"LOAD PWCode "+STR$~code%

950 INPUT"ID: "I$

960 ON ERROR PROCpw1 :REM Catch 'Wrong password' error

970 OSCLI"I AM "+I$ :REM Attempt logon with no password

980 END

990 :

1000 DEFPROCpw1:IFERR<>&BB:REPORT:PRINT" at line ";ERL:END

1010 ONERROR OFF

1020 INPUT"PW: "P$:P$=LEFT$(P$+" ",10)

1030 $pw%=P$ :REM Put string in buffer

1040 P$=STRING$(10,"*") :REM Wipe string

1050 X%=pw%:Y%=X%DIV256 :REM XY=>string

1060 A%=1:CALLcode% :REM Encrypt one string

1070 OSCLI"I AM "+I$+" "+$pw% :REM Do encrpted logon

1080 $code%=STRING$(255,CHR$0) :REM Wipe code

1090 END

1100 :

1110 REM Demo of use with *PASS

1120 REM ----------------------

1130 :

1140 DIM code% &100,pw% 31 :REM Encrypted string is 29 chars + <cr>

1150 OSCLI"LOAD PWCode "+STR$~code%

1160 INPUT"Old PW: "O$:O$=LEFT$(O$+" ",10)

1170 INPUT"New PW: "N1$:INPUT"New PW: "N2$

1180 IFN1$<>N2$:PRINT"Retype PW":END

1190 N1$=LEFT$(N1$+" ",10)

1200 $pw%=O$+" "+N1$ :REM Put string in buffer

1210 O$=STRING$(10,"*"):N1$=O$:N2$=O$ :REM Wipe strings

1220 X%=pw%:Y%=X%DIV256 :REM XY=>string

1230 A%=2:CALLcode% :REM Encode two strings

1240 OSCLI"PASS "+$pw% :REM Do encrpted password change

1250 $code%=STRING$(255,CHR$0) :REM Wipe code

1260 END