C+ C Title: FINGER.FTN C Author: T. R. Wyant C Date: 02-Oct-1985 C Modified: C Remarks: C This is the mainline for the RSX version of FINGER. C- INTEGER*2 ERRBUF(10) ! Error message parms. INTEGER*2 ERRORF ! Error formatting function. INTEGER*2 NTSTAT(2) ! DECnet status. INTEGER*2 LINK(36) ! DECnet connect blk. INTEGER*4 MCR ! Task name of MCR CLI INTEGER*2 NETERR ! = Rad50 "NET" INTEGER*2 NTCB(48) ! Connect request block. INCLUDE 'FINGERCOM' INCLUDE 'IPCOMM' DATA MCR /6RMCR.../ DATA NETERR /3RNET/ C C======================================================================= C C Code. C C....................................................................... C C Initialization. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Preset any needed variables. C CALL ERRSET (29, , .FALSE., , .FALSE.) ! No such file. CALL ERRSET (43, , .FALSE., , .FALSE.) ! File name spec err. IPSKFG = .TRUE. ! Tell parser to skip blanks. NETMOD = .FALSE. ! Assume not in network mode. IPSLOC = 1 ! Command always starts at 1. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Open the net. If we can't, not in net mode. C CALL OPNNTW(LUNMBX,NTSTAT) ! Init the net. IF (NTSTAT(1) .LT. 0) ! If we failed, we must be 1 GO TO 1400 ! local. Go to MCR for cmd. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Get our local node name. C CALL GLNNTW (NTSTAT, 6, OURNAM) C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Try to dequeue a connection. If can't, not in net mode. C CALL GNDNTW(NTSTAT,NTTYP,96,NTCB,,.TRUE.,NTCONN) IF (NTSTAT(1) .LT. 0) ! If we failed, we must be 1 GO TO 1400 ! local. Go to MCR for cmd. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Accept the connect, and try to get command. C If we can't, just die. C NETMOD = .TRUE. ! We are in network mode. CALL ACCNTW(LUNLIN,NTSTAT,NTCB) ! Accept the connection. IF (NTSTAT(1) .LT. 0) GO TO 9990 ! If can't get it, die. CALL RECNTW(LUNLIN,NTSTAT, ! Get the command 1 IPBLEN,IPBUF) ! line. IF (NTSTAT(1) .LT. 0) GO TO 9990 ! If can't get it, die. IPSLEN = NTSTAT(2) ! Get its length. GO TO 1600 ! Parse the command C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Get a command from MCR. C 1400 CALL GETMCR(IPBUF,IPSLEN) ! Get an MCR command. GO TO 1600 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C We got our command. Now parse it and dispatch. C 1600 CALL FINPSR ! Parse the command. IF (NODEL .GT. 0) GO TO 5000 ! If we have a nodename, DECnet. C C....................................................................... C C Local node request. C 4000 CALL FINLCL GO TO 9990 C C....................................................................... C C Remote node request. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Link to the remote FINGER. C 5000 ERRBUF(1) = NODEL CALL GETADR(ERRBUF(2),NODNAM) CALL BFMT0(,LINK,NODEL,NODNAM, ! The remote FINGER is net 1 117) ! object 117 IRETRY = 2 ! We get three chances. 5010 CALL CONNTW(LUNLNK,NTSTAT,LINK) ! Attempt to connect. IF (NTSTAT(1) .GT. 0) ! If we made it, 1 GO TO 5020 ! proceed. IRETRY = IRETRY - 1 ! We lose a life. IF (IRETRY .LE. 0) GO TO 9510 ! If we're really dead, die. CALL WAIT(3,2,IDSW) ! Wait a bit. GO TO 5010 ! Go back and try some more. 5020 CONTINUE ! We made it. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Reformat and send the command. C CALL SNDNTW(LUNLNK,NTSTAT, ! Send the command 1 IPSLEN,IPBUF(IPSLOC)) ! off. IF (NTSTAT(1) .LT. 0) GO TO 9520 ! If didn't make it, die. ENCODE (IPBLEN-1,95020,IPBUF(2))! Tell user we're on 1 (NODNAM(I),I=1,NODEL) ! DECnet. IPSLOC = 2 ! Where we are. IPSLEN = NODEL + 10 ! How big we are. CALL FINOUT ! Write it. IPBUF(2) = ' ' ! CC byte. IPBUF(3) = ' ' ! Empty line. IPSLOC = 2 ! Where we are. IPSLEN = 2 ! How big we are. CALL FINOUT ! Write it. 95020 FORMAT ('0[',A1,'.DECnet]') C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Receive until link broken. C 5500 IPBUF(1) = 0 ! Null carriage control. CALL RECNTW(LUNLNK,NTSTAT, ! Recieve the next 1 IPBLEN-1,IPBUF(2)) ! buffer. IF (NTSTAT(1) .LE. 0) ! If it didn't make it, 1 GO TO 9910 ! quit. IPSLOC = 1 ! Where the data is. IPSLEN = NTSTAT(2) + 1 ! How much there is. CALL FINOUT ! Write it. GO TO 5500 ! Loop back for more. C C....................................................................... C C Error handlers. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Failed to connect to the node or object. C 9510 IPSLOC = 2 IPSLEN = ERRORF(IPBUF(IPSLOC), 1 '%0Finger - Error - Failed to reach node %VA::' 2 ,ERRBUF,NETERR,NTSTAT) CALL FINOUT GO TO 9990 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Failed to send the command. C 9520 IPSLOC = 2 IPSLEN = ERRORF(IPBUF(IPSLOC), 1 '%0Finger - Error - Failed to send command to %VA::' 2 ,ERRBUF,NETERR,NTSTAT) CALL FINOUT GO TO 9910 C C....................................................................... C C Common exit code. C 9910 CALL DSCNTW(LUNLNK) 9990 IF (NETMOD) CALL DSCNTW(LUNLIN) ! If in net mode, disconn. CALL CLSNT CALL EXIT END