+-+-+-+ Beginning of part 15 +-+-+-+
Xc  than actually responding to a particular condition.  The routine
Xc  convert all signals into messages for transmission to the invoker.
Xc  This routine uses ReturnMail to transmit the message back to the
Xc  jnet invoker.  The routine exits with a CONTINUE flag.  If
Xc  there are errors that should actually be handled (arithmetic or
Xc  whatever) by some system handler,  they will not be.
X
X`009Integer`009`009SS$_Status, `009`009SS$_Normal/1/
X`009Integer`009`009SignalVector(8),`009MechanismVector(5)
X`009Integer`009`009Message_Limit/10/,`009Message_Count/0/
X`009Integer`009`009Depth
X`009Integer`009`009MsgLen,`009`009MsgLen2
X`009Character`009Msg*255,`009Msg2*132
X`009Character`009LF/10/,`009`009CR/13/
X`009Character`009FLUSH/255/
X`009External`009Fing_Abort
X
X`009jnet_Signal_Handler = SS$_Normal
X`009SS$_Status = SignalVector(2)
X`009If ( SS$_Status .eq. SS$_Normal ) Return
X`009Call Sys$Getmsg(%Val(SS$_Status),MsgLen,Msg,%VAL(1),)
X`009Call Sys$Fao(Msg(:MsgLen),MsgLen2,Msg2,
X`0091`009%Val(SignalVector(4)),
X`0092`009%Val(SignalVector(5)),
X`0093`009%Val(SignalVector(6)),
X`0094`009%Val(SignalVector(7)))
X`009Call jnet_Out_Routine(LF//'%FINGER-E-OOPS, '
X`0091`009//Msg2(:MsgLen2)//CR//FLUSH)
Xc  unwind to the calling routine (Finger_jnet)
X`009Depth = MechanismVector(3)
X`009MechanismVector(4) = %Loc(Fing_Abort)`009! Set return code
X`009Call Sys$Unwind(Depth,%Val(0))
X
X`009Return
X
X1001`009Format(A)
X`009End
X`012
Xc-------------------------------------------------------------------------
X`009Subroutine jnet_Out_Routine(Text)
X
Xc`009This routine sends a message back over jnet
Xc`009It must buffer input and form records out of stream type
Xc`009data, stripping CR, LF etc. in the process.
X
X`009Character`009Text*(*)
X`009Integer`009`009TextLen
X`009Character`009LF/10/,`009CR/13/, Flush/255/
X
X`009Character`009Buffer*132
X`009Integer`009`009BufferPointer, MaxPointer
X
X`009Integer`009`009FirstTime
X`009Common`009`009/zip/ FirstTime
X
X`009Common`009/jnet_Buffer/ BufferPointer, MaxPointer,
X`0091`009`009Buffer
X
X`009TextLen = Len(Text)
X
Xd`009call returnmail(text(:textlen))
Xd`009return
X
X`009If (TextLen .eq. 0) Return
X
X`009Do ii = 1, TextLen
X`009    If (Text(ii:ii) .ne. CR) then
X`009`009If (Text(ii:ii) .ne. LF) then
X`009`009    If (Text(ii:ii) .ne. flush) then
X`009`009`009BufferPointer = BufferPointer + 1
X`009`009`009Buffer(BufferPointer:BufferPointer) = Text(ii:ii)
X`009`009    Endif
X`009`009Endif
X`009    Endif
X`009    If (Text(ii:ii) .eq. LF) then
X`009`009If (BufferPointer .ne. 0) then
X`009`009    Call ReturnMail(Buffer(:BufferPointer))
X`009`009    BufferPointer = 0
X`009`009Else
X`009`009    If (FirstTime .ne. 1) then
X`009`009`009Call ReturnMail(' ')
X`009`009    Else
X`009`009`009FirstTime = 0
X`009`009    Endif
X`009`009Endif
X`009    Endif
X`009    If (Text(ii:ii) .eq. flush) then
X`009`009If (BufferPointer .ne. 0) then
X`009`009    Call ReturnMail(Buffer(:BufferPointer))
X`009`009    BufferPointer = 0
X`009`009Endif
X`009    Endif
X`009    If (BufferPointer .gt. MaxPointer-1) then
X`009`009Call ReturnMail(Buffer(:BufferPointer))
X`009`009BufferPointer = 0
X`009    Endif
X`009End do
X`009Return
X`009End
$ GOSUB UNPACK_FILE

$ FILE_IS = "FINGERDEF.INC"
$ CHECKSUM_IS = 1043869064
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
Xc  This file is particularly for system dependent definitions
Xc  likely to change with VMS versions
X    `032
Xc  from UAFDEF VMS 5.1
X      Parameter UAF$T_Username = 4      ! offset to Username
X      Parameter UAF$S_Username = 32     ! length of Username
Xc  the next 3 fields are counted strings, so offset and length are adjusted
Xc  by 1
X      Parameter UAF$T_Owner = 85        ! offset to Owner
X      Parameter UAF$S_Owner = 31        ! length of Owner
XC
XC   mods by Mike Cochran <Mike@Mecan1> to fix last user in UAF problem
XC
X      Parameter UAF$K_DefDev = 117      ! offset to count
X      Parameter UAF$T_DefDev = 118      ! offset to Default Device
X      Parameter UAF$S_DefDev = 31       ! length of Default Device
X      Parameter UAF$K_DefDir = 149      ! offset to count
X      Parameter UAF$T_DefDir = 150      ! offset to Default Directory
X      Parameter UAF$S_DefDir = 63       ! length of Default Directory
Xc                                       ! mail messages not in UAF
X      Parameter UAF$Q_LASTLOGIN_I = 397 ! offset to Last login time
X      Parameter UAF$S_LASTLOGIN_I = 8   ! length of Last login time
XC
X    `032
X      Parameter UAF$K_Length = 1412     ! record length (Maximum)
X
Xc  Offset (initial subscript) of UIC
X`009Parameter UAF$K_UIC = 37`009! Offset (counting from 1) to uic
Xc`009`009`009`009`009! (member, group)
X    `032
X      Parameter UAF$L_Flags = 469       ! offset to flags longword
XC
XC Bits (and masks) for FLAGS longword
XC
X`009INTEGER*4 UAF$V_DISCTLY`009`009!no user control-y
X`009INTEGER*4 UAF$V_DEFCLI`009`009!only allow user default cli
X`009INTEGER*4 UAF$V_LOCKPWD`009`009!disable set password command
X`009INTEGER*4 UAF$V_CAPTIVE`009`009!captive account (no overrides)
X`009INTEGER*4 UAF$V_DISACNT`009`009!no interactive login
X`009INTEGER*4 UAF$V_DISWELCOM`009!skip welcome message
X`009INTEGER*4 UAF$V_DISMAIL`009`009!skip new mail message
X`009INTEGER*4 UAF$V_NOMAIL`009`009!disable mail delivery
X`009INTEGER*4 UAF$V_GENPWD`009`009!passwords must be generated
X`009INTEGER*4 UAF$V_PWD_EXPIRED`009!password has expired
X`009INTEGER*4 UAF$V_PWD2_EXPIRED`009!2nd password has expired
X`009INTEGER*4 UAF$V_AUDIT`009`009!audit all actions
X`009INTEGER*4 UAF$V_DISREPORT`009!skip last login messages
X`009INTEGER*4 UAF$V_DISRECONNECT`009!inhibit reconnections
X`009INTEGER*4 UAF$V_AUTOLOGIN`009!auto-login only
X`009INTEGER*4 UAF$V_DISFORCE_PWD_CHANGE`009!Disable forced password change
X`009PARAMETER (UAF$V_DISCTLY=0)
X`009PARAMETER (UAF$V_DEFCLI=1)
X`009PARAMETER (UAF$V_LOCKPWD=2)
X`009PARAMETER (UAF$V_CAPTIVE=3)
X`009PARAMETER (UAF$V_DISACNT=4)
X`009PARAMETER (UAF$V_DISWELCOM=5)
X`009PARAMETER (UAF$V_DISMAIL=6)
X`009PARAMETER (UAF$V_NOMAIL=7)
X`009PARAMETER (UAF$V_GENPWD=8)
X`009PARAMETER (UAF$V_PWD_EXPIRED=9)
X`009PARAMETER (UAF$V_PWD2_EXPIRED=10)
X`009PARAMETER (UAF$V_AUDIT=11)
X`009PARAMETER (UAF$V_DISREPORT=12)
X`009PARAMETER (UAF$V_DISRECONNECT=13)
X`009PARAMETER (UAF$V_AUTOLOGIN=14)
X`009PARAMETER (UAF$V_DISFORCE_PWD_CHANGE=15)
X
XC privilege definitions (converted to masks)
X    `032
X      Parameter PRV$M_Cmkrnl = '00000001'X
X      Parameter PRV$M_World = '00010000'X
X      Parameter PRV$M_Oper = '00040000'X
X      Parameter PRV$M_Sysprv = '10000000'X
X    `032
Xc FAB offsets for user open
X      Parameter FAB$B_ACMODES = 74
Xc      Parameter FAB$V_LNM_MODE = 0
X    `032
Xc CLI return codes
X      Parameter CLI$_Defaulted = '0003FD21'X
$ GOSUB UNPACK_FILE

$ FILE_IS = "FINGERFLG.FOR"
$ CHECKSUM_IS = 878002896
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009Parameter`009FlagTestOff = 1
X`009Parameter`009FlagInteractive = 2
X`009Parameter`009FlagBatch = 2**2
X`009Parameter`009FlagSubprocess = 2**3
X`009Parameter`009FlagNetwork = 2**4
X`009Parameter`009FlagSystem = 2**5
X`009Parameter`009FlagDisSubj = 2**6
X`009Parameter`009FlagIAM  = 2**7
X`009Parameter`009FlagAll`009 = 2**8
X`009Parameter`009FlagSort = 2**9
X`009Parameter`009FlagArea = 2**10
X! spare here
X`009Parameter`009FlagHelp = 2**12
X`009Parameter`009FlagVersion = 2**13
Xc  Qualifiers for individuals
X`009Parameter`009FlagPlan = 2**14
X`009Parameter`009FlagMail = 2**15
Xc  Display qualifiers
X`009Parameter`009FlagSwapped = 2**16
X`009Parameter`009FlagPid`009 = 2**17
X`009Parameter`009FlagProcessname = 2**18
X`009Parameter`009FlagUsername = 2**19
X`009Parameter`009FlagPersonalName = 2**20
X`009Parameter`009FlagImageName = 2**21
X`009Parameter`009FlagTerminal = 2**22
X`009Parameter`009FlagLoginTime = 2**23
X`009Parameter`009FlagCpuTime = 2**24
X`009Parameter`009FlagIdleTime = 2**25
X`009Parameter`009FlagLocation = 2**26
X`009Parameter`009FlagTTType = 2**27
X`009Parameter`009FlagMessage = 2**28
X`009Parameter`009FlagState = 2**29
X`009Parameter`009FlagSize = 2**30
X! spares here
X
Xc  Show everything
X`009Parameter`009FlagFull = 'FFFF0000'X
$ GOSUB UNPACK_FILE

$ FILE_IS = "FINGERLAT.FOR"
$ CHECKSUM_IS = 2103012922
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
Xc FINGERLAT.FOR - Speaks to TSM to return information about current
Xc terminal server users. Of course, if DEC documented the interface
Xc to the terminal server maintenance stuff, this wouldn't be neces-
Xc sary.
X
Xc This is terrible - either it or I should be shot, what can I say?
Xc It fills a need we have here at SPC, and it *does* work, even if
Xc it is truly wretched.
X
Xc NOTE: You may have to increase the DECNET account's Bytlm quota
Xc`009for this command to work across the net. 4096 was too small,
Xc`00920480 works just fine (but is certainly too large).
X
Xc------------------------------------------------------------------
X`009Integer Function LAT_Finger (Node, Finger_Out_Routine)
X
X`009Include`009`009'GETJPIDEF.FOR'
X`009Include`009`009'Fingerdef.Inc'
X
X`009Character`009Node*32, Network*20, TSMCommand*128
X`009Character`009TextLine*255
X
X`009Character`009Get_Network*20
X`009Integer`009`009i, ii, jj, Privilege(2) /0,0/
X`009Integer*2`009Mbx_Chan
X
X`009Character`009CR/13/, LF/10/, FLUSH/255/
X`009Integer`009`009Btrim
X
X`009External`009Finger_Out_Routine
X`009External`009Fing_Complete, Fing_Abort
X
Xc  Turn on SYSPRV and OPER so we can use TSM
X`009Privilege(1) = Prv$M_Sysprv .or. Prv$M_Oper
X`009Call Sys$Setprv(%val(1),privilege,,)
X
Xc  Create a mailbox to communicate...
X`009ii = Sys$Crembx(,Mbx_Chan,,,,,'MBOX')
X`009
Xc  Find out where we are so we can include the directory spec in the command
X`009I = 1
X`009II = 1
X`009ITEM_LIST2(II+IC) =`009JPI$_IMAGNAME
X`009ITEM_LIST2(II+BL) =`009L_IMAGNAME
X`009ITEM_LIST(I+BA) =`009%LOC(IMAGNAME)
X`009ITEM_LIST(I+RL) =`009%LOC(RL_IMAGNAME)
X`009ITEM_LIST(I+3) = 0`009! End of list
X
X`009jj = Sys$GetJPIW(,,,Item_List,,,)
X`009Do i = Rl_imagname,0,-1
X`009    If (imagname(i:i) .eq. ']') Goto 40
X`009    If (imagname(i:i) .eq. '>') Goto 40
X`009    If (imagname(i:i) .eq. ':') Goto 40
X`009Enddo
X
Xc  Now go play with TSM
X 40`009TSMCommand = '@'//imagname(:i)//'FINGERLAT '//Node(:Btrim(Node))
X`009Open (Unit=1, File='MBOX', Status='OLD')
X`009ii = Lib$Spawn(TSMCommand,,'MBOX',%ref(3),,,jj,,,,,)
X`009If (.not. ii) Then
X`009    Call Sys$Setprv(,privilege,,)
X`009    Call Finger_Out_Routine(': link failed]'//CR//LF//FLUSH)
X`009    Call Lib$Signal(%val(ii))
X`009    LAT_Finger = %loc(Fing_Abort)
X`009    Return
X`009EndIf
X
Xc  Do something useful while the image activator takes TSM out of suspended
Xc  animation...
X`009Network = Get_Network('X')
X`009Call Finger_Out_Routine('.'//Network(:Btrim(Network))//']'//
X`0091  CR//FLUSH)
X`009
X 45`009Read (1,100,End=50) TextLine
X`009Call Finger_Out_Routine(LF//TextLine(:Btrim(TextLine))//CR)
X`009Goto 45
X
X 50`009Close (unit=1)
X `032
Xc  Turn off SYSPRV and OPER
X`009Call Sys$Setprv(,privilege,,)
X
Xc  Display results
X`009LAT_Finger = %loc(Fing_Complete)
X`009Return
X
X 100`009Format (A)
X`009End
$ GOSUB UNPACK_FILE

$ FILE_IS = "FINGERMSG.MSG"
$ CHECKSUM_IS = 705837211
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.FACILITY`009FINGER,117/PREFIX=FING_
X
X`009.SEVERITY`009SUCCESS
X
XCOMPLETE`009<Finger command complete>
X
X`009.SEVERITY`009WARNING
X
XNOWILD`009`009<no wild card match.  Command complete>
X
X`009.SEVERITY`009ERROR
X
XABORT`009`009<finger aborted.  Command complete>
XNONET`009`009<network unavailable>
XNONODE`009`009<no such node defined>
XMULTJ`009`009<multiple jnet links not allowed. Command complete>
XjNA`009`009<jnet not available>
XNOSERVICE`009<remote node does not support FINGER commands>
XUNREACHABLE`009<remote node is not currently reachable>
X
X`009.END
$ GOSUB UNPACK_FILE

$ FILE_IS = "FINGERSHO.FOR"
$ CHECKSUM_IS = 1495427889
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
Xc FINGERSHO.FOR - This is here due to an optimization bug in VAX Fortran V5.1
X
Xc------------------------------------------------------------------
X`009Subroutine Show_Info (HeaderWritten, Finger_Out_Routine,
X`0091                     TestOutput)
X
Xc  This routine sorts the user info array, and outputs it.
X
X`009Include`009`009'GETJPIDEF'
X`009Include`009`009'FingerFlg'
X`009Include`009`009'Fingerdef.inc'
X
X`009External`009Finger_Out_Routine
X
X`009Integer`009`009PID_array, STS_array, State_array,
X`0091`009`009PgCnt_array, FP_array
X
X`009Character`009Prcnam_array*15, Username_array*12,
X`0091`009`009Terminal_array*8
X
X`009Dimension`009PID_array(200), STS_array(200),
X`0091`009`009State_array(200), PgCnt_array(200),
X`0092`009`009Prcnam_array(200), Username_array(200),
X`0093`009`009Terminal_array(200), FP_array(200)
X
X`009Common`009/Info/`009PID_array, STS_array, State_array,
X`0091`009`009PgCnt_array, Prcnam_array, Username_array,
X`0092`009`009Terminal_array, Last_Number, FP_array
X
X`009Character*20`009Get_Image, Image_Name
X`009Character*11`009Login_Time
X`009Character*10`009CPU_Time
X`009Character*20`009Get_LastName, LastName, LN_array, SortType
X`009Character*32`009WhoAmI
X`009Logical`009`009HeaderWritten, Swapped
X`009Integer`009`009TestOutput,`009FlagProcess
X`009Integer`009`009Index, Index_array, Temp, SortField, l_WhoAmI
X`009Dimension`009Index_array(200), LN_array(200)
X`009Common /Sorter/`009SortType, SortField, WhoAmI, l_WhoAmI
X
Xc  Sorting is done by a bubble sort (yeah, I know .... yech! ... but it
Xc  was easy!).  To have reasonable performance, an array of indecies
Xc  is initialized in sequence, and then the indecies are swapped around
Xc  as the sort proceeds.  Then, that array is used to select the user
Xc  info in the sorted order.
X
Xc  Initialize the index array, and get the sort information too.
Xc  [rph] this whole if-then-else used to be INSIDE the DoWhile. I
Xc  hoisted it to prevent situations in which if you were sorting on
Xc  field 5 you'd end up with 5*Last_number extra compares.
X
X`009Index = 1
X`009If (SortField .eq. 0) then
X`009  DoWhile(Index .le. Last_Number)
X`009    Index_array(Index) = Index
X`009    LN_array(Index) = ' '`009`009`009!20 spaces
X`009    LN_array(Index) = Get_LastName(Username_array(Index))
X`009    Index = Index + 1
X`009  EndDo
X`009Else If (SortField .eq. 1) then
X`009  DoWhile(Index .le. Last_Number)
X`009    Index_array(Index) = Index
X`009    LN_array(Index) = ' '`009`009`009!20 spaces
X`009    LN_array(Index) = Username_array(Index)
X`009    Index = Index + 1
X`009  EndDo
X`009Else If (SortField .eq. 2) then
X`009  DoWhile(Index .le. Last_Number)
X`009    Index_array(Index) = Index
X`009    LN_array(Index) = ' '`009`009`009!20 spaces
X`009    LN_array(Index) = Prcnam_array(Index)
X`009    Index = Index + 1
X`009  EndDo
X`009Else If (SortField .eq. 3) then
X`009  DoWhile(Index .le. Last_Number)
X`009    Index_array(Index) = Index
X`009    LN_array(Index) = ' '`009`009`009!20 spaces
X`009    Write(LN_array(Index), 1001) PID_array(Index)
X`009    Index = Index + 1
X`009  EndDo
X`009Else If (SortField .eq. 4) then
X`009  DoWhile(Index .le. Last_Number)
X`009    Index_array(Index) = Index
X`009    LN_array(Index) = ' '`009`009`009!20 spaces
X`009    LN_array(Index) = Terminal_array(Index)
X`009    Index = Index + 1
X`009  EndDo
X`009Else If (SortField .ge. 5) then
X`009  DoWhile(Index .le. Last_Number)
X`009    Index_array(Index) = Index
X`009    LN_array(Index) = ' '`009`009`009!20 spaces
X`009    Image_Name = Get_Image(PID_array(Index),LOGINTIM,CPUTIM)
X`009    If (SortField .eq. 5) Then
X`009      Call Sys$AscTim(,Login_Time,LOGINTIM,%val(1))
-+-+-+-+-+ End of part 15 +-+-+-+-+-