+-+-+-+ Beginning of part 24 +-+-+-+
X`009`009string(i:i) = char(bytary(i))
X`009`009i = i + 1
X`009end do
X`009string(i:) = ' '
X`009return
X`009end
$ GOSUB UNPACK_FILE

$ FILE_IS = "TERMINAL.MAR"
$ CHECKSUM_IS = 1360863026
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.Title`009TERM_Info - Get information about a terminal
X`009.Ident`009/V01.001/
X`009.Enable`009SUP                                `032
X`009.Default Displacement,Word
X`009.Subtitle Introduction
X;+
X;
X; ----- TERM_Info:  Get information about a terminal;
X;
X; Facility:
X;
X;`009VAX/VMS system programming
X;
X; Abstract:
X;
X;`009This module provides a routine which can be called from any
X;`009VAX native  language to obtain information about a specific
X;`009terminal.
X;
X; Environment:
X;
X;`009VAX/VMS native mode, VMS V4.2 or later, CMKRNL privilege.
X;
X; Version:`009V01.001
X; Date:`009`00912-Apr-1988
X;
X;
X; Modifications:
X;
X;
X;-
X
X`009.Page
X`009.Subtitle Local definitions
X
X`009.Library "SYS$LIBRARY:LIB"
X`009`009;Get special macros from here
X`009.Link`009"SYS$SYSTEM:SYS.STB"/Selective_Search
X`009`009;Ease the link process a bit
X
X`009.NoCross`009;Save a tree
X
X`009$DCDEF`009`009`009`009;Device class & type definitions
X`009$DDBDEF`009`009`009`009;Device data block offsets
X`009$SSDEF`009`009`009`009;System service codes
X`009$TTYUCBDEF`009`009`009;Terminal UCB offsets
X`009$UCBDEF`009`009`009`009;UCB offsets
X
X`009.Cross`009`009`009`009;Turn CREF back on
X
X
X`009.Page
X`009.Subtitle`009TERMINFO`009- Get information about a terminal
X
X;+
X;
X; ----- TERM_INFO:  Get information about a terminal
X;
X;
X; The calling program must have  CMKRNL privilege and  must be linked
X; with SYS.STB.
X;
X; Call sequence:
X;
X;  status.wlv = TERM_INFO (terminal.rt.dx, term_info_structure.m?.r)
X;  term_info_structure :
X;`009.long`009ucb$l_duetim
X;`009.long`009ucb$l_pid
X;`009.word`009ucb$w_wrtt_link
XINFO_SIZE = 10
X;
X; Inputs:
X;
X;`0094(AP)`009- Address of a descriptor of the device name.
X;
X; Outputs:
X;
X;`0098(AP)`009- Address of a term_info structure.
X;
X;`009R0`009- SS$_NOPRIV:`009 No CMKRNL privilege.
X;`009`009- SS$_ACCVIO:`009 One of the arguments is not accessible.
X;`009`009- SS$_NOSUCHDEV: The specified device can't be found.
X;`009`009- SS$_IVDEVNAM:`009 The specified device isn't a terminal.
X;`009`009- SS$_NORMAL:`009 Success.
X;
X;-
X
X`009.Psect`009TERM_INFO`009EXE,RD,NOWRT,PIC,SHR,PAGE
X
X`009.Entry`009TERM_INFO,`094M<>`009`009; Entry here
X
X`009$CMKRNL_S ROUTIN=B`09420$,-`009; Do this
X`009`009ARGLST=(AP)`009`009;   in kernel mode
X
X10$:`009RET`009`009`009`009; Done, status in R0
X
X; Here in kernel mode to do all of the actual work.
X
X20$:`009.Word`009`094M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X`009`009;Here in kernel mode to get some info
X
X; First, check to see if we can read the argument list.
X
X`009MOVL`009#SS$_ACCVIO,R0`009`009; Presume we can't
X`009IFNORD`009#<3*4>,(AP),10$`009`009; Probe the argument list
X
X; Check the number of arguments
X
X`009MOVL`009#SS$_INSFARG,R0`009`009; Presume we have too few arguments
X`009CMPB`009#2,(AP)`009`009`009; Do we have enough arguments?
X`009BNEQ`00910$`009`009`009; If NEQ no, it's wrong somehow
X`009
X; Check to see if we can write the term_info structure.
X`009
X`009MOVL`009#SS$_ACCVIO,R0`009`009; Presume we can't
X`009IFNOWRT`009#INFO_SIZE,@8(AP),10$`009; Probe the term_info structure
X`009MOVL`0098(AP),R10`009`009; save the address of term_info struct.
X
X; See if we can read the device name descriptor.
X
X`009MOVL`0094(AP),R1`009`009; Address the device name descriptor
X`009JSB`009G`094EXE$PROBER_DSC`009; Probe the descriptor
X`009BLBC`009R0,10$`009`009`009; Sigh.
X`009MOVQ`009R1,-(SP)`009`009; Save copy of the probed descriptor
X`009MOVL`009SP,R11`009`009`009; Remember where it is
X`009CLRW`0092(R11)`009`009`009; Never mind the type and class info
X
X; Ok.  Now go hunt down the device the user told us was a terminal
X
X`009MOVL`009G`094CTL$GL_PCB,R4`009`009; Get my PCB address
X`009JSB`009G`094SCH$IOLOCKR`009`009; Lock the I/O database mutex
X`009MOVL`009R11,R1`009`009`009; Address the device name descriptor
X`009JSB`009G`094IOC$SEARCHDEV`009`009; Go search for the device.
X`009BLBC`009R0,30$`009`009`009; We lose.
X
X; Now check to see if it's really a terminal.
X`009MOVL`009#SS$_IVDEVNAM,R0`009; Presume it isn't a terminal
X       `009CMPB`009#DC$_TERM,UCB$B_DEVCLASS(R1)`009; Is it a terminal?
X`009BNEQ`00930$`009`009`009; If NEQ no.
X
X; okay, we have this device UCB in R1, let's change it so that the
X; physical UCB is in R1, and the logical UCB is in R2, note that
X; these may well be the same thing, only if the terminal is redirected
X; will there be any differene.
X`009MOVL`009UCB$L_TL_PHYUCB(R1),R2
X`009BEQL`00921$
X`009MOVL`009R2,R1`009; okay, store the physical UCB in R1...
X
X21$:`009; Let's get R2 pointing to logical UCB if there is one, else physical
X    `009MOVL`009R1,R2`009; assume it's not redirected
X`009BBC`009#DEV$V_RED,UCB$L_DEVCHAR2(R1),22$
X`009MOVL`009UCB$L_TT_LOGUCB(R1),R2
X`009BNEQ`00922$
X`009MOVL`009R1,R2`009; this should never occur
X
X22$:`009CLRW`009R3`009`009`009; clear the link number
X`009BBC`009#DEV$V_RTT,UCB$L_DEVCHAR2(R1),25$
X`009MOVW`009UCB$W_RTT_LINK(R1),R3`009; get the link number
X
X25$:`009MOVL`009UCB$L_DUETIM(R1),R0`009; get duetim
X`009BEQL`00926$`009`009`009; if zero, save it as zero...
X`009SUBL3`009R0,G`094EXE$GL_ABSTIM,R0`009; save duetim
X26$:`009MOVL`009R0,(R10)+
X
X27$:`009MOVL`009UCB$L_PID(R2),R0`009; Get internal PID
X   `009JSB`009G`094EXE$IPID_TO_EPID`009; Convert to extended PID
X`009MOVL`009R0,(R10)+`009`009; Save external PID
X`009MOVW`009R3,(R10)+`009`009; save rtt_link
X
X`009MOVL`009#SS$_NORMAL,R0`009`009; Success!
X`009MOVL`009G`094CTL$GL_PCB,R4`009`009; Get my PCB address again
X
X30$:`009PUSHL`009R0`009`009`009; Save the return status
X`009JSB`009G`094SCH$IOUNLOCK`009`009; Unlock the I/O database mutex
X`009SETIPL`009#0`009`009`009; Drop back down from IPL$_ASTDEL
X`009POPL`009R0`009`009`009; Restore the return status
X`009RET`009`009`009`009; Back to user mode
X
X`009.End
$ GOSUB UNPACK_FILE

$ FILE_IS = "UCXFINGER.FOR"
$ CHECKSUM_IS = 910559663
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009integer function tcp_finger(host,comm,finger_out_routine)
X
Xc  Outgoing finger for VMS/Ultrix Connection (UCX) TCP/IP
Xc  Terry Kennedy, SPC, 27-Aug-1991
Xc  Some functions derived from existing TCPFINGER.FOR
X
X`009implicit`009none
X
X`009external`009fing_nonode, fing_nonet
X`009external`009fing_complete, fing_abort
X`009external`009fing_noservice, fing_unreachable
X
X`009external`009finger_out_routine
X
X`009integer*4`009btrim, get_host, open_net, read_net
X`009character*20`009network, get_network
X
X`009character*(*)`009host,comm
X
X`009integer`009`009blen, i, i1, i2, i3, i4, j, lll
X`009byte`009`009address(4)
X`009character*2`009line, buffer*1024
X`009character*132`009tempcom, tempcom1
X`009character*15`009ctemp
X`009
Xc  Default return status
X
X`009tcp_finger = %loc(fing_complete)
X`009call inet_lower(host)
X
Xc   must terminate with cr/lf
X
X`009if (comm(1:6) .eq. 'FINGER') then
X`009  lll = index(comm,' ')
X`009  if ((lll .ne. 0) .and. (lll+1 .le. len(comm))) then
X`009    tempcom1 = comm(lll+1:)
X`009  else
X`009    tempcom1 = ' '
X`009  endif
X`009else
X`009  tempcom1 = comm
X`009endif
X`009lll = btrim(tempcom1)
X`009if(lll .eq. 1 .and. tempcom1(1:1) .le. ' ') then
X`009  tempcom = char(13)//char(10)
X`009else
X`009  tempcom=tempcom1(1:lll)//char(13)//char(10)
X`009endif
X
Xc`009see if we know this host
X
X`009buffer = ' '
X`009i = get_host(host, buffer)
X`009if (i .ne. 1) then
X`009  tcp_finger = %loc(fing_nonode)
X`009  return
X`009endif
X`009ctemp = buffer
X`009call str$trim(buffer, buffer, blen)
X`009i = index(buffer, '.')
X`009read(buffer(:i-1), '(i)', err=100) i1
X`009buffer(i:i) = 'x'
X`009j = index(buffer, '.')
X`009read(buffer(i+1:j-1), '(i)', err=100) i2
X`009buffer(j:j) = 'x'
X`009i = index(buffer, '.')
X`009read(buffer(j+1:i-1), '(i)', err=100) i3
X`009read(buffer(i+1:blen), '(i)', err=100) i4
X`009call stick(i1, i2, i3, i4, address)
X`009go to 200
X
Xc`009something mondo bogus about the IP address
X
X100`009tcp_finger = %loc(fing_nonode)
X`009return
X
Xc`009wonderful - now try an open
X
X200`009i = open_net(address)
X`009if (i .ne. 1) then
X`009  tcp_finger = %loc(fing_nonet)
X`009  if (i .eq. 660) then
X`009    tcp_finger = %loc(fing_noservice)
X`009  endif
X`009  if (i .eq. 8340) then
X`009    tcp_finger = %loc(fing_unreachable)
X`009  endif
X`009  return
X`009endif
X
Xc`009get network name
X
Xc`009Site-specific: Finger normally adds ".DECnet", ".BITNET", etc. to the
Xc`009header line. For TCP/IP networks this is a bit silly these days, since
Xc`009the domains end in ".EDU", etc. In the "old days" it made sense to add
Xc`009a ".ARPA". If you want to still do this, fiddle the following lines...
X
Xc`009network = get_network('T')
Xc`009if (network .eq. '?') network = 'ARPA'
Xc`009call finger_out_routine('.'//network(:btrim(network))//']'
Xc    1`009//char(13)//char(10))
X
X`009call finger_out_routine(']'//char(13)//char(10))
X`009call finger_out_routine(char(13)//char(10)//char(255))
X
Xc`009write the command to the network
X
X`009call write_net(%ref(tempcom), btrim(tempcom))
Xc`009now read responses until it's done sending
X
X300`009i = read_net(%ref(buffer))
X`009if (i .ne. 0) then
X`009  call finger_out_routine(buffer(1:i))
X`009  call lib$wait(.25)
X`009  go to 300
X`009endif
X`009tcp_finger = %loc(fing_complete)
X`009return
X`009end
X
Xc`009translate string to lower case
X
X        subroutine inet_lower(buf)
X
X        character*(*)`009buf
X`009character*26`009ucase/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
X`009character*26`009lcase/'abcdefghijklmnopqrstuvwxyz'/
X`009call str$translate(buf,buf,lcase,ucase)
X`009return
X`009end
$ GOSUB UNPACK_FILE

$ FILE_IS = "UCXSUBS.MAR"
$ CHECKSUM_IS = 1465076473
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.TITLE`009UCXSUBS Utility subroutines for UCX TCP/IP
X`009.IDENT`009/V1.0-00/
X
X; from get_host.mar
X
X`009.LIBRARY`009/SYS$SHARE:LIB.MLB/
X
XDEV:`009.ASCID`009/BG:/
XCHAN:`009.LONG`0090
XIOSB:`009.QUAD`0090
XCOMMAND:.LONG`009LENGTH
X`009.ADDRESS`009COMM
XCOMM:`009.BYTE`0091
X`009.BYTE`0090
X`009.WORD`0090
XLENGTH=.-COMM
XHOST_D:`009.BLKL`0092
X
XHOST_NAM:.BLKL`0092
X
X`009.ENTRY GET_HOST,`094M<R10>
X
X`009MOVL`0094(AP),R0
X`009MOVL`009(R0),HOST_D
X`009MOVL`0094(R0),HOST_D+4
X`009MOVL`0098(AP),R0
X`009MOVL`009(R0),HOST_NAM
X`009MOVL`0094(R0),HOST_NAM+4
X
X`009$ASSIGN_S`009DEVNAM=DEV, CHAN=CHAN
X
X`009$QIOW_S`009`009CHAN=CHAN,-
X`009`009`009FUNC=#IO$_ACPCONTROL,-
X`009`009`009IOSB=IOSB,-
X`009`009`009P1=COMMAND,P2=#HOST_D,-
X`009`009`009P3=#HOST_NAM,P4=#HOST_NAM
X`009BLBC`009R0,DONE
X`009CMPW`009#1,IOSB
X`009BEQLU`009DONE
X`009MOVZWL`009IOSB,R0
XDONE:
X`009RET
X
X; from netio.mar
X
X`009$IODEF
X`009$INETSYMDEF
XPORTNUM=79
X
X;------------------VARIABLES------------------------;
X;DEV:`009.ASCID`009/BG:/
X;CHAN:`009.BLKW`0091
X;IOSB:`009.BLKQ`0091
XLEN:`009.LONG`0090
X
X;-------------------------------;
X;`009SOCKET STRUCTURE`009;
X;-------------------------------;
XPAR11:`009.WORD`009INET$C_TCP
X`009.BYTE`009INET_PROTYP$C_STREAM
X`009.BYTE`0090
X
XPAR12:`009.LONG`00916
X`009.ADDRESS LOCAL_ADR
X
XLOCAL_ADR:
X`009.WORD`009INET$C_AF_INET
X`009.BYTE`0090,50
X`009.BYTE`009129,24,8,20
X`009.BLKB`0098
X
XPAR13:`009.LONG`00916
X`009.ADDRESS SOCKET
X
XSOCKET:`009.WORD`009INET$C_AF_INET
XPORT:`009.WORD`009PORTNUM`009`009`009;PORT #
XADDRESS:.BYTE`009129,24,8,20`009`009;ADDRESS
X`009.BLKL`0092`009`009`009;UNUSED
X
X`009.ENTRY`009OPEN_NET,`094M<>
X
X`009CMPL`009#0,@4(AP)
X`009BEQLU`009LOCAL
X`009MOVL`009@4(AP),ADDRESS
X
XLOCAL:
X`009$ASSIGN_S`009CHAN=CHAN,DEVNAM=DEV
X
X`009$QIOW_S`009`009CHAN=CHAN,-
X`009`009`009FUNC=#IO$_SETMODE,-
X`009`009`009IOSB=IOSB,-
X`009`009`009P1=PAR11,P3=#PAR12
X
X;-------------------------------;
X;`009REVERSE THE BYTES`009;
X;-------------------------------;
X`009MOVB`009PORT,R0
X`009MOVB`009PORT+1,PORT
X`009MOVB`009R0,PORT+1
X
X;---------------;
X;   CONNECT`009;
X;---------------;
X`009$QIOW_S`009`009CHAN=CHAN,-
X`009`009`009FUNC=#IO$_ACCESS,-
X`009`009`009IOSB=IOSB,-
X`009`009`009P3=#PAR13
X`009BLBC`009R0,ERROR
X`009MOVZWL`009IOSB,R0
X`009BLBC`009R0,ERROR
XERROR:
X`009RET
X
X
X;--------------------------------------------------;
X`009.ENTRY`009WRITE_NET,`094M<>
X`009MOVL`009@8(AP),LEN
X
X`009$QIOW_S`009`009CHAN=CHAN,-
X`009`009`009FUNC=#IO$_WRITEVBLK,-
X`009`009`009IOSB=IOSB,-
X`009`009`009P1=@4(AP),P2=LEN
X
X`009RET
X
X;--------------------------------------------------;
X`009.ENTRY READ_NET,`094M<>
XAGAIN:
X`009$QIOW_S`009`009CHAN=CHAN,-
X`009`009`009FUNC=#IO$_READVBLK,-
X`009`009`009IOSB=IOSB,-
X`009`009`009P1=@4(AP),P2=#1024
X`009CMPW`009#1,IOSB
X`009BNEQU`009DISCONNECT
X
X`009MOVZWL`009IOSB+2,R0
X`009RET
X
XDISCONNECT:
X`009MOVL`009#0,R0
X`009RET
X
X; from openconnect.mar
X
XTEMPORARY:`009.BLKB`0094
X`009.ENTRY`009STICK,`094M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X
X`009MOVB`009@4(AP),TEMPORARY
X`009MOVB`009@8(AP),TEMPORARY+1
X`009MOVB`009@12(AP),TEMPORARY+2
X`009MOVB`009@16(AP),TEMPORARY+3
X
X`009MOVL`009TEMPORARY,@20(AP)
X`009RET
X`009.END
$ GOSUB UNPACK_FILE

$ FILE_IS = "UCXTEST.COM"
$ CHECKSUM_IS = 980261851
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$!..BuildLib.Com`009`009`009Build Finger Libraries
X$!..`009`009`009`009`009R. Garland / CUCHEM / Feb-1985
X$!.. VMS V5.1 version
X$ Set`009NoOn
X$ Type`009Sys$Input
X
X`009This procedure builds the required libraries for Finger.
X
X$ Inquire Ans "Do you wish to compile everything? (YES) "
X$ All = 0
X$ If Ans .eqs. "" then All = 1
X$ If Ans then All = 1
X$ If All then goto B_1
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile FINGER.FOR? (YES) "
X$ C_1 = 0
X$ If Ans .eqs. "" then C_1 = 1
X$ If Ans then C_1 = 1
X$ If .not. C_1 then Goto B_1_1
X$ B_1:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
V$! ignore compiler warnings... harmless (which - the compiler or the warnings
X?)
X$ Fortran/NoCheck/NoDebug`009FINGER.FOR
X$ Fortran/NoCheck/NoDebug/NoOptimize FINGERSHO.FOR
X$ B_1_1:`009!'F$Verify(0)
X$ If All then goto B_2
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile FINGERSHR.FOR? (YES) "
X$ C_2 = 0
X$ If Ans .eqs. "" then C_2 = 1
X$ If Ans then C_2 = 1
X$ If .not. C_2 then Goto B_2_2
X$ B_2:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Fortran/NoCheck/NoDebug`009FINGERSHR.FOR
X$ B_2_2:`009!'F$Verify(0)
X$ If All then goto B_2A
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile FINGMAINT.FOR? (YES) "
X$ C_2A = 0
X$ If Ans .eqs. "" then C_2A = 1
X$ If Ans then C_2A = 1
X$ If .not. C_2A then Goto B_2_2A
X$ B_2A:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Fortran/NoCheck/NoDebug`009FINGMAINT.FOR
X$ B_2_2A:`009!'F$Verify(0)
X$ If All then goto B_3
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile FINGMAIN.FOR? (YES) "
X$ C_3 = 0
X$ If Ans .eqs. "" then C_3 = 1
X$ If Ans then C_3 = 1
X$ If .not. C_3 then Goto B_3_3
X$ B_3:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Fortran/NoCheck/NoDebug`009FINGMAIN.FOR
X$ B_3_3:`009!'F$Verify(0)
X$ If All then goto B_4
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
-+-+-+-+-+ End of part 24 +-+-+-+-+-