From:	CSBVAX::MRGATE!graham@drcvax.arpa@SMTP 26-AUG-1988 11:56
To:	ARISIA::EVERHART
Subj:	SNAP, 2 OF 7


Date: 26 Aug 88 11:18:00 EST
From: <graham@drcvax.arpa>
Subject: SNAP, 2 OF 7
To: "everhart%arisia.decnet" <everhart%arisia.decnet@ge-crd.arpa>
Reply-To: <graham@drcvax.arpa>

+-+-+-+ Beginning of part 2 +-+-+-+
X        movl    phd$l_imgcnt(r4),acb_l_imgcnt(r5) ;sequence number of image
X        pushr   #^m<r5>                 ;save regs for movc3
X        movc3   #codelen,code,@acb$l_kast(r5)     ;copy code segment
X        popr    #^m<r5>                 ;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^exe$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^sch$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^ctl$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 priority?
X        bgequ   9$                      ;if GEQU yes, don't boost priority
X        cmpb    #16,r0                  ;will boost be into realtime priority?
X        bgtru   9$                      ;if GEQU yes, don't boost priority
X        jsb     G^sch$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^exe$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  <end_lock-begin_lock> le 512
X
X; Code placed in non-paged buffer executed in
X; destination process context.
X
X        .enable lsb
X
Xcode:   pushr   #^m<r6,r7>              ;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    #^A/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^lnm$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^pio$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    #^m<r6,r7>              ;restore r6, r7
X
X        movl    acb_l_origpid(r5),acb$l_pid(r5) ;turn the block around
X        movab   b^20$,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^exe$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^sch$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^ctl$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^exe$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   #^m<r5>                 ;save ACB address
X        movc3   #<acb_s_device+acb_s_ddstring>,(r0),(r1) ;copy info
X        popr    #^m<r5>                 ;restore ACB
X
X25$:    movl    acb$l_pid(r5),r1        ;get pid for wake
X        movl    G^ctl$gl_pcb,r4         ;get pid
X        setipl  #ipl$_synch             ;raise to synch
X        jsb     G^sch$wake              ;wake process
X        setipl  #ipl$_astdel            ;lower ipl
X        movl    r5,r0                   ;set address for release
X        jmp     G^exe$deanonpaged       ;free block and exit
X
Xcodelen = .-code                        ;size of code segment
X
X        .end
$ GOSUB UNPACK_FILE
$ FILE_IS = "SNAP.FOR"
$ CHECKSUM_IS = 1913347703
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XC Snapshot program with options to monitor and alter processes.  
XC Created by: Dan Graham, Dynamics Research Corporation
XC Andover, MA 01810  --  (617) 475-9090 ext. 2352  Eternal thanks go to Ned 
XC Freed for the LIB_DEFAULT_DIR procedure and to the unknown DEC hacker who 
XC wrote WATCH.
XC
XC DISCLAIMER:  This program is designed not to damage a system, however, 
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
X`009PROGRAM SNAPSHOT
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
X`009INCLUDE '($DVIDEF)/NOLIST'
X`009INCLUDE '($JPIDEF)/NOLIST'
X`009INCLUDE '($SSDEF)/NOLIST'
X`009INCLUDE '($IODEF)/NOLIST'
X`009INCLUDE '($LNMDEF)/NOLIST'
X`009INCLUDE '($SMGDEF)/NOLIST'
X
X`009PARAMETER MAX_PROCESSES = 100
X`009PARAMETER READ_BUF_LEN = 34
X`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(17)
X`009RECORD /ITMLST/ DVI_LIST(2)
X`009RECORD /ITMLST/ LOGICAL_LIST(2)
X
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
X`009CHARACTER*23 PROC_COUNT
X`009CHARACTER*78 INPUT_BUFFER,DATA_LINE(MAX_PROCESSES),TOP_LINE,HELP_LINE(16)
X`009CHARACTER*30 MENU_OPTION(3),PLINE
X`009CHARACTER*72 STAT_LINE(11)
X`009CHARACTER*6 SERVER,PORT
X`009CHARACTER*16 LAT_DEV_NAME
X`009INTEGER*2 LT_CHAN
X`009INTEGER*2 IOSB(4),C
X`009CHARACTER*34 READ_BUF
X`009CHARACTER*3 PCOUNT
X`009CHARACTER*30 DEVNAM,ID
X`009DATA DEVNAM /'SYS$INPUT:'/
X`009CHARACTER*75 DIRECTORY
X`009LOGICAL*1 ESC
X`009DATA ESC /"33/
X`009CHARACTER*2 HRS,MINS,SECS,HUNDS,PRIBP,DAYSP,PRIP
X`009CHARACTER*9 BUFIOP,DIRIOP,PAGEFLTSP
X`009CHARACTER*1 FLAG,SPACE/' '/,CHOICE,NEWPRIBP
X`009CHARACTER*12 USERNAME
X`009CHARACTER*15 PRCNAM,PUIC,CPUTIMEP
X`009CHARACTER*7 TERMINAL
X`009CHARACTER*100 IMAGE
X`009CHARACTER*64 IMAGES
X`009CHARACTER*29 PIMAGE
X`009CHARACTER*5 STATE
X`009CHARACTER*8 HEXPID,ACCOUNT,NODENAME,PHY_TERM
X`009CHARACTER*49 DCLCMD
X`009CHARACTER*23 LOGINTIME
X`009CHARACTER*20 TOD
X`009CHARACTER*4 MEM
X`009INTEGER*2 UIC(2),IDLEN,UICLEN
X`009INTEGER*4 PIDTOALTER,FULUIC,SUSFLAG,I,ISP,IPL,DUMMY,
X`0091`009ICOUNT,OUTFLAG,DECNET,NUM_OF_PROCS,LINE_COUNT
X`009INTEGER*4 PID,ISTATE,PID2,WSSIZE,ALTPID(MAX_PROCESSES),DIRIO,PAGEFLTS
X`009INTEGER*4 PRI,PRIB,CPUTIM,LOGINTIM(2),DAYS,HOURS,MINUTES,TEMP
X`009INTEGER*4 SECONDS,HUNDREDTHS,IDUIC,NEWPRIB,CHAN,CURTIM(2),BUFIO
X`009BYTE NULL
X
X`009STATUS = SYS$SETPRI(,,%VAL(5),)
X
X`009STATUS = SMG$CREATE_PASTEBOARD (PB_ID)
X`009STATUS = SMG$CREATE_VIRTUAL_KEYBOARD (KB_ID)
X
X`009OPT_ROW = 24
X`009OPT_COL = 80
X`009STATUS = SMG$CREATE_VIRTUAL_DISPLAY(OPT_ROW,OPT_COL,VD1_ID)
X`009OPT_ROW = 18
X`009OPT_COL = 78
X`009STATUS = SMG$CREATE_VIRTUAL_DISPLAY(OPT_ROW,OPT_COL,VD2_ID,
X`0091`009SMG$M_BORDER)
X
X`009TOP_LINE = 'Username     Process name    State Term    Mem  Image'
X`009STATUS = SMG$PUT_CHARS (VD1_ID,TOP_LINE,
X`0091`009%REF(2),%REF(3),,,)
V`009TOP_LINE = 'Again   Delete  Force   View    Stats   Cont    Modify  Exit   
X '
X`009STATUS = SMG$PUT_CHARS (VD1_ID,TOP_LINE,
X`0091`009%REF(24),%REF(1),,,)
X
X`009STATUS = SMG$PASTE_VIRTUAL_DISPLAY (
X`0091`009VD1_ID,PB_ID,%REF(1),%REF(1))
X`009STATUS = SMG$PASTE_VIRTUAL_DISPLAY (
X`0091`009VD2_ID,PB_ID,%REF(4),%REF(2))
X
X`009HELP_LINE(1) = '                        +------+------+------+------+'
X`009HELP_LINE(2) = '                        |      | This |Redraw| Exit |'
X`009HELP_LINE(3) = '                        |      | Help |Screen|Screen|'
X`009HELP_LINE(4) = '                        +------+------+------+------+'
X`009HELP_LINE(5) = '                        |Modify|      |      |      |'
X`009HELP_LINE(6) = '                        | Proc |      |      |      |'
X`009HELP_LINE(7) = '                        +------+------+------+------+'
X`009HELP_LINE(8) = '                        | View | Proc | Show |      |'
X`009HELP_LINE(9) = '                        | Term |Stats | Cont |      |'
X`009HELP_LINE(10) = '                        +------+------+------+------+'
X`009HELP_LINE(11) = '                        |  Do  |Delete|Force |      |'
X`009HELP_LINE(12) = '                        |Again |Proc  |  ^Y  |Press |'
X`009HELP_LINE(13) = '                        +------+------+------+ for  +'
X`009HELP_LINE(14) = '                        |             |      |action|'
X`009HELP_LINE(15) = '                        |             |      |      |'
X`009HELP_LINE(16) = '                        +-------------+------+------+'
X
X`009LOGICAL_LIST(1).BUFLEN = 8
X`009LOGICAL_LIST(1).ITMCOD = LNM$_STRING
X`009LOGICAL_LIST(1).BUFADR = %LOC(NODENAME)
X`009LOGICAL_LIST(1).RETADR = 0
X`009LOGICAL_LIST(2).END_LIST = 0
X`009DVI_LIST(1).BUFLEN = 8
X`009DVI_LIST(1).ITMCOD = DVI$_TT_PHYDEVNAM
X`009DVI_LIST(1).BUFADR = %LOC(PHY_TERM)
X`009DVI_LIST(1).RETADR = 0
X`009DVI_LIST(2).END_LIST = 0
X`009JPI_LIST(1).BUFLEN = 12
X`009JPI_LIST(1).ITMCOD = JPI$_USERNAME
X`009JPI_LIST(1).BUFADR = %LOC(USERNAME)
X`009JPI_LIST(1).RETADR = 0
X`009JPI_LIST(2).BUFLEN = 100
X`009JPI_LIST(2).ITMCOD = JPI$_IMAGNAME
X`009JPI_LIST(2).BUFADR = %LOC(IMAGE)
X`009JPI_LIST(2).RETADR = 0
X`009JPI_LIST(3).BUFLEN = 4
X`009JPI_LIST(3).ITMCOD = JPI$_PID
X`009JPI_LIST(3).BUFADR = %LOC(PID2)
X`009JPI_LIST(3).RETADR = 0
X`009JPI_LIST(4).BUFLEN = 15
X`009JPI_LIST(4).ITMCOD = JPI$_PRCNAM
X`009JPI_LIST(4).BUFADR = %LOC(PRCNAM)
X`009JPI_LIST(4).RETADR = 0
X`009JPI_LIST(5).BUFLEN = 4
X`009JPI_LIST(5).ITMCOD = JPI$_STATE
X`009JPI_LIST(5).BUFADR = %LOC(ISTATE)
X`009JPI_LIST(5).RETADR = 0
X`009JPI_LIST(6).BUFLEN = 7
-+-+-+-+-+ End of part 2 +-+-+-+-+-
------
