.TITLE JTexedel ;set this process exempt from eacf etc. .IDENT 'V001' ; 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. $DEF UCB$L_ICPFGS .BLKL 2 ; Flags. Reserve 2 longs so we need ; not mess with this later. $VIELD UCB,0,<- ,- ; 1 if this intercept and all > ; below understand finipl8. $def ucb$l_ufil1 .blkl 8 ; for others' intercepts if needed $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. magic=^xF0070000 + ddt$k_length + <256*> p.magic=^xF0070000 + ddt$k_length + <256*> ;magic=^xF013F000 + ddt$k_length + <256*> ;p.magic=^xF013F000 + ddt$k_length + <256*> .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) 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 ldt$l_ace = 64 ;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 ;register save, r0 to r15 ldt$l_flgs = 376 ;slop storage for flags ldt$l_parm = 380 ;storage for up to 6 params (6 longs) ldt$l_fib = 404 ;FIB we use for OUR I/O ; 72 bytes max for our FIB ldt$l_acl = 476 ;storage for ACL read-in; 512 bytes ldt$l_itmlst = 988 ;item list to read the ACL all in if ;we can. ldt$l_aclsiz = 1020 ;size of the ACL on the file ldt$l_rtnsts = 1024 ;status back from daemon ldt$l_myfid = 1032 ;file id from read-acl call ldt$l_mydid = 1040 ;dir id in user's fib ldt$l_psl = 1048 ;psl of original i/o ldt$l_fnd = 1056 ;filename desc of orig i/o (p2 arg) ;2 longs ldt$l_fndd = 1064 ;data area for filename (256 bytes) ldt$l_fdtctx = 1324 ;save area for user's FDT context ptr ldt$l_size = 1336 ldt$k_clrsiz = 1332 ;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 ; ; 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 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 mPID: ; Owner of mbxice (if any). .BLKL 1 lpct: .long 0 ;scratch dvl: .long 0 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 iosb: .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 20 ;length .byte dsc$k_dtype_t ;text .byte 1 ;static .address wrkdat wrkdat: .blkb 20 .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/ deads: .ascid /NORMAL/ ;deassign JT: from disk (turn off) nldsc: .ascid /NLA0:/ .align long ; 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 ; ; 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 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 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 .long 0,0 ;null terminate the list .long 0 uace: .blkb 256 ;copy of our ACE mdace: .blkb 256 .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$: 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) ; MUST HAVE ASSIGNMENT TO VD: UNIT IN ANY CASE. 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 $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 ; reenabling? if so no msg bneq 145$ ; if disabling eacf, log the fact. calls #0,g^jtemitlog ; send info about who's doing it... 145$: $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 ;;; BRW 300$ 301$: ; ERROR RETURN ... CLOSE FAB & LEAVE $PUTMSG_S MSGVEC=ERROR ;Pump out error message ; deassign logic 478$: $DASSGN_S CHAN=VDCHN ret 300$: RET fdhostd_exit: advdd_exit: $DASSGN_S CHAN=VDCHN RET .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 MOVL 8(AP),R1 ;;; ADDRESS VDn NAME DESCRIPTORS JSB G^IOC$SEARCHDEV ;;; GET UCB ADDRESS INTO R1 BLBS R0,160$ BRW BSH_XIT 1176$: 166$: movl #8,r0 brw bsh_xit 160$: movl r1,r5 ;use r5 for local ucb (JT dvc) beql 166$ ;fail if no ucb... ; BUGGER THE UCB 1164$: ; be sure this IS a JT device cmpl ucb$l_icsign(r5),#magic ;got right magic no.? bneq 1176$ ;if not then not JTdriver movl g^ctl$gl_pcb,r4 ;get our pcb, for safety tstl deafg ;deassigning ourselves? beql 1178$ ;if not branch ; UNset "exempt" status movl pcb$l_pid(r4),r6 ;get our pid cmpl r6,ucb$l_exedel+00(r5) bneq 1179$ ;this ours? clrl ucb$l_exedel+00(r5) 1179$: cmpl r6,ucb$l_exedel+04(r5) bneq 1180$ ;this ours? clrl ucb$l_exedel+04(r5) 1180$: cmpl r6,ucb$l_exedel+08(r5) bneq 1181$ ;this ours? clrl ucb$l_exedel+08(r5) 1181$: cmpl r6,ucb$l_exedel+12(r5) bneq 1182$ ;this ours? clrl ucb$l_exedel+12(r5) 1182$: movl #1,r0 brw bsh_xit 1178$: ; SET "exempt" status movl pcb$l_pid(r4),r6 ;get our pid ;fill in an empty slot in any, else use first tstl ucb$l_exedel+00(r5) bneq 1183$ 1190$: movl r6,ucb$l_exedel+00(r5) brb 1182$ 1183$: tstl ucb$l_exedel+04(r5) bneq 1184$ movl r6,ucb$l_exedel+04(r5) brb 1182$ 1184$: tstl ucb$l_exedel+08(r5) bneq 1185$ movl r6,ucb$l_exedel+08(r5) brb 1182$ 1185$: tstl ucb$l_exedel+12(r5) bneq 1186$ movl r6,ucb$l_exedel+12(r5) brb 1182$ 1186$: brb 1190$ 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 .END ADVDD