*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/07 15:18:06  mclareni
* Initial revision
*
*
#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 <user.address>filename.filetype on VM
*     address defaults to 191. If field <> missing, defaults to
*     current userid.
*
*     Valid filenames:
*                     FN.FT
*                     <JAMIE>FN.FT
*                     <JAMIE.191>FN.FT
* SFS                 POOL:<JAMIE.A191>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
