lp$filt=0 ; define to filter log/phy i/o from user mode to mounted devices pcbmsk$$=0 .TITLE JTDRiver ;skeleton driver implementing ucb linkage .IDENT 'V01h' ; Copyright 1993,1994 Glenn C. Everhart ; All rights reserved ; Author: Glenn C. Everhart ; ; mods: ; 30/jun/1994 GCE - Change kernel mapping logic to use a bitmap instead ; so we can basically map everything (to within an ambiguity factor). ; Use a 2KB buffer bitmap, which covers 16000 file numbers and will do ; a pretty good job of rejecting the rest. Then we can turn on the logic ; to only look at mapped files and save taking a performance hit on ; anything else (to all intents & purposes). For the moment just make the ; bitmap space a 2048 byte block constant in size for simplicity. In a ; later version we may make it vary in size. Use of this will allow us ; to protect ANY number of files even if the ACE gets deleted on them ; all... ; 7/7/94 gce - Deallocate LDT only AFTER the dowait call... ; ; real_pvt=0 ;define to include code that on bit 2048 prevents opens on ;assigned devices, privs or not. ;securdv=0 ;define to use for EACF driver where we do NOT allow ;jtexedel to exempt delete checks. Undefine for undelete ;version. ;evax = 1 ;alpha=1 ;bigpage=1 ;addressbits=32 x$$$dt=0 .if ndf,evax .macro .jsb_entry output ; jsb entry .endm .macro driver_data .PSECT $$$105_PROLOGUE .endm .macro driver_code .PSECT $$$115_DRIVER .endm .endc ; above for Alpha only. ; ; function: "Tricks" driver. ; Implements FDT capture (based on code published on sigtapes and ; info-vax for "standard" capture techniques) and implements file ; marking and transparent daemon access on open and various other ; times. Also throws in fragmentation avoider. ; ; the driver works by intercepting FDT entries of a host driver and ; adding its own ahead of them. The most complex intercept is the ; open one (accfilt and on). It decides the i/o is of interest and ; issues its own $qio to read the file ACL to look for our ACE (application ; ACE, flagged by my initials). If this is found or the file is in an ; internal "look at" list then some actions happen immediately: ; setting privs/identifiers/base priority/softlinks. If the "send to ; daemon" flag is set in the ace (1 bit of flags) the open daemon ; (jtdmn) is sent a message and we wait on EF 31 till the daemon sends ; a special knl ast back. Note our qio thread produces a normal ; kernel AST and that does a special kernel AST from which the ; daemon call may be done. Once back, we reissue the FDT calls lower ; on kernel stack. On completing this we flag the mainline may go on ; set efn 31 and our "waitfor" cell, and go on. Once the mainline resumes ; it can delete the LDT (local area stuff) if appropriate or shorten ; it and free most of the memory grabbed during open. The open daemon ; can signal to either cause the i/o to fail or to make it seem to ; succeed without actually doing the open by appropriate return codes. ; ; delete and extend daemons are basically similar (as a directory daemon ; would be) but since they work on all files they omit the kernel thread ; that does its own I/O. ; ; For softlinks, in addition to moving file opens there 'n' ; back, keep a device table to let us refer to devices by using some ; hi bits in file ID & RVN areas to refer to rel. vol of a softlink-set ; by editing dir files on the way by when opened to have these bogus ; file IDs. On create, must check DID field & see if we have an LDT ; with a flag for that dir, so we'd again clobber create (& user chnl) to ; point at the other disk during time the file's open. That may let us ; produce the illusion that softlinked dirs really "are" on the current ; volume. ; ; We will support file moving, delete management, dynamic priority, ; privs & identifiers, daemon-based additional access controls, ; (which might be file integrity tests & conditional softlinks), ; and space management eventually. Also we'll eventually support ; special action on directore read-in so the dirs' files get arbitrated ; by a daemon instead of directly read. That'll let them be treated as ; softlinks too without having to clutter the disk, (ever maybe) ; with junk file headers. ; (juicer has dir layout docs in its comments.) ; ; Initial version basically to support security & limited hsm stuff, ; not ALL softlink possibilities. ; ; Glenn C. Everhart, November 1993 ; ; For a follow-on, we will add support for removing file headers completely. ; Note that we can do a softlink to other files so long as we can tell ; that the file should be so linked. Having a bitmap to let us filter ; out uninteresting files, our open daemon can tell that. To handle requests ; other than open we need to catch access without io$m_access, io$_acpcontrol, ; and some other functions of io$_modify and maybe io$_delete (depends on ; policy decision...SHOULD a file "somewhere else" be deleted apart from ; its "home" location...I think not, so just fake success for that). Where ; these don't open a file, we do the softlink by resetting the IRP only, ; not the channel too. Thus no catching logic is needed to put the user ; channel back. ; By catching I/O in this way we can read in a linked directory from ; "somewhere" and just tag those file IDs as being in our bitmap, and ; record for the daemon that those files are on device xxx:, then let ; the daemon return the correct device softlink info to let the file ; be accessed at its home. The directory would reside on the local ; disk. When a file got created in it, the directory would get a real ; entry. An inswap would need the "somewhere" entry to be removed and ; a real one added and the daemon's data telling it where the real file ; was reset. At each directory open for such a directory that was "really" ; somewhere else, though, a merge of the then-current remote directory ; and the local one would be needed, concurrently updating the daemon's ; database, so new files created on the other device would appear in ; the local file, but files really on the local disk would appear. There ; could be problems where the directory read was from the XQP with ; this, though, so we may want to just pull the directory in every time ; regardless. We get control ahead of the XQP, but must ensure all ; processing of this kind is in another process, as the XQP is not in ; an interruptable point for this stuff. ; ; It is possible to have directory entries pointing at nonexistent ; file headers and file IDs and have the access daemon (that handles ; io$_access, io$_acpcontrol etc.) generate a softlink to some real ; file on the fly. If the nonexistent directory entries are flagged by, ; say, bit 8 of the RVN being set, it might be possible to reset the ; access to the desired one in kernel mode. If done by a daemon using ; some other flagging (a bitmap maybe? Or maybe use RVN 255?) then ; the daemon is responsible for setting the correct FID and device into ; the request and device can be stored in the daemon database. Thus ; an outswapped file could be completely offline, yet the directory ; entry could be "there", and in moments of not inswapping it might be ; left pointing at some scratch file header that would point at a zero ; length file, via dynamic softlink, so that directory entries and so ; on would succeed even though their info would be fairly useless. ; (It's possible to reset the EOF pointer of these to the right size ; and possibly reset the date before each access should we choose to ; do so; file would be zero size anyhow. If a daemon access is used, ; the extra overhead of resetting date every time and so on might not ; be too bad. It would mean that the outswapped file size and at least ; creation date would still be visible even if the file ID was actually ; useless.) ; A second release would be usefully able to perform these operations ; so that outswapped file headers could be purged away, yet directory ; operations would continue to be able to show the files. This would mean ; that the directory files would continue to be large, but the index ; file would not grow boundlessly. If such a directory were outswapped, ; it might be inswapped later,being able to outswap only if it had no ; current files. This is a little easier than softlinking directories ; since no merging is needed. Directory opens are usually done by ; RMS in exec mode, and this would make it easy to shove an outswapped ; directory back in, from our daemon, doing so before the XQP actually ; gets the request queued to move anything. We'd need extra data in ; a daemon database and possibly in a knl mode bitmap to flag what ; was a directory; an outswapped directory might need to be flagged ; with an otherwise illegal FID so we would have a sure and certain ; tag to use on it. Inswapping it would then have to replace the ; FID in the parent directory. The directory file format seems not to ; have any checksums, so this will be comparatively clean and simple. ; Flagging in this way would allow clear detection of directory files, ; though the daemon would need to back up the test with its own data ; so inadvertent bogus matches would just be allowed to continue. (One ; might coopt RVN 255 and RVN 254 for directories and files respectively ; where one wanted a simple tag that could be used to recognize swapped ; dirs and files.) This way one could get rid of file headers off a disk, ; and periodically trim off directory files, yet the directories would ; still apparently be there if anyone looked (and if a mode to open ; them were selected; if not, the directory file could just be pointed ; at some ordinary file and the open would NOT show another directory). ; Normally you'd want to limit depth of opening old outswapped directories ; by telling the daemon how old a directory might be and still be opened ; (so a simple dir [...]*.* doesn't inswap everything unless that's really ; wanted). Since you'd be regulating at the granularity of directories ; filetype cuts might not show up, but directories would. Users could ; reset directory creation dates with the FILE utility or similar if ; they wanted to keep these dates useful. A script to reset directory ; revision dates to the date of last file creation should be supplied ; to be run periodically, so that this information would be more ; useful; VMS normally doesn't maintain it. ; ;vms$$v6=0 ;add forvms v6 def'n vms$v5=1 ; define v5$picky also for SMP operation v5$picky=1 .SBTTL EXTERNAL AND LOCAL DEFINITIONS ; ; EXTERNAL SYMBOLS ; .library /SYS$SHARE:LIB/ ; $ADPDEF ;DEFINE ADAPTER CONTROL BLOCK $CRBDEF ;DEFINE CHANNEL REQUEST BLOCK $DYNDEF ;define dynamic data types $DCDEF ;DEFINE DEVICE CLASS $DDBDEF ;DEFINE DEVICE DATA BLOCK $DEVDEF ;DEFINE DEVICE CHARACTERISTICS $DPTDEF ;DEFINE DRIVER PROLOGUE TABLE $EMBDEF ;DEFINE ERROR MESSAGE BUFFER $IDBDEF ;DEFINE INTERRUPT DATA BLOCK $IODEF ;DEFINE I/O FUNCTION CODES $DDTDEF ; DEFINE DISPATCH TBL... $ptedef $vadef $IRPDEF ;DEFINE I/O REQUEST PACKET $irpedef $PRDEF ;DEFINE PROCESSOR REGISTERS $SSDEF ;DEFINE SYSTEM STATUS CODES $UCBDEF ;DEFINE UNIT CONTROL BLOCK $sbdef ; system blk offsets $psldef $prdef $acldef $rsndef ;define resource numbers $acedef $VECDEF ;DEFINE INTERRUPT VECTOR BLOCK $pcbdef .if df,pcb$m_nounshelve pcbmsk$$=0 .endc .iif ndf, PCB$M_NOUNSHELVE, PCB$M_NOUNSHELVE=^x80000 .iif ndf, PCB$M_SHELVING_RESERVED,PCB$M_SHELVING_RESERVED=^x100000 .iif ndf, PCB$V_NOUNSHELVE,PCB$V_NOUNSHELVE=19 .iif ndf, PCB$V_SHELVING_RESERVED,PCB$V_SHELVING_RESERVED=20 $statedef $jibdef $acbdef $vcbdef $arbdef $wcbdef $ccbdef $fcbdef $phddef $RABDEF ; RAB structure defs $RMSDEF ; RMS constants ; defs for acl hacking $fibdef $atrdef p1=0 ; first qio param p2=4 p3=8 p4=12 p5=16 p6=20 ;6th qio param offsets .IF DF,VMS$V5 ;VMS V5 + LATER ONLY $SPLCODDEF $cpudef .ENDC ; ; UCB OFFSETS WHICH FOLLOW THE STANDARD UCB FIELDS ; $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_oldfdt .blkl 1 ;fdt tbl of prior fdt chain ; ; $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$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=^xF012F000 + ddt$k_length + <256*> p.magic=^xF012F000 + 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. ; ; Set FDT table start mask for each unit by keeping it here. ; We need just enough to get back to user's FDTs. $def ucb$l_fdtlgl .blkl 2 ;legal fcn msks $def ucb$l_fdtbuf .blkl 2 ;buffered fcn msks $def ucb$l_fdtmfy .blkl 3 ;modify fcn $def ucb$l_fdtbak .blkl 3 ;"go back" fcn $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$K_JT_LEN .BLKW 1 ;LENGTH OF UCB ;UCB$K_JT_LEN=. ;LENGTH OF UCB $DEFEND UCB ;END OF UCB DEFINITONS ; 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 nonzero if doing 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 = 1052 ;filename desc of orig i/o (p2 arg) ;2 longs ldt$l_fndd = 1060 ;data area for filename (256 bytes) ldt$l_size = 1324 ldt$k_clrsiz = 1320 ;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 ; 07 - "temporary" tag. Format: ; 07, len, , ;16 bytes ; 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. .SBTTL STANDARD TABLES ; ; DRIVER PROLOGUE TABLE ; ; THE DPT DESCRIBES DRIVER PARAMETERS AND I/O DATABASE FIELDS ; THAT ARE TO BE INITIALIZED DURING DRIVER LOADING AND RELOADING ; driver_data JT_UNITS=300 JT$DPT:: .iif ndf,spt$m_xpamod,dpt$m_xpamod=0 .if df,evax .if ndf,vms$$v6 DPTAB - ;DPT CREATION MACRO END=JT_END,- ;END OF DRIVER LABEL ADAPTER=NULL,- ;ADAPTER TYPE = NONE (VIRTUAL) FLAGS=DPT$M_SMPMOD!DPT$M_NOUNLOAD, - ;SET TO USE SMP DEFUNITS=2,- ;UNITS 0 THRU 1 thru 31 UCBSIZE=UCB$K_JT_LEN,- ;LENGTH OF UCB step=1,- MAXUNITS=JT_UNITS,- ;FOR SANITY...CAN CHANGE NAME=JTDRIVER ;DRIVER NAME .iff DPTAB - ;DPT CREATION MACRO END=JT_END,- ;END OF DRIVER LABEL ADAPTER=NULL,- ;ADAPTER TYPE = NONE (VIRTUAL) FLAGS=DPT$M_SMPMOD!dpt$m_xpamod!DPT$M_NOUNLOAD, - ;SET TO USE SMP,xa DEFUNITS=2,- ;UNITS 0 THRU 1 thru 31 step=1,- UCBSIZE=UCB$K_JT_LEN,- ;LENGTH OF UCB MAXUNITS=JT_UNITS,- ;FOR SANITY...CAN CHANGE NAME=JTDRIVER ;DRIVER NAME .endc .iff .if ndf,vms$$v6 DPTAB - ;DPT CREATION MACRO END=JT_END,- ;END OF DRIVER LABEL ADAPTER=NULL,- ;ADAPTER TYPE = NONE (VIRTUAL) FLAGS=DPT$M_SMPMOD!DPT$M_NOUNLOAD, - ;SET TO USE SMP DEFUNITS=2,- ;UNITS 0 THRU 1 thru 31 UCBSIZE=UCB$K_JT_LEN,- ;LENGTH OF UCB MAXUNITS=JT_UNITS,- ;FOR SANITY...CAN CHANGE NAME=JTDRIVER ;DRIVER NAME .iff DPTAB - ;DPT CREATION MACRO END=JT_END,- ;END OF DRIVER LABEL ADAPTER=NULL,- ;ADAPTER TYPE = NONE (VIRTUAL) FLAGS=DPT$M_SMPMOD!dpt$m_xpamod!DPT$M_NOUNLOAD, - ;SET TO USE SMP,xa DEFUNITS=2,- ;UNITS 0 THRU 1 thru 31 UCBSIZE=UCB$K_JT_LEN,- ;LENGTH OF UCB MAXUNITS=JT_UNITS,- ;FOR SANITY...CAN CHANGE NAME=JTDRIVER ;DRIVER NAME .endc .endc DPT_STORE INIT ;START CONTROL BLOCK INIT VALUES DPT_STORE DDB,DDB$L_ACPD,L,<^A\F11\> ;DEFAULT ACP NAME DPT_STORE DDB,DDB$L_ACPD+3,B,DDB$K_PACK ;ACP CLASS .IF NDF,VMS$V5 DPT_STORE UCB,UCB$B_FIPL,B,8 ;FORK IPL (VMS V4.X) .IFF ;DEFINE FOR VMS V5.X & LATER DPT_STORE UCB,UCB$B_FLCK,B,SPL$C_IOLOCK8 ;FORK IPL (VMS V5.X + LATER) .ENDC ; These characteristics for an intercept driver shouldn't look just ; like a real disk unless it is prepared to handle being mounted, etc. ; Therefore comment a couple of them out. DPT_STORE UCB,UCB$L_DEVCHAR,L,- ;DEVICE CHARACTERISTICS ; RANDOM ACCESS DPT_STORE UCB,UCB$L_DEVCHAR2,L,- ;DEVICE CHARACTERISTICS ; Prefix name with "node$" (like rp06) DPT_STORE UCB,UCB$B_DEVCLASS,B,DC$_DISK ;DEVICE CLASS DPT_STORE UCB,UCB$W_DEVBUFSIZ,W,512 ;DEFAULT BUFFER SIZE ; FOLLOWING DEFINES OUR DEVICE "PHYSICAL LAYOUT". It's faked here. DPT_STORE UCB,UCB$B_TRACKS,B,1 ; 1 TRK/CYL DPT_STORE UCB,UCB$B_SECTORS,B,64 ;NUMBER OF SECTORS PER TRACK DPT_STORE UCB,UCB$W_CYLINDERS,W,16 ;NUMBER OF CYLINDERS DPT_STORE UCB,UCB$B_DIPL,B,8 ;DEVICE IPL DPT_STORE UCB,UCB$B_ERTMAX,B,10 ;MAX ERROR RETRY COUNT DPT_STORE UCB,UCB$W_DEVSTS,W,- ;INHIBIT LOG TO PHYS CONVERSION IN FDT ;... ; ; don't mess with LBN; leave alone so it's easier to hack on... ; DPT_STORE REINIT ;START CONTROL BLOCK RE-INIT VALUES ; DPT_STORE CRB,CRB$L_INTD+VEC$L_ISR,D,JT_INT ;INTERRUPT SERVICE ROUTINE ADDRESS .if ndf,evax DPT_STORE CRB,CRB$L_INTD+VEC$L_INITIAL,- ;CONTROLLER INIT ADDRESS D,JT_ctrl_INIT ;... DPT_STORE CRB,CRB$L_INTD+VEC$L_UNITINIT,- ;UNIT INIT ADDRESS D,JT_unit_INIT ;... .endc DPT_STORE DDB,DDB$L_DDT,D,JT$DDT ;DDT ADDRESS DPT_STORE UCB,UCB$L_UNIQID,D,DPT$TAB ;store DPT address ; (change "XX" to device ; mnemonic correct values) DPT_STORE UCB,UCB$L_ICSIGN,L,magic ; Add unique pattern (that might ; bring back some memories in ; DOS-11 users) ; HISTORICAL NOTE: under DOS-11, one would get F012 and F024 errors ; on odd address and illegal instruction traps. If we don't have ; this magic number HERE, on the other hand, we're likely to see ; bugchecks in VMS due to uncontrolled bashing of UCB fields! DPT_STORE END ;END OF INITIALIZATION TABLE ; ; DRIVER DISPATCH TABLE ; ; THE DDT LISTS ENTRY POINTS FOR DRIVER SUBROUTINES WHICH ARE ; CALLED BY THE OPERATING SYSTEM. ; ;JT$DDT: .if df,evax DDTAB - ;DDT CREATION MACRO DEVNAM=JT,- ;NAME OF DEVICE START=JT_STARTIO,- ;START I/O ROUTINE FUNCTB=JT_FUNCTABLE,- ;FUNCTION DECISION TABLE CTRLINIT=JT_CTRL_INIT,- UNITINIT=JT_UNIT_INIT,- CANCEL=0,- ;CANCEL=NO-OP FOR FILES DEVICE REGDMP=0,- ;REGISTER DUMP ROUTINE DIAGBF=0,- ;BYTES IN DIAG BUFFER ERLGBF=0 ;BYTES IN ;ERRLOG BUFFER .iff DDTAB - ;DDT CREATION MACRO DEVNAM=JT,- ;NAME OF DEVICE START=JT_STARTIO,- ;START I/O ROUTINE FUNCTB=JT_FUNCTABLE,- ;FUNCTION DECISION TABLE ; CANCEL=0,- ;CANCEL=NO-OP FOR FILES DEVICE ; REGDMP=0,- ;REGISTER DUMP ROUTINE ; DIAGBF=0,- ;BYTES IN DIAG BUFFER ERLGBF=0 ;BYTES IN ;ERRLOG BUFFER .endc ; ; FUNCTION DECISION TABLE ; ; THE FDT LISTS VALID FUNCTION CODES, SPECIFIES WHICH ; CODES ARE BUFFERED, AND DESIGNATES SUBROUTINES TO ; PERFORM PREPROCESSING FOR PARTICULAR FUNCTIONS. ; v15a: .address vcstp15 ;AST address for internal AST kasta: .address jtkast ;SKAST addr for daemon to use ACLlit: .ascii /GCEV/ ;literal for our use for ACE flag ; code chaining data: chnflg: .long 0 ;chain or use our FDT chain flag...use ours if 0 myonoff: fdtonoff: .long 0 ;switch my fdt stuff off if non-0 .ascii /flag/ ;define your own unique flag here; just leave it 4 bytes long! .long 0 ;fdt tbl from before patch fdt_chn = -12 fdt_prev = -4 fdt_idnt = -8 JT_FUNCTABLE: newfdt: FUNCTAB ,- ;LIST LEGAL FUNCTIONS ; MOUNT VOLUME ; no-op phys I/O for a test here... FUNCTAB ,- ;BUFFERED FUNCTIONS ; MOUNT VOLUME myfdtstart: ; io$_format + modifiers (e.g. io$_format+128) as function code ; allows one to associate a JT unit and some other device; see ; the JT_format code comments for description of buffer to be passed. functab JT_format,- ;point to host disk FUNCTAB JT_ALIGN,- ;TEST ALIGNMENT FUNCTIONS (does nothing) ; ; First our very own filter routines ; ; Following FDT function should cover every function in the local ; FDT entries between "myfdtbgn" and "myfdtend", in this case just ; mount and modify. Its function is to switch these off or on at ; need. .if ndf,lp$filt Functab fdtswitch,- .iff Functab fdtswitch,- .endc myfdtbgn=. ; Leave a couple of these in place as an illustration. You would of course ; need to insert your own if you're messing with FDT code, or remove these if ; you don't want to. The FDT switch logic is a waste of time and space if ; you do nothing with them... ; They don't actually do anything here, but could be added to. Throw in one ; to call some daemon at various points and it can act as a second ACP ; when control is inserted at FDT time (ahead of the DEC ACP/XQP code!) FUNCTAB MFYMOUNT,- ;MOUNT FUNCTION ; MOUNT VOLUME functab accfilt,- ;Access file (open files) functab deacfilt,- ;deaccess file (close) functab crefilt,- ;create file FuncTab DelFilt,- ;delete file FuncTab MFYFilt,- ;modify filter (e.g. extend) .if df,lp$filt ; The logical I/O filter is optional but is intended to allow one to ; test that the device is non-foreign mounted and if mounted and NOT foreign ; it will reject logical or physical r/w from user mode channels. This is ; designed to help protect against apps like ods2-reader that bypass the ; file system, privs or no. FUNCTAB RWFilt,- ;read/write logical filter .endc ;lp$filt myfdtend=. ; Note that if we want to allow numerous disk drivers to be patched ; by this one there is not a unique path to the original fdt ; routine. Therefore use a UCB cell for the patch, not a cell ; ahead of the FDT. That way each unit gets a good return ; path. That's why there's an "oldfdt" cell in the UCB here. ; ; ; Following contains all legal functions in mask... ; That way it can transfer all control to a "previous" FDT chain. fdtlclcnt: FuncTab fdttoorig,- ; MOUNT VOLUME ; Now the "standard" disk FDT routines needed to let ODS-2 work (or ods-1 !) ; (Where we are doing read - or possibly write- virtual by hand ourselves ; we may never get to these BTW...) FUNCTAB +ACP$READBLK,- ;READ FUNCTIONS FUNCTAB +ACP$WRITEBLK,- ;WRITE FUNCTIONS FUNCTAB +ACP$ACCESS,- ;ACCESS FUNCTIONS FUNCTAB +ACP$DEACCESS,- ;DEACCESS FUNCTION FUNCTAB +ACP$MODIFY,- ;MODIFY FUNCTIONS FUNCTAB +ACP$MOUNT,- ;MOUNT FUNCTION ; MOUNT VOLUME FUNCTAB +EXE$LCLDSKVALID,- ;LOCAL DISK VALID FUNCTIONS ;PACK ACKNOWLEDGE FUNCTAB +EXE$ZEROPARM,- ;ZERO PARAMETER FUNCTIONS ; AVAILABLE FUNCTAB +EXE$ONEPARM,- ;ONE PARAMETER FUNCTION FUNCTAB +EXE$SENSEMODE,- ;SENSE FUNCTIONS FUNCTAB +EXE$SETCHAR,- ;SET FUNCTIONS ; This routine normally would be called to go back to our FDT chain at ; fdtlclcnt; it lies after all normal ones would go. It transfers from the FDT ; table in the UCB to the JTdriver table. At fdtlclcnt we transfer to the ; original driver fdt chain. Note this needs serious mods in axp step2... mybak: FuncTab fdttoucb,- ; MOUNT VOLUME ; Data used for templates and so on here ; item list for reading ACL gceacl: .word 512 ;ACL buffer is 512 bytes long .word atr$c_readacl ;read the whole ACL in if we can gceaba: .long 0 ;address of ACL buffer in LDT .word 4 ;get ACL length .word atr$c_acllength ; this item reads ACL length gceala: .long 0 ; address in LDT of cell to get ACL size .long 0,0 ;terminator for item list gcetpl=.-gceacl ;length of template. ; Flag literal used to check for MY ACL entries. gceflg: .ascii /GCEV/ ;use my initials... jt_ucb: jt_utb: .rept jt_units .long 0 .endr .long 0,0,0,0,0,0,0,0,0,0 driver_code ; fdtswitch - ; Based on state of "myonoff" variable either enable or disable ; my FDT processing, allowing the FDT chain to remain always intact. ; This needs to be the first of a chain of FDT entries added to the ; FDT processing of a driver. fdtswitch: .jsb_entry output= tstl fdtonoff ;global on/off bneq 1$ rsb ;go to next FDT if null 1$: addl2 #,r8 ;pass our fdt codes rsb ;return to std ; fdttoorig - ; This entry continues FDT processing at the point after the new ; entries by returning to the original FDT chain at the point where ; that chain begins. (It is presumed that FDT entries will always be ; added ahead of existing ones due to the nonreturning nature of ; FDT processing.) This is done instead of simply duplicating the ; DEC FDT entries because in this way multiple FDT patches can ; coexist, as would be impossible if this trick were not used. As ; can be seen, its overhead is minimal. ; The old FDT location is kept in the UCB for our device because ; that allows us to get back to different FDTs when several drivers' ; FDT chains are pointed here first. fdttoorig: .jsb_entry output= pushl r0 ; (this routine gets called a fair bit and if GETJTUCB can be ; called less, things speed up.) jsb getjtucb ;get UCB for JT unit from stolen ;one tstl r0 ;r0 is return UCB bgeq 1$ ;if not negative, not a UCB tstl ucb$l_oldfdt(r0) ;a prior fdt exist? beql 1$ movl ucb$l_oldfdt(r0),r8 ;point to original FDT point addl2 #<16-12>,r8 ;pass the 2 entry masks 1$: ;back up since sysqioreq adds 12 popl r0 2$: rsb ;off to the previous FDT routines. ; fdttoucb - ; This entry continues FDT processing at the point after the new ; entries by returning to the original FDT chain at the point where ; that chain begins. (It is presumed that FDT entries will always be ; added ahead of existing ones due to the nonreturning nature of ; FDT processing.) This is done instead of simply duplicating the ; DEC FDT entries because in this way multiple FDT patches can ; coexist, as would be impossible if this trick were not used. As ; can be seen, its overhead is minimal. ; The old FDT location is kept in the UCB for our device because ; that allows us to get back to different FDTs when several drivers' ; FDT chains are pointed here first. .if df,evax fdttoucb: .jsb_entry output= .iff fdttoucb: .endc pushl r0 ; (this routine gets called a fair bit and if GETJFUCB can be ; called less, things speed up.) movab myfdtstart,r8 ; Conditionalize this. If the inst is not there, we skip the first of our ; FDT routines (i.e., the io$_format entry) so that io$_format to jtdriver ; is thus distinct from io$_format to the victim (intercepted) device. ;this is goodness since it allows us to intercept FD devices etc. that need ; to issue io$_format to control the driver too. .if df,lcl$fmt subl2 #12,r8 ;start at our FDT entries .endc ; note sysqioreq adds 12 so we start 12 bytes earlier. 1$: ;back up since sysqioreq adds 12 popl r0 2$: rsb ;off to the previous FDT routines. ; ; GETJTUCB - Find JT: UCB address, given r5 points to UCB of the patched ; device. Return the UCB in R0, which should return 0 if we can't find ; it. ; This routine is called a lot and therefore is made as quick as ; it well can be, especially for the usual case. getjtucb: .jsb_entry output= ; clrl r0 ;no UCB initially found pushl r10 pushl r11 ;faster than pushr supposedly ; pushr #^m ; Assumes that R5 is the UCB address of the device that has had some ; code intercepted and that we are in some bit of code that knows ; it is in an intercept driver. Also assumes R11 may be used as ; scratch registers (as is true in FDT routines). Control returns at ; label "err" if the DDT appears to have been clobbered by ; something not following this standard, if conditional "chk.err" ; is defined. ; Entry: R5 - victim device UCB address ; Exit: R11 - intercept driver UCB address chk.err=0 movl ucb$l_ddt(r5),r10 ;get the DDT we currently have ; note we know our virtual driver's DPT address!!! movab JT$dpt,r11 ;magic pattern is DPT addr. ; lock this section with forklock so we can safely remove ; entries at fork also. Use victim device forklock. ; (don't preserve r0 since we clobber it anyway.) forklock lock=ucb$b_flck(r5),savipl=-(sp),preserve=NO 2$: cmpl (r10),R11 ;this our own driver? ; beql 1$ ;if eql yes, end search ; ; The somewhat odd layout here removes extra branches in the ; most common case, i.e., finding our driver the very first time ; through. The "bneq" branch next time is usually NOT taken. ; bneq 5$ ;check next in chain if not us ; At this point R10 contains the DDT address within the intercept ; driver's UCB. Return the address of the intercept driver's UCB next. movab <0-ucb$a_vicddt>(r10),r11 ;point R11 at the intercept UCB ; brb 4$ ; note in this layout we can comment this out. 4$: forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,preserve=NO ; NOW clobber r0 and put things back. movl r11,r0 ; popr #^m popl r11 popl r10 ;supposedly faster than popr rsb ; Make very sure this DDT is inside a UCB bashed according to our ; specs. The "p.magic" number reflects some version info too. ; If this is not so, not much sense searching more. 5$: cmpl (r10),#p.magic bneq 3$ ;exit if this is nonstd bash ; follow DDT block chain to next saved DDT. movl (r10),r10 ;point R10 at the next DDT in the ;chain bgeq 3$ ; (error check if not negative) brb 2$ ;then check again ;1$: 3$: clrl r11 ;return 0 if nothing found brb 4$ ; ; Few macros for long distance branches... ; .macro blssw lbl,?lbl2 bgeq lbl2 brw LBL LBL2: .endm .macro beqlw lbl,?lbl2 bneq lbl2 brw lbl lbl2: .endm .macro bgequw lbl,?lbl2 blssu lbl2 brw lbl lbl2: .endm .macro bneqw lbl,?lbl2 beql 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. ; This macro makes it easy to zero an allocated area before using it. ; Leaves no side effects...just zeroes the area for "size" bytes ; starting at "addr". .macro zapz addr,size pushr #^m ;save regs from movc5 movc5 #0,addr,#0,size,addr popr #^m ;save regs from movc5 .endm ; .SBTTL Our FDT Filter Routines ; These routines are edited from the JTdriver versions to call ; getJTucb, assuming they are called with R5 pointing at the patched ; driver's UCB. ; INPUTS: ; ; R3 - IRP ADDRESS (I/O REQUEST PACKET) ; R4 - PCB ADDRESS (PROCESS CONTROL BLOCK) ; R5 - UCB ADDRESS (UNIT CONTROL BLOCK) ; R6 - CCB ADDRESS (CHANNEL CONTROL BLOCK) ; R7 - BIT NUMBER OF THE I/O FUNCTION CODE ; R8 - ADDRESS OF FDT TABLE ENTRY FOR THIS ROUTINE ; (AP) - ADDRESS OF FIRST QIO PARAMETER ; Filter routines. ; These do the interesting stuff. ; ;AccFilt: Handles open (io$_access) requests. ; Operation: ; 1. Check that access is really OK here (not our own daemons, not ; our own internal I/O, either dummy FID to call daemon at once ; or not in our job, and that function has io$m_access bit ; set if not a bogus fid (& relevant fcnmsk bit). ; 2. Store the I/O context (registers etc.) in a structure called ; our Local Data Table (LDT) ; (note: skip 2-5 if dummy FID & just call daemon if needed) ; 3. Start an i/o thread to read the ACL in. Note we make mainline wait ; via waitfor ef#31 and loop till our local data structure says ; we got r0 return from USER'S i/o. Flag nodelete till done ; unless it was set at start. Use per-process counter to do ; the nodelete state right. ; 4. If our ACE is there (3rd long containing "GCEV") then store it in ; our structure for later. Junk stuff we don't need any more. ; 5. ASTs (knl, -> sp. knl) of internal I/O get to skast state. ; 6. If ACE says to call daemon, or if ACL not all there and our ACE not ; seen, call daemon (in latter case flagging to read ACL one ACE at ; a time) ; 7. Either direct or from SKAST from daemon return, restore regs ; & context and issue user i/o. Unblock mainline once we get ; r0 status from that i/o (return approp. value) and undo ; no-delete, no-suspend flagging of process. Free knl stuff if ; no need for it, or leave it for delete FDT processing. ; AccFilt: .jsb_entry ; skip kernel channels bitb #3,irp$b_rmod(r3) ;see if any nonknl bits are there bneq 1$ ;if neq yes, ok to continue 2$: rsb ;no, cannot munge knl packet 1$: ; Also check quotas like the DEC FDT routines do to ensure quotas are ; not going to be violated. No need to go further if so. movl pcb$l_jib(r4),r1 ;get the JIB .if df,evax tstl jib$l_filcnt(r1) ;got any files left? .iff tstw jib$w_filcnt(r1) ;got any files left? .endc bleq 2$ ;no, skip now. ;check device not mounted, mounted, shadowset part etc. bbs #dev$v_dmt,ucb$l_devchar(r5),2$ bbc #dev$v_mnt,ucb$l_devchar(r5),2$ bitl #,ucb$l_devchar2(r5) bneq 2$ bbs #dev$v_for,ucb$l_devchar(r5),2$ ; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are ; set in PCB, omit the filtering. .if df,pcbmsk$$ ; if reserved shelving bit is clear we filter as usual bbc #pcb$v_shelving_reserved,pcb$l_sts2(r4),502$ ; if and only if both bits are set we skip out bbs #pcb$v_nounshelve,pcb$l_sts2(r4),2$ 502$: .endc ; Quotas and so on look OK. Can't economically check more here. pushr #^m ; original r5 now at 4(sp). Must get that to continue the ops. jsb getJTucb ;find JTdriver ucb tstl r0 bgeqw popout movl r5,ucb$l_backlk(r0) ;save link'd ucb in ours too. movl r0,r5 ;point R5 at JT UCB bitl #1,ucb$l_ctlflgs(r5) ;doing this filtering? beqlw popout ; Make sure this isn't one of OUR daemons cmpl pcb$l_pid(r4),ucb$l_daemon(r5) ;open etc. daemon? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exdmn(r5) ;not extend daemon beqlw popout cmpl pcb$l_pid(r4),ucb$l_deldmn(r5) beqlw popout ;not delete daemon cmpl pcb$l_pid(r4),ucb$l_exempt(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid? beqlw popout ;make sure not a knl mode channel (leave the XQP channel alone!!!) cmpb ccb$b_amod(r6),#1 ;this the XQP's chnl? ; if less than 1 skip too...though that isn't supposed to happen bleqw popout ; if so scram NOW. bitl #1024,ucb$l_ctlflgs(r5) ; checking for bogus FIDs? beql 3$ ; if eql no .if df,evax movl irp$l_qio_p1(r3),r0 ;get P1 param .iff movl p1(ap),r0 .endc beql 3$ movl 4(r0),r0 ;point at user FIB beql 3$ ; skip if none there ; fid = fileno, fileseq, rvn, filenohi ; if filenohi .gt.128 and rvn .gt.128 as unsigned numbers then ; treat the operation here. ; Other h.o. bits are used to act as device switches here if this ; is selected. This requires of course that real volume sets ; be limited to maybe 32 volumes and that real maxfiles be less ; than the 24 bits' worth, for those volumes monitored here. Since ; this monitor is per disk, the function CAN just be disabled on large ; volume sets. bitb #128,fib$w_fid+4(r0) ;rvn bit set? beql 3$ bitb #128,fib$w_fid+5(r0) ;hi fileno set? bneq 4$ ;if so skip open funct. test 3$: .if df,evax bitl #,irp$l_func(r3) ; see if this is really an OPEN .iff bitw #,irp$w_func(r3) ; see if this is really an OPEN .endc beqlw popout ;if not, scram brb 93$ 4$: ; If here, we have a file id that appears fake and are flagging ; such. Arrange to call the daemon in that case. ; Note no LDT exists yet, so we'll do tests later, before issuing ; our own i/o, to test this. 93$: ; Ensure the file is not already open too, like DEC FDT routines do. tstl ccb$l_wind(r6) ;if a window exists, open now bneqw popout ;so scram fast. ; ; Now ensure that this call is not in the same JOB as the daemon. ; (This lets the daemon spawn processes to do some work.) pushr #^m ;get some regs movl ucb$l_daemon(r5),r10 ;get the daemon PID bleq 5$ movzwl r10,r7 ;get process index ; like code in FQdriver... movl g^sch$gl_pcbvec,r6 ;get pcb vector movl (r6)[r7],r8 ;get a PCB address tstl r8 ;ensure a system addr bgeq 5$ ;skip if not cmpl r10,pcb$l_pid(r8) ;be sure this is the daemon process bneq 5$ ;else skip ; ok, we for sure have the daemon's PCB now. See if the JIBs match cmpl pcb$l_jib(r8),pcb$l_jib(r4) ;same JIB as daemon's? bneq 5$ ;if not, don't skip out popr #^m ;get regs back now 48$: brw popout ;then buzz off 5$: popr #^m ;get regs back now ; Ensure this is not our own internal IRP by checking vs the AST address in ; the IRP. movab vcstp15,v15a cmpl v15a,irp$l_ast(r3) ;our IRP should be skipped beqlw popout ; ; Add "keep private volumes really private" by seeing if the volume ; owner (ucb$l_pid) is nonzero and if it is, if it does not match ; irp$l_pid then fail this i/o. .if df,real_pvt pushl r0 bitl #2048,ucb$l_ctlflgs(r5) ;2048 bit means keep pvt dvc pvt beql 148$ movl ucb$l_backlk(r5),r0 ;get original ucb tstl ucb$l_pid(r5) ;device owned by a pid? beql 148$ ;if eql no, skip out tstl irp$l_pid(r3) ;can't check internal irps blss 148$ cmpl irp$l_pid(r3),ucb$l_pid(r5) ;this i/o from owner? beql 148$ ;yah...let it by ; I/O from someone else. Return error... popl r0 popr #^m ;restore regs now movl #ss$_drverr,r0 ;this is the error jmp g^exe$abortio ;so stop the open HERE. 148$: popl r0 .endc ; if we want to check only files in our store, do the following... ; In some cases this will reduce overhead a LOT. bitl #^x40000,ucb$l_ctlflgs(r5) ;check magic bit beql 50$ pushr #^m ;need some regs .if df,evax movl irp$l_qio_p1(r5),r0 ;get FIB desc .iff movl p1(ap),r0 .endc beql 47$ movl 4(r0),r0 ;get fib addr beql 47$ movzwl fib$w_fid(r0),r1 ;get file number (check numbers beql 47$ ; if no filenum, look ; to save space) .if df,wd.lst movl #f.nums,r2 ; get size of store movab ucb$l_fnums(r5),r3 ; point at store 49$: cmpw (r3)+,r1 ; same file number? beql 47$ ; if so go ahead sobgtr r2,49$ .iff ;bitmap .iif ndf,f.nums,f.nums=16 .iif ndf,f.nsiz,f.nsiz=2048 movl #f.nsiz,r2 ; size of array movl ucb$l_fnums(r5),r3 ; get storage area beql 47$ ; no bitmap means look ; r1 is file number... .iif ndf,f.mask,f.mask=-16384 ;max bits to use in bitmap check bicl #f.mask,r1 ;clear extra bits ashl #-3,r1,r2 ;r2 gets byte offset into bitmap addl3 r3,r2,r0 ;get the address bicl #-8,r1 ;isolate bit in byte now (0-7) bbs r1,(r0),47$ ;if the bit is zero, not here ;if the bit is set, though, go fer it .endc ; fall thru...no match popr #^m brw popout 47$: popr #^m 50$: ; Looks like we need to deal with this IRP. ; First allocate some space to save the I/O context and find where this ; operation's LDT should be added. ; Do this from device IPL and save registers since we need them here. .iif df,x$$$dt,jsb g^ini$brk ;**************** debug *************** pushl r0 pushl r1 pushr #^m tstl ucb$l_prcvec(r5) ;got a process vector? blss 131$ ;if so no need to grab one pushr #^m movl g^sch$gl_maxpix,r1 ashl #5,r1,r1 ;get 32 bytes per process ; link to LDT ; ccb addr ; proc. counter of enable/disable deletion ; finish count for our thread, bumped before we do i/o, decremented when ; user's i/o r0 return avail. ; pv.ldt=0 pv.ccb=4 pv.eds=8 pv.fin=12 pushl r1 jsb g^exe$alonpagvar ;get some pool popl r1 blbc r0,31$ zapz (r2),r1 ;zero it all initially movl r2,ucb$l_prcvec(r5) ;set initial pointer in UCB popr #^m ; now grab filenum bitmap store .if ndf,wd.lst .iif ndf,f.nsiz,f.nsiz=2048 clrl ucb$l_fnums(r5) pushr #^m movl #f.nsiz,r1 ;bytes to get jsb g^exe$alonpagvar ;get some pool blbc r0,31$ movl r2,ucb$l_fnums(r5) zapz (r2),r1 31$: .endc popr #^m 131$: devicelock lockaddr=ucb$l_dlck(r5), - lockipl=ucb$b_dipl(r5),preserve=YES ; Lock this stuff where we manipulate our data structures, then drop ; to IPL2 so's not to crash due to user stuff not in memory jsb findldt ;get our LDT if any. (normally none) tstl r0 ;did we find one ready? ; must reallocate if we found one...should never get one twice beql 55$ ;if eql, good, no LDT. Grab one from pool. ;got an ldt. Free it up. pushl r1 ; point past this LDT so link is ok movl ldt$l_fwd(r0),ldt$l_fwd(r1) ;remove this ldt from chain ; r0 = addr = ldt movl ldt$l_fresiz(r0),r1 ;get size jsb g^exe$deanonpgdsiz ;free it popl r1 ;ok, now the bogus LDT is gone. Get a new one. 55$: tstl r1 ;got a valid pointer? beqlw 2000$ ;if not, skip out pushl r1 movl #ldt$l_size,r1 ;ldt size to get jsb g^exe$alonpagvar ;go get pool popl r1 blbs r0,56$ ;if ok, go on 989$: brw 2000$ ;else skip out. 56$: movl r2,(r1) ;point link at this one movl r1,r9 ;save copy here clrl ldt$l_fwd(r2) ;zero our fwd pointer movl #ldt$k_clrsiz,r10 zapz (r2),r10 ;clear entire LDT out fassstt ; now wee have the LDT created. Set it up. movl #ldt$l_size,ldt$l_fresiz(r2) ;set up the size to free movl r6,ldt$l_ccb(r2) ;claim the LDT for us movl r2,r11 ;want the LDT less volatile ; Need to set up the process structure here. Since findldt doesn't ; return it, wee need to get it directly off the UCB. pushr #^m movl ucb$l_prcvec(r5),r1 ;start of ldt chain bgeq 999$ ;lose if none movzwl pcb$l_pid(r4),r2 ;get index ashl #5,r2,r2 ;get tbl entry offset ; shift 5 so 32 bytes = 8 longs per entry addl3 r2,r1,r3 ;point r3 at our slot movl r3,r1 ;let r1 return as link addr 999$: popr #^m movl r1,ldt$l_prcstr(r11) ;set up pointer to process struct bgeqw 2000$ addl2 #8,ldt$l_prcstr(r11) ;pass LDT base info to get to our counters ; allocate the synch structure we need now. ; (if we keep ldt allocated till wait falls thru and dealloc after ; then we may be able to just use the ldt here though.) movl #16,r1 jsb g^exe$alonpagvar blbs r0,57$ ;if all well, fine ;no aux struct so skip out clrl (r9) ;clr pointer to ldt movl r11,r0 ;addr to free movl ldt$l_fresiz(r11),r1 ;size to free jsb g^exe$deanonpgdsiz brw 2000$ ;skip out 57$: movl r2,ldt$l_synch(r11) ;save pointer to synch block clrq (r2) ;set it initially null movl r11,r1 ;save ldt pointer deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES movpsl ldt$l_psl(r11) ;save original psl of request for later insv #2,#psl$v_ipl,#psl$s_ipl,ldt$l_psl(r11) ;enforce ipl2 movab ldt$l_regs(r11),r0 ;where to save regs popr #^m movl r2,(r0)+ movl r3,(r0)+ movl r4,(r0)+ movl r5,(r0)+ ;save all registers. movl r6,(r0)+ ;use movl since we don't know its movl r7,(r0)+ ;quadword aligned. movl r8,(r0)+ movl r9,(r0)+ movl r10,(r0)+ movl r11,(r0)+ ;save all registers pushr #^m movl r1,r11 ;r11 is again the LDT ; now fix up saved R5 to point at original intercepted ucb movl ucb$l_backlk(r5),ldt$l_regs+12(r11) movab ldt$l_parm(r11),r0 ;save qio params .if df,evax movl irp$l_qio_p1(r3),(r0)+ movl irp$l_qio_p2(r3),(r0)+ movl irp$l_qio_p3(r3),(r0)+ movl irp$l_qio_p4(r3),(r0)+ movl irp$l_qio_p5(r3),(r0) .iff movl p1(ap),(r0)+ movl p2(ap),(r0)+ movl p3(ap),(r0)+ movl p4(ap),(r0)+ movl p5(ap),(r0)+ .endc ; get the params like user FIB stuff... .if df,evax movl irp$l_qio_p1(r3),r10 ;fib desc. .iff movl p1(ap),r10 .endc movl 4(r10),r10 ;point at fib ityself movl fib$l_acctl(r10),ldt$l_accmd(r11) ;save "how open" clrb ldt$l_accmd+3(r11) ;clear window size .if df,evax movl pcb$l_prib(r4),ldt$l_bprio(r11) ;save base prio .iff movzbl pcb$b_prib(r4),ldt$l_bprio(r11) ;save base prio .endc ; save file id, dir id from user call initially. Get file ID later after ; our i/o as a "better" number [should be the same]. movl fib$w_fid(r10),ldt$l_myfid(r11) movzwl fib$w_fid+4(r10),ldt$l_myfid+4(r11) movl fib$w_did(r10),ldt$l_mydid(r11) ;save dir id too movzwl fib$w_did+4(r10),ldt$l_mydid+4(r11) movl g^ctl$gl_phd,r9 ;get proc. hdr movl phd$q_privmsk(r9),ldt$l_wprv(r11) ;save working privs movl phd$q_privmsk+4(r9),ldt$l_wprv+4(r11) ;save working privs movl phd$q_authpriv(r9),ldt$l_aprv(r11) ;save auth privs movl phd$q_authpriv+4(r9),ldt$l_aprv+4(r11) ;save auth privs movl r5,ldt$l_jtucb(r11) ;save jt ucb here too ; set up template, blast it into the LDT for item list movab ldt$l_acl(r11),gceaba ;acl buffer address movab ldt$l_aclsiz(r11),gceala ;length of acl movab gceacl,r9 ;point at template now movab ldt$l_itmlst(r11),r8 pushr #^m ;don't let movc3 trash these movc3 #gcetpl,(r9),(r8) ;copy filled-in template to our ;itemlist in ldt popr #^m ;fib desc still in r10 movab ldt$l_fib(r11),r9 ;copy user fib .if df,evax movl @irp$l_qio_p1(r3),r8 ;get size user has .iff movl @p1(ap),r8 .endc cmpl r8,#64 bleq 59$ ;if ok branch movl #64,r8 59$: pushr #^m ;don't let movc3 trash these movc3 r8,(r10),(r9) ;copy user FIB popr #^m bicl #^xfff,fib$l_acctl(r9) ;no special open bits ;ensure fib has nothing special clrl fib$l_aclctx(r9) ;no acl context ; ; An open might look up a filename so copy user desc too. .if df,evax movl irp$l_qio_p2(r3),r8 ;get desc. pointer .iff movl p2(ap),r8 ;get desc pointer .endc beql 159$ ;if no p2 arg, skip save movl (r8),ldt$l_fnd(r11) ;copy user desc. cmpw #255,ldt$l_fnd(r11) ;see if count to big bgeq 259$ ;if geq all well movw #255,ldt$l_fnd(r11) ;else chop off 259$: movl 4(r8),r8 ;point at user data now beql 159$ pushr #^m ;don't let movc3 trash these movab ldt$l_fndd(r11),r1 ;our ldt data address movab ldt$l_fndd(r11),ldt$l_fnd+4(r11) ;fill in data addr movzbl ldt$l_fnd(r11),r0 ;count to move beql 359$ movc3 r0,(r8),(r1) ;copy filename string 359$: popr #^m 159$: ; Basically all set up now. Issue a $qio with an AST to point to the ; normal-knl-AST code and start waiting the mainline for ef #31 (the junk ; efn) and for the extra "iosb" area to get bumped. Block deletion of the ; process during this $qio by hand, counting this up and down per PROCESS. movl ldt$l_prcstr(r11),r1 ;get process data block ; deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES ; Before issuing our I/O, see if this is a bogus file id ; that we let by earlier and route it to the daemon if so, directly ; without reading the ACL. ; R5 should still be pointing at the JT unit here since we issue another ; $qio which handles getting it moved... bitl #1024,ucb$l_ctlflgs(r5) ; checking for bogus FIDs? beqlw 103$ ; if eql no .if df,evax movl irp$l_qio_p1(r3),r0 ;get P1 param .iff movl p1(ap),r0 .endc beqlw 3$ movl 4(r0),r0 ;point at user FIB beqlw 3$ ; skip if none there ; fid = fileno, fileseq, rvn, filenohi ; if filenohi .gt.128 and rvn .gt.128 as unsigned numbers then ; treat the operation here. ; Other h.o. bits are used to act as device switches here if this ; is selected. This requires of course that real volume sets ; be limited to maybe 32 volumes and that real maxfiles be less ; than the 24 bits' worth, for those volumes monitored here. Since ; this monitor is per disk, the function CAN just be disabled on large ; volume sets. bitb #128,fib$w_fid+4(r0) ;rvn bit set? beql 105$ bitb #128,fib$w_fid+5(r0) ;hi fileno set? beql 105$ ;if so skip open funct. test ; If here, we have a file id that appears fake and are flagging ; such. Arrange to call the daemon in that case. ; Note no LDT exists yet, so we'll do tests later, before issuing ; our own i/o, to test this. ; LDT pointer in R11 here. movl r11,r0 movl r5,r1 popr #^m movl r0,r11 movl r1,r0 popl r1 popl r1 ;leave r0 alone ; now stack is clean except of push popl r5 ;get original r5 back tstl (sp)+ ;& remove saved r0 ; Now replace regs on stack, but we do leave R11 pointing at LDT. ; Since R11 is scratch for FDT routines, this is ok. Other ; stacked regs in r2-r10 range get left alone but we ; continue with r5 = JT UCB (stacked r5=victim ucb). pushr #^m movl r0,r5 ;set r5 to jt ucb pushr #^m ;now stack is same as ;after push of r0-r11 brw fakfd4 ;go handle fake fids 105$: 103$: ; (r1) = count up/down our knl threads ; 4(r1) = disable delete counter tstl 4(r1) ;is del inhibited now? bgtr 61$ incl (r1) ;count knl thread up here. bitl #,pcb$l_sts(r4) ;is delete inhibited now? bneq 160$ ;if so leave it alone 61$: incl 4(r1) ;bump inhibit counter once more bisl #,pcb$l_sts(r4) ;inhib del 160$: movl ldt$l_synch(r11),r10 ;point r10 at the synch block ; the $qio will return with all regs except r0,r1 ; First have to get the channel number from the CCB address which was passed ; in R6 so we can use the channel for OUR $qio. ; ; This is system dependent. .if df,evax ;evax defined for alpha movl r6,r12 ;deduced from sysqioreq src subl2 g^ctl$ga_ccb_table,r12 ;subtract base address ashl #-5,r12,r12 ;divide by ccb$k_length = 32 ; assume ccb$k_length eq 32 incl r12 ;1-based pushl r13 bicl3 #^c<^x0000f000>,r12,r13 ;r13 -> hi 4 bits bicl2 #^xf000,r12 ;get low 12 bits masked off ashl #4,r12,r12 ;shift 12 up ashl #-12,r13,r0 ;shift the 4 down bisl r0,r12 ;merge movzwl r12,r12 ;ensure h.o. bits off popl r13 ;restore borrowed reg ; r12 is now channel movl r12,r8 .iff ;vax vers movl r6,r8 subl2 g^ctl$gl_ccbbase,r8 ;form -chnl mnegl r8,r8 movzwl r8,r8 ;r12 should be channel now .endc ; .iif df,x$$$dt,jsb g^ini$brk ; .iif df,x$$$dt,cmpl r6,r6 ; now issue the $qio ; form descriptor for fib on stack pushl r11 ;be VERY sure we keep valid ldt ptr subl #16,sp ;get 4 longs movl sp,r10 ;descriptor is len, addr movl #64,(r10) movab ldt$l_fib(r11),4(r10) ;(r10) is descriptor of fib now. movl #gcetpl,8(r10) ;length of itemlist movab ldt$l_itmlst(r11),12(r10) ;now have descriptor for itmlst ;begin the $qio here clrl -(sp) ;p6 movl 12(r10),-(sp) ;p5 clrl -(sp) ;p4 clrl -(sp) ;p3 ; Where user open involves a dir lookup, we might need one too. ; Therefore supply the filename he used if we found one. tstl ldt$l_fndd(r11) ;got a p2? bneq 459$ ;if so fill in clrl -(sp) ;p2 zero if none here brb 559$ 459$: pushab ldt$l_fnd(r11) ;p2 as our copy of user p2 in knl space 559$: movab (r10),-(sp) ;p1 movl r11,-(sp) ;ast parm = LDT address movab vcstp15,-(sp) ;ast address = vcstp15 (step 1.5 of thread) movl ldt$l_synch(r11),-(sp) ;iosb = synch + 8 addl2 #8,(sp) ;this gives us a way to getthe status for debug tstl (sp) ;ensure negative blss 659$ clrl (sp) ;if synch addr illegal use 0 659$: ; clrl -(sp) ;no iosb movl #io$_access,-(sp) ;function movl r8,-(sp) ;channel number movl #31,-(sp) ;junk event flag movl g^ctl$gl_pcb,r4 ;point at our PCB just in case .if df,evax calls #12,g^sys$qio ;do the i/o .iff ; force curr, prev mode to knl (=0) before issuing the request here. movpsl -(sp) ;force prev knl mode too bicl #,(sp) insv #0,#psl$v_ipl,#psl$s_ipl,(sp) ;sys services like ipl 0 on vax pushab 158$ rei ;continues at 158$ with stack clear 158$: .if ndf,ee$qq calls #12,g^exe$qio ;do the i/o (kernel entry!!!) .iff calls #12,g^sys$qio ;do the i/o (kernel entry!!!) .endc .endc setipl ipl=#2,environ=UNIPROCESSOR ;back to astdel addl2 #16,sp ;clean the stack. popl r11 ; r11 should still be the LDT address, R10 the synch block address. .iif df,x$$$dt,jsb g^ini$brk ;*********************debug*************** blbs r0,3500$ ;if I/O was ok, continue brw 500$ ;else take error path 3500$: ;the user's i/o. .if ndf,evax movl ldt$l_psl(r11),-(sp) ;get to original I/O PSL jsb 301$ brb 302$ 301$: rei 302$: .endc ; if ldt got deallocated before here, could be disaster. movl ldt$l_synch(r11),r10 ;status blk address jsb dowait ;await done movl r10,r0 ;r0 status from user's I/O here usually now ; Now that dowait is done we can free the LDT with no fear of having it ; deallocated out from under dowait. setipl ipl=#2,environ=UNIPROCESSOR pushl r0 ; ; Now we can deallocate either the whole LDT or the part below the ; ACE. ; Rather than fiddle, leave the whole ACE buffer there, chopping ; off after it. ; LDT is pointed at by R11 here. ; Note we have our regs back because fdtlop etc. saves all in its ; entry mask. Thus the regs are original qio regs. For findldt we ; need r5=JT unit UCB though, so get that. movl ldt$l_regs+12(r11),r5 ;original ucb jsb getjtucb ;find JT UCB again tstl r0 ;lose if we cannot beqlw 86$ ; movl r0,r5 ;now r5=JT ucb devicelock lockaddr=ucb$l_dlck(r5), - lockipl=ucb$b_dipl(r5),preserve=YES pushl r5 cmpl ldt$l_ace+8(r11),acllit ;this our ACE? beql 80$ ;if eql we must keep the ace till close ; clean all out jsb findldt ;find where this LDT is ; On return r1 is previous LDT (which we need) and r0 is ; LDT address (must be same as R11). cmpl r0,r11 bneq 85$ ;if we get bad LDT, don't mess ; r1 is prev LDT, r11 is this one. movl ldt$l_fwd(r11),ldt$l_fwd(r1) ;collapse this LDT out of chain ;now deallocate this LDT & go ; If this is the LAST LDT, just to be safe, clear paranoid mode. ; r5 is jt ucb now, R11 is LDT address jsb chklast ;check for last LDT movl ldt$l_fresiz(r11),r1 ;length to free movl r11,r0 ;addr to free jsb g^exe$deanonpgdsiz ;free it brw 85$ 80$: ; shorten by reallocate/copy/delete jsb findldt cmpl r0,r11 bneq 85$ ;if we get bad LDT, don't mess movl r1,r10 ;move prev-ldt addr to r10...keep from harm movl #ldt$l_regs,r1 ;length to allocate jsb g^exe$alonpagvar blbc r0,85$ ;leave LDT alone if we can't grab less movl r2,r9 ;new addr save movc3 #ldt$l_regs,(r11),(r9) ;copy 1st part of LDT ; now free the old LDT after we move linkage. movl #ldt$l_regs,ldt$l_fresiz(r9) ;set size as less movl r9,ldt$l_fwd(r10) ;point prev. LDT at this. movl ldt$l_fresiz(r11),r1 movl r11,r0 ;dealloc old ldt jsb g^exe$deanonpgdsiz ;free it ; now old LDT should be free so we're done. 85$: popl r5 deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES 86$: popl r0 ; get all the saved regs off the stack popr #^m popl r1 popl r1 ;leave r0 alone but clean stack brw 510$ 500$: movl r11,r0 ;save LDT pointer in r0 ; (need LDT at stp2bad) popr #^m popl r1 popl r1 ;leave r0 alone ;stp2bad preserves all regs via save/restore. movl r0,r11 pushl r11 jsb stp2bad ;go try & resume i/o setipl ipl=#2,environ=UNIPROCESSOR ; R11 can be scratched in fdt code since it gets restored on exit from ; the system service. popl r11 movl #ss$_accvio,r0 ;set generic error ; ; free the ldt now to keep it clean. pushr #^m ; Now we can deallocate either the whole LDT or the part below the ; ACE. ; Rather than fiddle, leave the whole ACE buffer there, chopping ; off after it. ; LDT is pointed at by R11 here. ; Note we have our regs back because fdtlop etc. saves all in its ; entry mask. Thus the regs are original qio regs. For findldt we ; need r5=JT unit UCB though, so get that. movl ldt$l_regs+12(r11),r5 ;original ucb jsb getjtucb ;find JT UCB again tstl r0 ;lose if we cannot beqlw 3086$ ; movl r0,r5 ;now r5=JT ucb devicelock lockaddr=ucb$l_dlck(r5), - lockipl=ucb$b_dipl(r5),preserve=YES pushl r5 ; For a bad I/O we won't get the file open so blow away the whole LDT ; cmpl ldt$l_ace+8(r11),acllit ;this our ACE? ; beql 3080$ ;if eql we must keep the ace till close ; clean all out jsb findldt ;find where this LDT is ; On return r1 is previous LDT (which we need) and r0 is ; LDT address (must be same as R11). cmpl r0,r11 bneq 3085$ ;if we get bad LDT, don't mess ; r1 is prev LDT, r11 is this one. movl ldt$l_fwd(r11),ldt$l_fwd(r1) ;collapse this LDT out of chain ;now deallocate this LDT & go ; If this is the LAST LDT, just to be safe, clear paranoid mode. ; r5 is jt ucb now, R11 is LDT address jsb chklast ;check for last LDT movl ldt$l_fresiz(r11),r1 ;length to free movl r11,r0 ;addr to free jsb g^exe$deanonpgdsiz ;free it brw 3085$ 3080$: ;; shorten by reallocate/copy/delete ; jsb findldt ; cmpl r0,r11 ; bneq 3085$ ;if we get bad LDT, don't mess ; movl r1,r10 ;move prev-ldt addr to r10...keep from harm ; movl #ldt$l_regs,r1 ;length to allocate ; jsb g^exe$alonpagvar ; blbc r0,3085$ ;leave LDT alone if we can't grab less ; movl r2,r9 ;new addr save ; movc3 #ldt$l_regs,(r11),(r9) ;copy 1st part of LDT ;; now free the old LDT after we move linkage. ; movl #ldt$l_regs,ldt$l_fresiz(r9) ;set size as less ; movl r9,ldt$l_fwd(r10) ;point prev. LDT at this. ; movl ldt$l_fresiz(r11),r1 ; movl r11,r0 ;dealloc old ldt ; jsb g^exe$deanonpgdsiz ;free it ; now old LDT should be free so we're done. 3085$: popl r5 deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES 3086$: popr #^m 510$: pushl r0 ;ensure waits run movl #31,-(sp) ;junk event flag calls #1,g^sys$setef popl r0 ;get status back ; Must now flush the pushr of off stack. popl r5 ;get saved r5 = ucb pointer tstl (sp)+ ;fix stack, leave r0 alone jmp g^exe$qioreturn ;do intermediate exit. 2000$: deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES popr #^m popl r1 popl r0 brw popout ;leave ; step 1.5 entry. Normal kernel AST here from our $qio. We take it and ; build a special kernel AST instead. .entry vcstp15,^m prm=4 movl prm(ap),r11 ;get LDT address back to familiar R11 ;grab an ACB for skast movl #,r1 ;size of an acb jsb g^exe$alonpagvar ;allocate space for acb blbc r0,999$ ;if we fail, lose zapz (r2),# ;zero the ACB initially movw r1,acb$w_size(r2) ;save size movl r11,acb$l_astprm(r2) ;ldt is AST parameter again movl r2,r5 ;sch$qast wants r5 to have acb movl g^ctl$gl_pcb,r4 ;point at our PCB just in case ; .if df,evax ; decl pcb$l_astcnt(r4) ;count down ast quota for this one ; .iff ; adawi #-1,pcb$w_astcnt(r4) ; .endc movab vcstep2,acb$l_kast(r5) ;goto vcstep2... movl pcb$l_pid(r4),acb$l_pid(r5) ;in this process clrl acb$l_ast(r5) ;set no ast movb #<1@acb$v_kast>,acb$b_rmod(r5) ;set skast mode movl #3,r2 ;prio boost of 3 (random...) jsb g^sch$qast ;requeue the acb 999$: movl #31,-(sp) ;set junk efn now calls #1,g^sys$setef ; movl #1,r0 ;normal status ret ;back to whatever now ; "step 2" entry. HERE we have (hopefully) the ACL read in and must now ; decode it. Also we need to see if we need to call the daemon and do so if ; this is appropriate. ; Note stp2bad is a very unusual path... stp2bad: .jsb_entry pushr #^m movl r0,r11 ;r11 now points at LDT pushl r0 movl #31,-(sp) ;set junk efn now calls #1,g^sys$setef ; popl r0 brw v2cmn ;go join common code to try & issue user's I/O vcstep2: .jsb_entry pushr #^m movl #31,-(sp) ;set junk efn now calls #1,g^sys$setef ; movl acb$l_astprm(r5),r11 ; get LDT addr ;now free the ACB pushr #^m movl r5,r0 ;address movl #acb$c_length,r1 ;size jsb g^exe$deanonpgdsiz popr #^m v2cmn: tstl r11 ;ensure LDT is good blss vcz ;if good, it's neg. addr vcx: popr #^m rsb ;else give up. vcz: ; Now get original IRP, UCB, etc. to registers so we can work normally. .iif df,x$$$dt,jsb g^ini$brk ;*********************debug*************** movl ldt$l_regs+4(r11),r3 ;get original R3 movl ldt$l_regs+12(r11),r5 ;and real device R5 jsb getjtucb ;go find JT UCB address tstl r0 ;got it? beql vcx ;if not give up. movl r0,r5 ;R5 is now JT UCB addr .iif df,x$$$dt,jsb g^ini$brk ;*********************debug*************** movab ldt$l_acl(r11),r9 ;now point at the ACL we read tstl (r9) ;whole ACL null? (shortcut) beqlw 15$ ;if so skip everything. ; acl in r9 ; get ACL size movl ldt$l_aclsiz(r11),r10 ;pass ACL size in R10 beqlw 15$ ;sanity check again ; Hunt up our ACE if possible & store in LDT addl3 #512,r9,r8 ;r8 is end address 7$: movzbl (r9),r7 ;get length beqlw 15$ ;if 0, skip cmpl r9,r8 ;past end? bgequw dnfid ;if so branch cmpb 1(r9),#ace$c_info ;application ACL? beql 8$ ;if so, see if ours. 9$: addl2 r7,r9 brb 7$ ;else keep looking 8$: cmpl 8(r9),acllit ;see if it's mine... bneq 9$ ;if neq skip ; aha...found OUR ACE. ; Fill in LDT pushr #^m movab ldt$l_ace(r11),r0 ;copy the ACE in movc3 r7,(r9),(r0) ;one fell swoop popr #^m brw dnfid ;if an ACE was there, don't fake one ; Check for our file number cache here and FAKE an ACE if none was seen. ; (Note we might still have an ACE in a too-long ACL; daemon must test that.) ; (If we fake an ACE and expected one, send an extra flag too.) 15$: movab ldt$l_fib(r11),r7 ;point at our fib bitl #32768,ucb$l_ctlflgs(r5) ;pretend ACE is there always? bneq fakfid ; if bit is set, do so. Use if disk ; has almost all files marked... ; If checking open files count is >0 we also fake access movl ldt$l_prcstr(r11),r7 ;get the proc structure bgeq 5503$ ;if it exiss... tstl <<6-2>*4>(r7) ;is the opnchk count + bgtr fakfid2 tstl <<7-2>*4>(r7) ;also if runchk set do it bgtr fakfid2 ;(acctl has bits set) 5503$: movab ldt$l_fib(r11),r7 ;point at our fib movzwl fib$w_fid(r7),r7 ;this file number .if df,wd.lst movl #f.nums,r10 ;number of filenumbers movab ucb$l_fnums(r5),r9 ;store of 16 bit file numbers 11$: cmpw (r9)+,r7 ;got our file number? beql fakfid ;if so gen. an ACE sobgtr r10,11$ ;check all .iff movl ucb$l_fnums(r5),r9 ; address of storage beql dnfdj bicl #f.mask,r7 ; clear extra bits ashl #-3,r7,r10 ; isolate bit number addl2 r9,r10 ;address to R10 bicl #-8,r7 ; get bit # bbs r7,(r10),fakfid ; and test if, gen ace if a 1 .endc dnfdj: brw dnfid ;if we see none, continue normally fakfid2: tstl <<6-2>*4>(r7) bleq fakfd3 bisl #ldt$m_opnchk,ldt$l_accmd(r11) fakfd3: tstl <<7-2>*4>(r7) ;bump runfcn count bleq fakfd4 bisl #ldt$m_runfcn,ldt$l_accmd(r11) fakfd4: movab ldt$l_ace(r11),r10 ;else gen. our ACE movb #13,(r10)+ ;ace length movb #ace$c_info,(r10)+ ;info flags movw #^xe01,(r10)+ ;other flags (hidden, prot, dmn) movl #^x8000001,(r10)+ ;call daemon movl acllit,(r10)+ ;flag OUR ACE movb #1,(r10)+ ;and insert an "inspectme" record brb dnfid ; Here flag we faked this fakfid: movab ldt$l_ace(r11),r10 ;else gen. our ACE movb #13,(r10)+ ;ace length movb #ace$c_info,(r10)+ ;info flags movw #^xe01,(r10)+ ;other flags (hidden, prot, dmn) movl #^x8000011,(r10)+ ;call daemon movl acllit,(r10)+ ;flag OUR ACE movb #1,(r10)+ ;and insert an "inspectme" record ; Rest will be 0 from initial zapz call of mem. in LDT on alloc. dnfid: 10$: ; See if the I/O we finished failed completely and if so forget about ; calling the daemon... movl ldt$l_synch(r11),r7 ;get synch block address bgeq 12$ ;if illegal forget it tstw 8(r7) ;check the IOSB return bgeq 12$ movl #8,ldt$l_rtnsts(r11) ;set failure status brw lclcnt ;if negative just continue on 12$: ; Save the file ID from our FIB for possible daemon use. movab ldt$l_fib(r11),r7 ;point at our fib movl fib$w_fid(r7),ldt$l_myfid(r11) movl fib$w_fid+4(r7),ldt$l_myfid+4(r11) ; Flag for the daemon if the ACL was too darn long. cmpl ldt$l_aclsiz(r11),#512 ;was acl too long? bleq 15$ ;if leq, no ; long ACL. If no ACE now, go hunt. tstb ldt$l_ace(r11) ;ace still null? bneq 15$ ;if not, leave alone movl ldt$l_aclsiz(r11),ldt$l_ace(r11) ;else save len movl #<<8*65536>+1>,ldt$l_ace+4(r11) ;and save magic # as flag 15$: ; Now see if we need to call the daemon. If so, best go and do it, ; getting back via SKAST. Afterwards, do any priv or ID mods or ; other alteration if user I/O is to go on; otherwise just do bogus ; good/bad finish. movl #1,ldt$l_rtnsts(r11) ;set return stat initially ok movab ldt$l_ace(r11),r10 ;point at our ACE bitl #1,4(r10) ;1 bit means call daemon beqlw 30$ ;if eql no daemon call. ; Need to call daemon. Do mailbox thing like fqdriver, after test that ; daemon exists. movl ucb$l_mbxucb(r5),r9 ;mailbox ucb here bgeqw 30$ bitl #ucb$m_online,ucb$l_sts(r9) ;is mbx online? beqlw 30$ ;if not, just issue i/o .if df,evax tstl ucb$l_refc(r9) ;someone listening? .iff tstw ucb$w_refc(r9) ;someone listening? .endc bleqw 30$ ;if leq no tstl ucb$l_orb(r9) ;someone own it (daemon)? bgeqw 30$ ;if geq no ;check daemon pid still valid pushr #^m movzwl g^sch$gl_maxpix,r7 ;max process index in VMS 22$: movl g^sch$gl_pcbvec,r6 ;get pcb vector address movl (r6)[r7],r8 ;get a PCB address tstl r8 ;system address should be < 0 bgeq 23$ ;if it seems not to be a pcb forget it cmpl ucb$l_daemon(r5),pcb$l_pid(r8) ;this our process? beql 21$ ;if so, jump out of loop 23$: sobgtr r7,22$ ;if not, look at next clrl ucb$l_daemon(r5) ;if cannot find process, zero our flag 21$: popr #^m tstl ucb$l_daemon(r5) ;got our daemon process there? beqlw 30$ ;if not, skip ; Looks OK to send a buffer to the daemon. Grab one and send the message, subl #96,sp ;get buffer on stack movl sp,r8 ;r8 points at it now movl r11,(r8) ;pass LDT movl r5,4(r8) ;pass UCB of JT dvc movl ucb$l_backlk(r5),8(r8) ;and original dvc UCB (needed...) movl r10,12(r8) ;point at our ACE movab jtkast,16(r8) ;point at where to send SKAST movl ldt$l_myfid(r11),20(r8) ;pass file id too movzwl ldt$l_myfid+4(r11),24(r8) ;all of it... movl ldt$l_accmd(r11),28(r8) ;send how-open info movl ldt$l_mydid(r11),32(r8) ;also directory ID movzwl ldt$l_mydid+4(r11),36(r8) ;all of it ; Reason for sending this stuff is that it's harder to retrieve it ; from another proc. context in thedaemon. movl g^ctl$gl_pcb,40(r8) ;send pcb movl g^ctl$gl_pcb,r4 movl pcb$l_pid(r4),44(r8) ;& pid so we can send an ast movl pcb$l_epid(r4),48(r8) ;& pid so we can send an ast movl r5,52(r8) ;ucb of JT device ; Now follow ucb$l_ddb to get device name, unit, allocls and ; nodename. pushr #^m movl ucb$l_backlk(r5),r0 ;get device ucb of victim movzwl ucb$w_unit(r0),56(r8) ;send unit number movl ucb$l_ddb(r0),r1 ;get DDB (name is there) movl ddb$l_allocls(r1),84(r8) ;save alloc class clrl 60(r8) ;zero nodename clrl 64(r8) ;(fill in below if it exists. This ; prevents stacked junk from being used. movl ddb$l_sb(r1),r1 ;get sys block if any bgeq 833$ ;if none, omit name grab movl sb$t_nodename(r1),60(r8) ;else save nodename movl sb$t_nodename+4(r1),64(r8) 833$: movl ucb$l_ddb(r0),r1 ;get DDB (name is there) movl ddb$t_name(r1),68(r8) movl ddb$t_name+04(r1),72(r8) movl ddb$t_name+08(r1),76(r8) movl ddb$t_name+12(r1),80(r8) ; copy device name too. Now msg has all we need to make a unique filename. ; Note we use alloc. class if present, else nodename. popr #^m movl #1,4(r8) ;flag as an open dmn call pushr #^m ;ensure ucb etc. get back movl r9,r5 ;ucb of mbx unit movl r8,r4 ;where buffer is movl #96,r3 ;message size jsb g^exe$wrtmailbox ;emit it popr #^m addl2 #96,sp ;fix stack blbs r0,31$ ;if ok, leave for now 30$: brw lclcnt ;helper branch 31$: ; Here when mailbox write is done. ; Exit this AST routine and await next. popr #^m movl #1,r0 ;say ok rsb ; Here for "local" operation to continue with the I/O. ; This point will merge AST return and fallthru if anything went ; wrong telling daemon and fallthru where daemon should not be called. ; At entry expect LDT pointer in R11. lclcnt: jsb prvidset ;alter privs/idents if appriopriate now ;(also base prio, etc.) movl r11,r0 ;now restore regs of original I/O movab ldt$l_regs(r0),r1 ;regs save r2-r11 movl (r1)+,r2 movl (r1)+,r3 movl (r1)+,r4 movl (r1)+,r5 movl (r1)+,r6 movl (r1)+,r7 movl (r1)+,r8 movl (r1)+,r9 movl (r1)+,r10 ; movl (r1)+,r11 ;now have all regs back ; actually, junk r11 again movl r0,r11 ; Now re-enable proc. delete, suspend, etc. etc. ; since we're about to reissue user I/O (or dummy junk it) movl ldt$l_prcstr(r11),r10 ;get block of info bgeq 10$ 1$: tstl 4(r10) ;check del-inhibit count bleq 2$ ;if 0 or - skip decl 4(r10) ;count down del-inhib. bgtr 2$ ;if gtr, no reenable bicl #,pcb$l_sts(r4) 2$: 10$: movl #31,-(sp) ;set ef. to end mainline wait calls #1,g^sys$setef ;when we get outta here, that is... ; This should allow the mainline to go on. ; get conditional softlink to return 7,not 1, so we can zap privs back ; .iif df,x$$$dt,jsb g^ini$brk ;***********************debug********* ;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 ; See if return status has a couple extra bits to flag we need opnchk ; mode and/or runfcn mode. These are hooks for additional processing if ; needed, should be handy for checking for Trojans... ; Be sure this isn't a cond'l softlink return cmpw ldt$l_rtnsts(r11),#7 ; is the low order word a softlink ; return? beql 7503$ ; if so skip paranoia countup etc cmpw ldt$l_rtnsts(r11),#3 ; fake opens don't close either beql 7503$ ; if so skip paranoia countup etc blbc ldt$l_rtnsts(r11),7503$ ; also no countup if failure access bitl #<^x0e0000>,ldt$l_rtnsts(r11) beql 503$ ; Looks like one of the magic bits should be set. ; Use the 7th longword in the prcvec structure (64 bytes is 8 ; longs now...) pushl r1 movl ldt$l_prcstr(r11),r1 ;get the proc structure of flags bgeq 1503$ bitl #^x080000,ldt$l_rtnsts(r11) beql 2503$ incl <<6-2>*4>(r1) ;bump count of opnchk bisl #ldt$m_opnchk,ldt$l_accmd(r11) 2503$: bitl #^x020000,ldt$l_rtnsts(r11) beql 3503$ ; set to spawn the test but not recall it since it's for this file only bisl #^x20000000,ldt$l_accmd(r11) 3503$: bitl #^x040000,ldt$l_rtnsts(r11) beql 1503$ incl <<7-2>*4>(r1) ;bump runfcn count bisl #ldt$m_runfcn,ldt$l_accmd(r11) ; flag bits in ldt and proc struct (since ldt flags get sent to dmn) 1503$: popl r1 7503$: bicl #<^x0e0000>,ldt$l_rtnsts(r11) ;clear flag bits if any 503$: cmpl ldt$l_rtnsts(r11),#7 ;cond. softlink path? bneq 53$ ; .iif df,x$$$dt,jsb g^ini$brk ;***********************debug********* movl #1,ldt$l_rtnsts(r11) ;yes, reset to just status 1 pushr #^m ; Do not blow the LDT away at this point. Just reset privs to orig. etc. movl g^ctl$gl_pcb,r4 .if df,evax movl ldt$l_bprio(r11),pcb$l_prib(r4) .iff movb ldt$l_bprio(r11),pcb$b_prib(r4) .endc movl ldt$l_wprv(r11),pcb$q_priv(r4) movl ldt$l_wprv+4(r11),pcb$q_priv+4(r4) movl ldt$l_wprv(r11),g^ctl$gq_procpriv movl ldt$l_wprv+4(r11),g^ctl$gq_procpriv+4 movl g^ctl$gl_phd,r4 movl ldt$l_aprv(r11),phd$q_authpriv(r4) movl ldt$l_aprv+4(r11),phd$q_authpriv+4(r4) movl ldt$l_wprv(r11),phd$q_privmsk(r4) movl ldt$l_wprv+4(r11),phd$q_privmsk+4(r4) jsb undoid ; reset identifiers too popr #^m 53$: movl r5,ldt$l_chnucb(r11) ;save original chnl ucb cmpl ldt$l_rtnsts(r11),#5 ;just did r/o softl inswap? beql 353$ jsb setsoftl ;handle softlinks if enabled and needed. 353$: cmpl r5,ccb$l_ucb(r6) ;new ucb for i/o? beql 12$ ;if eql no. jsb movldt ;else move LDT to new JT unit links 12$: movl ccb$l_ucb(r6),r5 ;get ccb ucb now movl r5,irp$l_ucb(r3) ;reset IRP device also ;now grab the args and save on stack. ; i.e., DO the user's I/O for him. ; Get args out of LDT subl #24,sp movl sp,r10 ;arg area in r10 movl ldt$l_parm+00(r11),00(r10) movl ldt$l_parm+04(r11),04(r10) movl ldt$l_parm+08(r11),08(r10) movl ldt$l_parm+12(r11),12(r10) movl ldt$l_parm+16(r11),16(r10) .if ndf,evax movl #0,20(r10) .iff movl irp$l_qio_p6(r3),20(r10) .endc ; on vax, restore original PSL (for previous mode) here. .if ndf,evax movl ldt$l_psl(r11),-(sp) ;get to original I/O PSL bsbb 301$ brb 302$ 301$: rei 302$: .endc ; Now see...should we junk the I/O? cmpl ldt$l_rtnsts(r11),#3 ;secret "fake success"? beql 50$ blbc ldt$l_rtnsts(r11),60$ ;or generate i/o fail? ; no i/o junking...reissue user I.O. callg (r10),fdtlop ;reissue user FDTs setipl ipl=#2,environ=UNIPROCESSOR brw 70$ 50$: ; Daemon disallowed the I/O so undo any driver-done mods to the ; process (privs, ids, base prio) since we will NOT be closing the file. movl #1,r0 pushl r0 ;save intermediate success since we ;do generate ASTs, IOSBs, etc. jsb clnprv pushl r0 pushl r1 callg (r10),fdtxit ;fake success brb 170$ 60$: ; Daemon disallowed the I/O so undo any driver-done mods to the ; process (privs, ids, base prio) since we will NOT be closing the file. movl #1,r0 pushl r0 ;save intermediate success since we ;do generate ASTs, IOSBs, etc. jsb clnprv pushl r0 pushl r1 callg (r10),fdtbxt ;failure 170$: popl r1 popl r0 ;get back r0,r1. r1=new r10 from clnup cmpl r0,r1 ;same ucb? bneq 270$ popl r0 brb 70$ 270$: popl r0 ; beql 70$ ;if so nothing more needed ; clnup found a softlink channel but the daemon disallowed the I/O ; so reset the channel back to the original device here. movl r1,r10 movl ccb$l_ucb(r6),r9 ;keep old ucb a mo... movl r10,ccb$l_ucb(r6) ;reset user channel to orig. device ; adjust ref counts now .if df,evax decl ucb$l_refc(r9) ;1 less chnl on old dvc bgtr 174$ ;if 1+, ok movl #1,ucb$l_refc(r9) ;mounted dsk should have 1 or more 174$: incl ucb$l_refc(r10) ;bump new count again .iff decw ucb$w_refc(r9) ;1 less chnl on old dvc bgtr 174$ ;if 1+, ok movw #1,ucb$w_refc(r9) ;mounted dsk should have 1 or more 174$: incw ucb$w_refc(r10) ;bump new count again .endc ; 70$: addl2 #24,sp movl ldt$l_synch(r11),r10 ;get synch block address ; gotta end mainline wait bgeq 3$ ;skip if illegal movl r0,(r10) ;end the wait now bneq 3$ ; $qio iosb is 8 off synch blk, but we don't want to fill in till here ; If we have a status (which we should), use it tstl 8(r10) ;iosb word 1 beql 73$ movl 8(r10),(r10) 73$: ; next line probably never runs movl #1,(r10) ;set nonzero if it was 0 3$: movl ldt$l_prcstr(r11),r10 ;get block of info bgeq 20$ tstl (r10) ;see if any threads counted beql 71$ decl (r10) ;count down threads used 71$: pushl r0 ;save user's fdt r0 movl #31,-(sp) ;set ef. to end mainline wait calls #1,g^sys$setef ;when we get outta here, that is... popl r0 20$: blbs r0,25$ ;if user i/o failed, reset his ; ; privs, prio for him. movl g^ctl$gl_pcb,r4 .if df,evax movl ldt$l_bprio(r11),pcb$l_prib(r4) .iff movb ldt$l_bprio(r11),pcb$b_prib(r4) .endc movl ldt$l_wprv(r11),pcb$q_priv(r4) movl ldt$l_wprv+4(r11),pcb$q_priv+4(r4) movl ldt$l_wprv(r11),g^ctl$gq_procpriv movl ldt$l_wprv+4(r11),g^ctl$gq_procpriv+4 movl g^ctl$gl_phd,r4 movl ldt$l_aprv(r11),phd$q_authpriv(r4) movl ldt$l_aprv+4(r11),phd$q_authpriv+4(r4) movl ldt$l_wprv(r11),phd$q_privmsk(r4) movl ldt$l_wprv+4(r11),phd$q_privmsk+4(r4) pushl r10 jsb undoid popl r10 25$: .if eq,1 ; Must not deallocate the LDT till dowait gets a chance to run. Therefore ; move this loop after dowait call. Otherwise we get a flaky crash on ; heavy I/O. ; ; Now we can deallocate either the whole LDT or the part below the ; ACE. ; Rather than fiddle, leave the whole ACE buffer there, chopping ; off after it. ; LDT is pointed at by R11 here. ; Note we have our regs back because fdtlop etc. saves all in its ; entry mask. Thus the regs are original qio regs. For findldt we ; need r5=JT unit UCB though, so get that. movl ldt$l_regs+12(r11),r5 ;original ucb jsb getjtucb ;find JT UCB again tstl r0 ;lose if we cannot beql 85$ ; movl r0,r5 ;now r5=JT ucb blbc @ldt$l_synch(r11),27$ ;if i/o failed, clr ldt cmpl ldt$l_ace+8(r11),acllit ;this our ACE? beql 80$ ;if eql we must keep the ace till close ; clean all out 27$: jsb findldt ;find where this LDT is ; On return r1 is previous LDT (which we need) and r0 is ; LDT address (must be same as R11). cmpl r0,r11 bneq 85$ ;if we get bad LDT, don't mess ; r1 is prev LDT, r11 is this one. movl ldt$l_fwd(r11),ldt$l_fwd(r1) ;collapse this LDT out of chain ;now deallocate this LDT & go movl ldt$l_fresiz(r11),r1 ;length to free movl r11,r0 ;addr to free jsb g^exe$deanonpgdsiz ;free it brw 85$ 80$: ; shorten by reallocate/copy/delete jsb findldt cmpl r0,r11 bneq 85$ ;if we get bad LDT, don't mess movl r1,r10 ;move prev-ldt addr to r10...keep from harm movl #ldt$l_regs,r1 ;length to allocate jsb g^exe$alonpagvar blbc r0,85$ ;leave LDT alone if we can't grab less movl r2,r9 ;new addr save movc3 #ldt$l_regs,(r11),(r9) ;copy 1st part of LDT ; now free the old LDT after we move linkage. movl #ldt$l_regs,ldt$l_fresiz(r9) ;set size as less movl r9,ldt$l_fwd(r10) ;point prev. LDT at this. movl ldt$l_fresiz(r11),r1 movl r11,r0 ;dealloc old ldt jsb g^exe$deanonpgdsiz ;free it ; now old LDT should be free so we're done. 85$: .endc ; exit the AST. popr #^m movl #1,r0 ;say ok rsb ; clnprv clnprv: .jsb_entry pushr #^m ;entry r5 is victim ucb addr jsb getjtucb ;get jt ucb tstl r0 bgeq 99$ movl r0,r5 ;r5 now is jt ucb movl r0,r10 ;set for clnup jsb clnupnd movl r5,r0 movl r10,r1 99$: popr #^m rsb; ; prvidset ; This entry reads the ACE and sets privs/idents/base prio of ; the process based on what the ACE has. ; On entry R11 contains the LDT pointer. prvidset: .jsb_entry pushr #^m movab ldt$l_ace(r11),r10 ;point at our ACE ; look for priv sets cmpl ldt$l_ace+8(r11),acllit ;this our ACE? bneqw 999$ movab 12(r10),r10 ;start of data 1$: movzbl (r10)+,r9 ;get fcn byte beqlw 999$ cmpb r9,#1 ;inspectme => not here beql 1$ cmpb r9,#2 ;moveme beql 1$ cmpb r9,#3 ;base prio set? bneq 2$ ;if not look more ; set base prio if ok cvtbl (r10)+,r8 ;prio to use to r8 movl (r10)+,r7 ;one long of sec.info movl ldt$l_myfid(r11),r2 ;file id movl ldt$l_myfid+4(r11),r3 ;hi fileid clrl r1 movl r8,r0 jsb auth ;compute auth key cmpl r0,r7 ;check against ace bneq 1$ ;if no good look more ; ok...set base prio movl g^ctl$gl_pcb,r4 .if df,evax movl r8,pcb$l_prib(r4) ;set base prio (axp) .iff movb r8,pcb$b_prib(r4) ;set base prio (axp) .endc brw 1$ 2$: cmpb r9,#4 ;priv set? bneq 3$ ;if neq look more movl (r10)+,r0 ;sec info movl r0,r7 movl (r10)+,r1 ;sec info movl r0,r8 movl ldt$l_myfid(r11),r2 ;file id movl ldt$l_myfid+4(r11),r3 ;hi fileid jsb auth movl (r10)+,r2 ;get info from ace movl (r10)+,r3 cmpl r0,r2 ;check auth info bneq 3$ cmpl r1,r3 bneq 3$ ; set privs to mask. movl g^ctl$gl_pcb,r4 movl r7,pcb$q_priv(r4) movl r8,pcb$q_priv+4(r4) movl r7,g^ctl$gq_procpriv movl r8,g^ctl$gq_procpriv+4 movl g^ctl$gl_phd,r4 movl r7,phd$q_authpriv(r4) movl r8,phd$q_authpriv+4(r4) movl r7,phd$q_privmsk(r4) movl r8,phd$q_privmsk+4(r4) brw 1$ 3$: cmpb r9,#5 ;ident set? bneq 4$ movl (r10)+,r0 ;sec info (identifier hi) movl r0,r7 movl (r10)+,r1 ;sec info (identifier lo) movl r0,r8 movl ldt$l_myfid(r11),r2 ;file id movl ldt$l_myfid+4(r11),r3 ;hi fileid jsb auth movl (r10)+,r2 ;get info from ace movl (r10)+,r3 cmpl r0,r2 ;check auth info bneq 34$ cmpl r1,r3 bneq 34$ ; grant identifier in r7,r8 to curr. process. clrq -(sp) ;clear privatr & procname cells movab -16(r10),-(sp) ;addr of identifier info clrq -(sp) ;null pid & prcname calls #5,grantid ;use internal code (from vms) brw 1$ 34$: clrq -8(r10) ;zero the identifier if it didn't ;authenticate, so we don't revoke it ;later brw 1$ 4$: cmpb r9,#6 ;softlink record? bneq 5$ ;skip out if illegal value movzbl (r10),r9 ;get length of data addl2 r9,r10 ;add to pointer brw 1$ 5$: cmpb r9,#7 ;temp tag? bneqw 999$ ;if ill value scram movzbl (r10),r9 ;get length addl2 r9,r10 brw 1$ 999$: popr #^m rsb ; auth - ; call: r0,r1 = security info ; r2,r3 = file ID ; ucb$l_keycry key; ucb ptr in r5 ; output in r0,r1 = auth string auth: .jsb_entry output= ; simple minded scrambler ; However not TOO simple minded. Don't want this to introduce a ; new security hole so do xors and some funny checksum adds xorl2 r3,r0 xorl2 r2,r1 xorl2 ucb$l_keycry(r5),r0 xorl2 ucb$l_keycry+4(r5),r1 ;bunch of xors to scramble ; now xor once more with a constant xorl2 #^x5218fba2,r0 xorl2 #^xaba7126c,r1 pushl r0 pushl r1 ashl #3,r0,r0 addl2 r0,r1 addl2 r2,r1 ; (sp) is old r1 ;4(sp) is old r0 addl2 r1,4(sp) movzwl ucb$l_keycry+5(r5),r1 addl2 r1,4(sp) movl (sp),r1 ;get old r1 ashl #5,r1,r1 addl2 r3,r1 addl2 r1,(sp) ;mix up r1 movzwl ucb$l_keycry+1(r5),r1 addl2 r1,(sp) ;for weirdness use a couple ffs's ffs #0,#32,(sp),r1 addl2 r1,4(sp) ffs #0,#32,4(sp),r1 addl2 r1,(sp) popl r1 popl r0 rsb ; ; setsoftl - ; Called with R11 = LDT, r5=orig channel UCB, r6=CCB ; If softlink needed, should set ccb$l_ucb to desired UCB ; or else let it alone. setsoftl: .jsb_entry pushr #^m clrl ldt$l_softf(r11) ;zero softlink flag cmpl ldt$l_ace+8(r11),acllit ;this our ACE? bneqw 999$ movab ldt$l_ace(r11),r10 ;point at the ACE now movab 12(r10),r10 ;start of data 1$: movzbl (r10)+,r9 ;get fcn byte beqlw 999$ cmpb r9,#1 ;inspectme => not here beql 1$ cmpb r9,#2 ;moveme beql 1$ cmpb r9,#3 ;base prio set? bneq 2$ ;if not look more ; set base prio if ok cvtbl (r10)+,r8 ;prio to use to r8 movl (r10)+,r7 ;one long of sec.info brw 1$ 2$: cmpb r9,#4 ;priv set? bneq 3$ ;if neq look more movl (r10)+,r0 ;sec info movl (r10)+,r1 ;sec info movl (r10)+,r2 ;get info from ace movl (r10)+,r3 brw 1$ 3$: cmpb r9,#5 ;ident set? bneq 4$ movl (r10)+,r0 ;sec info movl (r10)+,r1 ;sec info movl (r10)+,r2 ;get info from ace movl (r10)+,r3 brw 1$ 4$: cmpb r9,#6 ;softlink record? bneqw 5$ ;skip out if illegal value movzbl (r10),r9 ;get length of data ; Softlink file. Find file & device and deal with it. ; Note: not looking at flags yet here. Just links files. ; (this is ok for a security tool. Directory links etc. not ; yet dealt with.) ; get file ID first movl r10,r8 ;point at data addl2 r9,r10 ;add to pointer used globally in this sub ; see if we should skip softlink recognition for this process. ; ldt$l_reg+8 is r4 which is a pcb pointer .if df,pcbmsk$$ movl g^ctl$gl_pcb,r4 ;get curr. pcb for sure ; if reserved shelving bit is clear we work as usual bbc #pcb$v_shelving_reserved,pcb$l_sts2(r4),502$ ; if and only if the nounshelve bit is clear, just skip softlinks bbc #pcb$v_nounshelve,pcb$l_sts2(r4),1502$ 502$: .endc incl r8 ;pass length byte movl r8,r9 ;use r9 as a base reg later addl2 #<1+4+2>,r8 ;pass flags, file id ; check & act on flags tstb (r9) ;normal link (0)? beql 901$ cmpb #1,(r9) ;r/o link? bneq 901$ ;no. Presume dir. link must work normally. bitl #fib$m_write,ldt$l_accmd(r11) ;r/o open (write bit clr?) beql 901$ ;yes, do write link 1502$: brw 1$ ;else don't do link. Daemon must coop too. 901$: incl ldt$l_softf(r11) ;flag we did have a softlink ; at r9, have ;next we get device name (counted ascii in ace) movl g^ctl$gl_pcb,r4 ;get curr. pcb for sure jsb g^sch$iolockw ;lock mutex ;build name descr. on stack subl2 #12,sp ;get space movl sp,r2 ;& pointer movzbw (r8)+,(r2) ;size of string movb #dsc$k_dtype_t,2(r2) movb #1,3(r2) ;fixed string movl r8,4(r2) ;data address movl r2,r1 ; string addr in r1 needed pushr #^m jsb g^ioc$searchdev ;find device popr #^m addl2 #12,sp ;put stack back blbc r0,7$ ;if can't find, skip it ; Looks ok. Now reset ref counts on the UCBs and fix up ; user FIB ref to new file and CCB UCB ref. movl ccb$l_ucb(r6),r7 ;old ucb .if df,evax decl ucb$l_refc(r7) ;count his refs down bgtr 10$ clrl ucb$l_refc(r7) .iff decw ucb$w_refc(r7) ;count his refs down bgtr 10$ clrw ucb$w_refc(r7) .endc 10$: movl r1,ccb$l_ucb(r6) ;update user CCB .if df,evax incl ucb$l_refc(r1) ;& count 1 ref up there .iff incw ucb$w_refc(r1) ;& count 1 ref up there .endc movl ldt$l_regs+4(r11),r3 ;get user IRP movl r1,irp$l_ucb(r3) ;point that at this ucb ;update FIB pointer now. movl ldt$l_parm(r11),r8 ;get P1 = fib descr. beql 7$ movl 4(r8),r8 ;get fib addr to r8 here beql 7$ movl 1(r9),fib$w_fid(r8) ;fill in file id movw 5(r9),fib$w_fid+4(r8) ;all 6 bytes clrw fib$w_did(r8) clrl fib$w_did+2(r8) ;set no lookup on softlinks...we have a file id bicw #fib$m_findfid,fib$w_nmctl(r8) ;no fid or wild lookup bicw #fib$m_wild,fib$w_nmctl(r8) clrl fib$l_wcc(r8) ;no wild context 7$: jsb g^sch$iounlock brw 1$ 5$: cmpb r9,#7 ;temp tag? bneq 999$ ;if ill value scram movzbl (r10),r9 ;get length addl2 r9,r10 brw 1$ 999$: popr #^m rsb ; ; movldt - ; Called with R11 = LDT entry, ccb$l_ucb(r6) = new UCB, ; ldt$chnucb = old UCB = r5. This routine should relink the ; LDT from the old device to the new one. movldt: .jsb_entry pushr #^m ; first find pointer to the old LDT movl g^ctl$gl_pcb,r4 devicelock lockaddr=ucb$l_dlck(r5), - lockipl=ucb$b_dipl(r5),preserve=YES pushl r5 jsb findldt ;get existing LDT tstl r0 beql 999$ movl r1,r10 ;old pointer in r10 now movl ldt$l_fwd(r11),ldt$l_fwd(r10) ;remove LDT from this chain ; now find new place for the LDT movl ccb$l_ucb(r6),r5 ;UCB we need to go to jsb findldt ;find where we can put ldt tstl r0 ;r0 better be 0 beql 2$ ; If this is the LAST LDT, just to be safe, clear paranoid mode. ; r5 is jt ucb now, R11 is LDT address jsb chklast ;check for last LDT movl ldt$l_fresiz(r11),r1 movl r11,r0 jsb g^exe$deanonpgdsiz brb 999$ 2$: clrl ldt$l_fwd(r11) ;set no fwd from us movl r11,ldt$l_fwd(r1) ;point other chain at us 999$: popl r5 deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES popr #^m rsb ; ; dowait. Enter with r10 = iosb block and r11 = ldt ; bashes r0 ; dowait: .jsb_entry output= setipl ipl=#0,environ=UNIPROCESSOR 10$: tstl (r10) ;iosb nonzero already? bneq 90$ movl ldt$l_prcstr(r11),r0 ;point at process string beql 90$ ;invalid -> exit tstl (r0) ;knl threads all done? ; all knl threads done means finished beql 90$ ;if so scram. ;looks like we need to wait. Do so. movl #31,-(sp) ;wait for efn 31 calls #1,g^sys$waitfr ; then clear it again movl #31,-(sp) calls #1,g^sys$clref brb 10$ ;then check again 90$: movl r10,r0 ;save data address movl (r10),r10 ;get status finally, return in r10 bneq 92$ ;if nonzero that's good movl #2,r10 ;else force nonzero but bogus 92$: pushr #^m ; deallocate the "iosb" block from pool now. movl #16,r1 ;16 bytes jsb g^exe$deanonpgdsiz popr #^m ; done now. rsb ; fdt redo entries. ; Logic pretty much copied from sysqioreq.mar bit .entry fdtlop,^m 10$: addl2 #12,r8 ;next mask bbc r7,(r8),10$ movl 8(r8),r0 ;get address jsb (r0) brb 10$ .entry fdtxit,^m movl #ss$_normal,r0 ;good fake exit jsb x$fini rsb .entry fdtbxt,^m movl #ss$_drverr,r0 ;bad fakeexit. no priv...the classic VMS status jsb x$fini rsb ;for appearances sake x$fini: .jsb_entry jmp g^exe$finishioc DeacFilt: .jsb_entry pushr #^m ; original r5 now at 4(sp). Must get that to continue the ops. jsb getJTucb ;find JTdriver ucb tstl r0 bgeqw popout movl r5,ucb$l_backlk(r0) ;save link'd ucb in ours too. movl r0,r5 ;point R5 at JT UCB bitl i^#65792,ucb$l_ctlflgs(r5) ;look at deaccess (close)? beqlw popout ; if eql no, forget it ; Make sure this isn't one of OUR daemons cmpl pcb$l_pid(r4),ucb$l_daemon(r5) ;open etc. daemon? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exdmn(r5) ;not extend daemon beqlw popout cmpl pcb$l_pid(r4),ucb$l_deldmn(r5) beqlw popout ;not delete daemon cmpl pcb$l_pid(r4),ucb$l_exempt(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid? beqlw popout ;make sure not a knl mode channel (leave the XQP channel alone!!!) cmpb ccb$b_amod(r6),#1 ;this the XQP's chnl? bleqw popout ; if so scram NOW. ; Looks like we need to inspect this entry. ; If there's a softlink, pass the FDT calls for the user, then ; restore the channel, remove LDT, etc. movl r5,r10 ;pass orig. UCB addr in R10 ; change it to orig. one in clenup if we need to reissue i/o & ; then reset chnl. jsb clnup ;go restore privs/prio/idents etc. cmpl r10,r5 ;need to reset chnl? beql 99$ ;if eql no, just exit pushl r10 ;need to remember desired UCB addr ; reissue rest of fdts pushl r5 ;keep JT ucb around movl ucb$l_backlk(r5),r5 ;victim ucb subl2 #24,sp ;make stack room movl sp,r9 .if df,evax movl irp$l_qio_p1(r3),(r9) movl irp$l_qio_p2(r3),04(r9) movl irp$l_qio_p3(r3),08(r9) movl irp$l_qio_p4(r3),12(r9) movl irp$l_qio_p5(r3),16(r9) movl irp$l_qio_p6(r3),20(r9) .iff movl p1(ap),(r9) movl p2(ap),04(r9) movl p3(ap),08(r9) movl p4(ap),12(r9) movl p5(ap),16(r9) movl p6(ap),20(r9) .endc callg (r9),fdtlop ;reissue fdt chain setipl ipl=#2,environ=UNIPROCESSOR addl2 #24,sp ; fix stack popl r5 popl r10 movl ccb$l_ucb(r6),r9 ;keep old ucb a mo... movl r10,ccb$l_ucb(r6) ;reset user channel to orig. device ; adjust ref counts now .if df,evax decl ucb$l_refc(r9) ;1 less chnl on old dvc bgtr 4$ ;if 1+, ok movl #1,ucb$l_refc(r9) ;mounted dsk should have 1 or more 4$: incl ucb$l_refc(r10) ;bump new count again .iff decw ucb$w_refc(r9) ;1 less chnl on old dvc bgtr 4$ ;if 1+, ok movw #1,ucb$w_refc(r9) ;mounted dsk should have 1 or more 4$: incw ucb$w_refc(r10) ;bump new count again .endc 99$: popr #^m movl #1,r0 ;tell caller all's well rsb clnup: .jsb_entry ; remove old ldt etc. after prio/priv/ident restore. If ; original UCB in LDT differs from UCB now, save orig ucb in R10 pushr #^m ; find LDT first. If none, not much to do. jsb findldt tstl r0 ;got an ldt? beqlw 999$ ;if eql no movl r0,r11 ;ldt in r0 if nonzero ;put prio/privs back movl g^ctl$gl_pcb,r4 .if df,evax movl ldt$l_bprio(r11),pcb$l_prib(r4) .iff movb ldt$l_bprio(r11),pcb$b_prib(r4) .endc ; Decrement opnchk flags etc. in prc structure since this file is being ; closed and has an ldt, if flagged. pushl r10 bbcc #ldt$v_opnchk,ldt$l_accmd(r11),3503$ ; opnchk was set. ; ; Note that ldt$l_prcstr points 2 longwords beyond prcstr entry start movl ldt$l_prcstr(r11),r10 ;get proc struct bgeq 3503$ ;paranoia decl <<6-2>*4>(r10) ;count opnchk down bgeq 3503$ clrl <<6-2>*4>(r10) ;clamp it positive 3503$: bbcc #ldt$v_runfcn,ldt$l_accmd(r11),4503$ movl ldt$l_prcstr(r11),r10 ;get proc struct bgeq 4503$ ;paranoia decl <<7-2>*4>(r10) ;count down runfcn bgeq 4503$ clrl <<7-2>*4>(r10) ;clamp positive 4503$: popl r10 movl ldt$l_wprv(r11),pcb$q_priv(r4) movl ldt$l_wprv+4(r11),pcb$q_priv+4(r4) movl ldt$l_wprv(r11),g^ctl$gq_procpriv movl ldt$l_wprv+4(r11),g^ctl$gq_procpriv+4 movl g^ctl$gl_phd,r4 movl ldt$l_aprv(r11),phd$q_authpriv(r4) movl ldt$l_aprv+4(r11),phd$q_authpriv+4(r4) movl ldt$l_wprv(r11),phd$q_privmsk(r4) movl ldt$l_wprv+4(r11),phd$q_privmsk+4(r4) ; See if this is closing a softlink that changed devices ; so the user channel needs to be put back. cmpl ldt$l_chnucb(r11),ccb$l_ucb(r6) ;softlink close? beql 1$ ;if eql no movl ldt$l_chnucb(r11),r10 ;else save orig. ucb 1$: ; put back idents pushl r10 jsb undoid ;undo ident hacking. Do this in a subroutine ;for clarity. We need to again root thru the ;ACE to accomplish this... popl r10 ; get rid of whole LDT ; clean all out ; Synch: LDT pertains to this process only, so should be no problem ; with other LDTs. The LDT vector is per-process. jsb findldt ;find where this LDT is ; On return r1 is previous LDT (which we need) and r0 is ; LDT address (must be same as R11). cmpl r0,r11 bneq 999$ ;if we get bad LDT, don't mess ; Use careful order so nothing else gets interfered with. ; r1 is prev LDT, r11 is this one. movl ldt$l_fwd(r11),ldt$l_fwd(r1) ;collapse this LDT out of chain ; If this is the LAST LDT, just to be safe, clear paranoid mode. ; r5 is jt ucb now, R11 is LDT address jsb chklast ;check for last LDT ;now deallocate this LDT & go movl ldt$l_fresiz(r11),r1 ;length to free movl r11,r0 ;addr to free jsb g^exe$deanonpgdsiz ;free it ; Now the LDT is freed and we go off on our merry way. The file gets closed ; by later FDT stuff. 999$: popr #^m rsb clnupnd: .jsb_entry ;no deletion of ldt here; do after DOWAIT call! ; remove old ldt etc. after prio/priv/ident restore. If ; original UCB in LDT differs from UCB now, save orig ucb in R10 pushr #^m ; find LDT first. If none, not much to do. jsb findldt tstl r0 ;got an ldt? beqlw 999$ ;if eql no movl r0,r11 ;ldt in r0 if nonzero ;put prio/privs back movl g^ctl$gl_pcb,r4 .if df,evax movl ldt$l_bprio(r11),pcb$l_prib(r4) .iff movb ldt$l_bprio(r11),pcb$b_prib(r4) .endc movl ldt$l_wprv(r11),pcb$q_priv(r4) movl ldt$l_wprv+4(r11),pcb$q_priv+4(r4) movl ldt$l_wprv(r11),g^ctl$gq_procpriv movl ldt$l_wprv+4(r11),g^ctl$gq_procpriv+4 movl g^ctl$gl_phd,r4 movl ldt$l_aprv(r11),phd$q_authpriv(r4) movl ldt$l_aprv+4(r11),phd$q_authpriv+4(r4) movl ldt$l_wprv(r11),phd$q_privmsk(r4) movl ldt$l_wprv+4(r11),phd$q_privmsk+4(r4) ; See if this is closing a softlink that changed devices ; so the user channel needs to be put back. cmpl ldt$l_chnucb(r11),ccb$l_ucb(r6) ;softlink close? beql 1$ ;if eql no movl ldt$l_chnucb(r11),r10 ;else save orig. ucb 1$: ; put back idents pushl r10 jsb undoid ;undo ident hacking. Do this in a subroutine ;for clarity. We need to again root thru the ;ACE to accomplish this... popl r10 ; Synch: LDT pertains to this process only, so should be no problem ; with other LDTs. The LDT vector is per-process. 999$: popr #^m rsb ; Revoke identifiers found granted by the ACE. undoid: .jsb_entry pushr #^m ; .iif df,x$$$dt,jsb g^ini$brk ;***********************debug********* movab ldt$l_ace(r11),r10 ;point at our ACE ; look for priv sets cmpl ldt$l_ace+8(r11),acllit ;this our ACE? bneqw 999$ movab 12(r10),r10 ;start of data 1$: movzbl (r10)+,r9 ;get fcn byte beqlw 999$ cmpb r9,#1 ;inspectme => not here beql 1$ cmpb r9,#2 ;moveme beql 1$ cmpb r9,#3 ;base prio set? bneq 2$ ;if not look more ; set base prio if ok cvtbl (r10)+,r8 ;prio to use to r8 movl (r10)+,r7 ;one long of sec.info brw 1$ 2$: cmpb r9,#4 ;priv set? bneq 3$ ;if neq look more movl (r10)+,r0 ;sec info movl (r10)+,r1 ;sec info movl (r10)+,r2 ;get info from ace movl (r10)+,r3 brw 1$ 3$: cmpb r9,#5 ;ident set? bneq 4$ ; If the auth check passed first time, it'll pass now, so check ; just as was done to grant, and revoke anything we would have granted ; initially. movl (r10)+,r0 ;sec info movl r0,r7 movl (r10)+,r1 ;sec info movl r0,r8 movl ldt$l_myfid(r11),r2 ;file id movl ldt$l_myfid+4(r11),r3 ;hi fileid ; At file close time we may have blown file ID away off end of LDT ; so don't authorize...just check for null identifier and don't revoke ; that... ; jsb auth movl (r10)+,r2 ;get info from ace movl (r10)+,r3 ; cmpl r0,r2 ;check auth info ; bneq 4$ ; cmpl r1,r3 ; bneq 4$ tstl r7 ;null identifier (1st long =0)? beql 4$ ;if so we didn't auth it on grant...no revoke ; UNgrant identifier in r7,r8 to curr. process. clrq -(sp) ;clear privatr & procname cells movab -16(r10),-(sp) ;addr of identifier info clrq -(sp) ;null pid & prcname calls #5,revokid ;use internal code (from vms) brw 1$ 4$: cmpb r9,#6 ;softlink record? bneq 5$ ;skip out if illegal value movzbl (r10),r9 ;get length of data addl2 r9,r10 ;add to pointer brw 1$ 5$: cmpb r9,#7 ;temp tag? bneq 999$ ;if ill value scram movzbl (r10),r9 ;get length addl2 r9,r10 brw 1$ 999$: popr #^m rsb ; ; Delfilt = ; Monitor delete requests; allow a daemon to "do something" first (like ; make a copy for awhile) DelFilt: .jsb_entry ; be sure not a knl channel tstl r6 ;is there a CCB (must be +) bleq 2$ ;if not skip out cmpb ccb$b_amod(r6),#1 ;knl mode access? bgtr 1$ 2$: rsb ;leave knl mode chnls alone! 1$: ; filter only if io$m_delete set .if ndf,evax bitw #io$m_delete,irp$w_func(r3) ;is he really deleting? .iff bitl #io$m_delete,irp$l_func(r3) ;is he really deleting? .endc beql 2$ ;no, just rename...branch ; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are ; set in PCB, omit the filtering. .if df,pcbmsk$$ ; if reserved shelving bit is clear we filter as usual bbc #pcb$v_shelving_reserved,pcb$l_sts2(r4),502$ ; if and only if both bits are set we skip out bbs #pcb$v_nounshelve,pcb$l_sts2(r4),2$ 502$: .endc ; Do deletion control stuff pushr #^m ; original r5 now at 4(sp). Must get that to continue the ops. jsb getJTucb ;find JTdriver ucb tstl r0 bgeqw popout movl r5,ucb$l_backlk(r0) ;save link'd ucb in ours too. movl r0,r5 ;point R5 at JT UCB ; Make sure this isn't one of OUR daemons cmpl pcb$l_pid(r4),ucb$l_daemon(r5) ;open etc. daemon? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exdmn(r5) ;not extend daemon beqlw popout cmpl pcb$l_pid(r4),ucb$l_deldmn(r5) beqlw popout ;not delete daemon cmpl pcb$l_pid(r4),ucb$l_exempt(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid? beqlw popout .if ndf,securdv cmpl pcb$l_pid(r4),ucb$l_exedel(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exedel+4(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exedel+8(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exedel+12(r5) ;exempted pid? beqlw popout .endc ;securdv ;make sure not a knl mode channel (leave the XQP channel alone!!!) cmpb ccb$b_amod(r6),#1 ;this the XQP's chnl? bleqw popout ; if so scram NOW. tstl ccb$l_wind(r6) ;if a window exists, open now beql 191$ ;if not open branch, no need for ;softlink test. bitl #<1>,ucb$l_ctlflgs(r5) ;user want open control? beql 191$ ;if not, no LDT to find will exist ; there COULD be an LDT and a softlink so don't allow deletes to open ; softlinks to delete the linked file. ; ********** new hack **************** ; ***** ctlflgs 80000 (hex) bit allows del of softlinked files ******** bitl #^x80000,ucb$l_ctlflgs(r5) ;give way to shut this off bneq 191$ ;if ctlflgs has 80000 hex bit pushr #^m ; find LDT first. If none, not much to do. jsb findldt tstl r0 ;got an ldt? beql 192$ ;if eql no ; Decrement opnchk flags etc. in prc structure since this file is being ; closed and has an ldt, if flagged. ;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 pushl r10 bbcc #ldt$v_opnchk,ldt$l_accmd(r0),3503$ ; opnchk was set. movl ldt$l_prcstr(r0),r10 ;get proc struct bgeq 3503$ ;paranoia decl <<6-2>*4>(r10) ;count opnchk down bgeq 3503$ clrl <<6-2>*4>(r10) ;clamp it positive 3503$: bbcc #ldt$v_runfcn,ldt$l_accmd(r0),4503$ movl ldt$l_prcstr(r0),r10 ;get proc struct bgeq 4503$ ;paranoia decl <<7-2>*4>(r10) ;count down runfcn bgeq 4503$ clrl <<7-2>*4>(r10) ;clamp positive 4503$: popl r10 tstl ldt$l_softf(r0) ;was there a softlink? beql 192$ ;if not skip ; must prevent the deletion by faking success. popr #^m pushl r0 brw 2999$ ;so fake success deleting the file. 192$: popr #^m 191$: ; Want this control? bitl #<128>,ucb$l_ctlflgs(r5) ;user want delete control? beqlw popout ;if eql no, skip out. ; Also...hack... ;if io$m_create is seen here (128 bit) we erase it from the ; irp but skip this i/o, to allow utils to do more work. ; This is because we probably will want other utilities to ; do deletions and need not to force them to be all within the ; daemon process. .if df,evax bitL #io$m_create,irp$l_func(r3) ;bogus subfunc? beql 10$ ;if not there, normal bicl #io$m_create,irp$l_func(r3) ;else remove and .iff bitw #io$m_create,irp$w_func(r3) ;bogus subfunc? beql 10$ ;if not there, normal bicw #io$m_create,irp$w_func(r3) ;else remove and .endc brw 999$ ;let delete by 10$: ; Now ensure that this call is not in the same JOB as the daemon. ; (This lets the daemon spawn processes to do some work.) pushr #^m ;get some regs movl ucb$l_deldmn(r5),r10 ;get the daemon PID bleq 5$ movzwl r10,r7 ;get process index ; like code in FQdriver... movl g^sch$gl_pcbvec,r6 ;get pcb vector movl (r6)[r7],r8 ;get a PCB address tstl r8 ;ensure a system addr bgeq 5$ ;skip if not cmpl r10,pcb$l_pid(r8) ;be sure this is the daemon process bneq 5$ ;else skip ; ok, we for sure have the daemon's PCB now. See if the JIBs match cmpl pcb$l_jib(r8),pcb$l_jib(r4) ;same JIB as daemon's? bneq 5$ ;if not, don't skip out popr #^m ;get regs back now 48$: brw popout ;then buzz off 5$: popr #^m ;get regs back now ; Notify deldmn if one exists. Let that do the real work. ; Looks like we CAN help, if there's someone out there we can yell for. ; Check this. pushl r0 pushl r10 pushl r11 .if ndf,evax movl p1(ap),r0 ;get fib .iff movl irp$l_qio_p1(r3),r0 .endc ifnord #4,4(r0),51$ movl 4(r0),r0 ;...from descriptor movl r0,r9 ;save user FIB address clrl r11 ;r11=0 ==> flag no security interest pushr #^m ;need some regs .if df,evax movl irp$l_qio_p1(r3),r0 ;get FIB desc .iff movl p1(ap),r0 .endc beql 450$ movl 4(r0),r0 ;get fib addr beql 450$ movzwl fib$w_fid(r0),r1 ;get file number (check numbers ; to save space) movl #f.nums,r2 ; get size of store .if df,wd.lst movab ucb$l_fnums(r5),r3 ; point at store 49$: cmpw (r3)+,r1 ; same file number? beql 47$ ; if so go ahead sobgtr r2,49$ .iff ;bitmap ; r1 is file number... movl ucb$l_fnums(r5),r3 ; addr of storage beql 47$ ; if none pretend everything matches .iif ndf,f.mask,f.mask=-16384 ;max bits to use in bitmap check bicl #f.mask,r1 ;clear extra bits ashl #-3,r1,r2 ;r2 gets byte offset into bitmap addl3 r3,r2,r0 ;get address bicl #-8,r1 ;isolate bit in byte now (0-7) bbs r1,(r0),47$ ;if the bit is zero, not here ;if the bit is set, though, go fer it .endc ; fall thru...no match 450$: popr #^m brb 51$ 47$: popr #^m incl r11 ; flag to check del access 50$: ; (r0 is too volatile) 51$: movl ucb$l_delmbx(r5),r10 ;get del mbx ucb if any bgeq 850$ ;if none, can'thelp. bitl #ucb$m_online,ucb$l_sts(r10) ;online? beql 850$ ;if not no soap .if df,evax tstl ucb$l_refc(r10) ;anyone listening? .iff tstw ucb$w_refc(r10) ;anyone listening? .endc beql 850$ ;if no, no dmn. tstl ucb$l_orb(r10) ;owner exist? bgeq 850$ ;if geq no, skip. ; check pid now for delpid pushr #^m movl g^sch$gl_maxpix,r7 ;max proc index 100$: movl g^sch$gl_pcbvec,r6 ;pcb vector movl (r6)[r7],r8 ;get a pcb tstl r8 ;got one? bgeq 101$ ;if geq no cmpl ucb$l_deldmn(r5),pcb$l_pid(r8) ;this our pid? beql 102$ ;if eql yes, all well 101$: sobgtr r7,100$ ;check 'em all clrl ucb$l_deldmn(r5) ;clr dmn pid if it isn'tthere now 102$: popr #^m tstl ucb$l_deldmn(r5) ;is the daemon around? beql 850$ ;if not skip out ; Looks like a msg can besent, so do so. For clarity do in a sub. ; .iif df,x$$$dt,jsb g^ini$brk ;******************debug ************ pushr #^m jsb snddelmsg ;send delete message popr #^m ; note secret return code 4096 indicates failure. 850$: 800$: popl r11 popl r10 cmpl r0,#3 ;fake return-ok status? beql 2999$ blbc r0,1999$ popl r0 999$: popr #^m movl #1,r0 rsb 1999$: popl r0 ;restore the stack popr #^m movl #ss$_drverr,r0 ;return no priv if daemon rejected the op jmp g^exe$abortio ;and abort the i/o 2999$: popl r0 ;fake success. Appear to allow delete but skip .if df,zotdi$ ; ensure if faking success that dir id looks empty so we get no msg .if ndf,evax movl p1(ap),r0 ;get fib .iff movl irp$l_qio_p1(r3),r0 .endc ifnord #4,4(r0),2951$ movl 4(r0),r0 ;...from descriptor beql 2951$ ;fib addr can't be 0 clrl fib$w_did(r0) ;clear dir id clrw fib$w_did+4(r0) ;(6 bytes) .endc 2951$: popr #^m movl #1,r0 jmp g^exe$finishioc ; apparently succeed ; ; Crefilt - ; Get create requests for purposes of doing space management. ; Needed also for cases where directory is a bogus one we put in ; to do directory softlinks; must then change device & did to a ; real one somewhere. Crefilt: .jsb_entry ; be sure not a knl channel tstl r6 ;is there a CCB (must be +) bleq 2$ ;if not skip out cmpb ccb$b_amod(r6),#1 ;knl mode access? bgtr 1$ 2$: rsb ;leave knl mode chnls alone! 1$: ; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are ; set in PCB, omit the filtering. .if df,pcbmsk$$ ; if reserved shelving bit is clear we filter as usual bbc #pcb$v_shelving_reserved,pcb$l_sts2(r4),502$ ; if and only if both bits are set we skip out bbs #pcb$v_nounshelve,pcb$l_sts2(r4),2$ 502$: .endc pushr #^m ; original r5 now at 4(sp). Must get that to continue the ops. jsb getJTucb ;find JTdriver ucb tstl r0 bgeqw popout movl r5,ucb$l_backlk(r0) ;save link'd ucb in ours too. movl r0,r5 ;point R5 at JT UCB bitl i^#16,ucb$l_ctlflgs(r5) ;look at create? beqlw popout ;if not skip ; Make sure this isn't one of OUR daemons cmpl pcb$l_pid(r4),ucb$l_daemon(r5) ;open etc. daemon? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exdmn(r5) ;not extend daemon beqlw popout cmpl pcb$l_pid(r4),ucb$l_deldmn(r5) beqlw popout ;not delete daemon cmpl pcb$l_pid(r4),ucb$l_exempt(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid? beqlw popout ;make sure not a knl mode channel (leave the XQP channel alone!!!) cmpb ccb$b_amod(r6),#1 ;this the XQP's chnl? bleqw popout ; if so scram NOW. ; .iif df,x$$$dt,jsb g^ini$brk ;**************** debug *************** bitl #8,ucb$l_ctlflgs(r5) ;doing cbt alloc on create? ; note NO extend size change on create...too darn risky... beql 8810$ ;if eql no pushl r0 .if ndf,evax movl p1(ap),r0 ;get fib .iff movl irp$l_qio_p1(r3),r0 .endc ifnord #4,4(r0),10$ movl 4(r0),r0 ;...from descriptor ifnord #4,fib$w_exctl(r0),10$ bitw #fib$m_extend,fib$w_exctl(r0) ;extending at all? beqlw 10$ ;if no extend, leave fib alone ; Because contiguous best try allocation flushes the entire extend cache, ; it can cause a tremendous performance hit. Therefore allow it to be ; separately switched so that the benefits of longer extents can be had ; if desired without forcing this flushing every time a file is extended. bitl i^#32,ucb$l_ctlflgs(r5) ;separate control for setting contig best try beql 10$ ; leave contig and contig-best-try alone bitw #,fib$w_exctl(r0) ;contig alloc? bneq 10$ ;if contig leave it alone bisw #fib$m_alconb,fib$w_exctl(r0) ;else set cbt alloc 10$: popl r0 8810$: bitl i^#512,ucb$l_ctlflgs(r5) ;doing space control? beql 21$ pushl r0 movl p1(ap),r0 ;get fib ifnord #4,4(r0),20$ movl 4(r0),r0 ;...from descriptor brw mspc ;go handle space control now 20$: popl r0 21$: brw popout ; PopOut: popr #^m pors: rsb ; Neat hack for modify... ; save old FIB values for extent amount & flags, run thru user FDTs, ; then restore user FIB if all is as was set here and if the thing still ; looks like a FIB (file ID same for example). This will (at least usually) ; leave user space unaltered across calls. Make it conditioned on a fcn ; bit so it can be turned off & work like now in case of problems. mfyfilt: .jsb_entry ;filter on MODIFY requests (e.g. extend) ; First do some preliminary checks for sanity. ; 1. Channel must NOT be kernel mode ; 2. Not a movefile tstl r6 ;is there a CCB (must be +) bleq pors ;if not skip out cmpb ccb$b_amod(r6),#1 ;knl mode access? bleq pors ;leave knl mode chnls alone! ;funct modifiers are bits 6-15 ; this is hex ffc0 ; Normal io$_modify should have no modifiers, so if it has it's ; for something else; leave that alone. .if ndf,evax bitw #^xFFC0,irp$w_func(r3) ;this a movefile or other modifier? .iff bitl #^xFFC0,irp$l_func(r3) ;this a movefile or other modifier? .endc bneq pors ;if so ignore it here. ; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are ; set in PCB, omit the filtering. .if df,pcbmsk$$ ; if reserved shelving bit is clear we filter as usual bbc #pcb$v_shelving_reserved,pcb$l_sts2(r4),502$ ; if and only if both bits are set we skip out bbs #pcb$v_nounshelve,pcb$l_sts2(r4),pors 502$: .endc pushr #^m ; original r5 now at 4(sp). Must get that to continue the ops. jsb getJTucb ;find JTdriver ucb tstl r0 bgeqw popout movl r5,ucb$l_backlk(r0) ;save link'd ucb in ours too. movl r0,r5 ;point R5 at JT UCB ; Make sure this isn't one of OUR daemons cmpl pcb$l_pid(r4),ucb$l_daemon(r5) ;open etc. daemon? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exdmn(r5) ;not extend daemon beqlw popout cmpl pcb$l_pid(r4),ucb$l_deldmn(r5) beqlw popout ;not delete daemon cmpl pcb$l_pid(r4),ucb$l_exempt(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid? beqlw popout ;make sure not a knl mode channel (leave the XQP channel alone!!!) cmpb ccb$b_amod(r6),#1 ;this the XQP's chnl? bleqw popout ; if so scram NOW. ; Now ensure that this call is not in the same JOB as the daemon. ; (This lets the daemon spawn processes to do some work.) pushr #^m ;get some regs movl ucb$l_exdmn(r5),r10 ;get the daemon PID bleq 5$ movzwl r10,r7 ;get process index ; like code in FQdriver... movl g^sch$gl_pcbvec,r6 ;get pcb vector movl (r6)[r7],r8 ;get a PCB address tstl r8 ;ensure a system addr bgeq 5$ ;skip if not cmpl r10,pcb$l_pid(r8) ;be sure this is the daemon process bneq 5$ ;else skip ; ok, we for sure have the daemon's PCB now. See if the JIBs match cmpl pcb$l_jib(r8),pcb$l_jib(r4) ;same JIB as daemon's? bneq 5$ ;if not, don't skip out popr #^m ;get regs back now 48$: brw popout ;then buzz off 5$: popr #^m ;get regs back now ; .iif df,x$$$dt,jsb g^ini$brk ;**************** debug *************** bitl i^#2,ucb$l_ctlflgs(r5) ;look at mfy? bneqw mfycmn ;if neq yes ; (test later will see about space control if doing this) bitl i^#512,ucb$l_ctlflgs(r5) ;doing space control? beql 701$ pushl r0 .if ndf,evax movl p1(ap),r0 ;get fib .iff movl irp$l_qio_p1(r3),r0 .endc beql 702$ ifnord #4,4(r0),702$ movl 4(r0),r0 ;...from descriptor beql 702$ 7701$: brw mspc ;if so go handle space control 701$: popr #^m rsb 702$: POPL R0 popr #^m RSB mspcj: POPL R0 popr #^m RSB mfycmn: ; here we can modify request fields in the FIB the user supplies to reduce ; fragmentation...e.g. set fib$l_exsz bigger or set fib$m_alconb bit ; in fib$w_exctl IFF fib$m_alcon is not set & set fib$m_aldef. ; pushl r0 .if ndf,evax movl p1(ap),r0 ;get fib .iff movl irp$l_qio_p1(r3),r0 .endc ifnord #4,4(r0),mspcj movl 4(r0),r0 ;...from descriptor ifnord #4,fib$w_exctl(r0),mspcj bitw #fib$m_extend,fib$w_exctl(r0) ;extending at all? beqlw mspc ;if no extend, leave fib alone ; ...and see if extend needs space ; Because contiguous best try allocation flushes the entire extend cache, ; it can cause a tremendous performance hit. Therefore allow it to be ; separately switched so that the benefits of longer extents can be had ; if desired without forcing this flushing every time a file is extended. bitl i^#32,ucb$l_ctlflgs(r5) ;separate control for setting contig best try beql 1$ ; leave contig and contig-best-try alone bitw #,fib$w_exctl(r0) ;contig alloc? bneq 1$ ;if contig leave it alone ; allow this on every nth extend. ; This will allow periodic flushes of the extent cache but will let ; it not be made totally useless. By flushing the extent cache periodically ; we can try to reduce the fragmentation it induces. ; if bit 16384 is not set, do not set aldef. bitl i^#16384,ucb$l_ctlflgs(r5) ;allow aldef? beql 704$ bisw #,fib$w_exctl(r0) ;set to use vol default if 704$: ;bigger than program's decl ucb$l_cbtctr(r5) ;count down bgtr 1$ ;and if >0 don't set cbt yet movl ucb$l_cbtini(r5),ucb$l_cbtctr(r5) ;else reset counter bisw #,fib$w_exctl(r0) ;else turn on contig best ;try and turn on use of ;system default extension if ;larger than program default 1$: ; One can add code to check file size and bump extension by more than default if ; it's big (for example, extend by 10% of its' size, not by a few blocks at a time). pushr #^m bitw #,fib$w_exctl(r0) ;contig alloc? bneqw 222$ ;leave size alone for contig alloc movl ccb$l_wind(r6),r7 ;get window block bgeq 222$ ;guard movl wcb$l_fcb(r7),r8 ;and file control blkock bgeq 222$ ;guard movl fcb$l_filesize(r8),r6 ;get filesize beql 222$ ; It is suggested to divide by acp$gb_window instead of 10... ; this is the acp_window sysgen param (default 7), the number of retrieval pointers ; present per window by default. This has no direct relation to size, but one must ; expect at least one retrieval pointer needs to change. In the default situation ; say 1/4th of file size can be used. ; ; The fraction starts at 1/4, but can be anywhere from 1/1 to 1/1000 divl2 ucb$l_frac(r5),r6 ;get 1/4 of current size or so incl r6 ;plus one...for good luck ;fncymod=1 ;chop this if desired ; .if df,fncymd cmpl r6,ucb$l_maxxt(r5) ;extending over max (nominally 120000) bleq 1222$ movl ucb$l_maxxt(r5),r6 ;clamp to max what we're forcing 1222$: ; .endc cmpl r6,ucb$l_minxt(r5) ;if less than 10 leave alone too bgeq 1223$ movl ucb$l_minxt(r5),r6 ;at least grab this minimum 1223$: ; .if df,fncymd ; never try to grab over1/8 of total free space. movl ucb$l_backlk(r5),r8 ;get host ucb (set just above) bgeq 222$ ;(better be there) movl ucb$l_vcb(r8),r8 ;point at vcb bgeq 222$ movl vcb$l_free(r8),r8 ;no. blks free ashl #-3,r8,r8 ;free space /8 cmpl r6,r8 ;extent over freespc/8? ; bgtr 222$ ;if so don't push it here bleq 3223$ ;if not all still ok movl r8,r6 ;else clamp to free/8 3223$: ; .endc cmpl r6,fib$l_exsz(r0) ;make sure we're increasing size bleq 222$ ;if less than user wants, leave alone ; if 4096 bit is clear, allow size ctl always. Otherwise only if aldef set. bitl i^#4096,ucb$l_ctlflgs(r5) beql 2222$ bitw #,fib$w_exctl(r0) ;set to use vol default if beql 222$ ;if aldef NOT set, leave size alone. 2222$: movl r6,fib$l_exsz(r0) ;fill in as new extend size 222$: popr #^m ; fall thru to space control mspc: ; on entry here r0 has user FIB address, r5 is jt ucb address. bitl i^#512,ucb$l_ctlflgs(r5) ;doing space control? beqlw 800$ ;guard against unwanted calls bitw #fib$m_extend,fib$w_exctl(r0) ;extending? beqlw 800$ ;if not no work here ; Now send msg to space daemon and await return via skast ; if user request will exhaust disk space but yet is less than 1/8 ; of disk size. (Some requests are just too darn hard to handle; if ; the request is for over 1/8 of disk size, we probably can't clean ; off enough to fix it anyway. ; ucb$l_exdmn & ucb$l_exmbx will be fields we use. pushr #^m ; ; Note: in this area we leave r3, r4, r5, r6, r7, and r8 pretty ; much alone since FDT processing uses those; r5 can be JT or target ; UCB, but the others get left intact so we can save & restore the i/o ; properly. movl ucb$l_backlk(r5),r10 bgeq 850$ ;(better be there) movl r10,r9 ;keep ucb around for size chk movl ucb$l_vcb(r10),r10 ;point at vcb bgeq 850$ movl vcb$l_free(r10),r10 ;no. blks free ; We want to be sure there tend to be a few free blocks left. This is ; quite arbitrary. If there are less than that many blocks before the ; extend, or will be after the extend, go hunt for space. freslop=20 cmpl r10,#freslop ;do we have at least freslop left? blssu 1850$ ; if not better make some room subl2 #freslop,r10 ;else subtract slop off cmpl fib$l_exsz(r0),r10 ;enough room there? blssu 850$ ;if lss then all OK 1850$: movl ucb$l_maxblock(r9),r9 ;disk size ashl #-3,r9,r9 ;divide by 8 cmpl fib$l_exsz(r0),r9 ;size req. > dsksize/8 ? bgeq 850$ ;if so, cannot help. Let it fail. ; Looks like we CAN help, if there's someone out there we can yell for. ; Check this. movl r0,r9 ;save user FIB address ; (r0 is too volatile) movl ucb$l_exmbx(r5),r10 ;get extend mbx ucb if any bgeq 850$ ;if none, can'thelp. bitl #ucb$m_online,ucb$l_sts(r10) ;online? beql 850$ ;if not no soap .if df,evax tstl ucb$l_refc(r10) ;anyone listening? .iff tstw ucb$w_refc(r10) ;anyone listening? .endc beql 850$ ;if no, no dmn. tstl ucb$l_orb(r10) ;owner exist? bgeq 850$ ;if geq no, skip. ; check pid now for expid pushr #^m movl g^sch$gl_maxpix,r7 ;max proc index 100$: movl g^sch$gl_pcbvec,r6 ;pcb vector movl (r6)[r7],r8 ;get a pcb tstl r8 ;got one? bgeq 101$ ;if geq no cmpl ucb$l_exdmn(r5),pcb$l_pid(r8) ;this our pid? beql 102$ ;if eql yes, all well 101$: sobgtr r7,100$ ;check 'em all clrl ucb$l_exdmn(r5) ;clr dmn pid if it isn't there now 102$: popr #^m tstl ucb$l_exdmn(r5) ;is the daemon around? beql 850$ ;if not skip out ; Looks like a msg can besent, so do so. For clarity do in a sub. ; .iif df,x$$$dt,jsb g^ini$brk ;**************** debug *************** jsb sndexmsg ;send extend message & wait till room found 850$: popr #^m 800$: popl r0 popr #^m .iif df,evax, movl #1,r0 ;tell the rest of vms ok to continue now. RSB ; sndexmsg - called with r5=JT ucb, r9=user FIB address ; Send a message to free space to the extend daemon via ucb$l_exmbx ; passing device and size needed. sndexmsg: .jsb_entry ; "can" the IRP status so it can continue, using a pool buffer. movl #120,r1 ;get some room jsb g^exe$alonpagvar ;via vms routines blbs r0,1$ rsb ;just return if out of space 1$: zapz (r2),#120 ;zero area movpsl 116(r2) ;save original PSL movl r2,r11 ;save msg blk address pushr #^m movl r11,(r2) ;store address of blk in msg block ; Note that R3 to R8 are unaltered from their original state ; here. We'll save these, then restore them after the AST ; and continue the thread. During this thread, we send a message ; to the daemon (with msgblk and address of sndexast and dvcname/unit ; and size needed) and then enter a wait loop awaiting a flag being ; set (wait for efn 31 in the loop). The AST will just set the ; flag and let things continue; it should get the msg blk as ; a parameter of the AST. movl ucb$l_backlk(r5),r0 ;get original dvc ucb movl ucb$l_ddb(r0),r1 ;get DDB (name is there) movab ddb$t_name(r1),r1 ;point at dvc name movl #2,4(r11) ;flag this an extend call movl (r1)+,8(r11) ;copy dvc name movl (r1)+,12(r11) movl (r1)+,16(r11) movl (r1)+,20(r11) ;counted name movzwl ucb$w_unit(r0),24(r11) ;unit no. ; Save the regs in case the daemon needs them. movl r3,28(r11) ;irp movl g^ctl$gl_pcb,r4 ;be sure pcb is in r4 movl r4,32(r11) movl r0,36(r11) ;orig. r5 = orig. dvc UCB movl r6,40(r11) ;ccb addr movl r7,44(r11) movl r8,48(r11) ;copy r7, r8 movl r9,52(r11) ;user FIB movl fib$l_exsz(r9),56(r11) ;size needed movl fib$w_fid(r9),60(r11) ;copy file id movl fib$w_fid+4(r9),64(r11) movl fib$l_acctl(r9),68(r11) ;how open movab sndexast,72(r11) ;where to send skast back to movl g^ctl$gl_pcb,76(r11) ;send pcb movl g^ctl$gl_pcb,r4 movl pcb$l_pid(r4),80(r11) movl pcb$l_epid(r4),84(r11) movl ucb$l_ddb(r0),r1 ;get DDB (name is there) movl ddb$l_allocls(r1),88(r11) ;save alloc class movl ddb$l_sb(r1),r1 ;get sys block if any bgeq 833$ ;if none, omit name grab movl sb$t_nodename(r1),92(r11) ;else save nodename movl sb$t_nodename+4(r1),96(r11) 833$: ; Reserve 4(r11) as wait flag. ; emit a message now to the daemon and wait for him to set us ; runnable again (setting ipl0 meanwhile to besure he can!) pushr #^m movl #120,r3 ;size of msg movl r5,r10 ;save jtdriver ucb movl ucb$l_exmbx(r5),r5 ;mailbox daemon ucb movl r11,r4 ;addr of msg to send jsb g^exe$wrtmailbox ;send it to the daemon popr #^m blbc r0,40$ ;br to dealloc space if we fail movl #pcb$m_nodelet,r9 ;set what bit to alter (if any) movl g^ctl$gl_pcb,r4 ;get current pcb address bitl #,pcb$l_sts(r4) ;is delete inhibited now? beql 67$ ;if not set now, we may alter clrl r9 ;else leave alone 67$: bisl r9,pcb$l_sts(r4) ;inhibit process delete ; across ipl0 interval clrl 4(r11) ;ensure we do synch... ; Wait for the AST to fire here. setipl ipl=#0,environ=UNIPROCESSOR ; Now we can issue a wait that a skast can interrupt. 65$: tstl 4(r11) ;done the wait? bneq 50$ pushl #31 calls #1,g^sys$clref tstl 4(r11) bneq 50$ pushl #31 ;wait for ef 31 calls #1,g^sys$waitfr brb 65$ 50$: ; now back to IPL2 to ensure no AST interruptions for what is left. setipl ipl=#2,environ=UNIPROCESSOR bicl r9,pcb$l_sts(r4) ;enable delete if we were inhibiting it .if ndf,lvdelpsl ;normally this is NOT defined so include the code pushl 116(r11) ;get original PSL back pushab 817$ ;by fake REI rei 817$: .endc movl 4(r11),r0 brb 41$ 40$: movl r11,r0 41$: pushl r0 movl r11,r0 movl #120,r1 ;size jsb g^exe$deanonpgdsiz ;free the msg block popl r0 popr #^m ; Once back here, all registers are OK and the FDT loop ; should just continue where it left off. rsb ; sndexast - ; return control from extend daemon to let the i/o continue. ; AST arg is scratch block address sndexast: .jsb_entry .iif df,x$$$dt,jsb g^ini$brk ;**************** debug *************** movl acb$l_astprm(r5),r11 ;msg blk address cmpl #4096,4(r11) ;if special returncode, leave it. beql 1$ cmpl #3,4(r11) ;leave secret fake-succ flag 3 alone beql 1$ movl #1,4(r11) ;let the wait end 1$: pushl #31 ; set ef 31 calls #1,g^sys$setef ;set the ef movl r5,r0 ;point at acb movl #,r1 ;size jsb g^exe$deanonpgdsiz ;deallocate the acb movl #1,r0 ;say all well rsb ; snddelmsg - called with r5=JT ucb, r9=user FIB address ; Send a message of file delete to the delete daemon via ucb$l_delmbx ; passing device name & fileinfo ; On entry if R11=1, chk security too. snddelmsg: .jsb_entry ; "can" the IRP status so it can continue, using a pool buffer. .if ndf,hsmonly ; if bit 64 set, and if r11=0, send no message, so msg goes to daemon ; only for knl tagged files if bit 64 set. bitl #64,ucb$l_ctlflgs(r5) beql 100$ tstl r11 ;this file tagged for security test? bneq 100$ ;yes, do it rsb ;no, leave 100$: .endc movl #<120+264>,r1 ;get some room jsb g^exe$alonpagvar ;via vms routines blbs r0,1$ rsb ;just return if out of space 1$: zapz (r2),#<120+264> ;zero area movpsl 116(r2) ;save original psl ; .iif df,x$$$dt,jsb g^ini$brk ;***************** debug ************ ; .if df,x$$$dt ; pushl r0 ; movab sndexast,r0 ;look at ast addr in dbg ; popl r0 ; .endc movl r11,112(r2) ;save flag of security test movl r2,r11 ;save msg blk address pushr #^m movl r11,(r2) ;store address of blk in msg block ; Note that R3 to R8 are unaltered from their original state ; here. We'll save these, then restore them after the AST ; and continue the thread. During this thread, we send a message ; to the daemon (with msgblk and address of sndexast and dvcname/unit ; and size needed) and then enter a wait loop awaiting a flag being ; set (wait for efn 31 in the loop). The AST will just set the ; flag and let things continue; it should get the msg blk as ; a parameter of the AST. movl ucb$l_backlk(r5),r0 ;get original dvc ucb movl ucb$l_ddb(r0),r1 ;get DDB (name is there) movab ddb$t_name(r1),r1 ;point at dvc name movl #3,4(r11) ;flag a delete call movl (r1)+,8(r11) ;copy dvc name movl (r1)+,12(r11) movl (r1)+,16(r11) movl (r1)+,20(r11) ;counted name movzwl ucb$w_unit(r0),24(r11) ;unit no. ; Save the regs in case the daemon needs them. movl r3,28(r11) ;irp movl g^ctl$gl_pcb,r4 ;be sure pcb is in r4 movl r4,32(r11) movl r0,36(r11) ;orig. r5 = orig. dvc UCB movl r6,40(r11) ;ccb addr movl r7,44(r11) movl r8,48(r11) ;copy r7, r8 movl r9,52(r11) ;user FIB movl fib$l_exsz(r9),56(r11) ;size needed movl fib$w_fid(r9),60(r11) ;copy file id movl fib$w_fid+4(r9),64(r11) movl fib$w_fid+8(r9),120(r11) ;Dir ID here movl fib$l_acctl(r9),68(r11) ;how open ; Let the extend AST code serve here too. movab sndexast,72(r11) ;where to send skast back to movl fib$w_did(r9),76(r11) ;send did too movzwl fib$w_did+4(r9),80(r11) movl g^ctl$gl_pcb,84(r11) ;send pcb movl g^ctl$gl_pcb,r4 movl pcb$l_pid(r4),88(r11) movl pcb$l_epid(r4),92(r11) movl ucb$l_ddb(r0),r1 ;get DDB (name is there) movl ddb$l_allocls(r1),96(r11) ;save alloc class movl ddb$l_sb(r1),r1 ;get sys block if any bgeq 833$ ;if none, omit name grab movl sb$t_nodename(r1),100(r11) ;else save nodename movl sb$t_nodename+4(r1),104(r11) 833$: ; ; If FID is null and P2 (filename descr.) is not, store filename for the ; daemon to use. It'll have to look the file up to get the file ID if that ; happens. Leave this to the daemon for simplicity of the kernel mode ; code here. tstl 60(r11) ; is file ID there? bneq 843$ ; if neq yes, just use that. ; fooey. no file id. Try and grab the filename. pushr #^m ; now we can movc w/o hassles. movl p2(ap),r10 ;get arg descriptor ; movl irp$l_qio_p2(r3),r10 ;get arg descriptor beql 844$ movl (r10),124(r11) ;save count here bleq 844$ movl (r10),r0 cmpl r0,#<264-8> bleq 845$ movl #<264-8>,r0 845$: ;clamp byte count to space available movab 128(r11),r1 ;destination address movl 4(r10),r2 ;source address beql 844$ movc3 r0,(r2),(r1) ;copy the data into the msg buffer 844$: popr #^m 843$: ; Reserve 4(r11) as wait flag. ; emit a message now to the daemon and wait for him to set us ; runnable again (setting ipl0 meanwhile to besure he can!) pushr #^m movl #<120+264>,r3 ;size of msg movl r5,r10 ;save jtdriver ucb movl ucb$l_delmbx(r5),r5 ;mailbox daemon ucb movl r11,r4 ;addr of msg to send jsb g^exe$wrtmailbox ;send it to the daemon popr #^m blbc r0,40$ ;br to dealloc space if we fail movl #pcb$m_nodelet,r9 ;set what bit to alter (if any) movl g^ctl$gl_pcb,r4 ;get current pcb address bitl #,pcb$l_sts(r4) ;is delete inhibited now? beql 67$ ;if not set now, we may alter clrl r9 ;else leave alone 67$: bisl r9,pcb$l_sts(r4) ;inhibit process delete ; across ipl0 interval clrl 4(r11) ; zero our wait cell so we do synch ; Wait for the AST to fire here. setipl ipl=#0,environ=UNIPROCESSOR ; Now we can issue a wait that a skast can interrupt. 65$: tstl 4(r11) ;done the wait? bneq 50$ pushl #31 calls #1,g^sys$clref ;clear efn 31 tstl 4(r11) bneq 50$ ;be sure wait still pending pushl #31 ;wait for ef 31 calls #1,g^sys$waitfr brb 65$ 50$: ; now back to IPL2 to ensure no AST interruptions for what is left. setipl ipl=#2,environ=UNIPROCESSOR movl g^ctl$gl_pcb,r4 ;get current pcb address bicl r9,pcb$l_sts(r4) ;enable delete if we were inhibiting it movl 4(r11),r0 ;if we got to daemon, flag ok brb 41$ 40$: movl #1,r0 ;let it go if mbx err 41$: pushl r0 .if ndf,lvdelpsl ;normally this is NOT defined so include the code pushl 116(r11) ;get original PSL back pushab 817$ ;by fake REI rei 817$: .endc movl r11,r0 movl #<120+264>,r1 ;size jsb g^exe$deanonpgdsiz ;free the msg block popl r0 popr #^m ; Once back here, all registers are OK and the FDT loop ; should just continue where it left off. rsb mfymount: .jsb_entry ; stick processing in here if doing anything at io$_mount i/o time. ; for here, do nothing. movl #1,r0 rsb ;++ ; ; JT_format - bash host disk tables to point at ours. ; ; With no function modifiers, this routine takes as arguments the name ; of the host disk (the real disk where the virtual disk will exist), ; the size of the virtual disk, and the LBN where the virtual disk ; will start. After these are set up, the device is put online and is ; software enabled. ; ; This routine does virtually no checking, so the parameters must be ; correct. ; ; Inputs: ; p1 - pointer to buffer. The buffer has the following format: ; longword 0 - (was hlbn) - flag for function. 1 to bash ; the targetted disk, 2 to unbash it, else ; illegal. ; longword 1 - virtual disk length, the number of blocks in ; the virtual disk. If negative disables ; FDT chaining; otherwise ignored. ; longword 2 through the end of the buffer, the name of the ; virtual disk. This buffer must be blank ; padded if padding is necessary ; ; ; p2 - size of the above buffer ;-- JT_format: .jsb_entry bicw3 #io$m_fcode,irp$w_func(r3),r0 ;mask off function code bneq 20$ ;branch if modifiers, special ;thus, normal io$_format will do nothing. rsb ;regular processing 100$: popr #^m 10$: movzwl #SS$_BADPARAM,r0 ;illegal parameter clrl r1 jmp g^exe$abortio 20$: .if ndf,evax movl p1(ap),r0 ;buffer address movl p2(ap),r1 ;length of buffer .iff movl irp$l_qio_p1(r3),r0 ;buff address movl irp$l_qio_p2(r3),r1 ;buff length .endc jsb g^exe$writechk ;read access? doesn't return on error ; clrl irp$l_bcnt(r3) ;paranoia, don't need to do this... pushr #^m .if ndf,evax movl p1(ap),r0 ;get buffer address .iff movl irp$l_qio_p1(r3),r0 .endc movl (r0)+,r7 ;get option code bleq 100$ ;0 or negative illegal cmpl r7,#2 ;3 and up illegal too bgtr 100$ incl chnflg movl (r0)+,r6 ;size of virtual disk (ignored) bleq 70$ clrl chnflg ;if 0 or neg. size don't chain... 70$: movab (r0),- ;name of "real" disk ucb$l_JT_host_descr+4(r5) .if ndf,evax subl3 #8,p2(ap),- ;set length of name in descriptor ucb$l_JT_host_descr(r5) .iff subl3 #8,irp$l_qio_p2(r3),- ucb$l_JT_host_descr(r5) .endc bleq 100$ ;bad length movab ucb$l_JT_host_descr(r5),r1 ;descriptor for... jsb g^ioc$searchdev ;search for host device blbs r0,30$ ;branch on success ; fail the associate... popr #^m movzwl #ss$_nosuchdev+2,r0 ;make an error, usually a warning clrl r1 jmp g^exe$abortio ;exit with error 30$: ;found the device ; r1 is target ucb address... ; move it to r11 to be less volatile movl r1,r11 cmpl r7,#1 ;bashing the target UCB? bneq 31$ jsb mung ;go mung target... brb 32$ 31$: ; Be sure we unmung the correct disk or we can really screw up a system. cmpl r11,ucb$l_vict(r5) ;undoing right disk? bneq 32$ ;if not skip out, do nothing. jsb umung ;unmung target 32$: ; bisw #ucb$m_valid,ucb$w_sts(r5) ;set volume valid ; bisw #ucb$m_online,ucb$w_sts(r5) ;set unit online ; movl ucb$l_irp(r5),r3 ;restore r3, neatness counts popr #^m movzwl #ss$_normal,r0 ;success jmp g^exe$finishioc ;wrap things up. mung: .jsb_entry ; steal DDT from host. Assumes that the intercept UCB address ; is in R5 (that is, the UCB in which we will place the DDT copy), ; and that the UCB of the device whose DDT we are stealing is ; pointed to by R11. All registers are preserved explicitly so that ; surrounding code cannot be clobbered. R0 is returned as a status ; code so that if it returns with low bit clear, it means something ; went wrong so the bash did NOT occur. This generally means some other ; code that does not follow this standard has grabbed the DDT already. ; The following example assumes the code lives in a driver so the ; unique ID field and magic number are set already. tstl ucb$l_mungd(r5) ;already munged/not deassigned? beql 6$ rsb ;no dbl bash 6$: pushr #^m ; Acquire victim's fork lock to synchronize all this. movl #ss$_normal,r0 ;assume success forklock ucb$b_flck(r11),- savipl=-(sp),preserve=YES ; find the current DDT address from the UCB (leaving the copy in ; the DDB alone) movl ucb$l_ddt(r11),r10 ;point at victim's DDB ; fill in host ucb tbl (makes chnl handling faster) movab jt_ucb,ucb$l_hucbs(r5) movl ucb$l_hucbs(r5),r9 ;get ucb table movzwl ucb$w_unit(r5),r0 ;get unit no. moval (r9)[r0],r9 ;point into tbl movl r11,(r9) ;save target ucb addr in tbl ; see if this DDT is the same as the original movl ucb$l_ddb(r11),r9 ;the ddb$l_ddt is the original cmpl ddb$l_ddt(r9),r10 ;bashing driver the first time? beql 1$ ;if eql yes ; driver was bashed already. Check that the current basher followed the ; standard. Then continue if it looks OK. cmpl (r10),#p.magic ;does the magic pattern exist? ; if magic pattern is missing things are badly messed. beql 2$ ;if eql looks like all's well movl #2,r0 ;say things failed brw 100$ ;(brb might work too) 2$: ; set our new ddt address in the previous interceptor's slot movab ucb$a_vicddt(r5),(r10) ;store next-DDT address relative ;to the original victim one 1$: movl #1,ucb$l_mungd(r5) ;say we munged jt movl r10,ucb$l_prevddt(r5) ;set previous DDT address up clrl ucb$l_intcddt(r5) ;clear intercepting DDT initially 3$: pushl r5 ; copy a little extra for good luck... movc3 #,(r10),ucb$a_vicddt(r5) ;copy the DDT popl r5 ;get UCB pointer back (movc3 bashes it) ; ; Here make whatever mods to the DDT you need to. ; ; FOR EXAMPLE make the following mods to the FDT pointer ; (These assume the standard proposed for FDT pointers) movab ucb$a_vicddt(r5),r8 ;get a base register for the DDT movl r5,JT_functable+fdt_prev ;save old FDT ucb address movl ddt$l_fdt(r10),ucb$l_oldfdt(r5) movl ucb$l_uniqid(r5),JT_functable+fdt_idnt ;save unique ID also ; copy legal and buffered entry masks of original driver. ; HOWEVER, set mask for format entry to be nonbuffered here since ; we deal with it. pushr #^m movab ucb$l_fdtlgl(r5),r9 ;our function table dummy in UCB movl ddt$l_fdt(r10),r7 ;victim's FDT table ; We want all functions legal in the victim's FDT table to be legal ; here. movl (r7),(r9)+ ;1st half legal mask movl 4(r7),(r9)+ ;2nd half legal mask movl 8(r7),(r9)+ ;1st half buffered mask movl 12(r7),(r9)+ ;2nd half buffered mask ; Now copy in our modify & back-to-original FDT cells. ; Thus every unit has its own legal & buffered masks, then goes to ; original FDT, and we don't mess with OUR FDTs. ; (Also original FDT tables aren't messed either.) ; (modify done in jtdriver fdts.) ; movl mymfy,(r9)+ ; modify template 1 ; movl mymfy+4,(r9)+ ; & 2 ; movl mymfy+8,(r9)+ ;and address ; Set -1 to set ALL possible function bits so we always go back. ; Flow becomes: ; FDT entry in ucb, with masks and one entry to go to JTdriver ; FDT table. ; ; JTdriver FDT table. Last entry goes to user's original FDT chain. ; ; Thus we simply insert our FDT processing ahead of normal stuff, but ; all fcn msks & functions will work for any driver. movl #-1,(r9)+ ;then catch-all "go back" movl #-1,(r9)+ ; to original fdt movl mybak+8,(r9) ; and address of same. movl #-1,fdtlclcnt ;set all funct mask bits movl #-1,fdtlclcnt+4 ;in "lclcnt" fdt entry too. popr #^m movab ucb$l_fdtlgl(r5),ddt$l_fdt(r8) ;point at our FDT table clrl myonoff ;turn my FDTs on ; ; Finally clobber the victim device's DDT pointer to point to our new ; one. ; Be sure normally that no trans buffers still think anything else is current ; so this can work even if things are real busy. .if ndf,xo$itb invalidate_tb .endc movab ucb$a_vicddt(r5),ucb$l_ddt(r11) .if ndf,xo$itb invalidate_tb .endc ; Now the DDT used for the victim device unit is that of our UCB ; and will invoke whatever special processing we need. This processing in ; the example here causes the intercept driver's FDT routines to be ; used ahead of whatever was in the original driver's FDTs. Because ; the DDT is modified using the UCB pointer only, target device units ; that have not been patched in this way continue to use their old ; DDTs and FDTs unaltered. ; ; Processing complete; release victim's fork lock 100$: forkunlock lock=ucb$b_flck(r11),newipl=(sp)+,- preserve=YES popr #^m rsb umung: .jsb_entry ; ; Entry: R11 points at victim device UCB and current driver is the one ; desiring to remove its entry from the DDT chain. Thus its xx$dpt: address ; is the one being sought. ("Current driver" here means the intercept ; driver.) ; It is assumed that the driver knows that the DDT chain was patched ; so that its UCB contains an entry in the DDT chain pushr #^m ; .iif df,x$$$dt,jsb g^ini$brk ;***********************debug********* movl r11,r5 ;hereafter use r5 as victim's UCB movl ucb$l_ddt(r5),r10 ;get the DDT we currently have movl ucb$l_ddb(r5),r1 ;get ddb of victim movl ddb$l_ddt(r1),r1 ;and real original DDT movl r10,r0 ;save ucb$l_ddt addr for later movab DPT$TAB,r11 ;magic pattern is DPT addr. ; lock this section with forklock so we can safely remove ; entries at fork also. Use victim device forklock. forklock lock=ucb$b_flck(r5),savipl=-(sp),preserve=YES 2$: cmpl (r10),R11 ;this our own driver? beql 1$ ;if eql yes, end search .if df,chk.err cmpl (r10),#p.magic bneqw 4$ ;exit if this is nonstd bash .endc ;chk.err ; follow DDT block chain to next saved DDT. movl (r10),r10 ;point R10 at the next DDT in the ;chain .if df,chk.err bgeqw 4$ ; (error check if not negative) .endc ;chk.err brb 2$ ;then check again 1$: ; At this point R10 contains the DDT address within the intercept ; driver's UCB. Return the address of the intercept driver's UCB next. tstl (r10) ;were we intercepted? bgeq 3$ ;if geq no, skip back-fixup ; we were intercepted. Fix up next guy in line. movl (r10),r11 ;point at interceptor movl (r10),(r11) 3$: ; if we intercepted someone, fix up our intercepted victim to skip by ; us also. movl (r10),r2 ;did we intercept ;original driver? cmpl r2,r1 ;test if this is original beql 5$ ;if eql yes, no bash ; replace previous intercept address by ours (which might be zero) movl (r10),(r2) 5$: ; Here remove FDT entries from the list if they were modified. ; This needs a scan of the FDT chain starting at the victim's ; ddt$l_fdt pointer and skipping around any entry that has address ; JT_functable: ; The FDT chain is singly linked. The code here assumes everybody ; plays by the same rules! ; NOTE: Omit this code if we didn't insert our FDT code in the chain!!! movl ddt$l_fdt(r0),r1 ;start of FDT chain movab JT_functable,r2 ;address of our FDT table clrl r3 movab <0-ucb$a_vicddt>(r10),r4 ;initially point at our ucb ; Also set the JT device offline when we unbash it. This is a simple ; flag that ctl prog. can use to tell if it's been used already. .if df,evax bicl #,ucb$l_sts(r4) .iff bicw #,ucb$w_sts(r4) .endc 6$: cmpl r1,r2 ;current fdt point at us? beql 7$ ;if eql yes, fix up chain movl r1,r3 ;else store last pointer movl fdt_prev(r1),r4 ;and point at next bgeq 8$ movl ucb$l_oldfdt(r4),r1 ;where last FDT pointer is in the ucb ;;;BUT not all UCBs will have the fdt offset at the same place!!! ;;;HOWEVER we will leave this in, putting the oldfdt field first after ;;;the regular UCB things. bgeq 8$ ;if not sys addr, no messin' brb 6$ ;look till we find one. 7$: ;r3 is 0 or fdt pointing to our block next ;r1 points at our fdt block tstl r3 ;if r3=0 nobody points at us bgeq 8$ ;so nothing to do movl fdt_prev(r1),r4 bgeq 17$ movl ucb$l_oldfdt(r4),-(sp) ;save old fdt loc movl fdt_prev(r3),r4 blss 18$ tstl (sp)+ brb 17$ 18$: movl (sp)+,ucb$l_oldfdt(r4) 17$: movl fdt_prev(r1),fdt_prev(r3) ;else point our next-fdt pointer at ;last fdt addr. 8$: ; ; Finally if the victim UCB DDT entry points at ours, make it point at ; our predecessor. If it points at a successor, we can leave it alone. cmpl r10,r0 ;does victim ucb point at our DDT? bneq 4$ ;if not cannot replace it movl (r10),ucb$l_ddt(r5) clrl (r10) ;zero jt munged flag 4$: forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,preserve=YES popr #^m ;copy our prior DDT ptr to next one rsb .SBTTL CONTROLLER INITIALIZATION ROUTINE ; ++ ; ; JT_ctrl_INIT - CONTROLLER INITIALIZATION ROUTINE ; ; FUNCTIONAL DESCRIPTION: ; noop ; INPUTS: ; R4 - CSR ADDRESS ; R5 - IDB ADDRESS ; R6 - DDB ADDRESS ; R8 - CRB ADDRESS ; ; THE OPERATING SYSTEM CALLS THIS ROUTINE: ; - AT SYSTEM STARTUP ; - DURING DRIVER LOADING ; - DURING RECOVERY FROM POWER FAILURE ; THE DRIVER CALLS THIS ROUTINE TO INIT AFTER AN NXM ERROR. ;-- JT_ctrl_INIT: .jsb_entry output= ;JT CONTROLLER INITIALIZATION ; CLRL CRB$L_AUXSTRUC(R8) ; SAY NO AUX MEM movl #1,r0 RSB ;RETURN .SBTTL INTERNAL CONTROLLER RE-INITIALIZATION ; ; INPUTS: ; R4 => controller CSR (dummy) ; R5 => UCB ; ctrl_REINIT: RSB ; RETURN TO CALLER .SBTTL UNIT INITIALIZATION ROUTINE ;++ ; ; JT_unit_INIT - UNIT INITIALIZATION ROUTINE ; ; FUNCTIONAL DESCRIPTION: ; ; THIS ROUTINE SETS THE JT: ONLINE. ; ; THE OPERATING SYSTEM CALLS THIS ROUTINE: ; - AT SYSTEM STARTUP ; - DURING DRIVER LOADING ; - DURING RECOVERY FROM POWER FAILURE ; ; INPUTS: ; ; R4 - CSR ADDRESS (CONTROLLER STATUS REGISTER) ; R5 - UCB ADDRESS (UNIT CONTROL BLOCK) ; R8 - CRB ADDRESS ; ; OUTPUTS: ; ; THE UNIT IS SET ONLINE. ; ALL GENERAL REGISTERS (R0-R15) ARE PRESERVED. ; ;-- JT_unit_INIT: .jsb_entry output= ;JT UNIT INITIALIZATION ; Don't set unit online here. Priv'd task that assigns JT unit ; to a file does this to ensure only assigned JTn: get used. ; BISW #UCB$M_ONLINE,UCB$W_STS(R5) ;SET UCB STATUS ONLINE ;limit size of JT: data buffers JT_bufsiz=8192 movl #JT_bufsiz,ucb$l_maxbcnt(r5) ;limit transfers to 8k MOVB #DC$_MISC,UCB$B_DEVCLASS(R5) ;SET DISK DEVICE CLASS clrl ucb$l_mungd(r5) ;not mung'd yet ; NOTE: we may want to set this as something other than an RX class ; disk if MSCP is to use it. MSCP explicitly will NOT serve an ; RX type device. For now leave it in, but others can alter. ; (There's no GOOD reason to disable MSCP, but care!!!) movl #^Xb22d4001,ucb$l_media_id(r5) ; set media id as JT ; (note the id might be wrong but is attempt to get it.) (used only for ; MSCP serving.) MOVB #DT$_FD1,UCB$B_DEVTYPE(R5) ;Make it foreign disk type 1 ; (dt$_rp06 works but may confuse analyze/disk) ;;; NOTE: changed from fd1 type so MSCP will know it's a local disk and ;;; attempt no weird jiggery-pokery with the JT: device. ; MSCP may still refuse to do a foreign drive too; jiggery-pokery later ; to test if there's occasion to do so. ; Set up crc polynomial movab jt_utb,ucb$l_hucbs(r5) ;host ucb table .if df,j$$vdsk ;normally not defined movl r5,ucb$l_backlk(r5) ;backlink UCB initially our own ; Set up to point the JT unit DDT at its own UCB initially. fork ;ensure allocation's ok pushr #^m ;save regs from movc etc. ; Move our DDT into our UCB and point ucb$l_ddt there so when we go a-hunting ; for it, we find it where we do our own virtual disk. movl ucb$l_ddt(r5),r6 ;where our ddt now is movab ucb$a_vicddt(r5),r7 ;where we'll copy it movc3 #ddt$k_length,(r6),(r7) ;copy our DDT popr #^m ;get back regs so we can ;find our UCB again. movab ucb$a_vicddt(r5),ucb$l_ddt(r5) ;point UCB DDT pointer at copy .endc clrl chnflg ;initially set to use our chain of FDTs ; Allocate process vector here. pushr #^m movl g^sch$gl_maxpix,r1 .iif df,x$$$dt,jsb g^ini$brk ;*******************debug*********** ashl #5,r1,r1 ;get 32 bytes per process ; link to LDT ; ccb addr ; proc. counter of enable/disable deletion ; finish count for our thread, bumped before we do i/o, decremented when ; user's i/o r0 return avail. ; pv.ldt=0 pv.ccb=4 pv.eds=8 pv.fin=12 pushl r1 jsb g^exe$alonpagvar ;get some pool popl r1 blbc r0,5$ zapz (r2),r1 ;zero it all initially movl r2,ucb$l_prcvec(r5) ;set initial pointer in UCB popr #^m ; now grab filenum bitmap store .if ndf,wd.lst .iif ndf,f.nsiz,f.nsiz=2048 clrl ucb$l_fnums(r5) pushr #^m movl #f.nsiz,r1 ;bytes to get jsb g^exe$alonpagvar ;get some pool blbc r0,31$ movl r2,ucb$l_fnums(r5) zapz (r2),r1 31$: .endc popr #^m movl #1,r0 RSB ;RETURN 5$: popr #^m BICL #UCB$M_ONLINE,UCB$L_STS(R5) ;SET UCB STATUS OFFLINE movl #1,r0 rsb ; ; findldt ; call with r5 = jt ucb cell, r6=ccb, r4=pcb ; Returns pointer to LDT in R0 ; r0=0 if none exists. returns r1 = address to link ldt to if r0=0 ; if r1 = 0 on return also, seriously bogus state like no ; prcvec table. ; call at device ipl. ; ; slot has ; pointer to LDT chain ; PID of owner process (in case it exits w/o cleanup) findldt: .jsb_entry output= pushr #^M movl g^ctl$gl_pcb,r4 clrl r0 ;initially nothing movl ucb$l_prcvec(r5),r1 ;start of ldt chain bgeq 999$ ;lose if none movzwl pcb$l_pid(r4),r2 ;get index ashl #5,r2,r2 ;get tbl entry offset ; shift 5 so 32 bytes = 8 longs per entry addl3 r2,r1,r3 ;point r3 at our slot movl r3,r1 ;let r1 return as link addr tstl 4(r1) ;empty slot? bneq 3$ clrl (r1) ;if slot is empty clr ldt area brb 5$ 3$: cmpl 4(r1),pcb$l_pid(r4) ;right pid? beql 5$ jsb freslot ;wrong so free all ldt's clrl (r1) 5$: movl pcb$l_pid(r4),4(r1) ;claim slot now 10$: tstl r1 ;ensure pointer ok bgeq 999$ ; check right process. movl ldt$l_fwd(r1),r11 ;get candidate ldt bgeq 999$ ;if null, none to find, but R1 pointer ok cmpl ldt$l_ccb(r11),r6 ;got right ccb? beql 800$ ;if we have it, branch movl r11,r1 ;else loop to next brb 10$ ;and retry 800$: movl r11,r0 ;return ldt addr in r0 999$: ; Callers may test r0=0 or r1=0. If they're +, return 0 since that's ; also an error. tstl r1 blss 997$ clrl r1 997$: tstl r0 blss 996$ clrl r0 ;return 0 instead of any positive values 996$: popr #^M rsb ; If this is the LAST LDT, just to be safe, clear paranoid mode. ; r5 is jt ucb now, R11 is LDT address ; jsb chklast ;check for last LDT chklast: pushr #^M movl g^ctl$gl_pcb,r4 clrl r0 ;initially nothing movl ucb$l_prcvec(r5),r1 ;start of ldt chain bgeq 999$ ;lose if none movzwl pcb$l_pid(r4),r2 ;get index ashl #5,r2,r2 ;get tbl entry offset ; shift 5 so 32 bytes = 8 longs per entry addl3 r2,r1,r3 ;point r3 at our slot movl r3,r1 ;let r1 return as link addr cmpl (r1),r11 ;Is this the last LDT about ;to be freed?? bneq 999$ ;if not skip last ldt paranoia clean ; Clean up the paranoia stuff in the slot. clrl <<6-2>*4>(r1) ;Clear counters that represent paranoia clrl <<7-2>*4>(r1) ;mode 999$: popr #^M rsb ; entry r1 is process slot freslot: .jsb_entry ;free entire slot, deallocating any LDTs. pushr #^M movl r1,r11 ;slot address bgeq 55$ movl (r1),r10 ;start LDT if any 10$: tstl r10 bgeq 50$ movl ldt$l_fwd(r10),r9 ;grab pointer to next ldt if any movl ldt$l_fresiz(r10),r1 ;size to free cmpl r1,# bgtru 50$ ;if the darn slot looks illegal forget this movl r10,r0 ;free this ldt bgeq 50$ ;at least if it looks potentially legal jsb g^exe$deanonpgdsiz movl r9,r10 brb 10$ ;keep looking 50$: zapz (r11),#32 ;zero all 32 bytes 55$: popr #^M rsb .SBTTL Other FDT ROUTINES .if df,lp$filt RWFilt: .jsb_entry ; If active, disallow phys/logical i/o from user mode if the disk is ; mounted. ; be sure not a knl channel tstl r6 ;is there a CCB (must be +) bleq 2$ ;if not skip out cmpb ccb$b_amod(r6),#4 ;knl mode access? beql 1$ 2$: rsb ;leave channels more priv'd than user alone 1$: ; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are ; set in PCB, omit the filtering. .if df,pcbmsk$$ ; if reserved shelving bit is clear we filter as usual bbc #pcb$v_shelving_reserved,pcb$l_sts2(r4),502$ ; if and only if both bits are set we skip out bbs #pcb$v_nounshelve,pcb$l_sts2(r4),2$ 502$: .endc pushr #^m ; original r5 now at 4(sp). Must get that to continue the ops. jsb getJTucb ;find JTdriver ucb tstl r0 bgeqw popout movl r5,ucb$l_backlk(r0) ;save link'd ucb in ours too. movl r0,r5 ;point R5 at JT UCB bitl i^#1048576,ucb$l_ctlflgs(r5) ;look at r/w log? beqlw popout ;if not skip ; Make sure this isn't one of OUR daemons cmpl pcb$l_pid(r4),ucb$l_daemon(r5) ;open etc. daemon? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exdmn(r5) ;not extend daemon beqlw popout cmpl pcb$l_pid(r4),ucb$l_deldmn(r5) beqlw popout ;not delete daemon cmpl pcb$l_pid(r4),ucb$l_exempt(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid? beqlw popout cmpl pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid? beqlw popout ;make sure that if it's a knl,exec,or super chnl we leave it alone cmpb ccb$b_amod(r6),#4 ;this chnl to be left alone? blssw popout ; if so scram NOW. bitl #dev$m_mnt,ucb$l_devchar(r5) ;mounted at all? beqlw popout ;if not mounted, r/w log. OK bitl #dev$m_for,ucb$l_devchar(r5) ;foreign mount? beqlw popout ; disallow the request...device is mounted, not /foreign and channel is ; user mode. MOVZWL #SS$_devmount,R0 ;No logical I/O to mounted disk ; (privilege or no!) JMP G^EXE$ABORTIO ;ABORT I/O rsb .endc ;++ ; ; JT_ALIGN - FDT ROUTINE TO TEST XFER BYTE COUNT ; ; FUNCTIONAL DESCRIPTION: ; ; THIS ROUTINE IS CALLED FROM THE FUNCTION DECISION TABLE DISPATCHER ; TO CHECK THE BYTE COUNT PARAMETER SPECIFIED BY THE USER PROCESS ; FOR AN EVEN NUMBER OF BYTES (WORD BOUNDARY). ; ; INPUTS: ; ; R3 - IRP ADDRESS (I/O REQUEST PACKET) ; R4 - PCB ADDRESS (PROCESS CONTROL BLOCK) ; R5 - UCB ADDRESS (UNIT CONTROL BLOCK) ; R6 - CCB ADDRESS (CHANNEL CONTROL BLOCK) ; R7 - BIT NUMBER OF THE I/O FUNCTION CODE ; R8 - ADDRESS OF FDT TABLE ENTRY FOR THIS ROUTINE ; 4(AP) - ADDRESS OF FIRST FUNCTION DEPENDENT QIO PARAMETER ; ; OUTPUTS: ; ; IF THE QIO BYTE COUNT PARAMETER IS ODD, THE I/O OPERATION IS ; TERMINATED WITH AN ERROR. IF IT IS EVEN, CONTROL IS RETURNED ; TO THE FDT DISPATCHER. ; ;-- nolchk=0 JT_ALIGN: .jsb_entry output= ;CHECK BYTE COUNT AT P1(AP) ; BLBS 4(AP),10$ ;IF LBS - ODD BYTE COUNT movl #1,r0 RSB ;EVEN - RETURN TO CALLER 10$: MOVZWL #SS$_IVBUFLEN,R0 ;SET BUFFER ALIGNMENT STATUS JMP G^EXE$ABORTIO ;ABORT I/O .SBTTL START I/O ROUTINE ;++ ; ; JT_STARTIO - START I/O ROUTINE ; ; FUNCTIONAL DESCRIPTION: ; ; THIS FORK PROCESS IS ENTERED FROM THE EXECUTIVE AFTER AN I/O REQUEST ; PACKET HAS BEEN DEQUEUED. ; ; INPUTS: ; ; R3 - IRP ADDRESS (I/O REQUEST PACKET) ; R5 - UCB ADDRESS (UNIT CONTROL BLOCK) ; IRP$L_MEDIA - PARAMETER LONGWORD (LOGICAL BLOCK NUMBER) ; ; OUTPUTS: ; ; R0 - FIRST I/O STATUS LONGWORD: STATUS CODE & BYTES XFERED ; R1 - SECOND I/O STATUS LONGWORD: 0 FOR DISKS ; ; THE I/O FUNCTION IS EXECUTED. ; ; ALL REGISTERS EXCEPT R0-R4 ARE PRESERVED. ; ;-- JT_STARTIO: .jsb_entry output= ;START I/O OPERATION ; ; PREPROCESS UCB FIELDS ; ; ASSUME RY_EXTENDED_STATUS_LENGTH EQ 8 ; CLRQ UCB$Q_JT_EXTENDED_STATUS(R5) ; Zero READ ERROR REGISTER area. ; ; BRANCH TO FUNCTION EXECUTION bbs #ucb$v_online,- ; if online set software valid ucb$w_sts(r5),210$ 216$: movzwl #ss$_volinv,r0 ; else set volume invalid brw resetxfr ; reset byte count & exit 210$: ; Unless we use this entry, we want to junk any calls here. brb 216$ ;just always say invalid volume. ; Get here for other start-io entries if the virtual disk code is ; commented out also, as it must be. FATALERR: ;UNRECOVERABLE ERROR MOVZWL #SS$_DRVERR,R0 ;ASSUME DRIVE ERROR STATUS RESETXFR: ; dummy entry ... should never really get here MOVL UCB$L_IRP(R5),R3 ;GET I/O PKT MNEGW IRP$W_BCNT(R3),UCB$W_BCR(R5) ; RESET BYTECOUNT ; BRW FUNCXT FUNCXT: ;FUNCTION EXIT CLRL R1 ;CLEAR 2ND LONGWORD OF IOSB REQCOM ; COMPLETE REQUEST ; PWRFAIL: ;POWER FAILURE BICW #UCB$M_POWER,UCB$W_STS(R5) ;CLEAR POWER FAILURE BIT MOVL UCB$L_IRP(R5),R3 ;GET ADDRESS OF I/O PACKET MOVQ IRP$L_SVAPTE(R3),- ;RESTORE TRANSFER PARAMETERS UCB$L_SVAPTE(R5) ;... BRW JT_STARTIO ;START REQUEST OVER JT_INT:: JT_UNSOLNT:: POPR #^M REI ;DUMMY RETURN FROM ANY INTERRUPT ;; jtkast: .jsb_entry ; special knl AST entry daemon should cause. pushr #^m movl acb$l_astprm(r5),r11 ;get LDT address movl r5,r0 ;dealloc. the acb movl #acb$c_length,r1 ;length used jsb g^exe$deanonpgdsiz ; get ucb pointer back movl ldt$l_regs+12(r11),r5 ;get victim dvc ucb jsb getjtucb ;find JT UCB now tstl r0 bgeq 12$ movl r0,r5 ;point at jt ucb now 12$: brw lclcnt ;go continue "step2" ast ; Local grant/revoke ID code needed because vms internal code won't ; work above IPL0. Ripped off vms listings so's it'll work right, ; kludged by hand to just set things up internally for current ; process only. ; Argument list offsets ; v.pidadr = 4 ; address of PID v.prcnam = 8 ; address of process name desc v.id = 12 ; address of identifier and attrib v.name = 16 ; address of identifier name desc v.mode = 16 ; grant/revoke mode for kernel routine v.prvatr = 20 ; address for previous attributes ;++ ; ; GRANTID - grant identifier to process ; REVOKID - revoke identifier from process ; ; CALLING SEQUENCE: ; GRANTID (v.pidadr, v.prcnam, ID, NAME, PRVATR) ; REVOKID (v.pidadr, v.prcnam, ID, NAME, PRVATR) ; ; INPUT PARAMETERS: ; v.pidadr: address of PID of process ; v.prcnam: address of descriptor of process name ; ID: address of identifier to grant ; NAME: address of descriptor of identifier name ; ; IMPLICIT INPUTS: ; NONE ; ; OUTPUT PARAMETERS: ; v.pidadr: address to store resulting PID ; IDADDR: address to store resulting identifier ; PRVATR: previous attributes of superseded or revoked identifier ; ;-- .if df,evax grantid: .call_entry preserve=,home_args=true,max_args=6 .iff .entry grantid,^m .endc MOVL #1,R3 ; set grant mode BRB gr10$ .if df,evax revokid: .call_entry preserve=,home_args=true,max_args=6 .iff .entry revokid,^m .endc CLRL R3 ; set revoke mode gr10$: MOVL v.id(AP),R2 ; get pointer to identifier BNEQ 20$ ; branch if ID specified CLRQ -(SP) ; allocate ID buffer on stack MOVL SP,R2 ; and set pointer 20$: TSTL (R2) ; see if a binary ID is supplied BNEQ 30$ ; if so, skip conversion brw 40$ ; call kernel mode routine with 30$: PUSHL v.prvatr(AP) ; previous attributes MOVQ R2,-(SP) ; identifier and mode MOVQ v.pidadr(AP),-(SP) ; v.pidadr & v.prcnam ; movl r2,-(sp) ; movl r3,-(sp) ; movl v.pidadr(ap),-(sp) ; movl v.pidadr+4(ap),-(sp) calls #5,grant_revoke ; go do the work. Already in knl mode 40$: RET ;++ ; ; GRANT_REVOKE - kernel mode rights list handling ; ; FUNCTIONAL DESCRIPTION: ; ; This routine does the kernel mode processing to grant or ; revoke an identifier. It locates the specified process ; and searches and modifies the rights list. ; ; CALLING SEQUENCE: ; GRANT_REVOKE (v.pidadr, v.prcnam, ID, MODE, PRVATR) ; ; INPUT PARAMETERS: ; v.pidadr: address of PID of process ; v.prcnam: address of descriptor of process name ; ID: address of identifier to grant ; MODE: 0 to revoke identifier, 1 to grant ; ; IMPLICIT INPUTS: ; NONE ; ; OUTPUT PARAMETERS: ; v.pidadr: address to store resulting PID ; PRVATR: previous attributes of superseded identifier ; ; IMPLICIT OUTPUTS: ; NONE ; ; SIDE EFFECTS: ; Identifier entered in specified rights list ; ;-- ; Main subroutine entry point. ; Works on current process, but is OK at elevated IPL (well, ASTDEL...) ; .entry grant_revoke,^M ;GRANT_REVOKE: ; .WORD ^M CLRQ R7 ; init rights vector index and free pointer MOVL R4,R6 ; save PCB addr in R6 movl g^ctl$gl_pcb,r4 ; current process lock lockname=sched,preserve=no ;set synch like exe$nampid does movl pcb$l_pid(r4),r1 ; get current process' IPID unlock lockname=sched,newipl=#ipl$_ASTDEL movl #ss$_normal,r0 ;fake the exe$nampid call MOVL R4,R6 ; save PCB address 50$: MOVL PCB$Q_PRIV+ARB$L_RIGHTSLIST(R6)[R7],R4 ; get rights list descriptor BEQL 100$ ; branch if none present ASHL #-3,(R4)+,R3 ; get rights list length MOVL (R4),R4 ; and rights list address 60$: MOVL v.id(AP),R1 ; get address of identifier ; this is an internal call...KNOW we can access args. movl 4(r1),r2 movl (r1),r1 ; MOVQ (R1),R1 ; get identifier and attributes ; MOVL v.prvatr(AP),R5 ; get pointer to prev. atr. longword clrl r5 ; no prev attrs BRB 90$ ; dive into loop ; ; To here when an empty entry is encountered in a list ; 70$: TSTL R8 ; check if we already have one BNEQ 100$ ; branch if so MOVL R4,R8 ; otherwise save the pointer BRB 100$ ; chain to next list if any ; ; Search the rights list for the desired identifier ; 80$: MOVL (R4),R0 ; get next identifier from rights list BEQL 70$ ; if zero, end of list CMPL R0,R1 ; see if matches desired ID BEQL 140$ ; if yes, exit loop ADDL #8,R4 ; next list entry 90$: SOBGEQ R3,80$ ; loop throught rights list ; ; Identifier not found in this list. ; 100$: TSTL R7 ; check which list in use BNEQ 110$ ; branch if not first ADDL #2,R7 ; point to extended rights list BRB 50$ ; and search it 110$: BLBC v.mode(AP),120$ ; branch if attempted revoke TSTL R8 ; see if empty entry found BEQL 180$ ; branch if not movl r1,(r8) movl r2,4(r8) ; MOVQ R1,(R8) ; store identifier in list 120$: MOVL #SS$_WASCLR,R0 ; if revoke - benign success 130$: RET ; ; Specified identifier found in rights list ; 140$: TSTL R5 ; see if prev attributes to be returned BEQL 150$ ; branch if not MOVL 4(R4),(R5) ; store previous attribites 150$: BLBC v.mode(AP),160$ ; branch to do revoke movl r1,(r4) movl r2,4(r4) ; MOVQ R1,(R4) ; store identifier in rights list BRB 170$ 160$: ASHL #3,R3,R3 ; compute remaining list size ADDL3 #8,R3,R0 ; compute size plus one entry MOVC5 R3,8(R4),#0,R0,(R4) ; collapse out found list entry 170$: MOVL #SS$_WASSET,R0 ; set return status RET ; ; No empty entries available - extend the rights list ; 180$: CLRQ R1 ; assume no block present MOVL PCB$Q_PRIV+ARB$L_RIGHTSLIST(R6)[R7],R9 ; point to rights list again BEQL 190$ ; branch if none exists movl (r9),r1 movl 4(r9),r2 ; MOVQ (R9),R1 ; get current block size and address 190$:; MOVQ R1,R3 ; save size and addr for later movl r1,r3 movl r2,r4 ADDL #ARB$S_LOCALRIGHTS+16,R1 ; increase size and add overhead JSB G^EXE$ALONONPAGED ; and allocate a new one BLBC R0,130$ ; branch on failure MOVL R2,R5 ; save block address SUBL3 #16,R1,(R2)+ ; set up actual list length MOVAB 8(R2),(R2)+ ; and descriptor pointer MOVW R1,(R2)+ ; block length MOVW #DYN$C_RIGHTSLIST,(R2)+ ; and block type movl r4,-(sp) movl r5,-(sp) ; MOVQ R4,-(SP) ; save R4 & R5 MOVC5 R3,(R4),#0,(R5),(R2) ; copy the contents and zero rest ; MOVQ (SP)+,R4 ; restore regs movl (sp)+,r5 movl (sp)+,r4 BLBC R7,200$ ; branch if extended process list MOVL (R5),G^EXE$GQ_RIGHTSLIST ; and store in system descriptor MOVL 4(R5),G^EXE$GQ_RIGHTSLIST+4 ; and store in system descriptor MOVL R4,R0 ; get pointer to old block BEQL 220$ ; branch if none SUBL #12,R0 ; point to start of block BRB 210$ 200$: MOVL R5,PCB$Q_PRIV+ARB$L_RIGHTSLIST(R6)[R7] ; set up new pointer MOVL R9,R0 BEQL 220$ ; branch if no old block 210$: JSB G^EXE$DEANONPAGED ; deallocate the old list 220$: BRW 50$ ; locate free entry and try again JT_END: ;ADDRESS OF LAST LOCATION IN DRIVER .END