.Title DSFSUB - Data Security Facility Subroutines .Ident 'DSFSUB V4.1' ; .library /mar:always/ ; ; Program: DSFSUB.MAR V4.1 ; ; Author: David G. North, CCP ; 1333 Maywood Ct ; Plano, Texas 75023-1914 ; (214) 902-3957 ; ; Date: 90.11.16 ; ; Revisions: ; Who Date Description ; D.North 901116 DECUS release (V4.0) ; D.North 911105 Bug in algorithm prevented all stream data-chaining ; -Since bug repair globally affects encryption, fix is ; -via a '/CHAIN' switch (can be set default in CLD). ; D.North 911105 HELP report changed ; D.North 911113 DECUS release (V4.1) ; ; License: ; Ownership of and rights to these programs is retained by the author(s). ; Limited license to use and distribute the software in this library is ; hereby granted under the following conditions: ; 1. Any and all authorship, ownership, copyright or licensing ; information is preserved within any source copies at all times. ; 2. Under absolutely *NO* circumstances may any of this code be used ; in any form for commercial profit without a written licensing ; agreement from the author(s). This does not imply that such ; a written agreement could not be obtained. ; 3. Except by written agreement under condition 2, source shall ; be freely provided with all binaries. ; 4. Library contents may be transferred or copied in any form so ; long as conditions 1, 2, and 3 are met. Nominal charges may ; be assessed for media and transferral labor without such charges ; being considered 'commercial profit' thereby violating condition 2. ; ; Warranty: ; These programs are distributed in the hopes that they will be useful, but ; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ; or FITNESS FOR A PARTICULAR PURPOSE. ; $chfdef $dvidef $iodef $libdef $rmsdef $ssdef ; Formatted LOG print routine using SIGNAL .MACRO LOGF msgnam,- V1,V2,V3,V4,V5,V6,V7,V8,V9,V10,- ?L_$$L2,?L_$$L3 .save_psect local_block .if ndf,DBG_SIGCODE .save_psect .psect _DBG_CODE,shr,rd,nowrt,exe DBG_SIGCODE: .entry STD_HANDLER, ^m ;standard condition handler movl CHF$L_SIGARGLST(AP),r4 ;get address of signal array cmpl CHF$L_SIG_NAME(r4),#SS$_UNWIND ;was this an unwind signal? beql cont ;SS$_CONTINUE an $UNWIND cmpl CHF$L_SIG_NAME(r4),#SS$_DEBUG ;was this a debug signal? beql resig ;resignal SS$_DEBUG pushab cont ;assume a continuable signal blbs CHF$L_SIG_NAME(r4),10$ ;signal is continuable movab unwind,(SP) ;set target to unwind to caller 10$: $PUTMSG_S - msgvec = @CHF$L_SIGARGLST(AP) rsb ;return to post-processing return: ret ;exit STD_HANDLER cont: movzwl #SS$_CONTINUE,r0 ;continue from exception brb return ;exit handler resig: movzwl #SS$_RESIGNAL,r0 ;resignal exception brb return ;exit handler unwind: movl CHF$L_MCHARGLST(AP),r5 ;get mechanism list address bisl #STS$M_INHIB_MSG,CHF$L_SIG_NAME(r4) ;force silence if exit movl CHF$L_SIG_NAME(r4),CHF$L_MCH_SAVR0(r5) ;copy signal name $UNWIND_S ;unwind to caller brb return ;exit handler .restore_psect .endc tstl logflg bneq L_$$L2 brw L_$$L3 L_$$L2: pushl (FP) movq r0,-(SP) DBG_K_ACNT = 2 .irp faoarg,<,,,,,,,,,> .if nb, pushl faoarg DBG_K_ACNT = DBG_K_ACNT + 1 .endc .endr movaw STD_HANDLER,(FP) ;set condition handler .extrn DSF_'msgnam pushl #DBG_K_ACNT;-2 ;numargs passed pushl #DSF_'msgnam calls #DBG_K_ACNT,g^LIB$SIGNAL movq (SP)+,r0 popl (FP) L_$$L3: $$$dot = . .restore_psect . = $$$dot .ENDM LOGF ; Branch (Word) on low bit clear .MACRO BLBCW - SRC,DST,?LCL BLBS SRC,LCL BRW DST LCL: .ENDM BLBCW ; Branch (Word) on low bit set .MACRO BLBSW - SRC,DST,?LCL BLBC SRC,LCL BRW DST LCL: .ENDM BLBSW .psect dsf$$data,noexe,rd,wrt,noshr,pic ; AUTODIN-II polynomial table used by CRC algorithm AUTODIN: .LONG ^O00000000000,^O03555610144,^O07333420310,^O04666230254 .LONG ^O16667040620,^O15332650764,^O11554460530,^O12001270474 .LONG ^O35556101440,^O36003711504,^O32665521750,^O31330331614 .LONG ^O23331141260,^O20664751324,^O24002561170,^O27557371034 rcsum: .long orcsum: .long rcnt: .long ocnt: .long ifile_fab: $fab fac = ,- ;read-only xab = ifile_xab,- ;stuff for last_block,eof_byte nam = ifile_nam ;nam blk for input file display ifile_rab: $rab fab = ifile_fab,- ;address of fab rhb = rhb_buffer,- ;specified for accurate copy mbf = 2,- ;Use multi-buffer 2 ubf = file_buffer1,- ;address of record buffer usz = file_buffer_size1 ;size of record buffer ifile_xab: $xabfhc ifile_nam: $nam - esa = inesa,- ess = NAM$C_MAXRSS,- rsa = inrsa,- rss = NAM$C_MAXRSS ofile_fab: $fab fac = ,- ;read-write fop = ,- ;max version number & create rat = ,- ;add cr's for type nam = ofile_nam ;nam blk for output file display ofile_rab: $rab fab = ofile_fab,- ;address of fab rhb = rhb_buffer,- ;specified for accurate copy mbf = 2 ;Use multi-buffer 2 ofile_nam: $nam - esa = ouesa,- ess = NAM$C_MAXRSS,- rsa = oursa,- rss = NAM$C_MAXRSS ouesa: .blkb NAM$C_MAXRSS oursa: .blkb NAM$C_MAXRSS inesa: .blkb NAM$C_MAXRSS inrsa: .blkb NAM$C_MAXRSS header_record: ;dup label for file_buffer1 file_buffer1: .blkb 2048 ;2048 byte == record max * 2 file_buffer_size1 = . - file_buffer1 ;calculate size of buffer rhb_buffer: .blkb 128 ;128 max fixed header size help: .ascid - ~DSF V4.1 ©1991, D_North, CCP!/!/~- ~Usage is: DSF [/OUTPUT=][/FORWARDS+][/BACKWARDS*+]-!/~- ~ [/HIGH_SECURITY*+][/BLOCK[={NOHEADER|[NO]AUTOMATIC*}]]-!/~- ~ [/METHODS={ALL|DES|PRIVATE*}][/INVERTED+][/[NO]CHAIN*]-!/~- ~ [/LOG*+][/ANNUNCIATE*+][/CONFIRM+]-!/~- ~ []~ faobuf: .udesc <512> cliopt: .ascid /METHODS/ cliall: .ascid /METHODS.ALL/ clides: .ascid /METHODS.DES/ clilcl: .ascid /METHODS.PRIVATE/ clihen: .ascid /HELP/ clihex: .ascid /HEX/ clihin: .ascid /HIGH_SECURITY/ clichn: .ascid /CHAIN/ clilon: .ascid /ANNUNCIATE/ clibln: .ascid /BLOCK/ cliblh: .ascid /BLOCK.NOHEADER/ clibla: .ascid /BLOCK.AUTOMATIC/ clifon: .ascid /FORWARDS/ cliban: .ascid /BACKWARDS/ cliivn: .ascid /INVERTED/ clifod: .long 0 cliken: .ascid /KEY/ savked: .long cliked: .udesc savkev: .long clikev: .udesc blktx: .ascid /block/ ublktx: .ascid /Block/ rectx: .ascid /record/ urectx: .ascid /Record/ umodtx: .long urectx modtx: .long rectx ftable: .blkb 256 btable: .blkb 256 high: .long 0 chain: .long 0 eofblk: .long 0 eofbyt: .long 0 invflg: .long 0 desflg: .long 0 lclflg: .long 0 hexflg: .long 0 logflg: .long 0 blkflg: .long 0 cr: .byte ^x0d sysin: .ascid /SYS$INPUT/ inchn: .long iniosb: .quad isatty: .long isttyl: .long !4,isatty,0,0 kverr: .ascid /Key verification error/<^x0d><^x0a> keyprm: .ascii /_Key: / kplen: .long 6 verprm: .ascii /_Verification: / vplen: .long 15 MULT = 31415989 ;(a) OFFS = 27182819 ;(c) MODU = 2147483647 ;(m) - X1 = (aX0+c) MOD m MUNG = 2047 ;Number of munge operations on the table ISEED = 41238 ;Initial seed value seed: .long ISEED ;starting seed (This is Xn and is updated in RAND) .psect dsf$$code,exe,rd,nowrt,shr,pic ;++ ; ** Generate next random number in sequence (note JSB entry) ;-- rand: pushr #^m mull3 seed,#MULT,r0 ;multiply addl #OFFS,r0 ;add in the offset clrl r1 ;Make into quadword ediv #MODU,r0,r0,seed ;Put remainder in SEED popr #^m ;restore registers rsb ;++ ; ** GENTBL - Generate randomized translation tables ;-- _gen1: clrl r1 ;Initialize count 10$: movzbl seed,r2 ;Get first swap index jsb rand ;Set new random movzbl seed,r3 ;Get second swap index jsb rand ;Set new random movb l^btable(r2),r4 ;swap step 1 movb l^btable(r3),l^btable(r2) ;swap step 2 movb r4,l^btable(r3) ;swap step 3 aoblss #MUNG,r1,10$ ;Do MUNG swaps rsb ;return gentbl: LOGF GENTBL jsb rand ;Initial randomize clrl r1 ;Initialize counter 10$: movb r1,l^btable(r1) ;Initialize table to 0-255 aoblss #256,r1,10$ ;256 times jsb _gen1 ;Flop us up good #1 clrl r1 ;Initialize counter 20$: xorb #^x0a6,l^btable(r1) ;Flip bits in all of table aoblss #256,r1,20$ ;256 times jsb _gen1 ;Flop us up good again clrl r1 ;Initialize counter 30$: xorb #^x31,l^btable(r1) ;Flip more bits in all of table movzbl l^btable(r1),r2 ;Get source byte movb r1,l^ftable(r2) ;Setup reverse trans table aoblss #256,r1,30$ ;256 times rsb ;return ;++ ; ** Bit scrambler routine ;-- .entry bitscr, ^m subl2 #4,sp clrl r4 movb 4(ap),r6 movzbl r6,r5 bsym.1: ashl r4,#1,r3 mcoml r5,r0 bicl3 r0,r3,r0 beql bsym.2 movzbl 8(ap),r2 ashl r4,#3,r1 mcoml r1,r1 mcoml r1,r1 bicl3 r1,r2,r1 mcoml r3,r3 bicl3 r3,r2,r3 ashl #1,r3,r0 bisl2 r0,r1 ashl r4,#2,r0 mcoml r2,r2 bicl3 r2,r0,r2 extzv #1,#31,r2,r0 bisb3 r0,r1,8(ap) bsym.2: aobleq #6,r4,bsym.1 movzbl 8(ap),r0 ret ;++ ; ** Do some XOR and bitshifts ;-- .entry xorp, ^m subl2 #4,sp xorb3 8(ap),4(ap),r0 movzbl r0,r1 bicl3 #-4,12(ap),r0 ashl #1,r0,r0 xorl2 r0,r1 bicl3 #-6,16(ap),r0 xorb3 r0,r1,8(ap) movzbl 8(ap),r0 ret ;++ ; ** FTRANS - forward translation phase ;-- ftrans: pushr #^m movtc r0,(r1),#0,ftable,r0,(r1) popr #^m rsb ;++ ; ** Bit unscrambler routine ;-- .entry ubitscr, ^m subl2 #4,sp movl #7,r4 movb 4(ap),r6 movzbl r6,r5 usym.1: ashl r4,#1,r3 mcoml r5,r0 bicl3 r0,r3,r0 beql usym.2 movzbl 8(ap),r2 ashl r4,#3,r1 mcoml r1,r1 mcoml r1,r1 bicl3 r1,r2,r1 mcoml r3,r3 bicl3 r3,r2,r3 ashl #1,r3,r0 bisl2 r0,r1 ashl r4,#2,r0 mcoml r2,r2 bicl3 r2,r0,r2 extzv #1,#31,r2,r0 bisb3 r0,r1,8(ap) usym.2: sobgeq r4,usym.1 movzbl 8(ap),r0 ret ;++ ; ** UnDo some XOR and bitshifts ;-- .entry uxorp, ^m<> subl2 #4,sp movzbl 8(ap),r1 bicl3 #-6,16(ap),r0 xorl2 r0,r1 bicl3 #-4,12(ap),r0 ashl #1,r0,r0 xorl2 r0,r1 movzbl 4(ap),r0 xorb3 r0,r1,8(ap) movzbl 8(ap),r0 ret ;++ ; ** BTRANS - backward translation phase ;-- btrans: pushr #^m movtc r0,(r1),#0,btable,r0,(r1) popr #^m rsb open_ifile: tstl blkflg beql 10$ bisb #FAB$M_BIO,ifile_fab+fab$b_fac ;set block I/O movw #512,ifile_rab+rab$w_usz ;set block size I/O 10$: $open fab = ifile_fab ;open file blbc r0,20$ ;go on if ok $connect - rab = ifile_rab ;connect an access stream blbc r0,20$ ;go on if ok tstl blkflg ;see if block decrypt beql 20$ ;not block... skipit extzv #3,#1,hexflg,r1 ;get 'decrypt' flag beql 20$ ;not a decrypt operation bsbb 30$ ;do block header acquire 20$: rsb ;back to caller 30$: bbc #0,blkflg,20$ ;spec'd noheader jsb get_lin ;grab a block (may be in HEX) rsb ;may have to 'undo' this later open_ofile: tstl blkflg ;is this blockmode? beql 10$ ;nope... do default stuff movab ifile_fab,r0 ; input file fab addr movab ofile_fab,r1 ; output file fab addr movl fab$l_alq(r0),fab$l_alq(r1) ; ... size in blks movw fab$w_deq(r0),fab$w_deq(r1) ; ... default extension qty movb fab$b_fsz(r0),fab$b_fsz(r1) ; ... fixed header size movw fab$w_mrs(r0),fab$w_mrs(r1) ; ... max record size movb fab$b_rat(r0),fab$b_rat(r1) ; ... record attributes movb fab$b_rfm(r0),fab$b_rfm(r1) ; ... record format bsbb 30$ ;yep... do rab_setup stuff 10$: $create fab = ofile_fab ;create file blbc r0,20$ ;skip out if died! $connect - rab = ofile_rab ;connect an access stream blbc r0,20$ ;skip out if died! tstl blkflg ;is this blockmode? beql 20$ ;nope... do default stuff bsbw 70$ ;yep... do post block stuff 20$: rsb ;back to caller 30$: bisb #FAB$M_BIO,ofile_fab+fab$b_fac ;set block I/O extzv #3,#1,hexflg,r1 ;get 'decrypt' flag bneq 40$ ;do decrypt operation brw 50$ ;do encrypt operation 40$: bbc #0,blkflg,20$ ;spec'd noheader pushr #^m ;these get tromped mnegl #-1,r0 ;prepare to CRC header crc AUTODIN,r0,#512-8,header_record ;do a check AUTODIN II CRC popr #^m ;these get tromped cmpl r0,header_record+512-4 ;is CRC the same?? beql 45$ ;valid CRC, header assumed bbc #1,blkflg,48$ ;spec'd header... issue error mnegl header_record+512-4,r0 ;get hdr CRC lword xorl header_record+512-8,r0 ;see if 2 CRC format beql 48$ ;assume bad CRC then ; the assumption that this field will be non-zero is based on the another ; assumption that the encryption facility will produce essentially ; random output. this would imply a probability of 1:4294967296 that ; this field would be zero in the case of a /BLOCK=NOHEADER file. Since ; the user can override the /BLOCK=AUTO from the command line, this minimal ; risk is considered acceptable. tstl header_record+512-12 ;see if last data lword is 0 beql 48$ ;assume this won't be 0 movl #2,blkflg ;flag a noheader decl rcnt ;remove count for bogus header movl #1,ifile_rab+rab$l_bkt ;jumpit backto VBN 1 rsb ;flagged /AUTO=NOHEADER 45$: movab header_record,r0 ; header record addr movab ofile_fab,r1 ; output file fab addr ;wbwbbllw = 21211442 = 33146 = 3446 = 386 = 98 = 17 movw (r0)+,fab$w_deq(r1) ; ... default extension qty movb (r0)+,fab$b_fsz(r1) ; ... fixed header size movw (r0)+,fab$w_mrs(r1) ; ... max record size movb (r0)+,fab$b_rat(r1) ; ... record attributes movb (r0)+,fab$b_rfm(r1) ; ... record format movl (r0)+,fab$l_alq(r1) ; ... size in blks movl (r0)+,eofblk ;block of first non-alloc byte movzwl (r0)+,eofbyt ;bytenum of first non-alloc byte rsb ;decrypt outFAB setup 48$: LOGF CKSMERR ;kill the decrypt $exit_s - code = #SS$_BUGCHECK 50$: bbs #0,blkflg,51$ ;do only if not /block=nohead rsb ;bye! 51$: movab ifile_fab,r0 ; input file fab addr movab header_record,r1 ; header record addr movw fab$w_deq(r0),(r1)+ ; ... default extension qty movb fab$b_fsz(r0),(r1)+ ; ... fixed header size movw fab$w_mrs(r0),(r1)+ ; ... max record size movb fab$b_rat(r0),(r1)+ ; ... record attributes movb fab$b_rfm(r0),(r1)+ ; ... record format movl fab$l_alq(r0),(r1)+ ; ... size in blks movl ifile_xab+xab$l_ebk,(r1)+ ; EOF block number movw ifile_xab+xab$w_ffb,(r1)+ ; EOF block byte offset ;wbwbbllw = 21211442 = 33146 = 3446 = 386 = 98 = 17 pushr #^m movc5 #0,#0,#0,#512-17,(r1) ;blast header state to zeroes mnegl #-1,r0 ;prepare to CRC header crc AUTODIN,r0,#512-8,header_record ;do a check AUTODIN II CRC movl r0,header_record+512-4 ;set final CRC mnegl r0,header_record+512-8 ;set second CRC popr #^m movab ofile_fab,r1 ; output file fab addr movw #64,fab$w_mrs(r1) ; force to FIX 64 movb #FAB$C_FIX,fab$b_rfm(r1) ; force to FIX 64 bbc #2,hexflg,60$ ;see if 'output' is in hex ashl #1,fab$l_alq(r0),fab$l_alq(r1) ;mod size in blks up 60$: rsb ;encrypt outFAB setup 70$: extzv #3,#1,hexflg,r1 ;get 'decrypt' flag beql 80$ ;do encrypt operation 75$: rsb ;nothing special to do now... 80$: bbc #0,blkflg,75$ ;spec'd noheader movw #512,ifile_rab+rab$w_rsz ;setup block header write size movab header_record,ifile_rab+rab$l_rbf ;set header address jsb put_lin ;write w/current parms rsb setup_irab: moval ifile_rab,r6 movb #rab$c_seq,rab$b_rac(r6) ;sequential get (stream) clrl rab$l_rop(r6) ;clear before setting bits bisl #,rab$l_rop(r6) rsb setup_orab: moval ofile_rab,r6 movb #rab$c_seq,rab$b_rac(r6) ;sequential get (stream) clrl rab$l_rop(r6) ;clear before setting bits bisl #,rab$l_rop(r6) rsb get_lin: movaw g^SYS$GET,r1 ;address of target routine tstl blkflg ;is this block mode? beql 10$ ;nope... keep SYS$GET movaw g^SYS$READ,r1 ;address of target routine 10$: pushl r1 ;save a copy of target routine clrq -(SP) ;no AST routines pushal ifile_rab calls #3,(r1) ;call target routine clrl ifile_rab+rab$l_bkt ;in case we were rewound popl r1 ;retrieve target routine blbs r0,20$ ;no errors... continue... brw _eogln ;return errors to caller 20$: bbs #1,hexflg,30$ ;de-hexing needed 25$: brw _eogly ;return success & count item 30$: movzwl ifile_rab+rab$w_rsz,r0 ;get recordsize to decode beql 25$ ;skip the hex stuff to 0-len rec tstl blkflg ;is this block mode? beql 40$ ;nope... do dehex directly addl #512,ifile_rab+rab$l_ubf ;jmp to next blk buffer clrq -(SP) ;no AST routines pushal ifile_rab calls #3,(r1) ;call target routine subl #512,ifile_rab+rab$l_ubf ;jmp backto first blk buffer movzwl ifile_rab+rab$w_rsz,r0 ;get last read size addl #512,r0 ;add to total length to decode 40$: ;begin dehex here... r0 bytes at (ifile_rab+rab$l_ubf) ashl #-1,r0,r0 ;half the size pushr #^m clrl r1 ;byte/word decode in progress movl ifile_rab+rab$l_ubf,r2 ;address of I/O buffer 45$: movzwl (r2)[r1],r4 ;get working word subl #^x3030,r4 ;remove ^a/00/ bias extzv #8,#8,r4,r3 ;get low nybble bicl #^xffffff00,r4 ;mask to high nybble cmpl r3,#9 blequ 50$ subl #^x41-^x3a,r3 ;unbias ^a/A/ 50$: cmpl r4,#9 blequ 60$ subl #^x41-^x3a,r4 ;unbias ^a/A/ 60$: bisl3 r3,r4,r5 ;test for overflows bicl #^xf,r5 ;mask the obvious beql 70$ ;all is well LOGF HEXCORR $EXIT_S - code = #SS$_BUGCHECK 70$: ashl #4,r4,r4 bisl r3,r4 movb r4,(r2)[r1] aoblss r0,r1,80$ brb 90$ 80$: brw 45$ 90$: popr #^m movl ifile_rab+rab$l_ubf,ifile_rab+rab$l_rbf movw r0,ifile_rab+rab$w_rsz ;'fixup' the rsz & rbf _eogly: movl #1,r0 ;indicate a success incl rcnt tstb rcnt bneq _eogln LOGF SRCPROC,rcnt,modtx _eogln: rsb ;back to caller xtab: .ascii /0123456789ABCDEF/ put_lin: incl ocnt ;note output of block/record movw ifile_rab+rab$w_rsz,ofile_rab+rab$w_rsz ;get recordsize movl ifile_rab+rab$l_rbf,ofile_rab+rab$l_rbf ;get recordaddr bbc #2,hexflg,10$ bsbb 40$ ;hexify the output buffer! 10$: tstl blkflg beql 20$ cmpw ofile_rab+rab$w_rsz,#400 ;see if it's two blocks bneq 15$ incl ocnt ;note output of block/record 15$: $write - rab = ofile_rab brb 30$ 20$: $put - rab = ofile_rab 30$: rsb ;back to caller 40$: movzwl ofile_rab+rab$w_rsz,r0 ;get size beql 30$ ;don't need to hex an empty buf cmpl r0,#file_buffer_size1/2 ;see if it'll fit blequ 50$ LOGF HEXOVF $EXIT_S - code = #SS$_ABORT 50$: movl ofile_rab+rab$l_rbf,r1 ;get address of i/o buffer pushr #^m ;save used regs 60$: movzbl -1(r1)[r0],r2 ;get source byte ashl #-4,r2,r3 ;get hi nybble bicl #^xfffffff0,r2 ;save lo nybble only movb l^xtab(r2),r2 ;translate lo to char movb l^xtab(r3),r3 ;translate hi to char ashl #8,r2,r2 ;shiftup low bisl r3,r2 ;create output byte movw r2,-2(r1)[r0] ;write target word sobgtr r0,60$ ;do all buffer popr #^m ;get used regs ashl #1,r0,r0 ;double output size movw r0,ofile_rab+rab$w_rsz ;reset dbl size rsb .entry passfile, ^m moval ifile_fab,r6 ;prepare to butcher the FAB movq @4(AP),r7 ;load input descriptor movab (r8),fab$l_fna(r6) ;address of input name movb r7,fab$b_fns(r6) ;length of input name movb #NAM$C_MAXRSS,ifile_nam+nam$b_ess movb #NAM$C_MAXRSS,ifile_nam+nam$b_rss moval ofile_fab,r6 ;prepare to butcher the FAB movab (r8),fab$l_dna(r6) ;address of input name (dflt) movb r7,fab$b_dns(r6) ;length of input name (dflt) movq @8(AP),r7 ;load output descriptor movab (r8),fab$l_fna(r6) ;address of image name movb r7,fab$b_fns(r6) ;length of image name movb #NAM$C_MAXRSS,ofile_nam+nam$b_ess movb #NAM$C_MAXRSS,ofile_nam+nam$b_rss jsb open_ifile ;open and connect to file blbcw r0,exit_type ;ooooops jsb setup_irab ;set stuff in rab for jsb open_ofile ;open and connect to file blbcw r0,exit_type ;ooooops jsb setup_orab ;set stuff in rab for tstl 20(AP) ;is a callback requested? bneq 2$ ;do callback brw 5$ ;skip callback 2$: clro -(SP) ;space for two descriptors movaq (SP),r0 ;input descriptor movaq 8(SP),r1 ;output descriptor clro -(SP) ;space for another descriptor movaq (SP),r2 ;input name_only descriptor movaq 8(SP),r3 ;output name_only descriptor movb NAM$B_RSL+ifile_nam,(r0) ;input length movl NAM$L_RSA+ifile_nam,4(r0) ;input address movb NAM$B_RSL+ofile_nam,(r1) ;output length movl NAM$L_RSA+ofile_nam,4(r1) ;output address movb NAM$B_NAME+ifile_nam,(r2) ;input name_only length movl NAM$L_NAME+ifile_nam,4(r2) ;input name_only address movb NAM$B_NAME+ofile_nam,(r3) ;output name_only length movl NAM$L_NAME+ofile_nam,4(r3) ;output name_only address movq r2,-(SP) ;push both name_only args movq r0,-(SP) ;push both file args calls #4,@20(AP) ;call thru to callback routine addl #8*4,SP ;kill temp descriptors blbs r0,5$ ;callback said OK pushl r0 bisl #FAB$M_DLT,ofile_fab+FAB$L_FOP ;clear delete on close!!! $close - fab = ofile_fab ;blast it bicl #FAB$M_DLT,ofile_fab+FAB$L_FOP ;clear delete on close!!! $close - fab = ifile_fab ;drop it popl r1 ;retrieve callback status cmpl r1,#SS$_OPRABORT ;did user abort the operation? bneq 4$ $exit_s - code = r1 ;return R1 to DCL 4$: ret ;return to caller 5$: LOGF MODE,umodtx ;Log mode selected tstl desflg ;are we using DES? beql 10$ movq @12(AP),r0 ;get key descrip pushl r1 ;address of zero-filled key calls #1,g^setkey 10$: movzbl #^x5b,rcsum ;reset checksum movq @12(AP),r0 ;get key descrip clrl r2 20$: xorb (r1)[r2],rcsum ;calculate a flyer! aoblss r0,r2,20$ ;all key! tstl high beql encode LOGF HIGHSEC ;Annunciate high-security mull rcsum,seed ;Multiply checksum into seed xorb rcsum,seed+1 ;Flip some bits movl rcsum,orcsum ;Save 'old' running csum jsb gentbl ;Generate translation table encode: LOGF FILPAS lin_loop: jsb get_lin ;read a line blbc r0,exit_type_ok_eof ;ooooops (or out of records) movzwl ifile_rab+rab$w_rsz,r0 movl ifile_rab+rab$l_rbf,r1 ;build descriptor of record bicl #^xffff0000,r0 jsb @16(AP) ;changer passed in! movw r0,ifile_rab+rab$w_rsz ;put back modif'd length jsb put_lin ;dump to ofile blbc r0,exit_type ;ooooops brb lin_loop ;clear and try again exit_type_ok_eof: cmpl #RMS$_EOF,r0 ;see if RMS_EOF bneq exit_type ;not so... pass it on movl #SS$_NORMAL,r0 ;force to normal exit_type: pushl r0 ;save the return code $close fab = ifile_fab ;close the user file $close fab = ofile_fab ;close the user file LOGF CPLSRC,rcnt,modtx LOGF CPLDST,ocnt,modtx popl r0 ;don't care if close died ret ;backto caller fwdchngr: tstl lclflg beql 10$ bsbw fwdlcl 10$: tstl desflg beql 20$ bsbw fwddes 20$: rsb fwddes: pushr #^m extzv #0,#3,r0,r2 ;get 'overrun' count {0..7} beql 10$ ;no correction needed {0} tstl blkflg ;are we in block mode? beql 5$ ;no...do record processing movl #512,r0 ;force block boundary brb 10$ ;and do business as usual 5$: addl #8,r0 ;force 'roundup' bicl #7,r0 ;roll back downto even offset movb r2,-1(r1)[r0] ;save 'overrun' value incl r0 ;'odd' byte indicates overrun 10$: pushr #^m clrl r4 ;buffer counter is zero so far clrq -(SP) ;running CBC space movaq (SP),r7 ;point to it ashl #-3,r0,r5 ;# of quad DES ops to do ; r0r1 = inrec ; r4 = buffer counter ; r5 = number of quad DES ops to do ; (r7) -> running CBC 20$: movaq (r1)[r4],r8 ;point to 'work' (source) clrl r2 ;prep for 8 operations 30$: xorb (r7)[r2],(r8)[r2] ;xor tmp into work pre DES aoblss #8,r2,30$ ;do all 8 bytes in quad movq r0,-(SP) ;save r0'r1 pushaq (r8) ;address of 'work' area just dun calls #1,g^endes ;DES the block movq (SP)+,r0 ;restore r0'r1 movq (r8),(r7) ;update CBC aoblss r5,r4,20$ ;do whole buffer +overlap addl #8,SP ;remove CBC work area popr #^m ;restore r0/r1 popr #^m ;restore other regs used rsb ;Chaining routine - forward pass fchain: tstl high beql 10$ tstl chain beql 10$ xorb r9,r6 ;chain in the old checksum xorl3 r6,r8,r9 ;make a new 'old' checksum 10$: rsb fwdlcl: tstl high beql 10$ tstl chain beql 10$ tstl r0 ;see if there is data bneq 10$ incl orcsum rsb 10$: pushr #^m movq @12(AP),r2 clrq r4 movl rcsum,r8 ;running csum for XOR movl orcsum,r9 ;'old' running csum ; r0r1 = inrec ; r2r3 = key ; r4 = buffer counter ; r5 = key index counter fzapit: tstl high beql 10$ jsb rand 10$: movzbl (r1)[r4],r6 ;data byte movzbl (r3)[r5],r7 ;key byte addb r7,r8 ;stuff into checksum bicl #^x300,r8 ;zapto 8 bits bsbw fchain ;do chaining if appropos ; NOW! munge up r6 with r7 & r4 & r5 & r8 xorb r8,r6 ;munge #1 movq r0,-(sp) ;save pushl r4 pushl r5 pushl r6 pushl r7 calls #4,g^xorp ;Was a C routine tstl high beql 20$ xorb seed,r0 20$: pushl r0 ;result pushl r7 calls #2,g^bitscr ;Was a C routine movl r0,r6 ;result movq (sp)+,r0 ;restore movb r6,(r1)[r4] ;put back data byte aoblss r2,r5,30$ clrl r5 ;wrap key extzv #1,#7,r8,r8 ;downshift key xorb #38,r8 ;munge somemore 30$: aoblss r0,r4,fzapit movl r8,rcsum movl r9,orcsum popr #^m tstl high beql 40$ jsb ftrans 40$: rsb bckchngr: tstl desflg beql 10$ bsbw bckdes 10$: tstl lclflg beql 20$ bsbw bcklcl 20$: rsb bckdes: pushl r2 pushr #^m clrl r4 ;buffer counter is zero so far clrq -(SP) ;temp CBC space movaq (SP),r6 ;point to it clrq -(SP) ;running CBC space movaq (SP),r7 ;point to it ashl #-3,r0,r5 ;# of quad DES ops to do ; r0r1 = inrec ; r4 = buffer counter ; r5 = number of quad DES ops to do ; (r6) -> temp CBC ; (r7) -> running CBC 10$: movaq (r1)[r4],r8 ;point to 'work' (source) movq (r8),(r6) ;temp CBC movq r0,-(SP) ;save r0'r1 pushaq (r8) ;address of 'work' area just dun calls #1,g^dedes ;DES the block backards movq (SP)+,r0 ;restore r0'r1 clrl r2 ;prep for 8 operations 20$: xorb (r7)[r2],(r8)[r2] ;xor CBC into work post DES aoblss #8,r2,20$ ;do all 8 bytes in quad movq (r6),(r7) ;copy CBC temp to running aoblss r5,r4,10$ ;do whole buffer +overlap addl #16,SP ;remove CBC work area popr #^m ;restore other regs used extzv #0,#3,r0,r2 ;get 'overrun' count {0..7} beql 30$ ;no correction needed {0} bicl #7,r0 ;roll back downto even offset bicb3 #^xf8,-1(r1)[r0],r2 ;recover 'overrun' value subl #8,r0 ;remove 'extra' space addl r2,r0 ;add back legit overrun 30$: tstl blkflg ;in block mode? beql 40$ ;nope... don't try adjust addl3 #1,ocnt,r2 ;check on block in progress cmpl r2,eofblk ;is EOF in the block just dun? bneq 40$ ;nope... skipit movl eofbyt,r0 ;set new output length 40$: popl r2 rsb ;Chaining routine - backward pass bchain: tstl high beql 10$ tstl chain beql 10$ movl r9,r7 ;save current orcsum xorl3 r6,r8,r9 ;make a partial new 'old' checksum xorb r7,r6 ;chain in the old checksum 10$: rsb bcklcl: tstl high beql 10$ tstl chain beql 10$ tstl r0 ;see if there is data bneq 10$ incl orcsum rsb 10$: tstl high beql 20$ jsb btrans 20$: pushr #^m movq @12(AP),r2 clrq r4 movl rcsum,r8 ;running csum for XOR movl orcsum,r9 ;get 'old' running csum ; r0r1 = inrec ; r2r3 = key ; r4 = buffer counter ; r5 = key index counter bzapit: tstl high beql 10$ jsb rand 10$: movzbl (r1)[r4],r6 ;data byte movzbl (r3)[r5],r7 ;key byte addb r7,r8 ;stuff into checksum bicl #^x300,r8 ;zapto 8 bits ; NOW! munge up r6 with r7 & r4 & r5 & r8 movq r0,-(sp) ;save pushl r6 ;result pushl r7 calls #2,g^ubitscr ;Was a C routine tstl high beql 20$ xorb seed,r0 20$: pushl r4 pushl r5 pushl r0 pushl r7 calls #4,g^uxorp ;Was a C routine movl r0,r6 ;result movq (sp)+,r0 ;restore xorb r8,r6 ;unmunge #1 bsbw bchain ;do chaining if appropos movb r6,(r1)[r4] ;put back data byte aoblss r2,r5,30$ clrl r5 ;wrap key extzv #1,#7,r8,r8 ;downshift key xorb #38,r8 ;munge somemore 30$: aoblss r0,r4,bzapit movl r8,rcsum movl r9,orcsum popr #^m rsb ;++ ; Begin CLI parsing subroutines ;-- .entry dsf_ask_cli, ^m<> pushaq @4(AP) bsbb askcli ret askcli: popl r0 ;get RSB address popl r1 ;get address of target pushl r0 ;fixup RSB address pushaq (r1) ;address of target calls #1,G^CLI$PRESENT ;check CLI cmpl r0,#CLI$_PRESENT ;see if specified beql 10$ ; cmpl r0,#CLI$_DEFAULTED ;see if defaulted beql 10$ ; cmpl r0,#CLI$_NEGATED ;see if spec'd negated beql 20$ ; xorl r0,r0 ;set not present flag rsb ;backto caller 10$: movzbl #1,r0 ;set enabled flag rsb ;backto caller 20$: mnegl #1,r0 ;set negated flag rsb ;backto caller tsthlp: pushaq clihen ;see if there's a help flag bsbw askcli cmpl r0,#1 bneq 10$ ;no help! $fao_s - ctrstr = help,- outlen = faobuf,- outbuf = faobuf pushaq faobuf ;formatted text calls #1,G^LIB$PUT_OUTPUT ;print the stuff $exit_s - code = #SS$_NORMAL ;getlost 10$: rsb tstopt: clrl desflg movzbl #1,lclflg ;default operation pushaq cliopt ;see if there's an OPT flag bsbw askcli cmpl r0,#1 beql 5$ ;go process spec rsb ;and do not annunciate dflt 5$: clrl lclflg pushaq cliall ;see if there's an ALL flag bsbw askcli cmpl r0,#1 bneq 7$ movl #1,lclflg ;set /ALL flags movl #1,desflg brw 40$ 7$: pushaq clides ;see if there's a DES flag bsbw askcli cmpl r0,#1 bneq 10$ movb r0,desflg 10$: pushaq clilcl ;see if there's a PRIVATE flag bsbw askcli cmpl r0,#1 bneq 20$ movb r0,lclflg 20$: cmpl r0,#-1 bneq 30$ clrl lclflg 30$: bisl3 lclflg,desflg,r0 bneq 40$ LOGF NOMETH movl #SS$_INSFARG,r0 ret 40$: LOGF DFLTOVRD tstl lclflg beql 50$ LOGF PRIMTH 50$: tstl desflg beql 60$ LOGF DESMTH 60$: rsb tstlog: clrl logflg pushaq clilon bsbw askcli cmpl r0,#1 bneq 10$ movb r0,logflg 10$: rsb tstinv: clrl invflg pushaq cliivn bsbw askcli cmpl r0,#1 bneq 10$ incl invflg tstl desflg beql 10$ LOGF DESNSYM 10$: rsb tsthex: clrl hexflg pushaq clihex bsbw askcli cmpl r0,#1 bneq 10$ incl hexflg 10$: rsb tstblk: clrl blkflg pushaq clibln bsbw askcli cmpl r0,#1 ;is /BLOCK[=xxx] present? bneq 99$ movb #3,blkflg ;set blkflg=auto... go get dflts movaq ublktx,umodtx ;Set mode text movaq blktx,modtx ;Set mode text pushaq clibla ;BLOCK.[NO]AUTOMATIC bsbw askcli cmpl r0,#1 ;is /BLOCK=AUTO present? beql 10$ ;yes... already default op cmpl r0,#-1 ;is it negated? bneq 10$ ;keep default op (not spec'd) bicl #2,blkflg ;alter to /BLOCK 10$: pushaq cliblh ;BLOCK.NOHEADER bsbw askcli cmpl r0,#1 ;is /BLOCK=NOHEADER present? bneq 99$ ;no... keep what we got movl #2,blkflg ;set to /BLOCK=NOHEADER 99$: rsb tsthis: clrl high pushaq clihin bsbw askcli cmpl r0,#1 bneq 10$ movb r0,high 10$: rsb tstchn: clrl chain pushaq clichn bsbw askcli cmpl r0,#1 bneq 10$ movb r0,chain 10$: rsb getkey: movl cliked,savked movl clikev,savkev pushaq cliken calls #1,G^CLI$PRESENT cmpl r0,#CLI$_PRESENT bneq 10$ pushaw cliked pushaq cliked pushaq cliken calls #3,G^CLI$GET_VALUE ;get Key value blbsw r0,endkey ret ;return error to DCL 10$: $assign_s - devnam = sysin,- chan = inchn blbs r0,20$ ret 20$: $getdviw_s - chan = inchn,- iosb = iniosb,- itmlst = isttyl blbs r0,30$ ret 30$: movzwl iniosb,r0 blbs r0,40$ ret 40$: cmpl isatty,#DC$_TERM beql 80$ 50$: $DASSGN_S - chan = inchn pushaw cliked pushal keyprm pushaq cliked calls #3,G^LIB$GET_INPUT cmpl r0,#SS$_ENDOFFILE beql 60$ cmpl r0,#RMS$_EOF bneq 70$ 60$: movl #SS$_ABORT,r0 70$: blbsw r0,endkey ret 80$: movw #128,cliked movq cliked,r2 movzwl r2,r4 $qiow_s - chan = inchn,- func = #IO$_READPROMPT!IO$M_NOECHO,- iosb = iniosb,- p1 = (r3),- p2 = r4,- p5 = #keyprm,- p6 = kplen blbs r0,90$ ret 90$: movzwl iniosb,r0 movzwl iniosb+2,cliked blbs r0,100$ ret 100$: cmpw iniosb+4,#^x0d beql 110$ movl #SS$_ABORT,r0 ret 110$: $qiow_s - chan = inchn,- func = #IO$_WRITEVBLK,- p1 = cr,- p2 = #1 movw #128,clikev movq clikev,r2 movzwl r2,r4 $qiow_s - chan = inchn,- func = #IO$_READPROMPT!IO$M_NOECHO,- iosb = iniosb,- p1 = (r3),- p2 = r4,- p5 = #verprm,- p6 = vplen blbs r0,120$ ret 120$: movzwl iniosb,r0 movzwl iniosb+2,clikev blbs r0,130$ ret 130$: cmpw iniosb+4,#^x0d beql 140$ movl #SS$_ABORT,r0 ret 140$: cmpw cliked,clikev bneq 150$ cmpc3 cliked,@cliked+4,@clikev+4 bneq 150$ brb endkey 150$: pushaq kverr calls #1,G^LIB$PUT_OUTPUT brw 80$ endkey: pushr #^m movq clikev,r0 movl savkev,r0 bicl #^xffff0000,r0 movc5 #0,#0,#0,r0,(r1) ;blast verification key space movq cliked,r0 ;length of key as is movl savked,r2 ;sizeof buffer bicl #^xffff0000,r0 bicl #^xffff0000,r2 addl r0,r1 ;jump 'ok' data subl r0,r2 ;calculate length of junk movc5 #0,#0,#0,r2,(r1) ;blast trailing key space popr #^m rsb ;++ ; DSF_CLI_GETKEY - recover key value from DSF_CLI_INIT call ;-- .entry dsf_cli_getkey, ^m movaq cliked,r0 ;return address of clikey data ret ;++ ; DSF_CLI_SETKEY - set value of cliked ;-- .entry dsf_cli_setkey, ^m movq @4(AP),r0 ;point to passed in key movzwl r0,r0 ;zap descriptor junk movw r0,cliked ;set new length movc3 r0,(r1),@cliked+4 ;copy new key data bsbw endkey ;blow away trailing space ret ;++ ; DSF_CLI_DOHELP - check for /HELP switch first ;-- .entry dsf_cli_dohelp, ^m ;++ ; *** Process option flags affecting pre-processing steps ;-- bsbw tsthlp ;/HELP flag ret ;++ ; DSF_CLI_INIT - initialize DSF routines from CLI parameters ;-- .entry dsf_cli_init, ^m ;++ ; *** Process required parameters (INPUT/OUTPUT provided by caller!) ;-- bsbw getkey ;KEY parameter (or rqstd data) ;++ ; *** Process basic option flags ;-- bsbw tstlog ;/LOG flag bsbw tsthex ;/HEX i/o flag bsbw tstopt ;Options flags bsbw tstblk ;/BLOCK flag bsbw tsthis ;/HIGH_SECURITY flag bsbw tstchn ;/CHAIN flag bsbw tstinv ;/INVERTED flag ;++ ; *** Process /FORWARD & /BACKWARD ;-- movab fwdchngr,clifod pushaq clifon bsbw askcli cmpl r0,#1 beql 10$ bisl #8,hexflg ;indication of ***DECRYPTION*** movab bckchngr,clifod pushaq cliban bsbw askcli cmpl r0,#1 beql 10$ movl #SS$_INSFARG,r0 ret 10$: ;++ ; *** Re-Process setup for /INVERTED if needed ;-- tstl invflg beql 15$ movab fwdchngr,r0 xorl r0,clifod movab bckchngr,r0 xorl r0,clifod ;switched processors on ya! HA! 15$: ; *** now... must set/reset /HEX flags as needed bbc #0,hexflg,20$ ;no HEX options spec'd extzv #3,#1,hexflg,r0 ;get 'decrypt' flag xorb #1,r0 ;change to 'encrypt' flag incl r0 ;map to {1,2} --> {decry,encry} bbssi r0,hexflg,20$ ;set correct flag 20$: bbc #1,hexflg,30$ ;skip annun LOGF HEXIN 30$: bbc #2,hexflg,40$ ;skip annun LOGF HEXOUT 40$: movzwl #SS$_NORMAL,r0 ;prepare success code ret ;backto caller ;++ ; ; DSF_PASS_FILE - do enc/dec pass on filenames passed, w/set key ; ; Inputs: ; 04(AP) - Input filename - used as default for output ; 08(AP) - Output filename - overrides input for output name ; 12(AP) - Confirm callback - calling routine must say 'ok' (opt.) ;-- .entry dsf_pass_file, ^m clrw cliked+2 ;zap off descriptor junk clrl rcnt ;clear record counters clrl ocnt ;clear record counters movl #ISEED,seed ;setup initial seed value tstl desflg ;are we supposed to do DES? beql 10$ calls #0,g^desinit ;initialize DES tables 10$: clrl r0 cmpl (AP),#3 ;see if callback passed blssu 20$ movl 12(AP),r0 ;get callback address 20$: pushl r0 ;callback address to passfile pushl clifod pushaq cliked pushaq @8(AP) ;output filename descriptor pushaq @4(AP) ;input filename descriptor calls #5,G^passfile ;perform file pass ret .end