machine m65816 case on string asis longa off longi off include 'OMM.equ' macro &l cstr &x &l dc.b &x, 0 endm macro native clc xce rep #$30 longa on longi on endm macro emulated sec xce longa off longi off endm macro &l bsr &x &l per @ok-1 brl &x @ok mend MACRO long &p1,&p2 lcla &bits &bits seta %00000000 ;&p1 setc &lc(&p1) ;&p2 setc &lc(&p2) if &p1='m' OR &p2='m' THEN &bits seta &bits+%00100000 longa on ENDIF if &p1='x' OR &p2='x' THEN &bits seta &bits+%00010000 longi on ENDIF IF &bits<>0 THEN rep #&bits ENDIF MEND MACRO short &p1,&p2 lcla &bits &bits seta %00000000 ;&p1 setc &lc(&p1) ;&p2 setc &lc(&p2) if &p1='m' OR &p2='m' THEN &bits seta &bits+%00100000 longa off ENDIF if &p1='x' OR &p2='x' THEN &bits seta &bits+%00010000 longi off ENDIF IF &bits<>0 THEN sep #&bits ENDIF MEND a1 equ $3c a2 equ $3e prmtbl equ $e0 lowtr equ $9b TXTPTR equ $b8 CHRGET equ $00b1 FRMNUM equ $dd67 GETADR equ $e752 CHKCLS equ $deb8 CHKOPN equ $debb CHKCOM equ $debe GETBYT equ $e6f8 SYNERR equ $dec9 WDM_ID equ $fe tkDATA equ $83 tkINPUT equ $84 tkTEXT equ $89 tkNEW equ $bf tkEND equ $80 tkVAL equ $e5 entry end entry native_parse_str1 entry native_parse_str2 proc proc hVERS dc.w $0000 hID dc.w 'hh' hSIZE dc.w end-start hORG dc.w start hAMPC dc.w amperct hKIND dc.w $0000 hRSRV1 dc.w $0000 hRSRV2 dc.w $0000 start cmp #MSG_AMPR ;ampersand call? beq do_ampr ;yes cmp #MSG_INFO ;get info string? beq do_info ;cmp #MSG_USER ;beq native_dispatch rts do_info lda a_info sta a1 lda a_info+1 sta a1+1 rts do_ampr ; & hash NEW numexpr ; & hash END ',' strvar ; & hash DATA ( numexpr, numexpr) ; & hash TEXT (strexpr) ; & hash '(' strexpr ')' ',' strvar ; & hash val (strexpr, strexpr), numvar ;jsr break ; can't pei since only want 1 byte. lda (TXTPTR) pha jsr CHRGET pla ldx #0 cmp #'(' beq @ok inx inx cmp #tkNEW beq @ok inx inx cmp #tkDATA beq @ok cmp #tkINPUT beq @ok inx inx cmp #tkTEXT beq @ok inx inx cmp #tkEND beq @ok inx inx cmp #tkVAL beq @ok jmp SYNERR @ok jmp (hash_table,x) hash_new ; todo -- use hash new(type),ok jsr CHKOPN jsr GETBYT stx type jsr CHKCLS stx prmtbl+0 stz prmtbl+1 bsr hash_native_init sta a1 ; return value. stz a1+1 lda (TXTPTR) cmp #',' beq @rw rts @rw jsr CHKCOM ldy #OMM_PUTWORD ldx #OMM_ID jmp OMMVEC hash_data jsr CHKOPN jsr FRMNUM jsr GETADR sty prmtbl+0 sta prmtbl+1 jsr CHKCOM jsr FRMNUM jsr GETADR sty prmtbl+2 sta prmtbl+3 bsr hash_native_data jmp CHKCLS hash_text jsr CHKOPN ldy #OMM_GETSTR ldx #OMM_ID jsr OMMVEC ; lowtr[0] = length, lowtr[1,2] = ptr lda lowtr+1 sta prmtbl+0 lda lowtr+2 sta prmtbl+1 lda lowtr sta prmtbl+2 stz prmtbl+3 bsr hash_native_data jmp CHKCLS hash_paren ; & hash ( type, strexpr ) , strvar jsr GETBYT stx type stx prmtbl+0 stz prmtbl+1 bsr hash_native_init jsr CHKCOM ldy #OMM_GETSTR ldx #OMM_ID jsr OMMVEC lda lowtr+1 sta prmtbl+0 lda lowtr+2 sta prmtbl+1 lda lowtr sta prmtbl+2 stz prmtbl+3 bsr hash_native_data jsr CHKCLS ; drop through... hash_end jsr CHKCOM ; buffer lda a_buffer sta lowtr+1 sta prmtbl+0 lda a_buffer+1 sta lowtr+2 sta prmtbl+1 ; length lda #64 sta prmtbl+2 stz prmtbl+3 ; call native to finish it... bsr hash_native_finish stz type lda prmtbl+2 ; length sta lowtr ldy #OMM_PUTSTR ldx #OMM_ID jmp OMMVEC hash_val ; &hash val(str1,str2),numvar ; validates a plaintext password against a hashed password. ; str1 = type $ salt $ hash ; str2 = plaintext ; returns 1 if & hash(type, salt+plaintext)=hash ;bsr break ; a1 used for return value (OMM_PUTWORD) stz a1 stz a1+1 jsr CHKOPN ldy #OMM_GETSTR ldx #OMM_ID jsr OMMVEC bsr native_parse_str1 jsr CHKCOM ldy #OMM_GETSTR ldx #OMM_ID jsr OMMVEC lda lowtr+1 sta prmtbl+0 lda lowtr+2 sta prmtbl+1 lda lowtr sta prmtbl+2 stz prmtbl+3 bsr native_parse_str2 jsr CHKCLS jsr CHKCOM ldy #OMM_PUTWORD ldx #OMM_ID jmp OMMVEC dc.b 0 * * immediate table * hash_table dc.w hash_paren dc.w hash_new dc.w hash_data dc.w hash_text dc.w hash_end dc.w hash_val a_info dc.w info a_buffer dc.w buffer dc.w 0 * * data * msb on info cstr '&SYSDATE Hash (KEGS) 1.0' msb off amperct cstr 'HASH' dc.b -1 type dc.w 0 export buffer buffer ds.b 64+2 hash_native_init native ldy #0 bra n hash_native_finish native ldy #2 bra n hash_native_data native ldy #1 ;bra n n ldx #'hh' lda #MSG_USER dc.b $42, WDM_ID emulated rts break brk $ea rts endp native_parse_str1 proc longa off longi off ; input - lowtr[0] = length, lowtr[1,2] = variable ptr. str equ lowtr+1 type equ prmtbl ldx lowtr native short m ldy #0 sty type tt @loop lda (str),y cmp #'$' beq @fini cmp #'0' blt @bad cmp #'9'+1 bge @bad ; type = type + a & 0x0f and #$0f pha lda type asl a ; x 2 sta type asl a ; x 4 asl a ; x 8 clc adc type adc 1,s sta type pla iny dex bne @loop @bad ldx #-1 ; length bra exit @fini long m iny ; skip '$' dex beq @bad phy phx ; save ; hash init ;lda type ;sta prmtbl lda #MSG_USER ldy #0 ldx #'hh' dc.b $42, WDM_ID ; ; now reset the string pointer. plx ; remaining pla ; processed clc adc str sta str sta prmtbl ldy #0 short m salt @loop lda (str),y cmp #'$' beq @fini iny dex bne @loop @bad ; terminate the hash session long m stz prmtbl ; type = 0 closes it. lda #MSG_USER ldy #0 ldx #'hh' dc.b $42, WDM_ID ldx #-1 bra exit @fini long m sty prmtbl+2 ; count iny dex ; bmi @bad would allow 0-length hash. beq @bad phy phx ; hash append the salt. lda #MSG_USER ldy #1 ldx #'hh' dc.b $42, WDM_ID ; copy the hash... plx ; remaining pla ; offset clc adc str sta prmtbl+4 exit stx a2 ; length / -1 on failure. emulated rts endp native_parse_str2 proc longa off longi off str equ lowtr+1 ldx lowtr ; length native bit a2 ; hash length bmi exit lda str sta prmtbl stx prmtbl+2 ; hash it lda #MSG_USER ldy #1 ldx #'hh' dc.b $42, WDM_ID ; and finish it per buffer pla sta prmtbl lda #64 sta prmtbl+2 lda #MSG_USER ldy #2 ldx #'hh' dc.b $42, WDM_ID lda prmtbl+2 ; actual size beq exit cmp a2 bne exit tay dey dey @loop lda (prmtbl),y cmp (prmtbl+4),y bne exit dey dey bpl @loop lda #1 sta a1 exit emulated rts endp end proc endp end