$ verify = 'f$verify("NO")'
$ if "''offload_uic_tst'" then set verify
$!-----------------------------------------------------------------------------
$!   OFFLOAD.UIC - The function of this procedure is to determine the if the
$!	directory specified has the same UIC as the user's current UIC.  If it
$!	does not, then and attempt is made to change the user's current UIC.
$!
$!	P1 - is to contain the disk & directory to be checked.  If P1 is
$!		omitted, then the current default directory is used.
$!
$!	P2 - is the logical name of the tape drive assigned the job.  If this
$!		is omitted, then "TAPE:" is assumed.
$!-----------------------------------------------------------------------------
$! 17-Apr-1984	R. A. Harris	Initial Coding.
$! 24-May-1984	R. A. Harris	Add logic to check to see if protection of
$!				  the tape prevents the user from reading 
$!				  after a UIC change and if it does, then to
$!				  check if the target directory protection 
$!				  allows the user to create files there.
$!				Write old and new UIC values into the log file.
$!-----------------------------------------------------------------------------
$ on error then goto abort
$!
$	cur_dir = f$logical("SYS$DISK") + f$directory()
$!
$!    Fetch the user's current UIC value.
$!
$	cur_uic = f$getjpi("","uic")
$	write sys$output "		Previous UIC = ''cur_uic'"
$!
$!    Fetch the UIC of the directory specified.
$!
$	if p1 .eqs. "" then p1 = f$logical("SYS$DISK") + f$directory()
$	set default 'p1'
$!
$!    Translate logical disk to check for rooted directory.
$!
$	next = ( f$parse(p1,,,"device") + "%" ) - ":%" - "%"
$	do_while_translation:
$	    dev := 'next'
$	    next = ( f$logical(dev) + "%" ) - ":%" - "%"
$	    if next .nes. "" then goto do_while_translation
$	enddo_while_translation:
$!
$!    Parse the directory to determine the directory file name and path.
$!
$	dir = f$parse(p1,,,"directory")
$	dir_s = f$length(dir)
$	l = 0
$	do_while_dots:
$	    p = f$locate(".",dir)
$	    if p .eq. dir_s then goto enddo_while_dots
$	    dir[p,1]:="%"
$	    l = p 
$	    goto do_while_dots
$	enddo_while_dots:
$!
$	dir = f$parse(p1,,,"directory") - "]" + ".dir"
$	dir[l,1]:="]"
$	if l .eq. 0 then dir = "[-" + dir
$	dev = dev + ":"
$	x = f$locate("]:",dev)
$	if x .ne. f$length(dev) then -
		dir = ( dev - "]:" ) + ( dir - "[" - "-" )
$	if f$locate(".]",dir) .nes. f$length(dir) then dir = dir - "."
$!
$!    Fetch necessary information and log it to sys$output
$!
$	dir_uic = f$file(dir,"uic")
$	dir_prot = f$file(dir,"pro")
$	write sys$output -
"		Directory UIC = ''dir_uic' - Protection = ''dir_prot'"
$!
$	tape := 'p2'
$	if p2 .eqs. "" then tape := TAPE:
$!
$	tape_uic = f$getdvi(tape,"ownuic")
$	tape_prot = f$getdvi(tape,"vprot")
$	write sys$output -
"		Tape UIC = ''tape_uic' - Protection = ''tape_prot'"
$!
$!    See if the directory specified is of a different UIC than the user's
$!	  current UIC.  
$!
$	if "''dir_uic'" .eqs. "''cur_uic'" then goto endif_uic_needed
$!
$!	  Fetch the UIC of the tape and the protection.
$!
$	    p = f$locate("WORLD",tape_prot) + 6
$	    world = f$extract(p,4,tape_prot) - "W" - "E" - "D"
$	    if "''world'" .eqs. "R" then goto endif_world_read
$!
$		l = f$locate(",",dir_uic)
$		dir_grp = f$extract(1,l,dir_uic) - "[" - ","
$		dir_grp = 'dir_grp'
$!
$		l = f$locate(",",tape_uic)
$		tape_grp = f$extract(1,l,tape_uic) - "[" - ","
$		tape_grp = 'tape_grp'
$!
$	        p = f$locate("GROUP",tape_prot) + 6
$	        group = f$extract(p,4,tape_prot) - "W" - "E" - "D"
$!
$		if 'tape_grp' .eq. 'dir_grp' .and. -
		   "''f$extract(0,1,group)'" .eqs. "R" then -
			goto endif_group_read
$!
$!		  Group and world access are not allowed, see if the user
$!		      is allowed to write into the directory with group or
$!		      world access.
$!
$		    p = f$locate("WORLD",dir_prot) + 6
$		    world = f$extract(p,4,dir_prot) - "R" - "E" - "D"
$		    if "''world'" .eqs. "W" then goto endif_world_write
$!
$			p = f$locate("GROUP",dir_prot) + 6
$			group = f$extract(p,4,dir_prot) - "R" - "E" - "D"
$			if 'tape_grp' .eq. 'dir_grp' .and. -
			   "''f$extract(0,1,group)'" .eqs. "W" then -
				goto endif_group_write
$!
$!			  It is determined to be impossible to read the
$!			      tape and write the file in the directory.
$!
$			    msg = "%IPSS$OFFLOAD-E-CANTBEDONE, " + -
				  "The UIC and protection on the tape " + -
				  "conflict with the UIC and protection " + -
				  "of the directory."
$			    write sys$error msg
$			    write sys$output msg
$!
$			endif_group_write:
$		    endif_world_write:
$!
$		    goto endif_uic_needed	! no UIC change to be done
$!
$		endif_group_read:
$	    endif_world_read:
$!
$!	  Change the user's UIC to match the UIC of the directory.
$!
$	    uic 'dir_uic'
$!
$	endif_uic_needed:
$	write sys$output "		Current UIC  = ''f$getjpi("","uic")'"
$!
$ abort:
$	set def 'cur_dir'
$!
$	if verify then set verify	!'f$verify("NO")'