swcompat=0 ;tst$cap=0 nolic=0 no.inhd=1 .TITLE JTDmn ;JT driver open daemon & setup program .IDENT 'V004' ; Copyright (c) 1994 Glenn C. Everhart. All Rights Reserved. ;x$$$dt=0 ;knl dbg ; ; FACILITY: ; Provides servicing of security filtering, file moving, and so on ; for JTdriver. ; Note: This set of code only connects to JT: units and lets the actual ; work be done by HOL routines of some sort. ; Mods: ; 6/30/94 GCE - support 2K bitmap for kernel-marked files. This will let ; us mark basically EVERY file with an ACE in kernel mode as well as ; in ACEs so if someone deletes an ACE it won't drop protection. ; ; ; Note: define VMS$V5 to build for Version 5.x of VMS. VMS$V5=1 ; ; ; AUTHOR: ; ; G. EVERHART ; ; 04-Aug-1989 D. HITTNER Cleaned up definitions, added messages ; 29-Aug-1989 G. Everhart Added more flexible device geometry selection ; 01-Dec-1993 G. Everhart Build JTdriver misc. daemon ;-- .PAGE .SBTTL EXTERNAL AND LOCAL DEFINITIONS .LIBRARY /SYS$SHARE:LIB/ ; ; EXTERNAL SYMBOLS ; $dyndef $ADPDEF ;DEFINE ADAPTER CONTROL BLOCK $ATRDEF $CRBDEF ;DEFINE CHANNEL REQUEST BLOCK $DCDEF ;DEFINE DEVICE CLASS $DDBDEF ;DEFINE DEVICE DATA BLOCK $ddtdef ;define driver dispatch tbl .if df,step2 ddt$l_fdt=ddt$ps_fdt_2 .endc $DEVDEF ;DEFINE DEVICE CHARACTERISTICS $DPTDEF ;DEFINE DRIVER PROLOGUE TABLE $DVIDEF ;Symbols for $GETDVI service. $EMBDEF ;DEFINE ERROR MESSAGE BUFFER $FABDEF $FATDEF $pcbdef $acbdef $ccbdef $FIBDEF ;Symbols for file information block. $IDBDEF ;DEFINE INTERRUPT DATA BLOCK $IODEF ;DEFINE I/O FUNCTION CODES $IRPDEF ;DEFINE I/O REQUEST PACKET $NAMDEF $PRDEF ;DEFINE PROCESSOR REGISTERS $RMSDEF $SBDEF $SCSDEF $SSDEF ;DEFINE SYSTEM STATUS CODES $STSDEF ;Symbols for returned status. $TPADEF ;Symbols for LIB$TPARSE calls. $UCBDEF ;DEFINE UNIT CONTROL BLOCK .if df,step2 $fdt_contextdef $fdtargdef $fdtdef .endc $VECDEF ;DEFINE INTERRUPT VECTOR BLOCK $XABDEF ; ; UCB OFFSETS WHICH FOLLOW THE STANDARD UCB FIELDS ; DEFINE THESE SO WE KNOW WHERE IN THE UCB TO ACCESS. WE MUST ; SET THE ONLINE BIT OR CLEAR IT, AND ALSO SET ; UCB$HUCB (HOST UCB ADDRESS), UCB$HFSZ (HOST FILE SIZE), ; AND UCB$HLBN (HOST LOGICAL BLOCK NUMBER OF FILE START) ; $DEFINI UCB ;START OF UCB DEFINITIONS ;.=UCB$W_BCR+2 ;BEGIN DEFINITIONS AT END OF UCB .=UCB$K_LCL_DISK_LENGTH ;v4 def end of ucb ; USE THESE FIELDS TO HOLD OUR LOCAL DATA FOR VIRT DISK. ; Add our stuff at the end to ensure we don't mess some fields up that some ; areas of VMS may want. ; Leave thisfield first so we can know all diskswill have it at the ; same offset. ; ; $def ucb$l_hucbs .blkl 1 ;host ucb table ; ; Add other fields here if desired. ; $def ucb$l_exdmn .blkl 1 ;extend dmn pid $def ucb$l_exmbx .blkl 1 ;extend dmn mbx ucb $def ucb$l_deldmn .blkl 1 ;delete daemon pid $def ucb$l_delmbx .blkl 1 ;delete dmn mailbox ucb ; ; $def ucb$l_ctlflgs .blkl 1 ;flags to control modes ; ; $def ucb$l_prcvec .blkl 1 ;process local data tbl $def ucb$l_daemon .blkl 1 ;daemon pid for open daemon $def ucb$l_mbxucb .blkl 1 ;mailbox for input to daemon $def ucb$l_keycry .blkl 2 ;ucb resident "key" for ACEs ;use as part of authenticator ;for security-relevant fcns. ;auth=f(file id, key, priv-info), match ace and computed ;auth tag. $def ucb$l_cbtctr .blkl 1 ;how many extents $def ucb$l_cbtini .blkl 1 ;init for counter ; preceding 2 fields allow specifying of contig-best-try extents ; on every Nth extend, not every one. This should still help keep ; file extensions from preferentially picking up chaff $def ucb$JTcontfil .blkb 80 $def ucb$l_asten .blkl 1 ;ast enable mask store ; $DEF ucb$l_minxt .blkl 1 ;min. extent $def ucb$l_maxxt .blkl 1 ;max extent $def ucb$l_frac .blkl 1 ;fraction to extend by $def ucb$l_slop .blkl 1 ;slop blocks to leave free ; DDT intercept fields ; following must be contiguous. $def ucb$s_ppdbgn ;add any more prepended stuff after this $def ucb$l_uniqid .blkl 1 ;driver-unique ID, gets filled in ; by DPT address for easy following ; by SDA $def ucb$l_intcddt .blkl 1 ; Our interceptor's DDT address if ; we are intercepted $def ucb$l_prevddt .blkl 1 ; previous DDT address $def ucb$l_icsign .blkl 1 ; unique pattern that identifies ; this as a DDT intercept block ; NOTE: Jon Pinkley suggests that the DDT size should be encoded in part of this ; unique ID so that incompatible future versions will be guarded against. .if df,swcompat $def ucb$a_morestuff .blkl 10 ; 2 longs for flags, 8 for other stuff .endc $def ucb$s_ppdend $def ucb$a_vicddt .blkb ddt$k_length ; space for victim's DDT .blkl 4 ;safety $def ucb$l_backlk .blkl 1 ;backlink to victim ucb ; Make the "unique magic number" depend on the DDT length, and on the ; length of the prepended material. If anything new is added, be sure that ; this magic number value changes. .if ndf,swcompat magic=^xF013F000 + ddt$k_length + <256*> p.magic=^xF013F000 + ddt$k_length + <256*> .iff magic=^xF0070000 + ddt$k_length + <256*> p.magic=^xF0070000 + ddt$k_length + <256*> .endc .iif ndf,f.nsiz,f.nsiz=2048 .iif ndf,f.nums,f.nums=16 .iif ndf,f.nsiz,f.nsiz=2048 ucb$l_fnums: .blkw f.nums ;store for file numbers to inspect whether ;an ACE is there or not. $DEF UCB$L_JT_HOST_DESCR .BLKL 2 ;host dvc desc. ; ; Store copy of victim FDT table here for step 2 Alpha driver. ; assumes FDT table is 64+2 longs long (+ 2 more longs if 64bit) .if df,irp$q_qio_p1 $def ucb$l_myfdt .blkl <+4> ;user FDT tbl copy + slop for safety .iff $def ucb$l_myfdt .blkl 70 ;user FDT tbl copy + slop for safety .endc $def ucb$l_oldfdt .blkl 1 ;fdt tbl of prior fdt chain $def ucb$l_vict .blkl 1 ;victim ucb, for unmung check $def ucb$l_mungd .blkl 1 ;munged flag, 1 if numg'd $def ucb$l_exempt .blkl 4 ;exempt PIDs $def ucb$l_exedel .blkl 4 ;pids exempt from delete checks only $def ucb$l_ktrln .blkl 1 $def ucb$l_k2tnm .blkl 1 .if df,msetrp ; mousetrap trace cells $def mtp$fmt .blkl 1 ;mousetrap get into format $def mtp$irp .blkl 1 $def mtp$ldt .blkl 1 $def mtp$trace .blkl 1 $def mtp$ccb .blkl 1 $def mtp$chan .blkl 1 $def mtp$ior0 .blkl 1 $def mtp$r1 .blkl 2 ;findldt tst $def mtp$r0 .blkl 1 $def mtp$trc2 .blkl 1 $def mtp$trc3 .blkl 2 .endc $DEF UCB$K_JT_LEN .BLKW 1 ;LENGTH OF UCB ;UCB$K_JT_LEN=. ;LENGTH OF UCB $DEFEND UCB ;END OF UCB DEFINITONS ; TO SET ONLINE: ; BISW #UCB$M_ONLINE,UCB$W_STS(R5) ;SET UCB STATUS ONLINE ; Macro to check return status of system calls. ; .MACRO ON_ERR THERE,?HERE BLBS R0,HERE BRW THERE HERE: .ENDM ON_ERR ; Define LDT offsets here. ldt$l_fwd = 0 ;forward link. (LDTs are singly linked) ldt$l_ccb = 4 ;CCB address so we can check ID ldt$l_accmd = 8 ;accmd from user FIB (tells how open) ;(we'll use high bits for some added flags) ldt$v_opnchk = 31 ; open check bit. If set always check opens from ; this process while this file is open. We pass it ; here since this long is passed to jtdmn. ldt$m_opnchk = ^x80000000 ldt$v_runfcn = 30 ; if set, jtdmn may run some function at open. ldt$m_runfcn = ^x40000000 ldt$l_wprv = 12 ;working privs ldt$l_aprv = 20 ;auth privs ldt$l_bprio = 28 ;process base priority ldt$l_prcstr = 32 ;pointer to per-process delblk count block ldt$l_synch = 36 ;address of "iosb" block used to ;end process waits & deallocated at ;end of those waits. ldt$l_iosb = 40 ;iosb for internal $qio ldt$l_jtucb = 48 ;pointer to jt: ucb ldt$l_fresiz = 52 ;length of LDT left since we will chop ;off unused parts of ACE after we read ;it to regain pool ; Keep chnucb in "permanent" part of LDT since it hangs around till close ; if we do a softlink. It will be zero unless there is a softlink so ; it acts as a flag to restore the channel, too. ldt$l_chnucb = 56 ;original channel UCB address ldt$l_softf = 60 ;flag if nonzero that we have softlink ; Softlink V2 support: ; Add fields for softlinked directories so we can keep DID, original UCB ; and link-to UCB around. We need to note a file has this DID, a UCB same ; as the original UCB, to ensure we link it to the new UCB automatically. ; We will then check file characteristics initially and for directories ; will record these fields in softlinks. On open of any file we must ; then check all LDTs on the device for a directory softlink record. ; Where we find one, if the DID matches the FID of this file and the ; UCB matches the original UCB (ldt$l_chnucb), we must softlink the ; file by altering the device. We will not in this case record this ; unless this is another directory (it would be a subdirectory then) ; but will just alter channel and use counts. ; ; The tricky parts are: ; 1. Such an open will be on the chnucb device normally, not the ; softlinked-to device. That means we must search all JT UCBs ; and not just the one pointed to. (Only active ones need be ; searched.) All except the current one are candidates. ; 2. We have to get added info on all read-acl calls, namely the ; file characteristics. The io$_access can do this. The attribute ; block is ; .word atr$w_size (4) (atr$s_uchar) ; .word atr$w_type (atr$c_uchar) ; .address attribute ; ; fch$m_directory set => directory ; ; Note this can just be tacked after the read-acl block. ; ; We can get the file ID from our access. We get linked-to file ID ; from our softlink and will just assume a directory softlinks to a ; directory. The softlink setup code can enforce this. ; Thus on a directory link we do NOT have to catch the open after ; it finishes and before return to user. ; ; When we encounter a directory file that needs to be linked, ; however, we need to build a LDT for it (or rather keep the ; one we presumably have) and set it up as though it also came from the ; other disk...but we must not reset the channel on close ; there. ; ldt$l_dirfid = 64 ; file ID of directory linked to. ldt$l_dirucb = 72 ; UCB of link-to address ldt$l_chars = 76 ; (get this from link lookup) ldt$svdel=16 ; size of area from ldt$l_dirfid to here ldt$l_ace = 64+ldt$svdel ;start of our ACE, up to 256 bytes long ; chop off what's below here, as we need it no more after the file is open. ldt$l_regs = 320+ldt$svdel ;register save, r0 to r15 ldt$l_flgs = 432+ldt$svdel ;slop storage for flags ldt$l_parm = 436+ldt$svdel ;storage for up to 6 params (6 longs) ldt$l_fib = 456+ldt$svdel ;FIB we use for OUR I/O ; 72 bytes max for our FIB ldt$l_acl = 532+ldt$svdel ;storage for ACL read-in; 512 bytes ldt$l_itmlst = 1044+ldt$svdel ;item list to read the ACL all in if ;we can. ldt$l_aclsiz = 1076+ldt$svdel ;size of the ACL on the file ldt$l_rtnsts = 1080+ldt$svdel ;status back from daemon ldt$l_myfid = 1088+ldt$svdel ;file id from read-acl call ldt$l_mydid = 1096+ldt$svdel ;dir id in user's fib ldt$l_psl = 1104+ldt$svdel ;psl of original i/o ldt$l_fnd = 1112+ldt$svdel ;filename desc of orig i/o (p2 arg) ;2 longs ldt$l_fndd = 1120+ldt$svdel ;data area for filename (256 bytes) ldt$l_fdtctx = 1380+ldt$svdel ;save area for user's FDT context ptr ldt$l_size = 1392+ldt$svdel ldt$k_clrsiz = 1388+ldt$svdel ;allocate a little slop. ; ACE format: ;ace: .byte length ; .byte type = ace$c_info ;application ACE ; .word flags ;stuff like hidden, protected... ; .long info-flags ;use 1 bit to mean call the daemon ; .ascii /GCEV/ ;my identifier ; .blkb data ;up to 244 bytes of data. ; data is a variable length list of stuff. ; Codes are as follows: ; 00 - nothing. Terminates list. ; 01 - starts "inspectme" record. Nothing more. We send FID from the LDT ; in this case. This makes these real fast to forge. ; 02 - "moveme" record. Again we send FID from LDT and need nothing more. ; We use info from the daemon to find the actual file based ; on the file ID here. ; 03 - "bprio" record. Format: ; 03, prio, ;total 6 bytes ; 04 - "priv" record. Format: ; 04, ;total 17 bytes ; 05 - "ident" record, format: ; 05, ;total 17 bytes ; 06 - "softlink" record, format: ; 06, len, flgs, ;variable len ; flags for softlinks: ; 0 = normal ; 1 = softlink only on read, act like moveme record if r/w open ; 2 = directory file softlink, pass to daemon for special ; handling so we can pull the dir in. ; more flags later as I think of them. ; more types as needed too. ; ; ; .PSECT ADVDD_DATA,RD,WRT,NOEXE,LONG ; sj_arg: .LONG 2 ;2 ARGS: HOST-DVC NAME, VD DVC NAME .ADDRESS DEV_BUF_DESC .ADDRESS VDV_BUF_DESC ; KERNEL ARG LIST ; lla: .long 1 .address gotit gotit: .long 0 K_ARG: .LONG 4 ;4 ARGS: HOST-DVC NAME, VD DVC NAME .ADDRESS DEV_BUF_DESC .ADDRESS VDV_BUF_DESC .address mbx_buf_desc .address shfnm ;shared JT device name ; .ADDRESS DDFNM ; .ADDRESS VDFNM swpal: .long 2 .long 0,0 DEFAULT_DEVICE: .ASCID /SYS$DISK/ .align long LOSTACEM: .ASCID /%SAFETY-W-ACE expected but missing! Regenerate ACEs./ .ALIGN LONG mbx_BUF: ; Buffer to hold mbxice name. .BLKB 40 mbx_BUF_SIZ = . - mbx_BUF mbx_BUF_DESC: ; Descriptor pointing to mbxice name. .LONG mbx_BUF_SIZ .ADDRESS mbx_BUF fidcre: .long 0,0 ;file ID to return on create messages fiducb: .long 0 ;UCB to use on return or 0 .long 0,0,0 ;FID and DID, 2 6 byte objects together mPID: ; Owner of mbxice (if any). .BLKL 1 lpct: .long 0 ;scratch lclcap: .long 0 ;local capab mask dvl: .long 0 DESBLK: .LONG 0 .ADDRESS XITHDL ;EXIT HANDLER ADDRESS .long 0 .address dvl .LONG 0,0 ;REST OF EXIT HANDLER CONTROL BLK mbx_ITEM_LIST: ; mbxice list for $GETDVI. .WORD mbx_BUF_SIZ ; Make sure we a have a physical device name. .WORD DVI$_DEVNAM .ADDRESS mbx_BUF .ADDRESS mbx_BUF_DESC .WORD 4 ; See if someone has this device allocated. .WORD DVI$_PID .ADDRESS mPID .LONG 0 .WORD 4 .WORD DVI$_DEVCLASS ; Check for a terminal. .ADDRESS mbx_CLASS .LONG 0 .LONG 0 ; End if item list. mbx_CLASS: .LONG 1 ioprog: .long 0 ;i/o in progress flag nedast: .long 0 ;need skast flg mbchn: .long 0 ;chnl for mailbox to jtdriver vchn: .long 0 ;chnl used to open dvc nlchn: .long 0 nlucb: .long 0 nlccb: .long 0 fb.nam: .long 0 ;filename descr. addr fb.ldt: .long 0 ;ldt copy addr iosb: .long 0,0 xxiosb: .long 0,0 IOSTATUS: .BLKQ 1 BUFG: .long 1 ;bash flag .long 1000 ; DEV_BUF: ; Buffer to hold device name. .BLKB 40 DEV_BUF_SIZ = . - DEV_BUF busz=.-bufg DEV_BUF_DESC: ; Descriptor pointing to device name. .LONG DEV_BUF_SIZ .ADDRESS DEV_BUF PID: ; Owner of device (if any). .BLKL 1 DEV_ITEM_LIST: ; Device list for $GETDVI. .WORD DEV_BUF_SIZ ; Make sure we a have a physical device name. .WORD DVI$_DEVNAM .ADDRESS DEV_BUF .ADDRESS DEV_BUF_DESC .WORD 4 ; See if someone has this device allocated. .WORD DVI$_PID .ADDRESS PID .LONG 0 .WORD 4 .WORD DVI$_DEVCLASS ; Check for a terminal. .ADDRESS DEV_CLASS .LONG 0 .LONG 0 ; End if item list. DEV_CLASS: .LONG 1 ;** vbufg: .long 2 ;deassign bash flag. Deassign victim dvc, not JT: dvc. .long 1000 VDV_BUF: ; Buffer to hold VDVice name. .BLKB 40 VDV_BUF_SIZ = . - VDV_BUF vbusz=.-vbufg VDV_BUF_DESC: ; Descriptor pointing to VDVice name. .LONG VDV_BUF_SIZ .ADDRESS VDV_BUF VPID: ; Owner of VDVice (if any). .BLKL 1 VDV_ITEM_LIST: ; VDVice list for $GETDVI. .WORD VDV_BUF_SIZ ; Make sure we a have a physical device name. .WORD DVI$_DEVNAM .ADDRESS VDV_BUF .ADDRESS VDV_BUF_DESC .WORD 4 ; See if someone has this device allocated. .WORD DVI$_PID .ADDRESS VPID .LONG 0 .WORD 4 .WORD DVI$_DEVCLASS ; Check for a terminal. .ADDRESS VDV_CLASS .LONG 0 .LONG 0 ; End if item list. VDV_CLASS: .LONG 1 ;** DEFNAM: WRK: .BLKL 1 ;SCRATCH INTEGER ; DESCRIPTOR FOR VDn: "FILENAME" .ALIGN LONG VDFNM: .WORD 255. ;LENGTH VDFTP: .BYTE DSC$K_DTYPE_T ;TEXT TYPE .BYTE 1 ; STATIC STRING .ADDRESS VDFNMD VDFNMD: .BLKB 256. ; DATA AREA .align long wrkstr: .word 80 ;length .byte dsc$k_dtype_t ;text .byte 1 ;static .address wrkdat wrkdat: .blkb 20 .blkb 240 .byte 0,0,0,0 ;safety ; ; DESCRIPTOR FOR NODE$FWAN: DEVICE NAME .ALIGN LONG DDFNM: .WORD 255. ;LENGTH DDFTP: .BYTE DSC$K_DTYPE_T ;TEXT TYPE .BYTE 1 ; STATIC STRING DDFNA: .ADDRESS DDFNMD DDFNMD: .BLKB 256. ; DATA AREA DDCHN: .LONG 0 VDCHN: .LONG 0 ;CHANNEL HOLDERS P1DSC: .ASCID /UNIT/ P2DSC: .ASCID /FNAM/ frcdsc: .ascid /FRACTION/ ;fract. of file to extend by minds: .ascid /MINIMUM/ ;min extent maxds: .ascid /MAXIMUM/ ;max extent adods: .ascid /ALDEFONLY/ ;default-ext. mod only deads: .ascid /DEASSIGN/ ;deassign JT: from disk (turn off) cbtds: .ascid /CBT/ fcnds: .ascid /FCNMSK/ ;function control mask modds: .ascid /MODE/ shrdsc: .ascid /SHARE/ licdsc: .ascid /LICENSE/ insdsc: .ascid /INSTALL/ fnumds: .ascid /FILENUM/ ;file number to tag in knl mode ;(/filenum:fil.num) reads a list of ; file numbers off a separate file.) efnmds: .ascid /EXEMPT/ ; files exempt from EACF controls if ; seen as current image ; efnmds=sw name. exfnm, exfnd, exfnl=filename keyds: .ascid /KEY/ mfyds: .ascid /MODIFY/ ;switch NOT to loop,just change params nldsc: .ascid /NLA0:/ .align long ; DESCRIPTOR FOR exempt file-of-filenames EXFNM: .WORD 255 .BYTE DSC$K_DTYPE_T,1 .ADDRESS EXFND EXFND: .BLKB 256 EXFNL: .LONG 0 ; DESCRIPTOR FOR filenum file RWFNM: .WORD 255 .BYTE DSC$K_DTYPE_T,1 .ADDRESS RWFND RWFND: .BLKB 256 RWFNL: .LONG 0 .iif ndf,f.nums,f.nums=16 .iif ndf,f.nsiz,f.nsiz=2048 ;bytes of mask .iif df,wd.lst,f.nsiz=f.nums*2 maxnums=f.nsiz/2 fnmx: .long maxnums fnums: .blkw maxnums ;storage for file numbers fnumct: .long 0 ;no. filenums in store fn.arg: .long 4 ;4 args .address rwfnm ;rw filename arg .address fnums ;storage for file numbers .address fnmx ;size of file number array .address fnumct ;output count nums added ; share dvc desc. shfnm: .word 255 .BYTE DSC$K_DTYPE_T,1 .address shfnd shfnd: .blkb 256 shfnl: .long 0 ; UCB data area shrflg: .long 0 ;share flag, nonzero if using another JT data shucb: .long 0 ;shared jt ucb fcnmsk: .long 0 modmsk: .long 0 ;mode selection deafg: .long 0 cbtct: .long 1 ;/cbt:n contig best tries every n opens frac: .long 3 min: .long 10 max: .long 2000 adflg: .long 0 ;set flg if aldef only HSTUCB: .LONG 0 ;SERVED UCB ADDRESS VDUCB: .LONG 0 ;LOCAL JT UCB ADDRESS mbxucb: .long 0 ;mailbox ucb storage mfyflg: .long 0 ; ; ERROR: .LONG 2 MESS: .LONG SS$_ABORT .LONG 0 kyfnm: .word 255 .byte dsc$k_dtype_t,1 .address kyfnmd kyfnmd: .blkl 64 binkey: .long 0,0 ;binary key val for jt ucb .macro beqlw lbl,?lbl2 bneq lbl2 brw lbl lbl2: .endm .macro bneqw lbl,?lbl2 beql lbl2 brw lbl lbl2: .endm .macro bgtrw lbl,?lbl2 bleq lbl2 brw lbl lbl2: .endm .macro bleqw lbl,?lbl2 bgtr lbl2 brw lbl lbl2: .endm .macro bgeqw lbl,?lbl2 blss lbl2 brw lbl lbl2: .endm ; allocate does not zero its result area. .macro zapz addr,size pushr #^m ;save regs from movc5 movc5 #0,addr,#0,size,addr popr #^m ;save regs from movc5 .endm .if ndf,evax .macro .jsb_entry ; entry .endm .endc BUFHDR: .LONG 0,0,0,0,0 BUF: .BLKL 8192. ; DATA AREA fnbuf: .blkb 264 ; 256 bytes for filename + safety fnbufd: .word 0 ; length .byte 1 .byte dsc$k_dtype_t ;fixed text string .address fnbuf gcelit: .ascii /GCEV/ ;special literal rtnst: .long 0 ;return status ainbf: .blkb 4 ;hdr here .blkl 1 ;my "call dmn" flg or 0 gcetgt: .long 0 ;will be "GCEV" for my ACEs .blkl 224 ;data .blkl 8 ;safety fid: .long 0,0 ;file id scratch storage ; scratch FIB to read acl with an entry at a time myfib: .long fibfid: .blkw 3 ;fid fibdid: .blkw 3 ;did fibctx: .long 0 ;wc context .long 0 ;nmctl/exctl .long 0,0,0,0,0,0 fibacx: .long 0 ;acl context fibast: .long 0 ;acl status fibgst: .long 0 ;status myfibl=.-myfib-2 ;size ; descriptors for io$_access mf3tp1: .word 255 .word atr$c_addaclent .globl myfdsc myfdsc: mfdsc: .long myfibl .address myfib ;open by file id ; Itemlist to get old ace, delete it, add replacement one. myil3: .word 255 ;length of itemlist item .word atr$c_fndacetyp ;find ace .address uace ;of our type ; rest is ignored in io$_access, must use io$_modify to change ; so comment it out for here ;;myin2: .word 255 ;; .word atr$c_delaclent ;delete an acl entry... ;; .address uace ;namely the old one ;;; locs to zero if the ace is empty now (0 in byte 16) ;;mf3b1: .word 255 ;; .word atr$c_addaclent ;add new ace ;;mf3b2: .address mdace ;modified ace ; read file charact. too .word 4 ; fill 4 bytes .word atr$c_uchar .address filchr ; get file charact. .long 0,0 ;null terminate the list .long 0 uace: .blkb 256 ;copy of our ACE mdace: .blkb 256 fibwrk: .blkl 32 fibdsc: .long 128 .address fibwrk namdsc: .long 0 .address namtxt namtxt: .blkl 64 ; text of filename .blkl 8 ; safety filchr: .long 0 ; file characteristics .PSECT ADVDD_CODE,RD,NOWRT,EXE,LONG .ENTRY ADVDD,^M clrl adflg clrl deafg ;not deassign movl #1,cbtct ;contig best try every time movl #4,frac movl #10,min movl #2000,max pushab deads calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 100$ incl deafg 100$: ; Only emit the licensing msg once per boot. callg lla,g^loglatch tstl gotit bneq 1105$ calls #0,g^licmsg ;emit the user-licensed msg 1105$: clrl fnumct ;set no filenums yet .if ndf,nolic ; check /license and /install before testing if license is valid. ; Must be so to allow licenses to be entered. pushab licdsc ; /license specified? calls #1,g^cli$present cmpl r0,#cli$_present bneq 103$ calls #0,g^jtprtsyi ; print system information key ret 103$: pushab insdsc calls #1,g^cli$present ;/install:key specified? cmpl r0,#cli$_present bneq 104$ pushab wrk ;return length pushab wrkstr pushab insdsc ;/install:key VALUE wanted movw #255,wrkstr ; set string length as needed calls #3,g^cli$get_value ;get the key string given blbc r0,1103$ movw wrk,wrkstr pushab wrkstr ; pass value string calls #1,g^kgetks ; get key string now 1103$: ret 104$: calls #0,g^igetcap ; check the license system. Exit if no license. .iff ; no-license version. ; Just set all capabilities, doing so very early on. calls #0,g^setcap1 movl #-1,r0 .endc movl r0,lclcap pushab fnumds ;/filenum:file seen calls #1,g^cli$present cmpl r0,#cli$_present ;was switch there? bneq 82$ pushab rwfnl ;ret length longword pushab rwfnm ;scratch string pushab fnumds ;get value of filename calls #3,g^cli$get_value ;get value of lbn on_err fdhostd_Exit ;skip on error ; now rwfnm has value movw rwfnl,rwfnm ;set string length .if df,wd.lst callg fn.arg,g^getfnm ;go get the number list .iff callg fn.arg,g^getfnb ;go get the number list .endc ; 82$: ; efnmds=sw name. exfnm, exfnd, exfnl=filename pushab efnmds ;/exempt:file seen calls #1,g^cli$present cmpl r0,#cli$_present ;was switch there? bneq 182$ pushab exfnl ;ret length longword pushab exfnm ;scratch string pushab efnmds ;get value of filename calls #3,g^cli$get_value ;get value of lbn on_err fdhostd_Exit ;skip on error ; now rwfnm has value movw exfnl,exfnm ;set string length pushab exfnm ;push filename descriptor calls #1,g^getexf ;go load exempt filenames (if any) ; 182$: clrl shrflg pushab shrdsc ;/share:jtan: given? calls #1,g^cli$present cmpl r0,#cli$_present ;was switch there? bneq 821$ pushab shfnl pushab shfnm pushab shrdsc calls #3,g^cli$get_value ;get value of lbn on_err fdhostd_Exit ;skip on error movw shfnl,shfnm incl shrflg ;say we got switch now. 821$: ; contig best try pushab cbtds ;/cbt:nnn contig best try open every n tries calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 320$ pushab wrk ;ret len pushab wrkstr ;string pushab cbtds calls #3,g^cli$get_value blbc r0,320$ pushl #17 ;ign. blanks pushl #4 ;4 byte result pushab cbtct ;result in "cbtct" pushab wrkstr ;string calls #4,g^ots$cvt_tu_l ;convert to bin blbs r0,321$ 322$: movl #1,cbtct ;default val. if err brb 320$ 321$: tstl cbtct ;chk lims bleq 322$ cmpl min,#1000 ;max 1000 too bgtr 322$ 320$: ; get key value if any. clrq binkey clrl kyfnmd ;zero key info at first pushab keyds ;/key seen? calls #1,g^cli$present cmpl r0,#cli$_present ;got it? bneq 3220$ ;br if not pushab wrk ;key len pushab kyfnm ;key string loc pushab keyds ;and /key select calls #3,g^cli$get_value movw wrk,kyfnm ;save length in string pushab binkey+4 pushab binkey pushab wrk pushab kyfnm calls #4,g^getpv ;compute the key 3220$: ;/aldefonly pushab adods ;/aldefonly? calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 10$ incl adflg 10$: pushab frcdsc ;/frac:n (n = 1 to 1000 ok) calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 20$ pushab wrk ;ret len pushab wrkstr ;string pushab frcdsc ;/frac: desc calls #3,g^cli$get_value blbc r0,20$ pushl #17 ;ign. blanks pushl #4 ;4 byte result pushab frac ;result in "frac" pushab wrkstr ;string calls #4,g^ots$cvt_tu_l ;convert to bin blbs r0,21$ 22$: movl #4,frac ;return frac=1/4 if error brb 20$ 21$: tstl frac ;chk lims bleq 22$ cmpl frac,#1000 bgtr 22$ 20$: pushab fcnds ;/fcnmsk:nnnnnn calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 721$ pushab wrk ;ret len pushab wrkstr ;string pushab fcnds ;/fcnmsk:mask calls #3,g^cli$get_value blbc r0,721$ pushl #17 ;ign. blanks pushl #4 ;4 byte result pushab fcnmsk ;result in fcnmsk pushab wrkstr ;string calls #4,g^ots$cvt_tu_l ;convert to bin blbs r0,721$ 722$: clrl fcnmsk ;zero mask if none seen 721$: clrl mfyflg pushab mfyds ;/modify calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 6721$ incl mfyflg 6721$: ; get mode mask as a bunch of bits. clrl modmsk pushab modds ;/mode:nnnnnn calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 3721$ pushab wrk ;ret len pushab wrkstr ;string pushab modds ;/mode:nnnnn calls #3,g^cli$get_value blbc r0,3721$ pushl #17 ;ign. blanks pushl #4 ;4 byte result pushab modmsk ;result in modmsk pushab wrkstr ;string calls #4,g^ots$cvt_tu_l ;convert to bin blbs r0,3721$ 3722$: clrl modmsk ;zero mask if none seen 3721$: ; min pushab minds ;/min:nnn min alloc to use calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 120$ pushab wrk ;ret len pushab wrkstr ;string pushab minds calls #3,g^cli$get_value blbc r0,120$ pushl #17 ;ign. blanks pushl #4 ;4 byte result pushab min ;result in "min" pushab wrkstr ;string calls #4,g^ots$cvt_tu_l ;convert to bin blbs r0,121$ 122$: movl #10,min ;return min=10 if err brb 120$ 121$: tstl min ;chk lims bleq 122$ cmpl min,#1000 ;max 1000 too bgtr 122$ 120$: ; max clrl max pushab maxds ;/max:nnn max alloc to use calls #1,g^cli$present cmpl r0,#cli$_present ;there? bneq 220$ pushab wrk ;ret len pushab wrkstr ;string pushab maxds calls #3,g^cli$get_value blbc r0,220$ pushl #17 ;ign. blanks pushl #4 ;4 byte result pushab max ;result in "max" pushab wrkstr ;string calls #4,g^ots$cvt_tu_l ;convert to bin blbs r0,221$ 222$: clrl max ;return max=10000 if err ; max=0 means 1/32 of disk size. brb 220$ 221$: tstl max ;chk lims bleq 222$ cmpl max,#1000000 ;max 1000000 too bgtr 222$ 220$: PUSHAB WRK ;PUSH LONGWORD ADDR FOR RETLENGTH PUSHAB VDFNM ;ADDRESS OF DESCRIPTOR TO RETURN PUSHAB P1DSC ; GET P1 (FDn: UNIT) CALLS #3,G^CLI$GET_VALUE ;GET VALUE OF NAME TO VDFNM ON_ERR ADVDD_EXIT ; tstl deafg ;/deas? no need for 2nd file ; bneq 40$ PUSHAB WRK ; GET 2ND FILE (served unit) PUSHAB DDFNM ; & ITS DESCRIPTOR PUSHAB P2DSC ; & PARAMETER NAME 'P2' CALLS #3,G^CLI$GET_VALUE ; GET FNM ON_ERR ADVDD_EXIT $ASSIGN_S - ; Get a channel to the DEVNAM=DDFNM,- ; device for host file CHAN=DDCHN ON_ERR ADVDD_EXIT ; LET ERRORS BY FOR THIS SINCE WE GET OUR INFO VIA OPEN ANYWAY SO ; CHANNEL REALLY DOESN'T HAVE TO BE THERE. ; Get the physical device name, and see if this device has an owner. ; (We must do this so we can get the host UCB address) $GETDVI_S - CHAN=ddchn,- ; Command line has device name. ITMLST=DEV_ITEM_LIST BLBS R0,40$ BRW advdd_EXIT 40$: 290$: ; Keep a channel to nla0: around. We will bash its UCB ; pointer to other devices when we need channels to them so we need ; not continually assign & deassign channels. ; We do this so we can set vchn to the current unit when we get a ; message from some JT unit of work to do; we actually point at the ; host device with it (ucb address is in the msg to us) $assign_s devnam=nldsc,chan=nlchn ; MUST HAVE ASSIGNMENT TO VD: UNIT IN ANY CASE. $ASSIGN_S - DEVNAM=VDFNM,- ; GET CHANNEL FOR VDn: CHAN=VDCHN ON_ERR ADVDD_EXIT ; SKIP OUT IF ERROR $GETDVI_S - CHAN=vdchn,- ; Command line has device name. ITMLST=VDV_ITEM_LIST BLBS R0,140$ BRW advdd_EXIT 140$: ; Here do the real work in kernel mode, having now the device ; descriptions and channels to the devces even! tstl deafg ;if /deas, do $qio, then knl work bneqw 307$ ; Set up mailbox channel to get open daemon information $crembx_s prmflg=#0,chan=mbchn,maxmsg=#576,bufquo=#36864,- promsk=#0 On_ERR advdd_exit ; need to get UCB address here somehow... $GETDVI_S - CHAN=mbchn,- ; Command line has device name. ITMLST=mbx_item_list BLBS R0,176$ 161$: BRW advdd_EXIT 176$: ; Got now the actual device name of the mailbox ; Let the kernel call perform the UCB lookup for us. ; ; FOUND A UNIT. NOW DECLARE EXIT HANDLER TO CLEAN UP ; IF WE GET A $FORCEX TO TERMINATE THE HOST PROCESS. PUSHAB DESBLK ; ADDRESS OF DESBLK CALLS #1,G^SYS$DCLEXH ; DECLARE EXIT HANDLER ; NOW GET OUR PID FOR USE LATER. Also get other info and set our pid ; and mailbox addresses in JR: UCB as needed. ; blbc r0,775$ ;no delete inhibit if exit hdlr bad .if ndf,no.inhd $cmkrnl_s routin=inhdel .endc 775$: $CMKRNL_S - ROUTIN=BASHUCB,ARGLST=K_ARG CMPL R0,#SS$_NORMAL ;Any errors? BEQL 300$ ;No, skip error routine MOVL R0,MESS ;Move error to message $cmkrnl_s routin=alwdel ;;; BRW 300$ 301$: ; ERROR RETURN ... CLOSE FAB & LEAVE $PUTMSG_S MSGVEC=ERROR ;Pump out error message ; deassign logic 307$: movl #2,bufg ;unmung fcn $qiow_s chan=vdchn,efn=#4,func=#,iosb=iosb,- p1=bufg,p2=#busz ; after unbashing the current host, take the JT unit offline ; $CMKRNL_S - ; ROUTIN=BASHUCB,ARGLST=K_ARG 478$: $cmkrnl_s routin=alwdel $DASSGN_S CHAN=VDCHN ret 300$: ; Since that worked OK, send the format function to the JT unit to ; finish bashing the host disk. movl #1,bufg ;set to bash device .if df,$useqm ; ($qio macro isn't as reliable as I could want) $qiow_s chan=vdchn,efn=#4,func=#,iosb=iosb,- p1=bufg,p2=#busz .iff clrq -(sp) clrq -(sp) pushl #busz pushab bufg clrq -(sp) pushab iosb movl #,-(sp) movl vdchn,-(sp) pushl #4 calls #12,g^sys$qiow .endc ; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES ; EITHER... 303$: clrl ioprog ;say no i/o in progress tstl shrflg ;sharing another daemon? beql 7721$ brb 478$ ; Begin reading mailbox and processing. 7721$: tstl mfyflg ;/modify switch (no loop?) bneq 478$ calls #0,exempt ; exempt the daemon and set flags ; so its spawned proc's can find that ; they may do so also. evtloop: clrl ioprog clrl nedast ; messages are currently 116 bytes or less, but read one even if bigger $qiow_s efn=#8,chan=mbchn,- iosb=iosb,func=#io$_readlblk,p1=bufhdr,p2=#400 clrl filchr ; set charact. as 0 ; get a msg in from driver & do what is needed. ; Open Message format (from JTdriver): ;0 LDT addr ; 1 (= flag this is open call) ; Victim device UCB address ; ACE address ;16 JTKAST address (where to send ast) ; FID, 1st long ; FID, 2nd long ; accmd (how-open) ; DID, 1st long ; DID, 2nd long ; PCB of process ;44 IPID of process (sch$qast uses) ; EPID of process ; JT UCB address ; ; ; Extend dmn msg format: ; Msg blk addr in knl mode ; 2 (= flag for extend call) ; dvc name (count + 15 bytes ascii) ; unit number, binary ; IRP addr ; PCB addr ; victim ucb ; ccb addr ; r7 ; r8 ; user FIB addr ; size user wants ; FID, 1st part ; FID, 2nd part ; how-open (fib$l_acctl) ;72 Where to send AST back ; PCB ; IPID ; EPID ; ; del dmn msg fmt: ;0 Msg blk addr in knl mode ; 3 (= flag for delete call) ; dvc name (count + 15 bytes ascii) ; ; ; ; unit number, binary ; IRP addr ; PCB addr ; victim ucb ; ccb addr ; r7 ; r8 ; user FIB addr ; size user wants ; FID, 1st part ; FID, 2nd part ; how-open (fib$l_acctl) ;72 Where to send AST back ; DID, high part ; DID, low part ; PCB ; IPID ; EPID ; Export the real work to our subroutines since the buffers ; have all we need. cmpl bufhdr+4,#1 ;open call? blss evtloop ;go back if not bgtrw 2$ ;if gtr check higher codes clrl filchr ; set charact. as 0 ; If we don't have all of the ACE then gotta try to read it ; and handle it. clrw fnbufd ;zero bufd len as flag it's empty movl #-1,vchn $cmkrnl_s routin=chkace tstl vchn ;should we find ACE? blss 10$ ;if still neg., no ; vchn now has chnl for ACE ; go read the ACE if we can. pushab fnbufd ;filename buffer pushab vchn ;chnl pushab uace ;ACE we'll use pushab bufhdr+20 ;file ID (8 bytes) calls #4,redacl ;go read the acl $cmkrnl_s routin=nlfix pushr #^m movzbl uace,r3 beql 15$ movab uace,r4 movab mdace,r5 movc3 r3,(r4),(r5) ;put uace we got into mdace too 15$: popr #^m 10$: movl #-1,vchn $cmkrnl_s routin=nlbash pushab vchn pushab uace pushab mdace ;pass the ACE buffers pushab bufhdr ;pass buffer we got incl ioprog movl #1,nedast ;set i/o going flags ; opnfilt(bufhdr,mdace,uace,vchn) ; Should return mdace as ACE we will send to the kernel again. ; initially uace & mdace are the same up to length of ace. ; vchn points at the device in case we need a channel there, provided ; it is positive. Do not use if negative!!! calls #4,g^opnfilt ;do open filter stuff movl r0,rtnst ;save return status $cmkrnl_s routin=rtnast $cmkrnl_s routin=nlfix brw evtloop 2$: cmpl bufhdr+4,#2 ;extend operation? bneq 3$ ;if not, skip movl #-1,vchn $cmkrnl_s routin=nlbashd pushab vchn pushab bufhdr ;pass buffer we got incl ioprog movl #2,nedast ;set i/o going flags ; extfilt(bufhdr,vchn) calls #2,g^extfilt ;do open filter stuff movl r0,rtnst $cmkrnl_s routin=endext $cmkrnl_s routin=nlfix brw evtloop 3$: cmpl bufhdr+4,#3 ;delete op? bgtr 4$ ;if not go back movl #-1,vchn $cmkrnl_s routin=nlbashd pushab vchn pushab bufhdr ;pass buffer we got incl ioprog movl #3,nedast ;set i/o going flags ; delfilt(bufhdr,vchn) calls #2,g^delfilt ;do open filter stuff movzwl r0,rtnst blbs r0,244$ movl #4096,rtnst ;secret error code to inhibit delete 244$: $cmkrnl_s routin=enddel $cmkrnl_s routin=nlfix 4$: cmpl bufhdr+4,#4 ;create operation? bneq 5$ movl #-1,vchn $cmkrnl_s routin=nlbash pushab fiducb ;FIB, UCB etc. to return pushab fidcre ;pass FID address to return pushab vchn pushab bufhdr ;pass buffer we got incl ioprog movl #3,nedast ;set i/o going flags ; crefilt(bufhdr,vchn,fiducb) ; Filter create ops, returns with ucb, fid, did etc. calls #4,g^crefilt ;do create filter stuff movzwl r0,rtnst blbs r0,1244$ movl #4096,rtnst ;secret error code to inhibit delete 1244$: ; Send the AST to finish off. $cmkrnl_s routin=endcre $cmkrnl_s routin=nlfix 5$: brw evtloop ; ; $cmkrnl_s routin=alwdel ; $DASSGN_S CHAN=DDCHN ;CLEAN UP I/O CHANNELS ; RET fdhostd_exit: advdd_exit: calls #0,unexempt $cmkrnl_s routin=alwdel $DASSGN_S CHAN=VDCHN RET ; ; EndCre - return args after create. Note we need to pass back a UCB ; and FID and DID also if doing this... ; .entry endcre,^m ; Send a skast back to where the last msg wanted one. movl bufhdr,r8 ;point at knl buffer (starts with its addr) bgeqw 152$ ;if illegal lose tstl bufhdr+72 ;AST addr OK? bgeqw 152$ ;if no, branch movl #acb$c_length,r1 ;size we need for an ACB jsb g^exe$alonpagvar ;get an ACB block blbc r0,151$ ;throw up hands if we fail clrl 8(r2) ;zero size, flag etc movw #acb$c_length,acb$w_size(r2) ;acb size movl bufhdr+88,acb$l_pid(r2) ;target pid movl bufhdr+72,acb$l_kast(r2) ;set skast address movl bufhdr,acb$l_astprm(r2) ;ldt as param msg.rtnfid=120+264 ; MUST match def in jtdriver... ; fill in buffer in kernel space since this is done in kernel mode. ; This means we pass the FID the daemon found back to the caller ; via this buffer in pool. movl fidcre,msg.rtnfid(r8) ;store file ID movl fidcre+4,msg.rtnfid+4(r8) ;for return clrl acb$l_ast(r2) ; no normal ast addr ; Restore file id, did that we need after completion movl fiducb,<120+264+16+100>(R8) ;UCB to use on return movl fiducb+4,<120+264+16+104>(R8) ;FID long 1 movl fiducb+8,<120+264+16+108>(R8) ;FID word 2, DID word 1 movl fiducb+12,<120+264+16+112>(R8) ;DID long 2 movb #<1@acb$v_kast>,acb$b_rmod(r2) ;special knl ast ; Fill in how-to-handle-i/o flag in ldt movl rtnst,4(r8) ;tell driver what to do with i/o movl #1,rtnst ;set return statusd next ;time. movl r2,r5 ;need r5 pointing at aqb movl #2,r2 ;boost prio by 2 jsb g^sch$qast ;queue the AST to JRdriver stuff ;back in desired target proc. context 150$: movl #ss$_normal,r0 ;return "all well" indicator 151$: ret 152$: movl #8,r0 ;error return if we're messed up... ret .entry chkace,^m ; check for "short" ACE .if ndf,evax movzwl nlchn,r0 mnegl r0,r8 movl g^CTL$GL_CCBBASE,R6 ;get end of CCB tbl (VAX SPECIFIC!!!) addl2 r8,r6 ;get ourt ccb ; movab (r6)[r8],r6 ;now have CCB .iff ;evax movl nlchn,r6 ;test chnl exists bleq 999$ ; Following sequence like that in ioc$iopost clrl -(sp) ;get CCB address in here pushal (sp) ;point to CCB pointer pushl nlchn ;push the channel number calls #2,G^IOC$CHAN_TO_CCB ;translate chnl to CCB address movl (sp)+,r6 ;get the CCB address to r6 .endc movl r6,nlccb ;store for later movl ccb$l_ucb(r6),nlucb movl bufhdr,r11 ;LDT pointer bgeq 999$ movl bufhdr+12,r10 ;ACE buffer address bgeq 999$ movab uace,r8 movzbl (r10),r7 ;ace length beql 999$ movc3 r7,(r10),(r8) ;copy ACE to our buffers movab mdace,r8 movc3 r7,(r10),(r8) cmpl 12(r10),gcelit ;my ACE there? beql 999$ bitl #^x8000000,8(r10) ;this a fake ace? bneq 800$ ;if so look up fid here movl ldt$l_aclsiz(r11),r9 ;size of acl? cmpl r9,#512 bleq 999$ ;if small enough to fit must have it. cmpl r9,ldt$l_ace(r11) ;size as set to look for? bneq 999$ cmpl #<<8*65536>+1>,ldt$l_ace+4(r11) bneq 999$ ;if no magic no lookee... brb 810$ 800$: ; If here, we need the filename too. ; Ensure we copy it from the LDT here. ; Copy the data length and address in the ACE area. ; These are all local space to jtdmn, so jtopn will be able to ; access them. Set up a descriptor too... movl ldt$l_fnd(r11),64(r10) ; pass filename size pushr #^m movl ldt$l_fnd(r11),r3 ;length movw r3,fnbufd ;set up descriptor right bleq 805$ movab ldt$l_fndd(r11),r1 ;data address is here movab fnbuf,r2 ;copy it here movl r2,68(r10) ;set data address in too. movab fnbufd,72(r10) ;send buffer descriptor too clrl (r2) ;zero 1st long at 1st... movc3 r3,(r1),(r2) ;copy the filename. DID there already. 805$: popr #^m 810$: ; look for the ACE ; Flag by making nlchn point to desired unity of JT movl bufhdr+8,ccb$l_ucb(r6) ;point chnl at victim bgeq 999$ movl nlchn,vchn 999$: movl #1,r0 ret ; Entries we use to make channels to disks. Start with channels to ; nla0:, and alter the UCB pointers to point at the disks. Note this ; avoids creating or messing with volume locks. .entry nlbash,^m ; bash nlchn with arg .if ndf,evax movzwl nlchn,r0 mnegl r0,r8 movl g^CTL$GL_CCBBASE,R6 ;get end of CCB tbl (VAX SPECIFIC!!!) addl2 r8,r6 ;get ourt ccb ; movab (r6)[r8],r6 ;now have CCB .iff ;evax movl nlchn,r6 ;test chnl exists bleq 999$ ; Following sequence like that in ioc$iopost clrl -(sp) ;get CCB address in here pushal (sp) ;point to CCB pointer pushl nlchn ;push the channel number calls #2,G^IOC$CHAN_TO_CCB ;translate chnl to CCB address movl (sp)+,r6 ;get the CCB address to r6 .endc movl r6,nlccb ;store for later movl ccb$l_ucb(r6),nlucb tstl bufhdr+36 ;be sure chnl ucb is ok bgeq 999$ ;leave chnl alone if illegal ucb addr movl bufhdr+36,ccb$l_ucb(r6) ;point chnl at victim bgtr 999$ movl nlchn,vchn 999$: movl #1,r0 ret .entry nlbashd,^m ; bash nlchn with arg .if ndf,evax movzwl nlchn,r0 mnegl r0,r8 movl g^CTL$GL_CCBBASE,R6 ;get end of CCB tbl (VAX SPECIFIC!!!) addl2 r8,r6 ;get ourt ccb ; movab (r6)[r8],r6 ;now have CCB .iff ;evax movl nlchn,r6 ;test chnl exists bleq 999$ ; Following sequence like that in ioc$iopost clrl -(sp) ;get CCB address in here pushal (sp) ;point to CCB pointer pushl nlchn ;push the channel number calls #2,G^IOC$CHAN_TO_CCB ;translate chnl to CCB address movl (sp)+,r6 ;get the CCB address to r6 .endc movl r6,nlccb ;store for later movl ccb$l_ucb(r6),nlucb tstl bufhdr+36 bgeq 999$ ;leave chnl alone if illegal ucb addr movl bufhdr+36,ccb$l_ucb(r6) ;point chnl at victim bgtr 999$ movl nlchn,vchn 999$: movl #1,r0 ret .entry nlfix,^m ; reset nlchn movl nlccb,r6 movl nlucb,ccb$l_ucb(r6) movl #1,r0 ret ; BASHUCB - AREA TO MESS UP UCB WITH OUR FILE DATA ; BEWARE BEWARE BEWARE ; runs in KERNEL mode ... HAS to be right. ; Saves lots of registers so they're free... .ENTRY BASHUCB,^M ; TAKEN LOOSELY FROM ZERO.MAR .if ndf,vms$v5 MOVL G^SCH$GL_CURPCB,R4 ;;; NEED OUR PCB .iff MOVL G^CTL$GL_PCB,R4 ;;; NEED OUR PCB (VMS V5) .endc clrl hstucb JSB G^SCH$IOLOCKW ;;; LOCK I/O DATABASE tstl deafg ;/deas needs no 2nd assign bneq 90$ clrl shucb tstl shrflg beql 466$ movl 16(ap),r1 ;look up /share:jt device jsb g^ioc$searchdev ;find the mailbox blbc r0,466$ ;see if r1 really points at a JT UCB cmpb ucb$b_devclass(r1),#dc$_disk beql 466$ ;JT devices are not disks cmpl ucb$l_icsign(r1),#magic ;got right magic no.? bneq 466$ ;if not eq, not a JT. Skip. movl r1,shucb ;save other JT UCB 466$: ;get mailbox info movl 12(ap),r1 jsb g^ioc$searchdev ;find the mailbox blbc r0,661$ ;big lose if none movl r1,mbxucb MOVL 4(AP),R1 ;;; ADDRESS DVC NAME DESCRIPTORS (target) JSB G^IOC$SEARCHDEV ;;; GET UCB ADDRESS INTO R1 for tgt BLBS R0,660$ 661$: BRW BSH_XIT 660$: ; 80$: MOVL R1,HSTUCB ;;; SAVE HOST UCB ADDRESS movl r1,r11 ;use r11 for target UCB BEQL 166$ ;;; ... BUT ZERO UCB ADDRESS LOOKS BAAAAD 90$: MOVL 8(AP),R1 ;;; ADDRESS VDn NAME DESCRIPTORS JSB G^IOC$SEARCHDEV ;;; GET UCB ADDRESS INTO R1 BLBS R0,160$ BRW BSH_XIT 160$: movl r1,vducb ;;; store vd ucb movl r1,r5 ;use r5 for local ucb (JT dvc) beql 166$ ;fail if no ucb... ; BUGGER THE UCB ; ASSUMES FILE LBN AND SIZE ALREADY RECORDED ; ALSO ASSUMES THAT ZERO LBN OR SIZE MEANS THIS ENTRY NEVER CALLED. ; (REALLY ONLY WORRY ABOUT ZERO SIZE; IF WE OVERMAP A REAL DEVICE ; THEN ZERO INITIAL LBN COULD BE OK.) ; ; CHECK REF COUNT FIRST... ONLY CAN GET AWAY WITH THIS ON DEVICE ; NOBODY'S USING... ; .. fake this since device may have count messed by advd somehow ; but will be allocated if mounted. ; ... for now ... 554$: ; CMPW UCB$W_REFC(R1),#1 ;;; CHECK COUNT VS 1 FOR THIS ; blssu 164$ ;if 1 or less, go on. brb 164$ ;(it doersn't matter ifthe local disk is in ; use...we don't bother it.) 166$: brw 165$ 164$: ; check that both UCBs are disk devices at least! ; We can't be sure all the device characteristics will be the ; same for the local device and the MSCP served remote one (and ; in fact they are not all alike!) but at least they had better ; both be disks or this function is not even approximately ; correct and will probably be quickly fatal to the system. tstl deafg ;/deas? r11 invalid. beql 1164$ ; for deassign, must set JT offline so it can be turned on again ; but just do all work here & scram. cmpl ucb$l_icsign(r5),#magic ;got right magic no.? bneq 1176$ ;if not then not JTdriver ; clear online & valid on JT dvc for next time .if df,evax bicl #ucb$m_online,ucb$l_sts(r5) ;set JT unit not online bicl #ucb$m_valid,ucb$l_sts(r5) ; & valid .iff bicw #ucb$m_online,ucb$w_sts(r5) ;set JT unit not online bicw #ucb$m_valid,ucb$w_sts(r5) ; & valid .endc 1166$: movl #1,r0 brw bsh_xit ;unlock & leave 1176$: movl #ss$_drverr,r0 brw bsh_xit 1164$: cmpb ucb$b_devclass(r11),#dc$_disk bneq 1176$ ;if not disk exit now. cmpl ucb$l_icsign(r5),#magic ;got right magic no.? bneq 1176$ ;if not then not JTdriver ; Be sure the unit is not online yet. If it is, someone else will ; be using its UCB so we don't want to screw this up. .if df,evax bitl #ucb$m_online,ucb$l_sts(r5) ;set JT unit online bneq 166$ .iff bitw #ucb$m_online,ucb$w_sts(r5) ;set JT unit online bneq 166$ .endc .if df,tst$cap ; if capability mask lacks low bits set, junk this call except for JTA0: ; Otherwise flag an error (drverr...) and exit. That way nothing will work ; past that date. tstl lclcap ; see if any bits are set bneq 1182$ ; if any are, go ahead tstw ucb$w_unit(r5) ; else look at unit number of JT bneq 1176$ 1182$: .endc ; Looks like we're gonna do the assign. Store backpointer for driver to ; check before unmung. movl r11,ucb$l_vict(r5) ;store ucb of victim in JT ucb ;;;must make maxbcnt and fipl match!!! ; Fork IPL will be same but maxbcnt often will not. Fix that here. movl g^ctl$gl_pcb,r4 ;get our pcb, for safety tstl shucb ;got a shared ucb? bneq 476$ movl pcb$l_pid(r4),ucb$l_daemon(r5) ;save our identity for jtdriver ;since this is the delete & extend daemon set them up too. movl pcb$l_pid(r4),ucb$l_exdmn(r5) movl pcb$l_pid(r4),ucb$l_deldmn(r5) ; fill in mailbox stuff too movl mbxucb,ucb$l_mbxucb(r5) ;open daemon movl mbxucb,ucb$l_exmbx(r5) ;extend daemon (space monitor) movl mbxucb,ucb$l_delmbx(r5) ;delete daemon brb 477$ 476$: pushl r9 movl shucb,r9 ; use the pointers from the other daemon for us. movl ucb$l_daemon(r9),ucb$l_daemon(r5) ;save our identity for jtdriver ;since this is the delete & extend daemon set them up too. movl ucb$l_exdmn(r9),ucb$l_exdmn(r5) movl ucb$l_deldmn(r9),ucb$l_deldmn(r5) ; fill in mailbox stuff too movl ucb$l_mbxucb(r9),ucb$l_mbxucb(r5) ;open daemon movl ucb$l_mbxucb(r9),ucb$l_exmbx(r5) ;extend daemon (space monitor) movl ucb$l_mbxucb(r9),ucb$l_delmbx(r5) ;delete daemon popl r9 477$: ; movl ucb$l_maxbcnt(r5),ucb$l_maxbcnt(r11) ;;;store max bytes as a word movl binkey,ucb$l_keycry(r5) ;store security key movl binkey+4,ucb$l_keycry+4(r5) ; ; Fill in kernel-tagged file numbers now, if any. pushr #^m .if df,wd.lst movl fnumct,r7 ;number of tags .iff movl #,r7 ;move whole bitmap .endc bleq 511$ .iif df,wd.lst,addl2 r7,r7 ;make a byte count movab fnums,r0 ;get numbers from here .if df,wd.lst movab ucb$l_fnums(r5),r1 ;copy them to here .iff movl ucb$l_fnums(r5),r1 beql 511$ .endc movc3 r7,(r0),(r1) ;move the data in 511$: popr #^m ; Now get on with the tricky part, replacing the DDT. Do this ; at device IPL so we have reasonable certainty nobody will mess with ; these structures until we get them all put into proper order. ; The DDT structure is 64 bytes long, so grab a block of pool of 64 bytes ; size and copy the existing DDT into it. ; (it is possible to save the old address if the conditional is used) .if df,evax bisl #ucb$m_online,ucb$l_sts(r5) ;set JT unit online bisl #ucb$m_valid,ucb$l_sts(r5) ; & valid .iff bisw #ucb$m_online,ucb$w_sts(r5) ;set JT unit online bisw #ucb$m_valid,ucb$w_sts(r5) ; & valid .endc movl ucb$l_maxblock(r11),ucb$l_maxblock(r5) ;copy geom for luck movw ucb$w_cylinders(r11),ucb$w_cylinders(r5) movb ucb$b_sectors(r11),ucb$b_sectors(r5) movb ucb$b_tracks(r11),ucb$b_tracks(r5) movl cbtct,ucb$l_cbtini(r5) ;set CBT opens every time ; movl #34,ucb$l_ctlflgs(r5) ;set to look at modify movl fcnmsk,ucb$l_ctlflgs(r5) ; set capture functions tstl adflg ;/aldefonly? beql 60$ bisl #4,ucb$l_ctlflgs(r5) ;set driver thus 60$: ; note 4 bit only extends if aldef is set. Don't set that just now. movl min,ucb$l_minxt(r5) ;min extent = 10 movl ucb$l_maxblock(r11),r0 tstl max ;user set max? beql 65$ movl max,r0 ;if so use his unless 0 brb 4$ 65$: ashl #-5,r0,r0 ; default max = 1/32 of disk size cmpl r0,#2000 ;but 2000 at least bgtr 4$ movl #2000,r0 ;max=0 => 1/32 of disksize or 2000 4$: movl r0,ucb$l_maxxt(r5) ;max extent movl frac,ucb$l_frac(r5) ;extend by 1/4 of file size movl cbtct,ucb$l_cbtctr(r5) 1000$: 165$: MOVL #SS$_NORMAL,R0 BSH_XIT: PUSHL R0 JSB G^SCH$IOUNLOCK ;;; UNLOCK I/O DATABASE (DROP IPL) POPL R0 ;;; REMEMBER R0 RET ;;; BACK TO USER MODE NOW ; rtnast - call from knl mode, send skast back to process. .entry rtnast,^m ; Send a skast back to where the last msg wanted one. movl bufhdr,r8 ;point at LDT bgeqw 152$ ;if illegal lose tstl bufhdr+16 ;AST addr OK? bgeqw 152$ ;if no, branch movl #acb$c_length,r1 ;size we need for an ACB jsb g^exe$alonpagvar ;get an ACB block blbc r0,151$ ;throw up hands if we fail clrl 8(r2) ;zero size, flag etc movw #acb$c_length,acb$w_size(r2) ;acb size movl bufhdr+44,acb$l_pid(r2) ;target pid movl bufhdr+16,acb$l_kast(r2) ;set skast address movl bufhdr,acb$l_astprm(r2) ;ldt as param clrl acb$l_ast(r2) ; no normal ast addr movb #<1@acb$v_kast>,acb$b_rmod(r2) ;special knl ast pushr #^m ; Fill in how-to-handle-i/o flag in ldt movl rtnst,ldt$l_rtnsts(r8) ;tell driver what to do with i/o movl #1,rtnst ;set return statusd next ;time. ; replace file characteristics into LDT if we read them here. tstl filchr beql 1149$ ; if none read skip no$unch = ^x40000000 ; as in jtdriver ; note the special stuff is in the high byte. ; (VMS does not (as of 7.2) use high byte for characteristics yet.) movzbl ldt$l_chars+3(r8),-(sp) ; save high byte bisb filchr+3,(sp) ; get all other bits movl filchr,ldt$l_chars(r8) ; else fill in file chrs now movb (sp),ldt$l_chars+3(r8) ; to keep flags bits tstl (sp)+ ; fixup stack 1149$: ; Now replace the edited ACE into the LDT. .iif df,x$$$dt,jsb g^ini$brk movab ldt$l_ace(r8),r10 ;stored ACE entry bgeq 153$ ;ill. addr -> no action movab mdace,r9 ;edited ace movc3 #256,(r9),(r10) ;copy edited ACE to ldt area tstb mdace+12 ;is it null? bneq 6150$ ;if not leave it that way 153$: clrq (r10) ;else zero the flags clrq 8(r10) ;that tell us anything's there clrq 16(r10) ;(i.e. clear 1st part of ACE) 6150$: popr #^m movl r2,r5 ;need r5 pointing at aqb movl #2,r2 ;boost prio by 2 jsb g^sch$qast ;queue the AST to JRdriver stuff ;back in desired target proc. context 150$: movl #ss$_normal,r0 ;return "all well" indicator 151$: ret 152$: movl #8,r0 ;error return if we're messed up... ret .entry endext,^m ; Send a skast back to where the last msg wanted one. movl bufhdr,r8 ;point at knl buffer (starts with its addr) bgeqw 152$ ;if illegal lose tstl bufhdr+72 ;AST addr OK? bgeqw 152$ ;if no, branch movl #acb$c_length,r1 ;size we need for an ACB jsb g^exe$alonpagvar ;get an ACB block blbc r0,151$ ;throw up hands if we fail clrl 8(r2) ;zero size, flag etc movw #acb$c_length,acb$w_size(r2) ;acb size movl bufhdr+80,acb$l_pid(r2) ;target pid movl bufhdr+72,acb$l_kast(r2) ;set skast address movl bufhdr,acb$l_astprm(r2) ;ldt as param clrl acb$l_ast(r2) ; no normal ast addr movb #<1@acb$v_kast>,acb$b_rmod(r2) ;special knl ast pushr #^m ; Fill in how-to-handle-i/o flag in ldt movl rtnst,4(r8) ;tell driver what to do with i/o bneq 677$ movl #1,4(r8) 677$: movl #1,rtnst ;set return statusd next ;time. popr #^m movl r2,r5 ;need r5 pointing at aqb movl #2,r2 ;boost prio by 2 jsb g^sch$qast ;queue the AST to JRdriver stuff ;back in desired target proc. context 150$: movl #ss$_normal,r0 ;return "all well" indicator 151$: ret 152$: movl #8,r0 ;error return if we're messed up... ret .entry enddel,^m ; Send a skast back to where the last msg wanted one. movl bufhdr,r8 ;point at knl buffer (starts with its addr) bgeqw 152$ ;if illegal lose tstl bufhdr+72 ;AST addr OK? bgeqw 152$ ;if no, branch movl #acb$c_length,r1 ;size we need for an ACB jsb g^exe$alonpagvar ;get an ACB block blbc r0,151$ ;throw up hands if we fail clrl 8(r2) ;zero size, flag etc movw #acb$c_length,acb$w_size(r2) ;acb size movl bufhdr+88,acb$l_pid(r2) ;target pid movl bufhdr+72,acb$l_kast(r2) ;set skast address movl bufhdr,acb$l_astprm(r2) ;ldt as param clrl acb$l_ast(r2) ; no normal ast addr movb #<1@acb$v_kast>,acb$b_rmod(r2) ;special knl ast ; Fill in how-to-handle-i/o flag in ldt movl rtnst,4(r8) ;tell driver what to do with i/o movl #1,rtnst ;set return statusd next ;time. movl r2,r5 ;need r5 pointing at aqb movl #2,r2 ;boost prio by 2 jsb g^sch$qast ;queue the AST to JRdriver stuff ;back in desired target proc. context 150$: movl #ss$_normal,r0 ;return "all well" indicator 151$: ret 152$: movl #8,r0 ;error return if we're messed up... ret .ENTRY XITHDL,^M TSTL IOPROG BEQL x1$ iokil: x1$: ; when we exit, allow process deletion calls #0,unexempt $cmkrnl_s routin=alwdel clrl ioprog tstl nedast beql 22$ ; send back a special knl AST to sender to continue the I/O ;;; cmpl #1,nedast ;check kind of AST needed bneq 860$ $cmkrnl_s routin=rtnast $cmkrnl_s routin=nlfix 860$: cmpl #2,nedast bneq 861$ $cmkrnl_s routin=endext $cmkrnl_s routin=nlfix 861$: cmpl #3,nedast bneq 862$ $cmkrnl_s routin=enddel $cmkrnl_s routin=nlfix 862$: ;;; clrl nedast 22$: ; set the driver into single-journal mode PUSHAB DESBLK ; ADDRESS OF DESBLK CALLS #1,G^SYS$CANEXH ; CANCEL EXIT HANDLER $CMKRNL_S - ROUTIN=SJUCB,ARGLST=SJ_ARG ;reset our ref count to 1 ; so deassign will decrement it to zero. $DASSGN_S CHAN=VDCHN ;ensure the JR: channel is clear $DASSGN_S CHAN=DDCHN ;CLEAN UP I/O CHANNELS ; ; declare host no longer is home. ret ; redacl(fid,myacebuf,vchn,filename) ; fid = 8 bytes ; myacebuf = 256 byte buffer p1=4 p2=8 .entry redacl,^m movl 16(ap),fb.nam movzwl @12(ap),vchn ;get channel bleq 999$ ;skip if illegal movq @p1(ap),fibfid ;get the file id movl p1(ap),R9 ;addr of fib in buff ; Check if ACE was NOT seen but driver flagged it should have been. ; Complain if so. clrl r1 cmpl #^X8000011,8(r9) ; Flagged as unseen but should have been bneq 100$ ; If not just continue ; pushab LOSTACEM ; complain msg ; calls #1,g^oprmsg ; send to operator movl #256,r1 100$: movl fibfid,r11 movzwl fibfid+4,r10 bsbw getace ;if r0=1 on return, we got an ACE, copy to caller, else he zeroes it blbc r0,999$ ;on error just return to caller pushl r1 pushl r0 ;preserve success status movc3 #255,ainbf,@p2(ap) ;copy ace to user buffer popl r0 popl r1 movl p2(ap),r0 addl2 r1,4(r0) ;set 256 bit in flags of ace 999$: ret ; getace - Entry to read an ACL for our ACE (if any) (used where ; the ACL is too long so we can't tell if our ACE is there or not.) getace: .jsb_entry tstw fnbufd ;is there a filename buffer? bleq 54$ ;if eql no, skip. ; If the filename buffer is filled in, it means this is a faked ACL and ; the fid may not have been read right. Try to read it now if so. Store ; if possible. clrl lpct clrl fibacx ;init acl context clrl fibast clrl fibctx ;init fib context clrl fibdid ;clear the DID... clrw fibdid+4 ;...fid all out pushr #^m movc5 #0,fibctx,#0,#48,fibctx ;clr fib generally past fid ; gotta try and read the file ID and save it in the LDT copy... clrl fibfid clrw fibfid+4 ; In the buffer from the driver, order is fid1,fid2,accmd, did1,did2 (all longs) movl 12(R9),fibdid ;get dir ID movw 16(R9),fibdid+4 ;(6 bytes) movab fnbufd,r7 ;filename descriptor $qiow_s efn=#0,chan=vchn,iosb=iosb,func=#io$_access,p1=mfdsc,p2=r7 blbc r0,50$ blbc iosb,50$ ; if it seemed to work, we should have the FID now. movl fibfid,(R9) movw fibfid+4,4(R9) ;COPY FILE ID we got tstl fibfid ;did we get a file id? bneq 52$ ;if nonzero, this looks ok tstw fibfid+4 ;is it all 0? bneq 52$ 50$: movl r11,fibfid ;else get back input file id movw r10,fibfid+4 movl fibfid,(R9) movw fibfid+4,4(R9) ;COPY FILE ID we got 52$: popr #^m 54$: clrl lpct clrl fibacx ;init acl context clrl fibast clrl fibctx ;init fib context clrl fibdid ;clear the DID... clrw fibdid+4 ;...fid all out pushr #^m movc5 #0,fibctx,#0,#48,fibctx ;clr fib generally past fid 100$: movab myil3,r7 ;address of itemlist incl lpct cmpl lpct,#250 ;max tries (got to terminate somewhere) bgeq 200$ ;if over this then exit ; processed here again, though it may be processed in other entries. .if df,onechn movl vdchn,vchn ;use global channel if using one only .endc $qiow_s efn=#0,chan=vchn,iosb=iosb,func=#io$_access,p1=mfdsc,p5=r7 movl iosb,r6 ;get result for debug blbc r6,200$ ;exit on error/end blbc fibast,200$ ;exit on ast status err blbc r0,200$ ;on qio call or i/o status cmpl gcelit,gcetgt ;our entry? beql 300$ ;if eql yes... brb 100$ ;else no, look some more 200$: popr #^m movl #2,r0 ;flag error to caller rsb 300$: popr #^m movl #1,r0 ;flag NO error to caller rsb ; .entry gtprv,^m gtprv:: .call_entry home_args=true,max_args=6 ;call gtprv(ldt,prv) $cmkrnl_s routin=gtkprv,arglst=(ap) ret .entry gtkprv,^m movl @4(ap),r2 ;ldt address bgeq 99$ ;skip if bad movl 8(ap),r3 ;addr for privs beql 99$ movl ldt$l_wprv(r2),(r3) ;copy working privs movl ldt$l_wprv+4(r2),4(r3) ;to user buffer 99$: movl #1,r0 ret ; call swpuic(new,old) .entry swpuic,^m movl 4(ap),swpal+4 ;new uic addr movl 8(ap),swpal+8 ;old uic addr $cmkrnl_s routin=kswpu,arglst=swpal ret .entry kswpu,^m MOVL G^CTL$GL_PCB,R2 ;get PCB movl pcb$l_uic(r2),r3 movl r3,@8(ap) ;save old uic for caller movl @4(ap),pcb$l_uic(r2) ;replace with new one movl #1,r0 ret ; sjucb - close ucb out .ENTRY SJUCB,^M pushl r1 .if ndf,vms$v5 MOVL G^SCH$GL_CURPCB,R4 ;;; NEED OUR PCB .iff MOVL G^CTL$GL_PCB,R4 ;;; NEED OUR PCB (VMS V5) .endc ;;; NEED IPID FOR DRIVER'S CALL TO SCH$POSTEF TO THIS HOST!! JSB G^SCH$IOLOCKW ;;; LOCK I/O DATABASE MOVL 8(AP),R1 ;;; ADDRESS VDn NAME DESCRIPTORS JSB G^IOC$SEARCHDEV ;;; GET UCB ADDRESS INTO R1 BLBS R0,160$ BRB JSH_XIT 160$: .if ndf,evax movw #1,ucb$w_refc(r1) ;;;ensure ref cnt bashes to 1 ;so deassign will work .iff movl #1,ucb$l_refc(r1) ;;;ensure ref cnt bashes to 1 ;so deassign will work .endc MOVL #SS$_NORMAL,R0 JSH_XIT: PUSHL R0 JSB G^SCH$IOUNLOCK ;;; UNLOCK I/O DATABASE (DROP IPL) POPL R0 ;;; REMEMBER R0 popl r1 RET ;;; BACK TO USER MODE NOW ; Quick function here to return operating mode mask. ; ; Mode meanings (used for delete etc...) ; Bit Meaning ; 0-1 0 = use .COM file ; 1 = use rename mode ; 2 = use copy (callable cvt) mode ; 3 = copy and add softlink. No database file genn'd ; 2 If set don't delete ANYthing immediately ; 3 If set don't include only included names ; 4 If set, delete file if no room for rename/copy ; If clear, leave file alone if copy area is full (return error though) ; 5 If set, no timetag on deleted files (use if using softlink...) ; .entry mymode,^m<> movl modmsk,r0 ;get mode mask ret .entry jgtprvs,^m subl2 #12,sp movl sp,r11 movl #2,(r11) movl 4(ap),4(r11) movl 8(ap),8(r11) $cmkrnl_s routin=kgtprvs,arglst=(r11) addl2 #12,sp ret .entry kgtprvs,^m ; expect 2 args, in knl mode ; this should be pcb address and address of priv vector movl @4(ap),r2 ;get pcb address bgeq 99$ movq pcb$q_priv(r2), r3 ;r3,r4 are privs now movl 8(ap),r6 ;output bleq 99$ movl r3,(r6)+ movl r4,(r6) 99$: ret ; set a bit in the array like jbdriver_bmap tests... ; Assumes array is 2KB long!!! .entry vbset,^m ; call vbset(bytearray,filnum) movl 4(ap),r2 ;array base movl @8(ap),r3 ;file number ; f.nuyms & f.mask must vary together .iif ndf,f.mask,f.mask=-16384 ; 2k buffer bicl #f.mask,r3 ;mask extra file num bits off ashl #-3,r3,r4 ;get byte in array to r4 addl3 r2,r4,r6 ;address correct byte bicl #-8,r3 ;get bit in byte bbss r3,(r6),10$ ;set the bit 10$: ret .entry inhdel,^m MOVL G^CTL$GL_PCB,R4 ;get PCB bisl #pcb$m_nodelet,pcb$l_sts(r4) ;prevent process deletion movl #ss$_normal,r0 ret .entry alwdel,^m MOVL G^CTL$GL_PCB,R4 ;get PCB bicl #pcb$m_nodelet,pcb$l_sts(r4) ;allow process deletion movl #ss$_normal,r0 ret .entry fixfid,^m movl 4(ap),r11 ;where to set file id movab fibwrk,r0 zapz (r0),#128 ;zero the FIB movw 6(r11),fibwrk+fib$w_did ;set up DID bneq 199$ 299$: brw 99$ 199$: movl @8(ap),fibwrk+fib$w_did+2 ;all 6 bytes movl @12(ap),namdsc ;copy the length bleq 299$ movl namdsc,r9 movl 16(ap),r8 addl2 #128,r8 ;get address of text movab namtxt,r7 ;and where to store it movc3 r9,(r8),(r7) ;copy text to our space now movzwl @20(ap),r2 ;get channel bleq 299$ ;must be + movab fibdsc,r5 movab namdsc,r6 ; use an io$_access function to cause the directory lookup $qiow_s chan=r2,efn=#2,func=#io$_access,iosb=xxiosb,p1=(r5),p2=r6 blbc r0,99$ blbc xxiosb,99$ movl fibwrk+fib$w_fid,(r11) movzwl fibwrk+fib$w_fid+4,4(r11) ;return file id 99$: ret .END ADVDD