From: CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 28-AUG-1989 23:58 To: MRGATE::"ARISIA::EVERHART" Subj: SNAP part 2 of 8 Message-Id: <8908290354.AA16738@crdgw1.ge.com> Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Mon, 28 AUG 89 14:49:13 PDT Received: from drcvax.af.mil by KL.SRI.COM with TCP; Mon, 28 Aug 89 14:31:09 PDT Date: 28 Aug 89 17:04:00 EST From: "Daniel J. Graham" Subject: SNAP part 2 of 8 To: "info-vax" -+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X addw2 r8,r6 ;compute new address X cvtbw ddstring,r8 ;get length of dd string X movc5 r8,ddstring+1,#`094A/ /,- X r7,(r6) ;install dd string X X20$: movl (sp)+,r0 ;retrieve status X ret X Xacb_l_origpid = acb$l_ast ;pid of requestor Xacb_l_imgcnt = acb$l_astprm ;image count in PHD Xacb_l_retloc = acb$l_kast+4 ;address to return data Xacb_s_retloc = 4 ;size of that address X;adjacency of next two items required Xacb_t_device = acb_l_retloc+acb_s_retloc ;SYS$DISK translation Xacb_s_device = lnm_size ;maximum size of it Xacb_t_ddstring = acb_t_device+acb_s_device ;default directory string Xacb_s_ddstring = dd_size ;directory string size Xacb_k_size = acb_t_ddstring+acb_s_ddstring ;total size of acb X ;ast code follows data X X; Routine to return device and directory data from the other process X X; Note that code to execute in other process' context follows data X; in ast control block. X X .enable lsb X X .entry get_defdir,`094m X X movl #,r1 ;size of non-paged buffer X jsb G`094exe$allocbuf ;allocate buffer for code and dat Va X blbs r0,1$ ;skip if no error X ret ;return X X1$: movl r2,r5 ;save address of packet X movl pid,acb$l_pid(r5) ;set target pid X movb #<1@acb$v_kast>,acb$b_rmod(r5) ;set special kernel ast X movab acb_k_size(r5),acb$l_kast(r5) ;set address for ast X movab device,acb_l_retloc(r5) ;set address of return location X movl G`094ctl$gl_pcb,r4 ;get address of current pcb X movl pcb$l_pid(r4),acb_l_origpid(r5) ;set pid for return X movl pcb$l_phd(r4),r4 ;get PHD address X movl phd$l_imgcnt(r4),acb_l_imgcnt(r5) ;sequence number of image X pushr #`094m ;save regs for movc3 X movc3 #codelen,code,@acb$l_kast(r5) ;copy code segment X popr #`094m ;restore registers X X; The AST is queued to the destination process unless it has delete or X; suspend pending set, or is currently suspended. X X movl pid,r2 ;get target pid before synching X Xbegin_lock: X setipl lock_ipl ;raise IPL to synch, lock code X X movl r2,r0 ;Call system routine for PCB X jsb G`094exe$ipid_to_pcb ;Since its not related to the PID X movl r0,r4 X movl #ss$_nonexpr,r0 ;assume non-existent process X tstl r4 ;see if we had an error X bneq 7$ ;skip if not X brw 10$ ;exit if so X X7$: cmpl pcb$l_pid(r4),r2 ;is pid same? X bneq 10$ ;br if not X tstl pcb$l_jib(r4) ;see if it has a jib X beql 10$ ;if not, don't try to queue the AST X bbs #pcb$v_delpen,pcb$l_sts(r4),10$ ;br if delete pending X movl #ss$_suspended,r0 ;assume suspended process X bbs #pcb$v_suspen,pcb$l_sts(r4),10$ ;br if suspend pending X cmpw #sch$c_susp,pcb$w_state(r4) X beql 10$ ;or if process suspended X cmpw #sch$c_suspo,pcb$w_state(r4) X beql 10$ ;or process suspended out of memory X cmpw #sch$c_mwait,pcb$w_state(r4) X beql 10$ ;or in MWAIT X movzbl #pri$_ticom,r2 ;set priority increment class X jsb G`094sch$qast ;queue ast for target X X; If process is in compute state and at a lower priority than the requesting X; process, boost its current priority to the requesting process's current X; priority. (Required because event reporting won't normallly boost a COM X; state process's priority). X X cmpw #sch$c_com,pcb$w_state(r4) ;process in compute state? X beql 8$ X cmpw #sch$c_como,pcb$w_state(r4) ;or compute out of memory? X bneq 9$ X8$: movl G`094ctl$gl_pcb,r3 ;get requestor's PCB address X movb pcb$b_pri(r3),r0 ;get requestor's current priority X cmpb r0,pcb$b_pri(r4) ;other process have a higher priorit Vy? X bgequ 9$ ;if GEQU yes, don't boost priority X cmpb #16,r0 ;will boost be into realtime priorit Vy? X bgtru 9$ ;if GEQU yes, don't boost priority X jsb G`094sch$chsep ;boost other process's priority X9$: brw out_and_wait ;successful AST queued, go wait X X; We were unable to deal with the specified process. Deallocate the system X; buffer and return. X X10$: pushl r0 ;push error code X movl r5,r0 ;get addr of AST packet X jsb G`094exe$deanonpaged ;deallocate the block X setipl #0 ;restore IPL X popl r0 ;restore status X ret ;and return X X; The AST is queued and the other process can handle it now. Lower X; IPL and wait for the response. X Xout_and_wait: X setipl #0 ;lower our IPL X $HIBER_S ;SKAST will wake us up X ret ;we're finished, return X Xlock_ipl: X .long ipl$_synch ;locate here to insure lock X Xend_lock: X assume le 512 X X; Code placed in non-paged buffer executed in X; destination process context. X X .enable lsb X Xcode: pushr #`094m ;we need these registers X movl r5,r7 ;save ACB in non-volatile register X X; We now translate SYS$DISK in the destination process context. This X; is done with calls to the internal LNM$ system routines. X X; Translate SYS$DISK X X movzbl #8,r0 ;set logical name length X movq #`094A/SYS$DISK/,-(sp) ;push logical name onto stack X moval (sp),r1 ;set logical name addr X movzbl process_table,r2 ;length of table name X moval process_table+1,r3 ;process name table name X movl #psl$c_user,r5 ;access mode = user X moval acb_t_device(r7),r6 ;point at lmnx buffer we have X jsb G`094lnm$search_one ;search for the logical name X addl #8,sp ;clean stack X blbs r0,44$ ;Exit on any error X clrb acb_t_device(r7) ;Error - return zero length string X X; Now get the default directory string X X44$: movab acb_t_ddstring(r7),r2 ;get addr to put default directory X movab G`094pio$gt_ddstring,r1 ;get addr of def dir X movb (r1),(r2)+ ;copy length X movzbl (r1)+,r0 ;convert to longword X movc3 r0,(r1),(r2) ;copy string X X movl r7,r5 ;restore ACB address X popr #`094m ;restore r6, r7 X X movl acb_l_origpid(r5),acb$l_pid(r5) ;turn the block around X movab b`09420$,acb$l_kast(r5) ;new AST routine X movb #<1@acb$v_kast>,acb$b_rmod(r5) ;set kast again X X6$: setipl #ipl$_synch ;raise IPL to synch, lock code X X movl acb_l_origpid(r5),r0 ;Get caller PID X jsb G`094exe$ipid_to_pcb ;Convert to PCB X movl r0,r1 X X cmpl pcb$l_pid(r1),acb$l_pid(r5) ;same PID in both places X bneq 8$ ;br if not X bbs #pcb$v_delpen,pcb$l_sts(r1),8$ ;error if delete pending X clrl r2 ;null priority increment X jsb G`094sch$qast ;queue the AST X setipl #ipl$_astdel ;drop back to AST delivery level X rsb X X; If the process did not exist, or was marked for delete, deallocate the X; blocks and return. X X8$: setipl #ipl$_astdel ;drop back to AST delivery level X movl r5,r0 ;get buffer address X jmp @#exe$deanonpaged ;deallocate it and exit X Xprocess_table: X .ascic /LOG$PROCESS/ X X; This is the special kernel mode AST code for the requesting process X; that copies the data from the system buffer to the requestor's address X; space. It first checks to see if the process is running the same image X; that started all this. If not, it punts, deallocating the buffer and X; exiting. X X20$: movl G`094ctl$gl_phd,r3 ;get process header address X cmpl phd$l_imgcnt(r3),acb_l_imgcnt(r5) ;see if the same X beql 21$ ;br if okay X movl r5,r0 ;set buffer address X jmp G`094exe$deanonpaged ;release the buffer and return X X21$: movab acb_t_device(r5),r0 ;get addr of data X movl acb_l_retloc(r5),r1 ;get addr to move data to X pushr #`094m ;save ACB address X movc3 #,(r0),(r1) ;copy info X popr #`094m ;restore ACB X X25$: movl acb$l_pid(r5),r1 ;get pid for wake X movl G`094ctl$gl_pcb,r4 ;get pid X setipl #ipl$_synch ;raise to synch X jsb G`094sch$wake ;wake process X setipl #ipl$_astdel ;lower ipl X movl r5,r0 ;set address for release X jmp G`094exe$deanonpaged ;free block and exit X Xcodelen = .-code ;size of code segment X X .end $ CALL UNPACK LIB_DEFAULT_DIR.MAR;1 1985540965 $ create/nolog 'f' XC Snapshot program with options to monitor and alter processes. `032 XC Created by: Dan Graham, Dynamics Research Corporation XC Andover, MA 01810 -- (617) 475-9090 ext. 2352 Eternal thanks go to Ned` V032 XC Freed for the LIB_DEFAULT_DIR procedure and to the unknown DEC hacker who` V032 XC wrote WATCH. XC XC DISCLAIMER: This program is designed not to damage a system, however,`032 XC the author and his company can take no responsibility for any adverse XC effects it has on any computer system. If improperly used, this program XC can crash a VAX. NEVER DO A VIEW ON AN RTAx TERMINAL!!! XC XC WARNING: THIS PROGRAM WILL BE A SERIOUS SECURITY PROBLEM IF IT IS USED XC BY NON TRUSTWORTHY PERSONS. THE ABILITY TO SEE WHAT ANOTHER USER IS DOING XC ON A SCREEN CAN CAUSE SERIOUS PROBLEMS IN MANY ORGANIZATIONS. USE WITH XC EXTREME DISCRETION AND DON'T BRAG ABOUT IT. XC XC - Version 1.5, Spring, 1989 XC Will run under VMS 5.x, single processor - definately XC multi processor - yes, but not fully tested XC X`009PROGRAM SNAP X X`009IMPLICIT INTEGER*4 (S) X`009INTEGER*4 STATUS,SYS$GETJPIW,SYS$DELPRC,SYS$SETPRI,SYS$QIOW,SYS$FAO X`009INTEGER*4 SYS$ASCTIM,SYS$IDTOASC,SYS$SUSPND,SYS$RESUME,STR$UPCASE X`009INTEGER*4 OTS$CVT_L_TZ,OTS$CVT_L_TI,SYS$ASSIGN,XSTATUS,SYS$GETTIM X`009INTEGER*4 SYS$TRNLNM,SYS$GETDVIW,SYS$FORCEX,LIB_DEFAULT_DIR X`009INTEGER*4 SYS$DASSGN,LIB$SUBX,SYS$GETUAI X`009INCLUDE '($DVIDEF)/NOLIST' X`009INCLUDE '($JPIDEF)/NOLIST' X`009INCLUDE '($SSDEF)/NOLIST' X`009INCLUDE '($IODEF)/NOLIST' X`009INCLUDE '($LNMDEF)/NOLIST' X`009INCLUDE '($UAIDEF)/NOLIST' X`009INCLUDE '($SMGDEF)/NOLIST' X X`009PARAMETER MAX_PROCESSES = 200 X`009PARAMETER READ_BUF_LEN = 34 XC`009PARAMETER IO$M_LT_READPORT = 256 XC FORSYSDEF DOESN'T HAVE THESE X`009PARAMETER SCH$C_COLPG = 1 X`009PARAMETER SCH$C_MWAIT = 2 X`009PARAMETER SCH$C_CEF = 3 X`009PARAMETER SCH$C_PFW = 4 X`009PARAMETER SCH$C_LEF = 5 X`009PARAMETER SCH$C_LEFO = 6 X`009PARAMETER SCH$C_HIB = 7 X`009PARAMETER SCH$C_HIBO = 8 X`009PARAMETER SCH$C_SUSP = 9 X`009PARAMETER SCH$C_SUSPO = 10 X`009PARAMETER SCH$C_FPG = 11 X`009PARAMETER SCH$C_COM = 12 X`009PARAMETER SCH$C_COMO = 13 X`009PARAMETER SCH$C_CUR = 14 XC XC STRUCTURE MAKES EASY ACCESS FOR JPI AND TRNLNM CALLS XC X`009STRUCTURE /ITMLST/ X`009 UNION X`009`009MAP X`009`009 INTEGER*2 BUFLEN,ITMCOD X`009`009 INTEGER*4 BUFADR,RETADR X`009`009END MAP X`009`009MAP X`009`009 INTEGER*4 END_LIST X`009`009END MAP X`009 END UNION X`009END STRUCTURE X`009RECORD /ITMLST/ JPI_LIST(18) X`009RECORD /ITMLST/ DVI_LIST(2) X`009RECORD /ITMLST/ LOGICAL_LIST(2) X`009RECORD /ITMLST/ UAI_LIST(17) X X`009CHARACTER*1 FLAG,SPACE/' '/,CHOICE,NEWPRIBP X`009CHARACTER*2 HRS,MINS,SECS,HUNDS,PRIBP,DAYSP,PRIP,PRCLIM X`009CHARACTER*3 PCOUNT,PGCOUNT,IPGCOUNT,PROC_CNTP X`009CHARACTER*4 MEM,WSQ,WSE,WSD X`009CHARACTER*5 STATE,MAXJ,FILP,ENQ X`009CHARACTER*6 SERVER,PGFL,BYTL X`009CHARACTER*7 TERMINAL,PORT X`009CHARACTER*8 HEXPID,ACCOUNT,NODENAME,PHY_TERM X`009CHARACTER*9 BUFIOP,DIRIOP,PAGEFLTSP X`009CHARACTER*12 USERNAME X`009CHARACTER*15 PRCNAM,PUIC,CPUTIMEP X`009CHARACTER*16 LAT_DEV_NAME X`009CHARACTER*17 LASTLOG X`009CHARACTER*20 TOD,DEFDIR,DEFDEV X`009CHARACTER*23 LOGINTIME,CONTIME X`009CHARACTER*29 PIMAGE X`009CHARACTER*30 MENU_OPTION(3),PLINE,ID,DEVNAM/'SYS$INPUT:'/,OWNER X`009CHARACTER*34 READ_BUF,LGICMD X`009CHARACTER*49 DCLCMD X`009CHARACTER*53 PROC_COUNT X`009CHARACTER*64 IMAGES X`009CHARACTER*72 STAT_LINE(12),UAF_LINE(12) X`009CHARACTER*75 DIRECTORY X`009CHARACTER*78 INPUT_BUFFER,DATA_LINE(MAX_PROCESSES),TOP_LINE,HELP_LINE(16 V) X`009CHARACTER*100 IMAGE X X`009BYTE NULL,UAFPRI X`009INTEGER*2 LT_CHAN,UAFUIC(2),IOSB(4),C,DEVLEN,OWNLEN,PROC_CNT X`009INTEGER*2 UIC(2),IDLEN,UICLEN,MAXJOBS,ENQLM,FILLM X`009INTEGER*4 PIDTOALTER,FULUIC,SUSFLAG,I,ISP,IPL,DUMMY,PAGES,F, X`0091`009LASTLOGIN(2),ICOUNT,OUTFLAG,DECNET,NUM_OF_PROCS, X`0091`009LINE_COUNT,INIT_COUNT,BYTLM,JOBTYPE X`009INTEGER*4 KB_ID,PB_ID,VD1_ID,VD2_ID,VD3_ID,CUR_ROW,CUR_COL,TERM_CODE X`009INTEGER*4 MIN_CUR,MAX_CUR,OPT_ROW,OPT_COL,SCROLL_TOP,SCROLL_BOTTOM X`009INTEGER*4 OPTION,CUR_ROW2,CUR_COL2,MIN_CUR2,MAD_CUR2,STR_LEN,AMT_TO_SCR +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+-