* * $Id: fainqr.F,v 1.1.1.1 1996/03/07 15:18:07 mclareni Exp $ * * $Log: fainqr.F,v $ * Revision 1.1.1.1 1996/03/07 15:18:07 mclareni * Fatmen * * #include "fatmen/pilot.h" SUBROUTINE FAINQR(DSNAME,CHHOST,CHNAME,IRC) *CMZ : 17/10/91 15.00.35 by Jamie Shiers *-- Author : Jamie Shiers 17/10/91 CHARACTER*(*) DSNAME,CHHOST,CHNAME CHARACTER*255 DSN,CHFILE #include "fatmen/fatbug.inc" #include "fatmen/slate.inc" #include "zebra/quest.inc" PARAMETER (NPOSS=4) CHARACTER*8 CHPOSS(NPOSS) #if defined(CERNLIB_VAXVMS) CHARACTER*255 CHDFS,DFSNAM INCLUDE '($RMSDEF)' INTEGER FAFNDF #endif #if defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS) CHARACTER*255 CHNFS #endif #if defined(CERNLIB_IBMVM) CHARACTER*8 USER,ADDR CHARACTER*16 CHSFS CHARACTER*80 CHGIME,CHLINE CHARACTER*1 MODE #endif #if defined(CERNLIB_SHIFT) CHARACTER*16 SHPOOL,SHUSER CHARACTER*11 SHLINK CHARACTER*255 CHDSN #endif LOGICAL IEXIST SAVE CHPOSS DATA CHPOSS(1)/'OSM'/, + CHPOSS(2)/'UNITREE'/, + CHPOSS(3)/'ADSM'/, + CHPOSS(4)/'EMASS'/ * * Return access method in IQUEST(1) * IQUEST(1) = 0 : unknown * 1 : VM/CMS mini-disk * 2 : VM/CMS SFS * 11 : VAX/VMS disk * 12 : VAXcluster disk * 13 : DFS (DECnet) * 14 : DECnet * 15 : CSPACK (zserv) * 16 : FPACK * 21 : Unix disk * 22 : NFS (e.g. $VARIABLE/file) * 23 : AFS * 24 : Shift pool file * 25 : Shift private file * 31 : Lachman OSM file * 32 : Unitree file * 33 : ADSM file * 34 : E-MASS file * * CHFILE contains on exit the fully qualified filename (VMS, Unix) * IRC = 0 IACC = 0 LDSN = LENOCC(DSNAME) DSN = DSNAME(1:LDSN) LHOST = LENOCC(CHHOST) * * URL? * IURL = INDEX(DSN(1:LDSN),'://') ISLASH = INDEX(DSN(1:LDSN),'/') IF(IURL.NE.0.AND.IURL.EQ.ISLASH-1) THEN IT = ICNTHU(DSN(1:IURL-1),CHPOSS,NPOSS) IF(IT.NE.0) IACC=30+IT #if defined(CERNLIB_UNIX) * * ... issue mssquery ... * #endif #if !defined(CERNLIB_UNIX) IRC = -1 #endif GOTO 99 ENDIF #if defined(CERNLIB_IBMVM) * * Get disk name and link to it * MODE = ' ' LSTA = INDEX(DSN,'<') IF(LSTA.NE.0) THEN * * Format of DSN is filename.filetype on VM * address defaults to 191. If field <> missing, defaults to * current userid. * * Valid filenames: * FN.FT * FN.FT * FN.FT * SFS POOL:FN.FT * CALL CTRANS('[','<',DSN,1,LDSN) CALL CTRANS(']','>',DSN,1,LDSN) LDOT = INDEX(DSN,'.') LBRA = INDEX(DSN,'>') IF((LDOT.NE.0).AND.(LDOT.LE.LBRA)) THEN LEND = LDOT ELSE LEND = LBRA ENDIF USER = DSN(LSTA+1:LEND-1) LUSR = LEND - LSTA - 1 ADDR = ' ' IF((LDOT.NE.0).AND.(LDOT.LE.LBRA)) THEN ADDR= DSN(LDOT+1:LBRA-1) ENDIF LCHSFS = INDEX(DSN(1:LDSN),':') IF(LCHSFS.NE.0) THEN CHSFS = DSN(1:LCHSFS) IF(IDEBFA.GE.2) PRINT *,'FAINQR. SFS pool = ', + CHSFS(1:LCHSFS) ENDIF IF(LCHSFS.EQ.0) THEN IACC = 1 CHGIME = 'EXEC GIME '//USER(1:LUSR)//' '//ADDR// + '(QUIET NONOTICE STACK)' ELSE IACC = 2 CHGIME = 'EXEC GIME '// + CHSFS(1:LCHSFS)//USER(1:LUSR)//'.'//ADDR// + '(QUIET NONOTICE STACK)' ENDIF CALL CSQMBL(CHGIME,1,80) LCHG = LENOCC(CHGIME) IF(IDEBFA.GE.1) PRINT *,'FAINQR. executing ', + CHGIME(1:LCHG) CALL VMCMS(CHGIME(1:LCHG),IGIME) IF(IGIME.GT.4) THEN IF(IDEBFA.GE.0) + PRINT *,'FAINQR return code from GIME = ',IGIME GOTO 99 ENDIF CALL VMRTRM(CHLINE,LENGTH) MODE = CHLINE(1:1) CHFILE = '/' // DSN(LBRA+1:LDSN) // ' ' // MODE LDSN = LDSN + 3 - LBRA ENDIF CALL CTRANS('.',' ',CHFILE,1,LDSN) #endif #if defined(CERNLIB_IBMMVS) CHFILE = '/'//DSN(1:LDSN) LDSN = LDSN + 1 #endif #if defined(CERNLIB_VAXVMS) * * Check hostname * IACC = 11 IF(LHOST.GT.0) THEN CALL FMVAXC(CHHOST(1:LHOST),ICODE) IACC = 11 + ICODE ENDIF * * Check DFS access * IF(ICODE.EQ.2) THEN * * First, get full file name * ICONT = 0 * IFIND = LIB$FIND_FILE(DSN(1:LDSN),CHDFS,ICONT) IFIND = FAFNDF(DSN(1:LDSN),CHDFS,ICONT) IEND = LIB$FIND_FILE_END(ICONT) IF(IFIND.EQ.RMS$_SUC) THEN LCHDSN = INDEX(CHDFS,':') - 1 IF(LCHDSN.GT.0) THEN CALL FMGTLG(CHDFS(1:LCHDSN),DFSNAM,'LNM$SYSTEM',JRC) IF((JRC.EQ.0).AND.(INDEX(DFSNAM,'DFSC').NE.0)) IACC = 13 ENDIF ELSE INQUIRE(FILE=CHHOST(1:LHOST)//'::'//DSN(1:LDSN), + EXIST=IEXIST) IF(IEXIST) THEN IACC = 14 CHFILE = CHHOST(1:LHOST)//'::'//DSN(1:LDSN) ENDIF ENDIF ENDIF #endif #if defined(CERNLIB_UNIX) IACC = 21 IF(DSN(1:5).EQ.'/afs/') IACC = 23 #endif #if defined(CERNLIB_SHIFT) * * Check if link already exists... * CHDSN = DSN(1:LDSN) SHLINK = 'FATMEN_LINK' INQUIRE(FILE=SHLINK,EXIST=IEXIST) IF(IEXIST) THEN IF(IDEBFA.GE.0) + PRINT *,'FAINQR. removing existing symbolic link...' IRC = SYSTEMF('rm '//SHLINK) ENDIF CALL CTRANS('<','[',DSN,1,LDSN) CALL CTRANS('>',']',DSN,1,LDSN) ILSQB = INDEX(DSN(1:LDSN),'[') IRSQB = INDEX(DSN(1:LDSN),']') IF(ILSQB.NE.0) THEN IF(IDEBFA.GE.1) PRINT *,'FAINQR. SHIFT POOL file...' IACC = 24 IDOT = INDEX(DSN(1:IRSQB),'.') SHPOOL = DSN(2:IDOT-1) SHUSER = DSN(IDOT+1:IRSQB-1) ISTART = IRSQB+1 IEND = LDSN IF (IDEBFA.GE.0) PRINT *,'FAINQR. Assign for logical unit ', + SHLINK,' pool = ',SHPOOL, + ' user = ',SHUSER,' dsn = ',DSN(ISTART:IEND) IRC = SYSTEMF('assign ` sfget -k -p '//SHPOOL// + ' -u '//SHUSER// ' '//CHDSN(ISTART:IEND)//' ` + '//SHLINK//' ') IF(IRC.NE.0) THEN PRINT *,'FAINQR. return code ',IRC,' from SFGET' GOTO 99 ENDIF ELSE IF(IDEBFA.GE.1) PRINT *,'FAINQR. SHIFT private file...' IACC = 25 IRC = SYSTEMF('assign '//CHDSN(1:LDSN)//' '// + SHLINK) IF(IRC.NE.0) THEN PRINT *,'FAINQR. return code ',IRC,' from SFGET' GOTO 99 ENDIF ENDIF DSN = SHLINK LDSN = 11 #endif #if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT)) * * Expand any environmental variable * IF(DSN(1:1).EQ.'$') THEN IACC = 22 LEND = INDEX(DSN,'/') #endif #if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT)) CALL GETENVF(DSN(2:LEND-1),CHNFS) #endif #if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT)) CALL FMGTLG(DSN(2:LEND-1),CHNFS,'LNM$SYSTEM',IRC) #endif #if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT)) IF(IS(1).EQ.0) THEN IF(IDEBFA.GE.3) PRINT *,'FAINQR. cannot expand ', + 'environmental variable/logical name ',DSN(2:LEND-1) IRC = 1 GOTO 99 ENDIF LCHNFS = IS(1) #endif #if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT)) CHFILE = CHNFS(1:IS(1)) // DSN(LEND:LDSN) LDSN = IS(1) + LDSN - LEND + 1 #endif #if (defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT)) * * If there is more than one slash in file name * assume that the intervening elements are directory names * JSLASH = INDEXB(DSN(1:LDSN),'/') IF(JSLASH.EQ.LEND) THEN CHNFS(LCHNFS+1:) = DSN(LEND+1:LDSN) LCHNFS = LCHNFS + LDSN - LEND ELSE CHNFS(LCHNFS+1:) = '[' // DSN(LEND+1:JSLASH-1) + // ']' // DSN(JSLASH+1:LDSN) LCHNFS = LCHNFS + LDSN - LEND + 1 CALL CTRANS('/','.',CHNFS,1,LCHNFS) ENDIF CHFILE = CHNFS(1:LCHNFS) #endif #if (defined(CERNLIB_UNIX)||defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_SHIFT)) ELSE IF(IACC.NE.14) CHFILE = DSN ENDIF #endif #if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_SHIFT)) CALL CUTOL(CHFILE) #endif LFILE = LENOCC(CHFILE) IF(IDEBFA.GE.2) PRINT *,'FAINQR. issuing inquire for ', + CHFILE(1:LFILE) INQUIRE(FILE=CHFILE(1:LFILE),EXIST=IEXIST,NAME=CHNAME) IF(.NOT.IEXIST) IRC = 1 #if defined(CERNLIB_IBMVM) * * Don't drop disks that were already accessed, our A disk etc. * IF(IGIME.NE.4.AND.MODE.NE.'A'.AND.MODE.NE.' ') + CALL VMCMS('EXEC DROP '//MODE//' (QUIET',IRT) #endif 99 CONTINUE IQUEST(1) = IACC END