e i g h t - c u b e d . c o m 

Processes with shared images open

Problem: you need to dismount a disk that has an image installed /SHARED on it. When you attempt to de-install the image, VMS tells you that it can't because someone has the image open. However, in this situation, SHOW DEV/FILES only shows you that the image is installed, and not who has it open. Bummer.

Solution:

$! See bottom of file for comments.
$       set on
$       on warning then goto error
$       on control_y then goto error
$       say := write sys$output
$       ask := read/error=error/end_of_file=error sys$command -
               command/prompt=
$       do_header = 1
$       required_privs = "WORLD, CMKRNL"
$       old_privs = f$setprv (required_privs)
$       if .not. f$privilege (required_privs)
$       then
$           say "Required privileges: " + required_privs
$           goto exit
$       endif
$ask_p1:
$       image = f$edit (p1, "uncomment, collapse")
$       if image .eqs. ""
$       then
$           ask "Image to search for? "
$           p1 = f$edit (command, "uncomment,collapse")
$           goto ask_p1
$       endif
$       if f$search (image) .eqs. ""
$       then
$           say "Can't find image: " + image
$           p1 = ""
$           goto ask_p1
$       endif
$       image = "]" + f$parse (image,,,"name") + -
                f$parse (image,,,"type") + ";"
$
$       context = ""
$       temp1 = "sys$scratch:" + f$unique() + ".tmp"
$       temp2 = "sys$scratch:" + f$unique() + ".tmp"
$loop:
$       pid = f$pid (context)
$       if pid .eqs. ""
$       then
$           goto end_loop
$       endif
$       open/write out 'temp1'
$       write out "$ define/user sys$output nl:"
$       write out "$ define/user sys$error n:"
$       write out "$ analyze/system"
$       write out "$ deck"
$       write out "set output " + temp2
$       write out "show process/channel/index=" + pid
$       write out "exit"
$       write out "$ eod"
$       write out "$ exit"
$       close out
$       @'temp1'
$       delete/nolog 'temp1';*
$       define/user sys$output nl:
$       define/user sys$error nl:
$       search 'temp2' "''image'"
$       if f$integer ($status) .eq. 1
$       then
$           if do_header
$           then
$               do_header = 0
$               say "PID      Process"
$           endif
$           say pid + " " + f$getjpi (pid, "prcnam")
$       endif
$       delete/nolog 'temp2';*
$       goto loop
$end_loop:
$       goto exit
$error:
$       set noon
$exit:
$       if f$trnlnm ("out") .nes. ""
$       then
$           close out
$       endif
$       if f$type (temp1) .nes. ""
$       then
$           if f$search (temp1) .nes. ""
$           then
$               delete/nolog 'temp1';*
$           endif
$       endif
$       if f$type (temp2) .nes. ""
$       then
$           if f$search (temp2) .nes. ""
$           then
$               delete/nolog 'temp2';*
$           endif
$       endif
$       old_privs = f$setprv (old_privs)
$       exit
$!++
$!
$! DESCRIPTION
$!
$!      This command procedure, given the name of an image file
$!      (or any file for that matter) uses SDA's SHOW PROCESS/CHANNEL
$!      command to locate processes that have an open channel to
$!      files of that name.  Note only the file name and type are
$!      matched, but this will usually be quite enough to locate the
$!      process you are looking for (and that way I don't have to get
$!      into messy file parsing and searching).
$!
$! AUTHOR
$!
$!      James F. Duff
$!
$! DATE
$!
$!      23-Jun-2009
$!
$! MODIFICATIONS
$!
$!      X01-00              Jim Duff       23-Jun-2009
$!      Original version of module.
$!
$!--