Figure Two - WINDOW_CLIENT.COM

$!
$! WINDOW_CLIENT.COM
$!
$! Author: 
$!
$!               John McMahon                        Phone:   (408) 427-4366
$!               TGV, Incorporated          FAX:     (408) 427-4365
$!               603 Mission Street              E-Mail:      MCMAHON@TGV.COM
$!               Santa Cruz, California 95060
$!
$! This program is based on code developed by John McMahon while under contract
$! to the Advanced Data Flow Technology Office - NASA Goddard Space Flight
$! Center in Greenbelt, Maryland during October 1989.
$! 
$! Usage:
$!
$!               $ WINDOW :== @WINDOW_DIRECTORY:WINDOW_CLIENT
$!               $ WINDOW nodename
$!
$!               "nodename" refers to the remote node that the user is
$!               requesting a DECterm from.  if the user does not specify
$!               a nodename, they will be prompted for it.
$! 
$! Function:
$!
$!               This program takes a remote DECnet nodename as input.  A
$!               connection is opened to the DECterm server program (DECnet
$!               object "DECterm").  A VMS status code is read back from
$!               the remote server and interpreted.
$!
$! Implicit Inputs:
$!
$!               None.
$!
$! Implicit Outputs:
$!
$!               When the DECterm server program on the remote node is triggered
$!               a DECterm window is created on this node.
$!
$! Side Effects:
$!
$!               None.
$!
$!-----------------------------------------------------------------------------
$ SET NoON
$!
$! Default_Node is the nodename used if the user hits return at the 
$! nodename prompt.
$!
$ Default_Node == "REMOTE::"
$!
$! Check to see if the user entered a nodename on the command line.
$! if not, prompt for a nodename.
$!
$ If P1 .Eqs. "" Then Inquire/Nopunc P1 "Remote Node [''Default_Node'] ? "
$!
$! If the user hit return at the prompt, assume the default node.
$!
$ If P1 .Eqs. "" Then P1 = Default_Node
$!
$! Strip off the double colons in the nodename if they have been specified.
$!
$ P1 = P1 - "::"
$!
$! Try to open the remote server using the "DECTERM" object name.
$! If successful, jump to the good connection routine.
$! If not, jump to the "try numeric object" routine.
$!
$! The filename we use to open the remote DECnet object takes the form of:
$!
$!      DECNETNODENAME""::"OBJECT="
$!
$! The first set of double quotes tells DECnet to NOT send any proxy
$! information to the remote node.  Since the remote object runs under a 
$! special privileged account, proxy would not work properly in most
$! cases.
$!
$! We try two object names.  First "DECTERM", and then "225".  If the DECTERM
$! object is defined in the local NCP database, then the DECTERM name will work
$! fine.  If not, DECnet returns a NOSUCHOBJ error...  We then fall back
$! on the object number, which is not checked against the local NCP database.  
$!
$ Open/Read/Write/Error=Try_Number Network_File 'p1'""::"DECTERM="
$ Goto Good_Connection

$ Try_Number:
$!
$! If the connection to "DECTERM" fails, we try accessing the object by it's
$! number "225".  If we succeed, we jump to the good connection routine.
$! If we fail, we assume that the remote node is unreachable and give up.  
$!
$ Open/Read/Write/Error=Unable Network_File 'p1'""::"225="
$ Goto Good_Connection

$ Unable:
$!
$! This routine is called after both attempts at network connections have
$! failed
$!
$ Write Sys$Output "Unable to establish connection to node ''p1'."
$ Exit

$ Good_Connection:
$ Write Sys$Output "Connection opened to node ''p1'."
$!
$! When a connection is successfully established this routine is called.
$! First we read the remote VMS status from the server, and then close off the
$! network connection.
$!
$ Read Network_File Remote_Status
$ If (.not. $Status)
$ Then
$       Remote_Status = $Status
$       Write Sys$Output "Error reading data from server..."
$ Endif
$ Close Network_File
$ Write Sys$Output " "
$!
$! Interpret the status from the server
$!
$ If (.not. Remote_Status)
$ Then
$      Write Sys$Output "Status from remote server was: ",remote_status
$      Write Sys$Output "(",F$Message(remote_status),")"
$      Write Sys$Output "Command did not complete properly."
$ Else
$      Write Sys$Output "Remote server acknowledged startup of window."
$ Endif
$ exit

==

[Figure 3]

$!
$! WINDOW_SERVER.COM
$!
$! Author: 
$!
$!               John McMahon                        Phone:   (408) 427-4366
$!               TGV, Incorporated          FAX:     (408) 427-4365
$!               603 Mission Street              E-Mail:      MCMAHON@TGV.COM
$!               Santa Cruz, California 95060
$!
$! This program is based on code developed by John McMahon while under contract
$! to the Advanced Data Flow Technology Office - NASA Goddard Space Flight
$! Center in Greenbelt, Maryland during October 1989.
$! 
$! Usage:
$!
$!               Executed by DECnet.  This program is started when a client
$!               asks for a DECnet connection to object "DECTERM" or "225".
$!
$! Function:
$!
$!               This program opens SYS$NET to complete a DECnet task-to-task
$!               connection.  SYS$NET is then parsed to find out who connected 
$!               to this program.  It then determines if a terminal controller
$!               process is needed.  Once the terminal controller is ready
$!               the WINDOW_CREATE program is called to tell the terminal 
$!               controller to create a new DECterm window.  Finally, a 
$!               VMS status is written back to SYS$NET and the connection
$!               is closed.
$!
$! Output:
$!
$! Implicit Inputs:
$!
$!               SYS$NET is used as the source of client nodename.
$!
$! Implicit Outputs:
$!
$!               The server creates a DECterm window on the client node.
$!               The NETSERVER.LOG file contains output from the command
$!               procedure.
$!                $!                $! Side Effects:
$!
$!               None.
$!
$!-----------------------------------------------------------------------------
$! Turn Verify Off
$ Set Noverify
$! Set the output rate for the log file to a reasonable value
$ SET OUTPUT_RATE=00:00:05.00
$! Establish An Error Handler
$ On Error Then Goto Error_Exit
$! Complete The Network Connection By Opening SYS$NET
$! This sends a signal back to the client indicating that the channel is open
$! If we didn't do this, the client would time out.
$ Open/Read/Write Network_Channel SYS$NET
$!
$! All log files are written to the SYS$LOGIN directory for the special 
$! network object account (X11_TERMINAL).  We purge files older than a day.
$!
$ Purge/Log/Before=Yesterday SYS$LOGIN:*.*
$!
$! Write (to NETSERVER.LOG) the current version of this file, and last revision
$! date.
$!
$ Procedure_Filename = F$Environment("Procedure")
$ Write Sys$Output Procedure_Filename,-
                   " Was Last Revised On ",-
                   F$File_Attribute(Procedure_Filename,"RDT")
$!
$! Write (to NETSERVER.LOG) what node we are running on and process information.
$! This is helpful if you are running in a VAXcluster and use a common account
$! for the DECterm object.
$!
$ This_Node = F$GETSYI("NODENAME")          
$ Write Sys$Output "This is node ",This_Node
$!
$! Determine where the connection came from.
$!
$! First... write the value of SYS$NET to NETSERVER.LOG for debugging
$! information
$ Write Sys$Output "SYS$NET is currently defined as:"
$ SHOW LOGICAL SYS$NET
$!
$! Parsing the Network Control Block (SYS$NET) to get the client information.
$!
$! NOTE: DECnet experts may question why we use this technique instead of
$! using the logical names SYS$REM_NODE and SYS$REM_ID.  Experiments with
$! these logical names indicate that they are only updated when a new
$! server process is created.  Since DECnet will reuse processes when they
$! are available, this makes the logical names unreliable as a source of 
$! information.
$! 
$! The Network Control Block (SYS$NET) has the following partial format:
$!
$! Field:        Length:                             Comment:
$! Nodename      Maximum 6 (Assumed Minimum 1)   Character string
$! ::"0=         Constant 5                          Constant
$! Username      Maximum 12 (Assumed Minimum 1)      Character String
$!                                                   (May be padded with spaces)
$! /             Constant 1                          Character String
$! (The rest of the fields are not needed)
$!                        
$! Load the symbol NCB_STRING with the contents of the NCB
$ NCB_STRING = F$Trnlnm("Sys$Net")
$! Locate the first colon in the string.  This points to the END of
$! the nodename field in the NCB
$ Colon_Location = F$Locate(":",NCB_STRING)
$! Extract the nodename from the network control block.
$ Client_NODE = F$Extract(0,Colon_Location,NCB_STRING)
$! Chop off the nodename and constant strings off the NCB.  This leaves
$! the username, the slash and the unused trailer fields.  This simplifies
$! the parsing of the username.
$ NCB_STRING = F$Extract(-
                 Colon_Location+5,-
                 F$Length(NCB_STRING),-
                 NCB_STRING)
$! Locate the first slash in the string.  This points to the END of
$! the username field in the truncated NCB
$ Slash_Location = F$Locate("/",NCB_STRING)
$! Extract the username from the truncated network control block.
$ Client_User = F$Extract(0,Slash_Location,NCB_STRING)
$! Write to NETSERVER.LOG who sent the request
$ Write Sys$Output "Request from ",Client_User," at ",Client_Node
$!
$! We now know who requested the window.
$!
$! Now we test for the existance of a terminal emulator for CLIENT_NODE.
$!
$! Note: Most of the DECterm creation code is based on sample routines 
$! provided by Digital in Section 4.8 of the VMS 5.2 Release Notes.
$! Abbreviated samples can be found in the VMS 5.3 supplement to the
$! DECwindows programming documentation.
$!
$! First check to see if there is a logical name pointing to a controller
$! mailbox.  The logical name format is:
$!
$!      DECW$DECTERM_MAILBOX_nodename::server.display
$!
$! In this program server and display are assumed to be zero (the default),
$! and nodename is equated to CLIENT_NODE
$!
$ Write Sys$Output "Testing for controller existance."
$ TERMINAL_EMULATOR_MAILBOX = -
    F$Trnlnm("decw$decterm_mailbox_''client_node'::0.0")
$!
$! If the logical name exists, verify that the mailbox specified exists.
$! If it does, we assume the controller is healthy and we do not start a new
$! one.
$!
$ if TERMINAL_EMULATOR_MAILBOX .nes. ""
$ then
$       if f$getdvi(terminal_emulator_mailbox,"exists") then -
          goto controller_exists
$ endif
$!
$!
$!
$!
$ Write Sys$Output "Starting a new controller."
$!
$! Create a unique file name for the controller command procedure
$! We use the process ID and the current time as the unique elements.
$! The subtraction of the spaces, colons, dashes, etc is to make the time
$! a valid subpart of a VMS file name.
$!
$! the local node and client node are included to ease debugging...
$!
$ Controller_Command_Procedure_Name = -
        "Sys$Login:COM_L_" + THIS_NODE + "_R_" + CLIENT_NODE +- 
        "_" + F$Getjpi(0,"pid") + "_" +-
        (F$Cvtime(,,"TIME") - ":" - ":" - ".") + ".TMP"
$! 
$! Translate any logical names in the command procedure name
$! The RUN LOGINOUT call (later on in the procedure) usually fails if you
$! use logical names.
$!
$ Controller_Command_Procedure_Name = -
        F$Parse(Controller_Command_Procedure_Name,,,,"NO_CONCEAL")
$!
$! Do the same type of thing for the SYS$ERROR file for the controller
$!
$ CONTROLLER_ERROR_NAME = -
        "Sys$Login:ERR_L_" + THIS_NODE + "_R_" + CLIENT_NODE +- 
        "_" + F$Getjpi(0,"pid") + "_" +-
        (F$Cvtime(,,"TIME") - ":" - ":" - ".") + ".TMP"
$ Controller_Error_Name = -
        F$Parse(Controller_Error_Name,,,,"NO_CONCEAL")
$!
$! And finally the SYS$OUTPUT file for the controller
$!
$ CONTROLLER_OUTPUT_NAME = -
        "Sys$Login:OUT_L_" + THIS_NODE + "_R_" + CLIENT_NODE +- 
        "_" + F$Getjpi(0,"pid") + "_" +-
        (F$Cvtime(,,"TIME") - ":" - ":" - ".") + ".TMP"
$ Controller_Output_Name = -
        F$Parse(Controller_Output_Name,,,,"NO_CONCEAL")
$!
$ Write Sys$Output "Input file for Server LOGINOUT is ",-
   Controller_Command_Procedure_Name
$ Write Sys$Output "Error file for Server LOGINOUT is ",-
   CONTROLLER_ERROR_NAME
$ Write Sys$Output "Output file for Server LOGINOUT is ",-
   CONTROLLER_OUTPUT_NAME
$!
$! We now build a command procedure to start up the controller.
$! this will be fed to LOGINOUT to create a detached process running
$! the DECW$TERMINAL image with SET DISPLAY pointing to CLIENT_NODE.
$!
$ open/write COMMAND_PROC_FILE 'controller_command_procedure_name'
$!
$! The detached process command procedure consists of a SET DISPLAY command,
$! and a RUN DECW$TERMINAL command encased in a loop.  If DECW$TERMINAL should
$! crash, the program will attempt to restart it 10 times before giving up.
$! Any change of status (Creation/Termination) of the process is reported to
$! the NETWORK operator via the REQUEST command.
$!
$ Write command_proc_file "$ SET NOON"
$ Write command_proc_file "$ SHOW PROC/PRIV"
$ Write command_proc_file "$ SET OUTPUT_RATE=00:00:05.00"
$ Write Command_proc_file "$ Restart_Count = 0"
$ write command_proc_file -
    "$ Restart: request/to=network ""decw$terminal executable startup."""
$ write command_proc_file "$ show symbol restart_count"
$!
$! The SET MESSAGE command includes the error messages that may occur when
$! DECW$TERMINAL has problems.  For some reason DEC has not included these
$! messages in the standard DEC messages library.
$!
$ Write command_proc_file "$ SET MESSAGE SYS$MESSAGE:decw$xlibmsg.exe"
$ write command_proc_file "$ set display/create/node=" + client_node + "::0.0"
$ write command_proc_file "$ run sys$system:decw$terminal"
$ write command_proc_file -
    "$ request/to=network ""decw$terminal executable termination."""
$ Write Command_proc_file "$ Restart_Count = Restart_Count + 1"
$ Write command_proc_file "$ If Restart_Count .Lt. 11 Then Goto Restart"
$ write command_proc_file -
    "$ request/to=network ""giving up on trying to restart decw$terminal!"""
$ close command_proc_file
$!
$! Enable SYSPRV (in case it was turned off by DECnet or a SYLOGIN proccedure)
$! SYSPRV is needed by the controller to access a psuedoterminal after it
$! is logged into.  If SYSPRV was not available, the terminal controller will
$! crash if the user uses a pull-down menu on the DECterm.
$!
$ Set proc/priv=sysprv
$!
$! Start the controller.
$! - Error and Output files are in SYS$LOGIN for the X11_TERMINAL account
$! - The controller process name is "DECterm_" with the client nodename
$!   appended.
$! - The high AST count is specified to insure the terminal controller
$!   has enough ASTs to support 10+ windows on this controller.
$!   If the controller goes into a RWAST (Resource Wait-AST), raise the
$!   /AST value here... and bump it up in the X11_TERMINAL SYSUAF entry.
$!
$ run /detach/input='controller_command_procedure_name'-
      /output='controller_output_name'-
      /error='controller_error_name'-
      /process="DECterm_''client_node'"-
      /AST=100-
      sys$system:loginout.exe
$ Set proc/priv=nosysprv
$!
$! Wait for the controller to start up...
$!
$ Wait 00:00:15
$ controller_exists:
$!
$! If the controller is running, we start here.
$!
$! Now call the Window Create program.  This program tells the window
$! generator to create a new window.
$!
$ Write Sys$Output "Starting Window Generator."
$ Window_Create := $WINDOW_DIRECTORY:WINDOW_CREATE
$ Window_Create 'client_Node'::0.0
$!
$! The Error_Exit label is jumped to if an error is detected inside the
$! command procedure.
$!
$ Error_Exit:
$ Save_Status = $Status
$! Send the status back to the client and close the connection...
$ Write Network_Channel Save_Status
$ Close Network_Channel                    
$! Tell DECnet to maintain one permanent process to service future 
$! requests quickly
$ Define Netserver$Servers_X11_TERMINAL "1"
$ Exit

==

[Figure 4]

        Program Window_Create
!
! WINDOW_CREATE.FOR
!
! Author: 
!
!                John McMahon                        Phone:   (408) 427-4366
!                TGV, Incorporated          FAX:     (408) 427-4365
!                603 Mission Street              E-Mail:      MCMAHON@TGV.COM
!                Santa Cruz, California 95060
!
! This program is based on code developed by John McMahon while under contract
! to the Advanced Data Flow Technology Office - NASA Goddard Space Flight
! Center in Greenbelt, Maryland during October 1989.
! 
! Usage:
!
!                Executed by the DECnet object command procedure
!                WINDOW_SERVER.COM.  The command procedure passes one
!                parameter of the format:
!
!                NODENAME::SERVER.DISPLAY
!
! Function:
!
!                This program calls the DECW$TERM_PORT routine to tell 
!                the DECwindows Terminal Controller to create a new terminal
!                window.
!
! Output:
!
!                A terminal window is created.
!
!-----------------------------------------------------------------------------


        Implicit None

        Character*128     Input_Line                 ! Command Line Text
        Integer*2         IL_Length         ! Length Of Input_Line
        Character*50      Terminal_Created  ! Device Name Of The
                                                     ! New Terminal
        Integer*2         TC_Length                  ! Length Of Terminal_Created    
        Integer*4         Status                     ! Generic Status Variable
        Integer*4         DECW$TERM_PORT             ! Create New Terminal Routine

!
! Fetch the command line 
!

        Type *,'Window Create Start'

        Call Lib$Get_Foreign(Input_Line,,%ref(IL_Length),)

        Type *,'Command Line: ',Input_Line(1:IL_Length)

!
! Send a message to the controller to create a new terminal
!
! The name of the created terminal is returned by the call
!

        Status = DECW$TERM_PORT(
     $            Input_Line(1:IL_Length),,,
     $            Terminal_Created,%REF(TC_Length))

        If (status .ne. 1) then 
                 print *,'DECW$TERM_PORT: status = ',status
                 Call Lib$Signal(%val(Status))
        end if

        If (TC_Length .gt. 0) then
                 Type *,'Terminal Created: ',Terminal_Created(1:TC_Length)
        end if

        Type *,'Window Create End'
                          end

==

 BUILD_WINDOW_CREATE.COM

$!
$! BUILD_WINDOW_CREATE.COM
$!
$! This routine builds the WINDOW_CREATE.EXE from the FORTRAN source
$!
$!
$ FORTRAN/EXTEND/CHECK=ALL WINDOW_CREATE
$ LINK WINDOW_CREATE,SYS$INPUT:/OPT
SYS$SHARE:DECW$TERMINALSHR/SHARE
$ EXIT