$! File: INSTALL_FPORT___SET_USER.COM
$!
$! This file installs the SET USER routine as a shared image, linking it if
$! needed.
$!
$! This is required as the SET USER routine must be linked against the
$! system symbol table, and must be rebuilt for each Version of OpenVMS.
$!
$! 11-Sep-1999 J. Malmberg
$!
$!============================================================================
$!===========================================================================
$!
$! Copyright 2000, John E. Malmberg, All Rights Reserved
$!
$! This program is free software; you can redistribute it and/or modify
$! it under the terms of the GNU General Public License as published by
$! the Free Software Foundation; either version 2 of the License, or
$! (at your option) any later version.
$!
$! This program is distributed in the hope that it will be useful,
$! but WITHOUT ANY WARRANTY; without even the implied warranty of
$! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
$! GNU General Public License for more details.
$!
$! You should have received a copy of the GNU General Public License
$! along with this program; if not, write to the Free Software
$! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
$!
$!===========================================================================
$!
$! Save environment
$!-----------------
$set noon
$old_priv = f$getjpi("","CURPRIV")
$!
$!
$! Turn on privileges for terminal servers and ports"
$!-----------------------------------------------------
$needed_priv = "CMKRNL,SYSNAM,SYSPRV"
$set proc/priv=('needed_priv')
$if .not. f$privilege(needed_priv) then goto no_priv
$!
$!
$! First find out what type of CPU we are on
$!-------------------------------------------
$hw_model = f$getsyi("HW_MODEL")
$if hw_model .ge. 1000
$then
$ arch = "AXP"
$else
$ arch = "VAX"
$endif
$!
$! Then get the OpenVMS version name
$!-----------------------------------
$node_swvers = f$getsyi("node_swvers")
$!
$! Now mangle the name into a suitable file specification
$!--------------------------------------------------------
$part1 = f$element(0,".",node_swvers)
$part2 = f$element(1,".",node_swvers)
$!
$vms_ver = part1
$if part2 .nes. "."
$then
$ vms_ver = part1 + "_" + part2
$endif
$!
$!
$! Where are the sources?
$!-----------------------
$procedure = f$environment("PROCEDURE")
$device = f$parse(procedure,,,"DEVICE")
$direct = f$parse(procedure,,,"DIRECTORY")
$source_dir = device + direct
$!
$!
$! Now figure out where the installed image is.
$!---------------------------------------------
$imagename = f$trnlnm("FRONTPORT___SET_USER")
$if imagename .eqs. ""
$then
$ imagename = "''source_dir'FRONTPORT___SET_USER_''arch'_''vms_ver'.EXE"
$ DEFINE/SYSTEM/EXEC FRONTPORT___SET_USER 'imagename'
$endif
$!
$!
$! Is there a C compiler present?
$!-------------------------------
$object1 = "''source_dir'FPORT___SET_USER.OBJ_''arch'"
$rebuild1 = "FALSE"
$decc_image = f$search("SYS$SYSTEM:DECC$COMPILER.EXE")
$if decc_image .nes. ""
$then
$!
$! Set up the correct CC command
$!--------------------------------
$ cc := cc/decc/warn=enable=level4
$!
$! GCC not implemented at this time.
$!-------------------------------------
$!
$! Are the objects up to date?
$!------------------------------
$ source1 = "''source_dir'FPORT___SET_USER.C"
$ if f$search(source1) .nes. ""
$ then
$ if f$search(object1) .eqs. ""
$ then
$ rebuild1 = "TRUE"
$ else
$ src_rdt = f$cvtime(f$file_attributes(source1, "RDT"), "COMPARISON")
$ obj_rdt = f$cvtime(f$file_attributes(object1, "RDT"), "COMPARISON")
$ if obj_rdt .lts. src_rdt then rebuild1 = "TRUE"
$ endif
$ if rebuild1
$ then
$ CC/object='object1' 'source1'
$ endif
$ endif
$endif
$!
$! And the images
$!---------------
$if arch .eqs. "ALPHA" then macro := macro/migration
$source2 = "''source_dir'SYS_SETUSER.MAR"
$object2 = "''source_dir'SYS_SETUSER.OBJ_''arch'"
$rebuild2 = "FALSE"
$if f$search(source2) .nes. ""
$then
$ if f$search(object2) .eqs. ""
$ then
$ rebuild2 = "TRUE"
$ else
$ src_rdt = f$cvtime(f$file_attributes(source2, "RDT"), "COMPARISON")
$ obj_rdt = f$cvtime(f$file_attributes(object2, "RDT"), "COMPARISON")
$ if obj_rdt .lts. src_rdt then rebuild2 = "TRUE"
$ endif
$ if rebuild2
$ then
$ MACRO/object='object2' 'source2'
$ endif
$endif
$!
$rebuild3 = "FALSE"
$if arch .eqs. "VAX"
$then
$ source3 = "''source_dir'FPORT___SET_USER_XFER.MAR"
$ object3 = "''source_dir'FPORT___SET_USER_XFER.OBJ"
$ if f$search(source3) .nes. ""
$ then
$ if f$search(object3) .eqs. ""
$ then
$ rebuild3 = "TRUE"
$ else
$ src_rdt = f$cvtime(f$file_attributes(source3, "RDT"), "COMPARISON")
$ obj_rdt = f$cvtime(f$file_attributes(object3, "RDT"), "COMPARISON")
$ if obj_rdt .lts. src_rdt then rebuild3 = "TRUE"
$ endif
$ if rebuild3
$ then
$ MACRO/object='object3' 'source3'
$ endif
$ endif
$endif
$!
$!
$! Is the image up to date?
$!--------------------------
$relink = rebuild1 .or. rebuild2 .or. rebuild3
$if f$search(imagename) .eqs. "" then relink = "TRUE"
$if .not. relink
$then
$ image_rdt = f$cvtime(f$file_attributes(imagename, "RDT"), "COMPARISON")
$ obj_rdt = f$cvtime(f$file_attributes(object1, "RDT"),"COMPARISON")
$ if image_rdt .lts. obj_rdt then relink = "TRUE"
$endif
$if .not. relink
$then
$ obj_rdt = f$cvtime(f$file_attributes(object2, "RDT"),"COMPARISON")
$ if image_rdt .lts. obj_rdt then relink = "TRUE"
$endif
$if .not. relink .and. (arch .eqs. "VAX")
$then
$ obj_rdt = f$cvtime(f$file_attributes(object3, "RDT"),"COMPARISON")
$ if image_rdt .lts. obj_rdt then relink = "TRUE"
$endif
$if relink
$then
$ if arch .eqs. "AXP"
$ then
$ LINK/SHARE='imagename' 'object1', 'object2'/SYSEXE,SYS$INPUT:/OPTION
gsmatch=lequal,1,0
identification = "FPORT S U 1.0"
SYMBOL_VECTOR=(fport___set_user = PROCEDURE)
$ else
$ LINK/SHARE='imagename' 'object1', 'object2', 'object3', -
SYS$SYSTEM:SYS.STB/selective_search, SYS$INPUT/opt
gsmatch=lequal,1,0
identification = "FPORT S U 1.0"
universal = fport___set_user
$ endif
$endif
$!
$!
$! Is the image already installed?
$!----------------------------------
$cmd = "ADD"
$if f$file_attributes(imagename,"KNOWN") then cmd = "REPLACE"
$!
$! install the new image NEVER WITH PRIVILEGES.
$!-------------------------------------------------
$install 'cmd' 'imagename' /SHARE/OPEN/HEADER
$!
$!
$! Clean up and exit
$!------------------
$all_exit:
$if f$type(old_priv) .eqs. "STRING" then set proc/priv=(NOALL,'old_priv')
$exit
$!
$!
$! No privilege for attempted operation
$!-------------------------------------
$no_priv:
$!
$ind = 0
$prv_loop:
$priv = f$element(ind,",",needed_priv)
$if priv .eqs. "," then goto prv_loop_end
$IF .NOT. F$PRIVILEGE(priv)
$THEN
$ WRITE SYS$OUTPUT "You need ''priv' privilege to run this procedure."
$ENDIF
$ind = ind + 1
$goto prv_loop
$prv_loop_end:
$ WRITE SYS$OUTPUT "Please see your system manager."
$goto all_exit