$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 19-MAR-1992 18:09:17.81 By user UDAA055 $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $!+ THIS PACKAGE DISTRIBUTED IN 6 PARTS, TO KEEP EACH PART $! BELOW 30 BLOCKS $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. [.LKSTAT]LKSTAT.C;1 $! 2. [.LKSTAT]LKSTAT.H;1 $! 3. [.LKSTAT]LKSTAT.MOD;1 $! 4. [.LKSTAT]LKSTAT.README;1 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete 'f'* $ exit $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' X/* X * AUTHOR: Gary Nebbett, CREATION DATE: 18th December, 1990 X */ X X#include X#include X#include X#include X#include X#include X#include X#include X#include X#include X#include "lkstat.h" X X#pragma builtins X X#define DVS$_DEVCLASS 1 X#define SS$_NOMOREDEV 2648 X#define DYN$C_LKB 53 X#define DYN$C_RSB 54 X#define LKB$L_SQFL 0x38 X X#define MAXDEPTH 32 X#define MAXRESNAM 512 X#define MAXOUTLINE 512 X#define MAXDISKS 255 X#define VOLCKNAMSIZ 12 X X Xstruct statistics `7B X int resources; X int master_res; X int dir_only_res; X int dir_res; X int root_res; X int master_root_res; X int max_chain; X int locks; X int sys_owned; X int proc_owned; X int local; X int prccpy; X int mstcpy; X`7D; X Xstruct lkbsum `7B X int local; X int prccpy; X int mstcpy; X int granted; X int waiting; X int converting; X int sys_owned; X int proc_owned; X`7D; X Xstruct options `7B X char all; X char full; X char stats; X char names; X FILE *out; X`7D; X Xstruct disktab `7B X char devnam`5B64 + 1`5D; X char lcknam`5BVOLCKNAMSIZ + 1`5D; X int indoff; X`7D; X X X#define terminate(reason) `7Bfprintf(reason, stderr); exit(0);`7D X Xstatic void cli(int argc, char **argv); Xstatic void snap_rsbs(); Xstatic void sort_rsbs(); Xstatic void disp_rsbs(); Xstatic int disk_scan(); Xstatic char * fton(int fid, char *lcknam); X Xglobalref unsigned long LCK$GL_HTBLSIZ, LCK$GL_MAXID; Xglobalref struct rsb **LCK$GL_HASHTBL`5B`5D; X Xstatic struct options option; Xstatic struct statistics stats; Xstatic struct disktab disktab`5BMAXDISKS`5D; Xstatic struct lkbsum *locksum; Xstatic struct rsb *rsblist; Xstatic long rsb_tree; Xstatic int rsblist_size; Xstatic int numdisks; X X Xmain(int argc, char **argv) X`7B X cli(argc, argv); X X rsblist_size = LCK$GL_MAXID * 2; X if ((rsblist = calloc(rsblist_size, sizeof (struct rsb))) == 0) X terminate("not enough memory\n"); X if ((locksum = calloc(rsblist_size, sizeof (struct lkbsum))) == 0) X terminate("not enough memory\n"); X X snap_rsbs(); X sort_rsbs(); X if (option.names) numdisks = disk_scan(); X disp_rsbs(); X return(SS$_NORMAL); X`7D X X/* ------------------------------------------------------------------------- V- X*/ X X/* X * Analyse the command line. We expect flags to be grouped rather than X * present individually (e.g. -l -s). X */ X Xstatic void cli(int argc, char **argv) X`7B X int i; X X option.out = stdout; X X if (argc == 1) return; X X for (i = (argv`5B1`5D`5B0`5D == '-' ? 1 : 0); argv`5B1`5D`5Bi`5D != 0; i V++) X switch (argv`5B1`5D`5Bi`5D) `7B X case 'l' : X option.full = 1; X break; X case 's' : X option.stats = 1; X break; X case 'a' : X option.all = 1; X break; X case 'n' : X option.names = 1; X break; X case 'o' : X if (argc >= 3) `7B X if ((option.out = fopen(argv`5B2`5D, "w"))) X break; X else X perror("fopen"); X `7D X default : X fprintf(stderr, "Usage: %s `5B-`5D`5Blanso`5D `5Bfil Vename`5D\n", X argv`5B0`5D); X exit(0); X `7D X`7D X X/* ------------------------------------------------------------------------- V- X*/ X X/* X * Convert a CSID to a SCS node name. X */ X Xstatic char * cton(unsigned long csid) X`7B X unsigned long status, code = SYI$_NODENAME; X unsigned short len; X static char scsname`5B16`5D; X struct dsc$descriptor buf; X X buf.dsc$b_class = buf.dsc$b_dtype = 0; X buf.dsc$w_length = sizeof(scsname); X buf.dsc$a_pointer = scsname; X X if ((status = lib$getsyi(&code, 0, &buf, &len, &csid, 0) != SS$_NORMAL)) X lib$stop(status); X scsname`5Blen`5D = 0; X return(scsname); X`7D X X/* ------------------------------------------------------------------------- V- X*/ X X/* X * This function tries to display resource names in the most accessible way X * possible; as such it contains a great deal of knowledge about the resourc Ve X * names used by various components of VMS. Indeed it even knows that some X * resource names are normally sub-resources of other resources. X * X * Note that this function identifies resources only by the rsb$t_resnam X * field; a resource is only completely identified when this is coupled X * with an access mode, a group (or lack thereof) and a parent. If someone X * has been creating locks with names similar to those used by VMS then X * this function will be fooled. X */ X X X#define efid(x) (((x) & 0xffff) + (((x) >> 8) & 0xff0000)) X#define fstrlen(x) (sizeof(x) - 1) X#define FIDOFF 18 X#define RMSDEVOFF 11 X Xstatic char sys$sys_id`5B`5D = "SYS$SYS_ID"; Xstatic char f11b$a`5B`5D = "F11B$a"; Xstatic char f11b$q`5B`5D = "F11B$q"; Xstatic char f11b$c`5B`5D = "F11B$c"; Xstatic char f11b$s`5B`5D = "F11B$s"; Xstatic char f11b$v`5B`5D = "F11B$v"; Xstatic char rms`5B`5D = "RMS$"; X Xstatic char * resnam(struct rsb *rsb, int parid) X`7B X static char buf`5BMAXRESNAM`5D; X char vollock`5BVOLCKNAMSIZ`5D; X unsigned long fid, *x; X unsigned char *file, *c = rsb->rsb$t_resnam; X int i, j = rsb->rsb$b_rsnlen; X X for (i = 0; (i < j) && isprint(*c); c++, i++) X buf`5Bi`5D = *c; X buf`5Bi`5D = 0; X X if (!memcmp(rsb->rsb$t_resnam, sys$sys_id, fstrlen(sys$sys_id))) `7B X x = &(rsb->rsb$t_resnam`5Bfstrlen(sys$sys_id)`5D); X sprintf(&buf`5Bfstrlen(sys$sys_id)`5D, "#%d", *x & 0xffff); X `7D X else if (!memcmp(rsb->rsb$t_resnam, f11b$a, fstrlen(f11b$a))) `7B X x = &(rsb->rsb$t_resnam`5BFIDOFF`5D); X if (option.names && (file = fton(efid(*x),`20 X `20 X&(rsb->rsb$t_resnam`5Bfstrlen(f11b$a)`5D)))) X sprintf(&buf`5BFIDOFF`5D, "%s", file); X else X sprintf(&buf`5BFIDOFF`5D, "#%d", efid(*x)); X `7D X else if (!memcmp(rsb->rsb$t_resnam, f11b$q, fstrlen(f11b$q))) `7B X x = &(rsb->rsb$t_resnam`5BFIDOFF`5D); X sprintf(&buf`5BFIDOFF`5D, "#%o,%o", (*x >> 16) & 0xffff, *x & 0xffff V); X `7D X else if (!memcmp(rsb->rsb$t_resnam, f11b$c, fstrlen(f11b$c))) `7B X x = &(rsb->rsb$t_resnam`5Bfstrlen(f11b$c)`5D); X memcpy(vollock, &(rsblist`5Bparid`5D.rsb$t_resnam`5Bfstrlen(f11b$v)` V5D),`20 X VOLCKNAMSIZ); X if (option.names && (file = fton(efid(*x), vollock))) X sprintf(&buf`5Bfstrlen(f11b$c)`5D, "%s", file); X else X sprintf(&buf`5Bfstrlen(f11b$c)`5D, "#%d", efid(*x)); X `7D X else if (!memcmp(rsb->rsb$t_resnam, f11b$s, fstrlen(f11b$s))) `7B X x = &(rsb->rsb$t_resnam`5Bfstrlen(f11b$s)`5D); X memcpy(vollock, &(rsblist`5Bparid`5D.rsb$t_resnam`5Bfstrlen(f11b$v)` V5D),`20 X VOLCKNAMSIZ); X if (option.names && (file = fton(efid(*x), vollock))) X sprintf(&buf`5Bfstrlen(f11b$s)`5D, "%s", file); X else X sprintf(&buf`5Bfstrlen(f11b$s)`5D, "#%d", efid(*x)); X `7D X else if (!memcmp(rsb->rsb$t_resnam, rms, fstrlen(rms))) `7B X x = &(rsb->rsb$t_resnam`5Bfstrlen(rms)`5D); X fid = (*x & 0xffff) + ((*(++x) & 0xff00) << 8); X if (option.names && (file = fton(fid, X&(rsb->rsb$t_resnam`5BRMSDEVOFF`5D)))) X sprintf(&buf`5Bfstrlen(rms)`5D, "%.*s %s",`20 X VOLCKNAMSIZ, &rsb->rsb$t_resnam`5BRMSDEVOFF`5D, file); X else X sprintf(&buf`5Bfstrlen(rms)`5D, "%.*s #%d",`20 X VOLCKNAMSIZ, &rsb->rsb$t_resnam`5BRMSDEVOFF`5D, fid); X `7D X else `7B X for (; (i < j); c++, i++) buf`5Bi`5D = isprint(*c) ? *c : '.'; X buf`5Bi`5D = 0; X `7D X X return(buf); X`7D X X/* ------------------------------------------------------------------------- V- X*/ X X/* X * We form a sorted binary tree of the RSBs; rather than adding the dec fiel Vd X * (the 10 bytes used by DEC in the lib$insert_tree, etc functions) to each V RSB X * structure, we define a small structure that just has an index into the ar Vray X * of RSBs and work with this. X */ X Xstruct rsb_node `7Bchar dec`5B10`5D; int index;`7D; X Xstatic rsb_cmp(int rsbn, struct rsb_node *rsb_node) X`7B X return(memcmp(rsblist`5Brsbn`5D.rsb$t_resnam,`20 X rsblist`5Brsb_node->index`5D.rsb$t_resnam, RSB$K_MAXLEN)); X`7D X Xstatic rsb_alloc(int rsbn, struct rsb_node **rsb_node) X`7B X if ((*rsb_node = malloc(sizeof **rsb_node)) == 0) X terminate("not enough memory\n"); X (*rsb_node)->index = rsbn; X return(1); X`7D X X/* X * Here we sort the RSBs based on the resource name, and collect some X * summary information as well. X */ X Xstatic void sort_rsbs() X`7B X unsigned long status, flag = 0; X struct rsb_node *rsb_node; X struct rsb *rsb = rsblist; X struct lkbsum *lks = locksum; X int rsbn; X X for (rsbn = 0; rsbn < stats.resources; rsbn++, rsb++, lks++) `7B X status = lib$insert_tree(&rsb_tree, rsbn, &flag, rsb_cmp,`20 X rsb_alloc, &rsb_node, 0); X if (status != LIB$_NORMAL && status != LIB$_KEYALRINS) X lib$stop(status); X X if (rsb->rsb$v_direntry) stats.dir_res++; X if (!rsb->rsb$w_lckcnt) stats.dir_only_res++; X if (!rsb->rsb$l_parent) stats.root_res++; X if (!rsb->rsb$l_csid) stats.master_res++; X if (!rsb->rsb$l_csid && !rsb->rsb$l_parent) stats.master_root_res++; X stats.locks += rsb->rsb$w_lckcnt; X stats.mstcpy += lks->mstcpy; X stats.prccpy += lks->prccpy; X stats.local += lks->local; X stats.sys_owned += lks->sys_owned; X stats.proc_owned += lks->proc_owned; X `7D X`7D X X/* ------------------------------------------------------------------------- V- X*/ X Xstatic char *mode`5B`5D = `7B"NL", "CR", "CW", "PR", "PW", "EX"`7D; Xstatic char rmod`5B`5D = `7B'K', 'E', 'S', 'U'`7D; X Xstruct parent `7Bunsigned long s0addr; int index;`7D; X X/* X * This function produces a report of the collected information. LKBs are X * only scanned if the -l option is given, so we check the presence of X * this option and only report the LKB summary if it was collected. X * X * The rsb structure definition contains a description of various flags; X * we just report three things under the banner flags: X * X * D means that the RSB is a directory entry. X * O means that the RSB is Only a directory entry and has no other use. X * X means that other flags were present. X * X * I think that most of the other flags are only used during cluster`20 X * transitions and are unlikely to be seen by this program. If you see X * an X and wonder just what bit was set, I can only say sorry! X * X * If a resource has sub-resources, we recursively invoke this function X * to display the sub-resources. X */ X Xstatic rsb_disp(struct rsb_node *rsb_node, struct parent *parent) X`7B +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-