.Title DSF - Data Security Facility Main module .Ident 'DSF V4.1' ; .library /mar:always/ ; ; Program: DSF.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 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. ; $ssdef $climsgdef $rmsalldef $iodef $sfdef .psect dsf$$data,noexe,rd,wrt,noshr,pic ofab: $fab - nam = onam onam: $nam - esa = oesa,- ess = NAM$C_MAXRSS,- rsa = orsa,- rss = NAM$C_MAXRSS oesa: .blkb NAM$C_MAXRSS orsa: .blkb NAM$C_MAXRSS cliann: .ascid /LOG/ clicon: .ascid /CONFIRM/ cliins: .long cliind: .udesc cliinn: .ascid /INPUT/ clious: .long clioud: .udesc clioun: .ascid /OUTPUT/ tmpous: .long tmpout: .udesc actous: .long actout: .udesc nxists: .long 0 ffctx: .long 0 dfltou: .udesc ;place to construct default output name dfltin: .ascid /SYS$DISK:[].LIS/ annflg: .long 0 conflg: .long 0 subflg: .long 0 subp1: .quad subp2: .udesc subtxs: .long subtxt: .udesc ;place to reconstruct a key answes: .long 0 answer: .udesc ttchn: .long 0 sysin: .ascid /SYS$COMMAND/ capmsk: .long 0,^x06000008 ;trap ^Z, ^Y, ^C iniosb: .blkq cnfprm: .ascid /_Proceed [N]: / cnflen = 14 .psect dsf$$code,exe,rd,nowrt,shr,pic getout: movl clioud,clious clrw clioud pushaq clioun calls #1,G^CLI$PRESENT cmpl r0,#CLI$_PRESENT bneq 10$ movw clious,clioud pushaw clioud pushaq clioud pushaq clioun calls #3,G^CLI$GET_VALUE ;get /OUTPUT value blbs r0,10$ ret ;buzzoff the error backto DCL 10$: rsb getinp: movl nxists,r0 ;see if we've been here before beql 10$ ;nope... execute 'present?' call blbs r0,20$ ;go do more inputs rsb ;return ending failure status 10$: movl cliind,cliins ;save the descriptor pushaq cliinn calls #1,G^CLI$PRESENT cmpl r0,#CLI$_PRESENT beql 20$ cmpl r0,#CLI$_DEFAULTED beql 20$ $exit_s - code = #SS$_INSFARG 20$: movl cliins,cliind ;restore the descriptor pushaw cliind pushaq cliind pushaq cliinn calls #3,G^CLI$GET_VALUE ;get /INPUT value movl nxists,r1 ;save for test movl r0,nxists ;preserve this for later tstl r1 ;see if it's initial call bneq 30$ ;jump if not initial call blbs r0,30$ ;test for error ret ;return error to DCL 30$: rsb ;return to caller gen_input: ;construct a physical input filename ;simple doobie for now... just copy input... do rest later! movl actous,actout ;restore actual output descriptor movzwl tmpout,actout ;movl length pushr #^m ;save MOVCx trash movc3 actout,@tmpout+4,@actout+4 ;Zing! data copied popr #^m ;recover MOVCx trash rsb ;backtocaller getnxin: ;get next LIB$FIND_FILE input filename movl tmpous,tmpout ;restore descriptor clrl -(SP) ;place for STV of failures pushl #2 ;flags for FILE_SCAN = MULTIPLE pushal (SP) ;flags for FILE_FILE pushal 8(SP) ;STV from RMS failure clrl -(SP) ;no related spec pushaq dfltin ;default inputspec pushal ffctx ;context of call pushaq tmpout ;temp output descriptor pushaq cliind ;filename to find calls #7,g^LIB$FIND_FILE ;look for a file addl #4,SP ;remove flags argument popl r1 ;recover STV for errors movq r0,-(SP) ;save return status values blbc r0,10$ ;oops... need to fixup status stuff ; now we gotta jump into the context stuff to get the returned *LENGTH* movl ffctx,r0 ;point to FIND_FILE internal FAB movl FAB$L_NAM(r0),r0 ;jump thru it to the NAM movzbl NAM$B_RSL(r0),tmpout ;set tmpout length from internal NAM 10$: movq (SP)+,r0 ;recover status junk rsb ;return success ; following code: remove preceding 10$, and uncomment to activate... this code ; will cause DSF to ignore the 'last specified directory', and assume ; SYS$DISK:[] with each new ','-separated input file ;10$: pushaq ffctx ;prepare to blast this context ; calls #1,g^LIB$FIND_FILE_END ;blast context ; clrl ffctx ;indicate context is gone ; movq (SP)+,r0 ;recover status values ; rsb ;return the error! iniout: movb clioud,ofab+fab$b_fns ;output filename size movab @clioud+4,ofab+fab$l_fna;output filename address $parse - fab = ofab ;try to parse user output blbs r0,10$ ;contin processing if error pushl ofab+fab$l_stv ;secondary status value pushl r0 calls #2,g^LIB$STOP ret ;return any errors to DCL 10$: pushr #^m clrl r7 ;no output default string yet movab @dfltou+4,r6 ;target for output construction movaw onam,r8 ;point to output NAM block ; bbc #NAM$V_QUOTED,NAM$L_FNB(r8) .macro NAMCPY chk,itm,wld,?ll1 bbc #NAM$V_'chk',NAM$L_FNB(r8),ll1 ;skip it if not there .iif nb,,- bbs #NAM$V_'wld',NAM$L_FNB(r8),ll1 ;skip wild entities movzbl NAM$B_'itm'(r8),r9 ;len to copy movc3 r9,@NAM$L_'itm'(r8),(r6)[r7] ;copy to here addl r9,r7 ;increment output index ll1: .endm NAMCPY NAMCPY NODE,NODE NAMCPY EXP_DEV,DEV NAMCPY EXP_DIR,DIR,WILD_DIR NAMCPY EXP_NAME,NAME,WILD_NAME NAMCPY EXP_TYPE,TYPE,WILD_TYPE NAMCPY EXP_VER,VER,WILD_VER movl r7,dfltou popr #^m rsb tstsub: clrl subflg ;no substitution by default calls #0,g^dsf_cli_getkey ;get address of user keybuffer to r0 movq (r0),r6 ;copy descriptor to r6'r7 movl r0,r8 ;save a copy 10$: locc #^a/?/,r6,(r7) ;see if there's a '?' bneq 30$ ;test for substitution, '?' found 20$: rsb ;end substitution search 30$: cmpl r0,#1 ;is this the last char? beql 20$ ;yes... cannot substitute cmpl r0,#2 ;is this the next to last char? beql 20$ ;yes... cannot substitute movl #7,r2 ;prep UC/LC/IN/OUT switch to UC/IN cmpw 1(r1),#^a/I?/ ;look for UC 'F?'ilename beql 40$ decl r2 ;change to LC/IN (6) cmpw 1(r1),#^a/i?/ ;look for UC 'F?'ilename beql 40$ decl r2 ;change to UC/OUT (5) cmpw 1(r1),#^a/O?/ ;look for LC 'f?'ilename beql 40$ decl r2 ;change to LC/OUT (4) cmpw 1(r1),#^a/o?/ ;look for LC 'f?'ilename beql 40$ movab 1(r1),r7 ;point past '?' just found subl3 4(r8),r7,r6 ;new length brw 10$ ;continue search 40$: ; '?F?' or '?f?' found... chop up the user key movl r2,subflg ;set substitution flag (1=u, 0=l) subl3 4(r8),r1,subp1 ;length, part1 movl 4(r8),subp1+4 ;address, part1 subl3 #3,r0,subp2 ;length, part2 movc3 subp2,3(r1),@subp2+4 ;copy remainder (rest is unstable!) rsb ;pieces set up .entry start, ^m calls #0,g^dsf_cli_dohelp ;do the help flag if spec'd bsbw getout ;grab output override value bsbw iniout ;init the output default pushaq cliann calls #1,dsf_ask_cli ;return {neg,abs,pres} mnegl r0,r0 ;mapto {-1,0,1} -> {1,0,-1} ashl #-1,r0,r0 ;smash lowest bit: -> {0,0,-1} mnegl r0,r0 ;mapto {0,0,1} = {n,a,p} movl r0,annflg ;save result pushaq clicon calls #1,dsf_ask_cli mnegl r0,r0 ;mapto {-1,0,1} -> {1,0,-1} ashl #-1,r0,r0 ;smash lowest bit: -> {0,0,-1} mnegl r0,r0 ;mapto {0,0,1} = {n,a,p} movl r0,conflg ;save result clrl nxists ;no status of last CLI input call bsbw getinp ;grab an input parm blbs r0,30$ ;got one... continue 20$: ret ;return an error in R0 30$: movl tmpout,tmpous ;save descriptor contents for use later clrl ffctx ;FILE_FILE context init bsbw getnxin ;try to get initial input (from RMS) blbc r0,20$ ;get lost if error occurred movl actout,actous ;save descriptor contents for use later ; complete the DSF initialization calls #0,g^dsf_cli_init ;initialize CLI parms & DSF blbs r0,35$ ;init completed OK ret ; now, do checking of the user-provided key to see if the user wants filenames ; embedded in the key by default using '?F?, or ?F?'. 35$: bsbw tstsub ;test for substitution in key ;begin loop to print thru filenames 40$: bsbw gen_input ;generate current input file spec pushaw confirm ;confirm subroutine pushaq dfltou ;default override pushaq actout ;input filename calls #3,g^dsf_pass_file ;do the file pass blbs r0,50$ ret ;oops! 50$: bsbw getnxin ;try to get next input (from RMS) blbs r0,40$ ;continue processing w/next filename bsbw getinp ;try to get next input (from CLI) blbc r0,60$ ;terminate processing upon get_error bsbw getnxin ;try to get new next input (from RMS) blbs r0,40$ ;continue processing w/next filename ret ;die w/last FIND_FILE error 60$: movzwl #SS$_NORMAL,r0 ret ; generate upper & lower case translation tables... uctab: $$$tmp = 0 .rept 256 .if ne <<<$$$tmp-^x61>&^x100>\^x100> & <<$$$tmp-^x7B>&^x100> .byte $$$tmp\^x20 .iff .byte $$$tmp .endc $$$tmp = $$$tmp+1 .endr lctab: $$$tmp = 0 .rept 256 .if ne <<<$$$tmp-^x41>&^x100>\^x100> & <<$$$tmp-^x5B>&^x100> .byte $$$tmp\^x20 .iff .byte $$$tmp .endc $$$tmp = $$$tmp+1 .endr gen_pwd: ;generate a password if needed from the ?f? stuff tstl subflg ;see if substitution req'd bneq 10$ ;non-zero... must substitute rsb ;exit... no subs req'd 10$: movl subtxt,subtxs ;save subtxt size movzwl subp1,subtxt ;preset subtxt length movc3 subp1,@subp1+4,@subtxt+4 ;copy part1 movq subtxt,r0 ;get whole descriptor movzwl r0,r0 ;remove descrip stuff movab (r1)[r0],r2 ;target for movtc movab uctab,r3 ;translation table address bbs #0,subflg,20$ ;branch for uppercase movab lctab,r3 ;translation table address 20$: movq @12(AP),r6 ;r6'r7 describes input fname bbs #1,subflg,30$ ;keep input movq @16(AP),r6 ;r6'r7 describes output fname 30$: movtc r6,(r7),#0,(r3),r6,(r2) ;poof... copied & cased movzwl r6,r0 ;zap any descrip junk addl r0,subtxt ;calculate new length movq subtxt,r0 ;get whole descriptor movzwl r0,r0 ;remove descrip stuff movab (r1)[r0],r2 ;target for movtc movc3 subp2,@subp2+4,(r2) ;copy second piece addw subp2,subtxt ;set new text length pushaq subtxt calls #1,g^dsf_cli_setkey ;set new key movl subtxs,subtxt ;restore empty descriptor movc5 #0,#0,#0,subtxt,@subtxt+4 ;clear key rsb .entry confirm, ^m bsbw gen_pwd ;generate a password if needed movl answer,answes tstl conflg ;see if confirm enabled bneq 20$ tstl annflg ;see if annunciation enabled bneq 20$ 10$: movl answes,answer movl #1,r0 ;all is well... bugoff ret 20$: PRINTF ,4(AP) PRINTF ,8(AP) tstl conflg ;see if confirm enabled bneq 30$ brw 10$ 30$: movl answes,answer ; Note: ; It would be nice to do a simple INQUIRE macro here, but this presents ; serious problems if we need to use ^Y to abort it. I had code that would ; unwind the LIB$GET_INPUT call, but the read was still outstanding on the ; terminal. Then... when RMS ran down, it screwed up ^T. Consequently, if ; you want it done right, do it yourself! bsbw set_capt ;capture ^Y stuff pushaq answer ;set target for read pushaq cnfprm ;set prompt bsbw get_cnf ;get confirm bsbw clr_capt ;clear capture ^Y stuff cmpw answer,#0 beql 45$ ;default 'N' cmpw answer,#1 bneq 30$ bicb #^x20,@answer+4 cmpb @answer+4,#^a/Y/ ;see if user ok'd us bneq 40$ brw 10$ 40$: cmpb @answer+4,#^a/N/ ;see if user denied it bneq 50$ 45$: movl answes,answer clrl r0 ret ;allow it to go 50$: cmpb @answer+4,#^a/Q/ ;see if user quit beql 60$ brw 30$ 60$: PRINTF movl #SS$_OPRABORT,r0 ;return special code ret get_cnf: popl r0 ;rsb add popl r1 ;prm popl r2 ;buf pushl r0 ;rsb add movzwl (r1),(r1) ;remove any descrip junk movzwl (r2),(r2) ;remove any descrip junk $qiow_s - chan = ttchn, - func = #IO$_READPROMPT,- iosb = iniosb,- p1 = @4(r2),- p2 = (r2),- p5 = 4(r1),- p6 = (r1) blbc r0,10$ movzwl iniosb,r0 blbc r0,10$ movw iniosb+2,(r2) ;set read length rsb ;return data 10$: cmpl r0,#SS$_ABORT ;was this a cancel I/O? bneq 30$ ;kill all unknown errors movw #1,(r2) ;set 1-char reply movb #^a/Q/,@4(r2) ;poke in a 'Q' 20$: rsb 30$: pushl r0 calls #1,g^SYS$EXIT ;abort the program to see err capt_ast: .word 0 $cancel_s - chan = ttchn ;blow away the read ret set_capt: clrq -(SP) pushaw ttchn pushaq sysin calls #4,g^SYS$ASSIGN ;assign channel to sysin $qiow_s - chan = ttchn,- func = #IO$_SETMODE!IO$M_OUTBAND,- p1 = capt_ast,- p2 = #capmsk rsb clr_capt: $dassgn_s - chan = ttchn ;drop TT channel rsb .end start