%TITLE 'CLAIM'
MODULE CLAIM (IDENT = 'V2.0-001', MAIN = CLAIM) =
BEGIN
!++
! FACILITY: 	    CLAIM
!
! ABSTRACT:
!
!   CLAIM is a program that allows users to claim ownership of files
!   in directories they own.
!
! MODULE DESCRIPTION:
!
!   This module contains all of the routines used to implement CLAIM.
!   The CLAIM command is defined in the file CLAIM_CLD.CLD as follows:
!
!   DEFINE VERB CLAIM
!   	IMAGE "CLAIM"
!   	PARAMETER P1,LABEL=FSPEC,PROMPT="File",VALUE(LIST,REQUIRED,TYPE=$FILE)
!   	QUALIFIER LOG
!
!   Use CDU (i.e., SET COMMAND) to define the verb.  Install CLAIM.EXE with
!   SYSPRV privilege for it to work for non-privileged users.  Privileges
!   are disabled on entry and turned on only when required.
!
! AUTHOR:   	    M. Madison
!   	    	    COPYRIGHT © 1988, RENSSELAER POLYTECHNIC INSTITUTE.
!   	    	    ALL RIGHTS RESERVED.
!
! CREATION DATE:    21-OCT-1988
!
! MODIFICATION HISTORY:
!
!   21-OCT-1988	V2.0-001    Madison 	Initial coding in BLISS.
!--

    LIBRARY 'SYS$LIBRARY:STARLET';

    FORWARD ROUTINE
    	CLAIM,
    	GET_FILE_INFO,
    	GET_BACK_LINK;

    BUILTIN
    	MATCHC;

    EXTERNAL LITERAL
    	CLAIM__NOREMOTE, CLAIM__NOMATCH, CLAIM__NOTOWNER,
    	CLAIM__NOOPNPAR, CLAIM__CANTCLAIM, CLAIM__SUCCESS,
    	CLAIM__ALREADY, CLAIM__BACKLINK,
    	CLI$_PRESENT;

    SWITCHES
    	ADDRESSING_MODE (EXTERNAL=GENERAL);

    EXTERNAL ROUTINE
    	LIB$GETJPI, CLI$PRESENT, CLI$GET_VALUE;


%SBTTL 'CLAIM'
GLOBAL ROUTINE CLAIM = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   This is the main routine for CLAIM, which executes as follows.
!   Any privilege images are disabled.  RMS control blocks are
!   initialized and the LOG qualifier status is obtained.
!   For each file specification on the command line,
!   	The file spec is parsed (using previous results as related fspecs).
!   	If parse is successful and no node name is present,
!   	    For each file matched by the file spec,
!   	    	The file's parent is opened by FID.
!   	    	The ownership of the parent directory is determined.
!   	    	If the owner UIC of the parent matches the process UIC,
!   	    	    The file is opened and the directory back-link
!   	    	    for the file is obtained.  If the back-link matches
!   	    	    what we think the parent is, then
!   	    	    	if the owner UIC is already the process UIC, we
!   	    	    	don't change it and we let user know it's the same,
!   	    	    	otherwise we reset the owner UIC -- success!
!   	    	    	If logging enabled, either success status is logged.
!   	    Once we finish $SEARCHing, we establish the current NAM block
!   	    as the "related" NAM block for further $PARSEing.
!   If no files were processed, CLAIM__NOMATCH is returned.  Otherwise,
!   SS$_NORMAL is returned.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   CLAIM
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	All file specifications processed.
!   CLAIM__NOMATCH: 	No files matched specification.
!
! SIDE EFFECTS:
!
!   None.
!--

    LOCAL
    	FAB : $FAB_DECL,
    	NAM : $NAM_DECL,
    	RELNAM : $NAM_DECL,
    	XABPRO : $XABPRO_DECL,
    	PRCPRV : BLOCK [8,BYTE],
    	SYSPRV : BLOCK [8,BYTE],
    	FSPEC : BLOCK [DSC$K_S_BLN,BYTE],
    	ESPEC : BLOCK [255,BYTE],
    	RSPEC : BLOCK [255,BYTE],
    	RELSPEC : BLOCK [255,BYTE],
    	PARENT : BLOCK [512,BYTE],
    	PARENT_OWNER,
    	ROOT_FOUND,
    	STATUS,
    	LOGGING,
    	DID_ONE;

    $SETPRV (ENBFLG=0, PRVADR=UPLIT (%X'FFFFFFFF',%X'FFFFFFFF'));
    LIB$GETJPI (%REF (JPI$_PROCPRIV),0,0, PRCPRV);
    $SETPRV (ENBFLG=1, PRVADR=PRCPRV);
    SYSPRV [0,0,32,0] = SYSPRV [4,0,32,0] = 0;
    SYSPRV [PRV$V_SYSPRV] = NOT .PRCPRV [PRV$V_SYSPRV];

    $INIT_DYNDESC (FSPEC);

    LOGGING = CLI$PRESENT (%ASCID'LOG') EQLU CLI$_PRESENT;
    DID_ONE = 0;

    $FAB_INIT (FAB=FAB, DNM='', NAM=NAM, FOP=NAM, XAB=XABPRO);
    $NAM_INIT (NAM=NAM, ESA=ESPEC, ESS=%ALLOCATION (ESPEC),
    	RSA=RSPEC, RSS=%ALLOCATION (RSPEC), NOP=NOCONCEAL);
    $XABPRO_INIT (XAB=XABPRO);

    WHILE CLI$GET_VALUE (%ASCID'FSPEC', FSPEC) DO
    BEGIN
    	FAB [FAB$L_FNA] = .FSPEC [DSC$A_POINTER];
    	FAB [FAB$B_FNS] = .FSPEC [DSC$W_LENGTH];
    	STATUS = $PARSE (FAB=FAB);
    	IF NOT .STATUS THEN
    	    SIGNAL (CLAIM__CANTCLAIM, 2, .NAM [NAM$B_ESL],
    	    	.NAM [NAM$L_ESA], .STATUS, .FAB [FAB$L_STV])
    	ELSE BEGIN
    	    IF .NAM [NAM$B_NODE] GTR 0 THEN
    	    	SIGNAL (CLAIM__NOREMOTE, 2, .NAM [NAM$B_ESL], .NAM [NAM$L_ESA])
    	    ELSE WHILE $SEARCH (FAB=FAB) DO
    	    BEGIN
    	    	DID_ONE = 1;
    	    	$SETPRV (ENBFLG=1, PRVADR=SYSPRV);
    	    	STATUS = GET_FILE_INFO (.NAM [NAM$B_DEV], .NAM [NAM$L_DEV],
    	    	    NAM [NAM$W_DID], PARENT_OWNER, PARENT);
    	    	$SETPRV (ENBFLG=0, PRVADR=SYSPRV);
    	    	IF NOT .STATUS THEN
    	    	    SIGNAL (CLAIM__NOOPNPAR, 2, .NAM [NAM$B_ESL],
    	    	    	.NAM [NAM$L_ESA], .STATUS, .FAB [FAB$L_STV])
    	    	ELSE BEGIN
    	    	    LOCAL PROC_UIC;
    	    	    LIB$GETJPI (%REF (JPI$_UIC),0,0, PROC_UIC);
    	    	    IF .PROC_UIC NEQ .PARENT_OWNER THEN
    	    	    	SIGNAL (CLAIM__NOTOWNER, 2, .PARENT [0,0,16,0],
    	    	    	    PARENT [2,0,0,0])
    	    	    ELSE
    	    	    BEGIN
    	    	    	LOCAL BACKLINK : BLOCK [ATR$S_BACKLINK,BYTE];
    	    	    	FAB [FAB$V_UPD] = 1;
    	    	    	$SETPRV (ENBFLG=1, PRVADR=SYSPRV);
    	    	    	STATUS = $OPEN (FAB=FAB);
    	    	    	GET_BACK_LINK (.NAM [NAM$B_DEV],
    	    	    	    .NAM [NAM$L_DEV], NAM [NAM$W_FID], BACKLINK);
    	    	    	$SETPRV (ENBFLG=0, PRVADR=SYSPRV);
    	    	    	IF NOT .STATUS THEN
    	    	    	    SIGNAL (CLAIM__CANTCLAIM, 2, .NAM [NAM$B_RSL],
    	    	    	    	.NAM [NAM$L_RSA], .STATUS,
    	    	    	    	.FAB [FAB$L_STV])
    	    	    	ELSE BEGIN
    	    	    	    LOCAL CLAIM_STATUS;
    	    	    	    IF NOT CH$EQL (6, NAM [NAM$W_DID],
    	    	    	    	    6, BACKLINK, %CHAR (0)) THEN
    	    	    	    	CLAIM_STATUS = CLAIM__BACKLINK
    	    	    	    ELSE IF .XABPRO [XAB$L_UIC] EQLU .PROC_UIC THEN
    	    	    	    	CLAIM_STATUS = CLAIM__ALREADY
    	    	    	    ELSE BEGIN
    	    	    	    	CLAIM_STATUS = CLAIM__SUCCESS;
    	    	    	    	XABPRO [XAB$L_UIC] = .PROC_UIC;
    	    	    	    END;
    	    	    	    $SETPRV (ENBFLG=1, PRVADR=SYSPRV);
    	    	    	    $CLOSE (FAB=FAB);
    	    	    	    $SETPRV (ENBFLG=0, PRVADR=SYSPRV);
    	    	    	    FAB [FAB$V_UPD] = 0;
    	    	    	    IF NOT .CLAIM_STATUS OR .LOGGING THEN
    	    	    	    	SIGNAL (.CLAIM_STATUS, 2, .NAM [NAM$B_RSL],
    	    	    	    	    .NAM [NAM$L_RSA]);
    	    	    	END; ! if file opened OK
    	    	    END;  ! if parent's owner UIC matched process UIC
    	    	END;  ! if GET_FILE_INFO succeeded
    	    END;  ! while $SEARCH
    	END; ! if $PARSE succeeded
!+
! Establish current NAM block as "related-filespec" NAM block for next
! call to $PARSE.
!-

    	CH$MOVE (NAM$C_BLN, NAM, RELNAM);
    	CH$MOVE (.NAM [NAM$B_RSL], RSPEC, RELSPEC);
    	RELNAM [NAM$L_RSA] = RELSPEC;
    	RELNAM [NAM$L_RLF] = RELNAM [NAM$L_ESA] = RELNAM [NAM$B_ESS] = 0;
    	$NAM_INIT (NAM=NAM, ESA=ESPEC, ESS=%ALLOCATION (ESPEC),
    	    RSA=RSPEC, RSS=%ALLOCATION (RSPEC), NOP=NOCONCEAL, RLF=RELNAM);

    END; ! WHILE CLI$GET_VALUE

    IF NOT .DID_ONE THEN CLAIM__NOMATCH
    ELSE SS$_NORMAL

END; ! CLAIM

%SBTTL 'GET_FILE_INFO'
ROUTINE GET_FILE_INFO ( DEVLEN  : BYTE,
    	    	    	DEVN_A  : REF VECTOR [,BYTE],
    	    	    	FID_A   : REF VECTOR [,WORD],
    	    	    	OWNER_A,
    	    	    	FSPEC_A : REF VECTOR [,BYTE]) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   This routine uses the QIO-ACP disk interface to obtain the
!   owner and file specification of a file based on its FID.
!   The file specification buffer must be able to hold 512 bytes.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   GET_FILE_INFO  devlen, devnam, fid, owner, fslen, fspec
!
! devlen:   unsigned_byte, byte (unsigned), read only, by value
! devnam:   char_string, character string, read only, by reference
! fid:	    file_id, word (unsigned), read only, by reference (3-word array)
! owner:    uic, longword (unsigned), write only, by reference
! fspec:    char_string, character string (VARYING (512)), write only,
!   	    	by reference
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    LOCAL
    	FIB : BLOCK [FIB$C_ACCDATA,BYTE],
    	FIBDSC : VECTOR [2],
    	DEVDSC : VECTOR [2],
    	ATRLST : BLOCKVECTOR [3,8,BYTE],
    	SPEC_BUF : VECTOR [256, WORD],
    	STATUS,
    	CHAN : WORD;

    CH$FILL (%CHAR (0), FIB$C_ACCDATA, FIB);
    FIBDSC [0] = FIB$C_ACCDATA;
    FIBDSC [1] = FIB;
    DEVDSC [0] = .DEVLEN;
    DEVDSC [1] = .DEVN_A;
    CH$MOVE (6, .FID_A, FIB [FIB$W_FID]);
    ATRLST [0,ATR$W_SIZE] = ATR$S_UIC;
    ATRLST [0,ATR$W_TYPE] = ATR$C_UIC;
    ATRLST [0,ATR$L_ADDR] = .OWNER_A;
    ATRLST [1,ATR$W_SIZE] = ATR$S_FILE_SPEC;
    ATRLST [1,ATR$W_TYPE] = ATR$C_FILE_SPEC;
    ATRLST [1,ATR$L_ADDR] = .FSPEC_A;
    ATRLST [2,ATR$W_SIZE] = ATRLST [2,ATR$W_TYPE] = 0;
    STATUS = $ASSIGN (DEVNAM=DEVDSC, CHAN=CHAN);
    IF NOT .STATUS THEN RETURN .STATUS;
    STATUS = $QIOW (CHAN=.CHAN, FUNC=IO$_ACCESS, P1=FIBDSC, P5=ATRLST);
    $DASSGN (CHAN=.CHAN);

    .STATUS

END; ! GET_FILE_INFO

%SBTTL 'GET_BACK_LINK'
ROUTINE GET_BACK_LINK ( DEVLEN  : BYTE,
    	    	    	DEVN_A  : REF VECTOR [,BYTE],
    	    	    	FID_A   : REF VECTOR [,WORD],
    	    	    	BLFID_A : REF VECTOR [,WORD]) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   This routine uses the QIO-ACP disk interface to obtain the
!   directory back-link for a file.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   GET_BACK_LINK  devlen, devnam, fid, blfid
!
! devlen:   unsigned_byte, byte (unsigned), read only, by value
! devnam:   char_string, character string, read only, by reference
! fid:	    file_id, word (unsigned), read only, by reference (3-word array)
! blfid:    file_id, word (unsigned), write only, by reference (3-word array)
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    LOCAL
    	FIB : BLOCK [FIB$C_ACCDATA,BYTE],
    	FIBDSC : VECTOR [2],
    	DEVDSC : VECTOR [2],
    	ATRLST : BLOCKVECTOR [2,8,BYTE],
    	STATUS,
    	CHAN : WORD;

    CH$FILL (%CHAR (0), FIB$C_ACCDATA, FIB);
    FIBDSC [0] = FIB$C_ACCDATA;
    FIBDSC [1] = FIB;
    DEVDSC [0] = .DEVLEN;
    DEVDSC [1] = .DEVN_A;
    CH$MOVE (6, .FID_A, FIB [FIB$W_FID]);
    ATRLST [0,ATR$W_SIZE] = ATR$S_BACKLINK;
    ATRLST [0,ATR$W_TYPE] = ATR$C_BACKLINK;
    ATRLST [0,ATR$L_ADDR] = .BLFID_A;
    ATRLST [1,ATR$W_SIZE] = ATRLST [1,ATR$W_TYPE] = 0;
    STATUS = $ASSIGN (DEVNAM=DEVDSC, CHAN=CHAN);
    IF NOT .STATUS THEN RETURN .STATUS;
    STATUS = $QIOW (CHAN=.CHAN, FUNC=IO$_ACCESS, P1=FIBDSC, P5=ATRLST);
    $DASSGN (CHAN=.CHAN);

    .STATUS

END; ! GET_BACK_LINK

END
ELUDOM