On 10/7/2024 11:52 AM, Dan Cross wrote:
In article <vdvoeq$1jerg$1@dont-email.me>,
Dave Froble <davef@tsoft-inc.com> wrote:
Well, some of the issue is in the text of the question. What does one mean be
"pass socket"?
>
Perhaps an example will be illuminating.
Ok, I normally refrain from posting large amounts of code. But, perhaps that will show what I was doing.
Notes:
In the Listener process, comments mention sub-process. Later I decided the worker process should be a detached process. Comments were never corrected.
I figured the inter-process communications to be important. In the development code I used a file for SYS$INPUT to the create process system service, and a mailbox. There are better methods, but I thought shared global sections and such was a bit much for a proof of concept.
An admission to Steve Hoffman that item lists can be a bit tedious, both to write, and to read.
It has been years since I worked on this ....
2 !********************************************************************
!
! Program: TCP_LISTENER.BAS
! Function: Test Using TCP/IP Sockets as a Listener
! Version: 1.00
! Created: 01-Dec-2011
! Author(s): DFE
!
! Purpose/description:
!
! This program will set up TCP/IP sockets to allow
! itself to listen for connection requests. When
! a connection request is received, this program
! will spawn a subprocess and have the subprocess
! service the connection request.
!
!********************************************************************
!
! Copyright 2011 by Dave Froble Enterprises, Inc.
!
! This program is the sole property of Dave Froble
! Enterprises, Inc. and may not be copied in whole
! or in part without the express written permission
! of Dave Froble Enterprises, Inc.
!
!********************************************************************
!
! Modification history:
!
!********************************************************************
Option Size = ( Integer Word , Real Double )
%Include "FL:SUPLIB.INC"
%Include "FL:KBCOMM.INC"
%Include "FL:TCP_STRUCT.INC"
%Include "SYS$SHARE:TCPIP$INETDEF.BAS"
%Include "$SSDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
%Include "$IODEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
%Include "$JPIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
External Long Function SYS$ASSIGN, ! System services &
SYS$CREMBX, &
SYS$CREPRC, &
SYS$DASSGN, &
LIB$GETDVI, &
SYS$QIOW
Declare Long ByteCount%, ! Longwords &
Long ClientNameLen%, &
Long ClientPort%, &
Long ConnectNameLen%, &
Long ConnectPort%, &
Long Ctx%, &
Long D9%, &
Long One%, &
Long ServerPort%, &
Long ShareVal%, &
Long Sock%, &
Long Stat%, &
Long Temp%, &
Long UIC%, &
Long WorkerPID%
!**************************************************
! Declare Variables of User Defined Structures
!**************************************************
DECLARE IOSB_Struct IOSB, ! I/O status blk &
ItemList_2 ServerItemLst, ! Server item list &
ItemList_2 SockOptItemList, ! Socket options list &
ItemList_3 ClientItemLst, ! Client item list &
ItemList_3 ConnectItemList, ! Connect sock list &
ItemList_3 ConnectItemList2, ! Connect sock list &
Socket_Options ListenOpt, ! Socket options &
Sock_Addr ClientAdr, ! Client IP adr/port &
Sock_Addr ConnectSockAdr, ! Connect sock data &
Sock_Addr ConnectSockAdr2, ! Connect sock data &
Sock_Addr ServerAdr, ! Server IP adr/port &
SockOpt OptList, ! Socket options list &
Buff ClientName, ! Client name buffer &
Buff ServerName, ! Server name buffer &
IP_Adr IP, ! Ip address &
Buff Msg ! Message buffer
200 !**************************************************
! Program Initialization
!**************************************************
GoSub 4990
Print #KB% ! Display banner
Print #KB%, P8$; " "; DATEL(D9%,4%); " "; TIME$(0%)
ServerPort% = 12345%
BuffSize% = Len(MSG::BUF$)
JobCount% = 0%
DetLogin$ = "SYS$SYSTEM:LOGINOUT.EXE"
Call SSGETJPI( X'304' , 2% , Z$ ) ! Get UIC
UIC% = CVT$F(Z$)
Print #KB%, "Listener UIC: "; Num1$(UIC%)
!**************************************************
! Assign channels to 'TCPIP$DEVICE:'
!**************************************************
Dev$ = "TCPIP$DEVICE:"
Stat% = SYS$ASSIGN( Dev$ , ListenCh% , , )
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to assign listener channel - "; E$
GoTo 4900
End If
Print #KB%, "Internal VMS channel for listener socket:"; ListenCh%
Stat% = SYS$ASSIGN( Dev$ , ClientCh% , , )
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to assign client channel - "; E$
GoTo 4900
End If
Print #KB%, "Internal VMS channel for client socket:"; ClientCh%
!**************************************************
! Create Listener socket
! Bind server's IP address and port # to listener
! socket, set socket as a passive socket
! Note: we used to do this in 2 calls, but can be combined
!**************************************************
ListenOpt::Protocol% = TCPIP$C_TCP ! Listener socket optn
ListenOpt::Typ$ = Chr$(TCPIP$C_STREAM)
ListenOpt::AF$ = Chr$(TCPIP$C_AF_INET)
One% = 1% ! Set to 'True'
SockOptItemList::Len% = 24% ! Socket options buffer
SockOptItemList::Typ% = TCPIP$C_SOCKOPT
SockOptItemList::Adr% = Loc(OptList::ReUseAdrLen%)
OptList::ReuseAdrLen% = 4%
OptList::ReuseAdrType% = TCPIP$C_REUSEADDR
OptList::ReuseAdrAdr% = Loc(One%)
OptList::ReusePortLen% = 4%
OptList::ReusePortType% = TCPIP$C_REUSEPORT
OptList::ReusePortAdr% = Loc(One%)
OptList::ShareLen% = 4%
OptList::ShareType% = TCPIP$C_SHARE
OptList::ShareAdr% = Loc(One%)
ServerItemLst::Len% = 16% ! Server item list
ServerItemLst::Typ% = TCPIP$C_SOCK_NAME
ServerItemLst::Adr% = Loc(ServerAdr::Fam%)
ServerAdr::Fam% = TCPIP$C_AF_INET ! Server Ip adr/port
ServerAdr::Port% = SWAP%(ServerPort%)
ServerAdr::IP.Adr% = TCPIP$C_INADDR_ANY
ServerAdr::Zero1% = 0%
ServerAdr::Zero2% = 0%
BackLog% = 1%
Stat% = SYS$QIOW( , ! Event flag &
ListenCh% By Value, ! VMS channel &
IO$_SETCHAR By Value, ! Operation &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
ListenOpt::Protocol%, ! P1 &
, ! P2 &
ServerItemLst::Len%, ! P3 - local socket nam
e &
BackLog% By Value, ! P4 - connection backl
og &
SockOptItemList::Len%, ! P5 - socket options &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to queue create and bind listener socket - "
; E$
GoTo 4900
End If
If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( IOSB::Stat% , E$ )
Print #KB%, "Unable to create and bind listener socket - "; E$
GoTo 4900
End If
Print #KB%, "Listener socket created ...."
Print #KB%, "Listener socket bind ...."
1000 !************************************************************
! Main Processing
!************************************************************
!**************************************************
! Wait for a Client Connection Request
!**************************************************
Listen_for_Connection:
Print #KB%
Print #KB%, "Port:"; ServerPort%
Print #KB%, "Waiting for a client connection ...."
ClientItemLst::Len% = 16% ! Client item list
ClientItemLst::Typ% = 0%
ClientItemLst::Adr% = Loc(ClientAdr::Fam%)
ClientItemLst::Ret.Len.Ptr% = Loc(ClientNameLen%)
ClientNameLen% = 16% ! Length of ClientAdr
ClientAdr::Fam% = 0% ! Client Ip adr/port
ClientAdr::Port% = 0%
ClientAdr::IP.Adr% = 0%
ClientAdr::Zero1% = 0%
ClientAdr::Zero2% = 0%
Stat% = SYS$QIOW( , ! Event flag &
ListenCh% By Value, ! VMS channel &
IO$_ACCESS OR IO$M_ACCEPT By Value, &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
, ! P1 &
, ! P2 &
ClientItemLst::Len%, ! P3 - client socket na
me &
ClientCh%, ! P4 - connect channel
&
, ! P5 &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to queue listen for client connection - "; E
$
GoTo Close_Listener_Socket
End If
If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( IOSB::Stat% , E$ )
Print #KB%, "Unable to listen for client connection - "; E$
GoTo Close_Listener_Socket
End If
!**************************************************
! A client has been granted a connection request
!**************************************************
IP::IP% = ClientAdr::IP.Adr%
ClientIP$ = NUM1$(Ascii(IP::IP1$)) + "." &
+ NUM1$(Ascii(IP::IP2$)) + "." &
+ NUM1$(Ascii(IP::IP3$)) + "." &
+ NUM1$(Ascii(IP::IP4$))
Print #KB%, "Client connection established:"
Print #KB%, " Client: "; ClientIP$
ClientPort% = SWAP%(ClientAdr::Port%)
ClientPort% = "65536"L + ClientPort% If ClientPort% < 0%
Print #KB%, " Port :"; ClientPort%
Msg$ = ""
!**************************************************
! Get device name of client socket
!**************************************************
Stat% = LIB$GETDVI( 32% , ! Item code &
ClientCh% , ! Channel # &
, ! Device name &
0% , ! Int val &
SocketDev$, ! Result string &
NameLen%) ! Result length
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to get client socket name - "; E$
GoTo Shutdown_Client_Socket
End If
Print #KB%, "Client socket device: <"; Trm$(SocketDev$); ">"
1050 !**************************************************
! Get connection socket data
!**************************************************
ConnectItemList::Len% = 16% ! Connect item list
ConnectItemList::Typ% = TCPIP$C_SOCK_NAME
ConnectItemList::Adr% = Loc(ConnectSockAdr::Fam%)
ConnectItemList::Ret.Len.Ptr% = Loc(ConnectNameLen%)
ConnectNameLen% = 16%
ConnectSockAdr::Fam% = 0% ! Connect Ip adr/port
ConnectSockAdr::Port% = 0%
ConnectSockAdr::IP.Adr% = 0%
ConnectSockAdr::Zero1% = 0%
ConnectSockAdr::Zero2% = 0%
ConnectItemList2::Len% = 16% ! Connect item list
ConnectItemList2::Typ% = TCPIP$C_SOCK_NAME
ConnectItemList2::Adr% = Loc(ConnectSockAdr2::Fam%)
ConnectItemList2::Ret.Len.Ptr% = Loc(ConnectNameLen2%)
ConnectNameLen2% = 16%
ConnectSockAdr2::Fam% = 0% ! Connect Ip adr/port
ConnectSockAdr2::Port% = 0%
ConnectSockAdr2::IP.Adr% = 0%
ConnectSockAdr2::Zero1% = 0%
ConnectSockAdr2::Zero2% = 0%
Stat% = SYS$QIOW( , ! Event flag &
ClientCh% By Value, ! VMS channel &
IO$_SenseMode By Value, ! Function &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
, ! P1 &
, ! P2 &
ConnectItemList::Len%, ! P3 - Connect socket n
ame &
ConnectItemList2::Len%, ! P4 &
, ! P5 &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to queue socket data request - "; E$
GoTo Close_Listener_Socket
End If
If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( IOSB::Stat% , E$ )
Print #KB%, "Unable to get socket data - "; E$
GoTo Close_Listener_Socket
End If
Print #KB%
Print #KB%, "Connection socket data:"
Print #KB%, " Family:"; ConnectSockAdr::Fam%
Print #KB%, " Port #:"; Swap%(ConnectSockAdr::Port%)
Print #KB%, " IP Adr:"; ConnectSockAdr::IP.Adr%
Print #KB%, " Word 3:"; ConnectSockAdr::Zero1%
Print #KB%, " Word 4:"; ConnectSockAdr::Zero2%
Print #KB%, " Family:"; ConnectSockAdr2::Fam%
Print #KB%, " Port #:"; Swap%(ConnectSockAdr2::Port%)
Print #KB%, " IP Adr:"; ConnectSockAdr2::IP.Adr%
Print #KB%, " Word 3:"; ConnectSockAdr2::Zero1%
Print #KB%, " Word 4:"; ConnectSockAdr2::Zero2%
1100 !**************************************************
! Peek the Incoming Message
!**************************************************
Read_Msg:
Print #KB%, "Peeking client message ...."
GoSub Peek_Socket ! Look for "SHUTDOWN"
If ( Stat% And SS$_NORMAL ) = 0%
Then Print #KB%, E$
GoTo Shutdown_Client_Socket
End If
Print #KB%, ByteCount%; "bytes read from socket"
Msg$ = Left(MSG::BUF$,ByteCount%)
Print #KB%, Len(Msg$); "message bytes in buffer"
!**************************************************
! Message Peeked, Display Message
!**************************************************
Msg_Completed:
Print #KB%, "Message peeked, message is"; Len(Msg$); "bytes"
Print #KB%, "<"; Msg$; ">"
GoTo Shutdown_Client_Socket If Edit$(Msg$,32%) = "SHUTDOWN"
!**************************************************
! Create a temporary mailbox for communications
!**************************************************
Print #KB%, "Creating MailBox"
Stat% = SYS$CREMBX( 0% By Value , ! Temp mailbox &
MbxCh% , ! Mailbox channel &
512% By Value , ! Max mxg size &
, ! Buffer quota &
0% By Value , ! Prot mask &
3% By Value , ! Access mode (user) &
, ! Logical name &
, ! Flags (read/write) &
) ! Null arg
Stat% = LIB$GETDVI( 32% , ! Item code &
MbxCh% , ! Channel # &
, ! Device name &
0% , ! Int val &
MbxDev$, ! Result string &
NameLen%) ! Result length
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to get mailbox name - "; E$
GoTo Shutdown_Client_Socket
End If
Print #KB%, "Mailbox created, name: <"; Trm$(MbxDev$); ">"
Call Parse( MbxDev$ , "MBA" , Z1$ , Z2$ )
Call Parse( Z2$ , ":" , Z1$ , Z2$ )
Call NIVAL( Z1$ , JobNum% , E% )
Print #KB%, "Job number will be: "; Num1$(JobNum%)
!**************************************************
! Create subprocess to process incoming request
!**************************************************
ProcName$ = "SockWorker" + Num1$(JobNum%)
CmdFile$ = ProcName$ + ".COM"
OutFile$ = ProcName$ + ".LOG"
Open CmdFile$ For Output As File #91%
Print #91%, "$ show logical tt"
Print #91%, "$ show logical sys$command"
Print #91%, "$ show logical sys$input"
Print #91%, "$ run TCP_WORKER"
Print #91%, MbxDev$
Print #91%, ClientIP$
Print #91%, Num1$(ClientPort%)
Print #91%, "$ exit"
Close #91%
Stat% = SYS$CREPRC( WorkerPID% , ! Worker PID &
DetLogin$ , ! Loginout &
CmdFile$ , ! Sys$Command &
OutFile$ , ! Sys$Output &
, ! Sys$Error &
, ! Priv mask &
, ! Quota mask &
ProcName$ , ! Process name &
Prio% By Value , ! Priority &
UIC% By Value , ! UIC &
, ! Term mbx &
64% By Value ) ! PRC$M_NOUAF
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to queue create worker process - "; E$
GoTo Close_Listener_Socket
End If
If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( IOSB::Stat% , E$ )
Print #KB%, "Unable to create worker process - "; E$
GoTo Close_Listener_Socket
End If
Print #KB%, "Worker process created:"
Print #KB%, " Name: "; ProcName$
Print #KB%, " PID: "; Num1$(WorkerPID%)
!Print #KB%, "Writing to MailBox"
!Open MbxDev$ As File #92%
!Field #92%, 32% as Mbx$
!Lset Mbx$ = SocketDev$
!Put #92%
!Lset Mbx$ = Num1$(ClientAdr::IP.Adr%)
!Put #92%
!Lset Mbx$ = Num1$(ClientPort%)
!Put #92%
!Get #92%
!Sleep 3%
!Close 92%
Input "Wait for worker process to acquire socekt", I0$
Stat% = SYS$DASSGN( MbxCh% By Value )
!**************************************************
! Worker Process has socket, close in Listener
!**************************************************
Print #KB%, "Closing client socket ...."
Stat% = SYS$QIOW( , ! Event flag &
ClientCh% By Value, ! VMS channel &
IO$_DEACCESS By Value, &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
, ! P1 - I/O buffer &
, ! P2 - length of buffer
&
, ! P3 &
, ! P4 &
, ! P5 &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to queue close connection socket - "; E$
GoTo 4900
End If
If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( IOSB::Stat% , E$ )
Print #KB%, "Unable to close connection socket - "; E$
GoTo 4900
End If
GoTo Listen_for_Connection
!**************************************************
!**************************************************
! 'SHUTDOWN' received, shut down listener
! Break the Connection
!**************************************************
Shutdown_Client_Socket:
Print #KB%, "Shutting down client socket ...."
Stat% = SYS$QIOW( , ! Event flag &
ClientCh% By Value, ! VMS channel &
IO$_DEACCESS OR IO$M_SHUTDOWN By Value, ! Function code &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
, ! P1 - I/O buffer &
, ! P2 - length of buffer
&
, ! P3 &
TCPIP$C_DSC_ALL By Value, ! P4 &
, ! P5 &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to queue close connection - "; E$
GoTo 4900
End If
If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( IOSB::Stat% , E$ )
Print #KB%, "Unable to close connection - "; E$
GoTo 4900
End If
!**************************************************
! Close Listener Socket
!**************************************************
Close_Listener_Socket:
Print #KB%, "Closing listener socket ...."
Stat% = SYS$QIOW( , ! Event flag &
ListenCh% By Value, ! VMS channel &
IO$_DEACCESS By Value, &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
, ! P1 - I/O buffer &
, ! P2 - length of buffer
&
, ! P3 &
, ! P4 &
, ! P5 &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to queue close listener socket - "; E$
GoTo 4900
End If
If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( IOSB::Stat% , E$ )
Print #KB%, "Unable to close listener socket - "; E$
GoTo 4900
End If
!**************************************************
! Deassign Channel(s)
!**************************************************
Deassign_Channel:
Print #KB%, "Deassigning client channel ...."
Stat% = SYS$DASSGN( ClientCh% By Value )
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to deassign client channel - "; E$
GoTo 4900
End If
Print #KB%, "Deassigning listener channel ...."
Stat% = SYS$DASSGN( ListenCh% By Value )
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to deassign listener channel - "; E$
GoTo 4900
End If
GoTo 4950
4900 !************************************************************
! Exit Point
!************************************************************
Print #KB%
E% = KBINPT( "Type <CR> to exit ...." , 0% , I0$ , E% )
4950 Print #KB%
Print #KB%, "End of "; P8$
Print #KB%
GoTo 32760
!************************************************************
! Subroutines
!************************************************************
4990 !**************************************************
! Program Initialization
!**************************************************
P9$ = "TCP_LISTENER" ! Program name
P8$ = "Test Using TCP/IP Sockets as a Listener" ! Function name
On Error GoTo 32000 ! Enable error trapping
KB% = 99% ! Keyboard channel
KB.MODE% = 0% ! Mode for keyboard ope
n
Call KBOPEN( KB% , KB.MODE% ) ! Open keyboard
X3% = 0% ! No cursor addressing
Z% = CTRLC ! ^C trap
Call SYPRAM(U1$,U1%,U2$,U3$,D9%,U5$,T2$) ! Read sys parameters
E1$ = " not a valid " ! Std error text
E2$ = "Unable to " ! Std error text
DI0$ = STRING$(4%,0%) ! DI zero string
Return !
6800 !**************************************************
! Peek into Socket
!**************************************************
Peek_Socket:
Stat% = SYS$QIOW( , ! Event flag &
ClientCh% By Value, ! VMS channel &
IO$_READVBLK By Value, ! Function code &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
MSG::BUF$ By Ref, ! P1 - I/O buffer &
BuffSize% By Value, ! P2 - length of buffer
&
, ! P3 &
TCPIP$C_MSG_PEEK By Value, ! P4 - peek at msg &
, ! P5 &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
E$ = "Unable to queue read server message - " + E$
Return
End If
Stat% = IOSB::Stat%
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
E$ = "Unable to read server message - " + E$
End If
ByteCount% = IOSB::Cnt%
Return
32000 !******************** ERROR TRAPS ********************
32700 Print ! Final error trap
Print "Unforseen error detected in <"; P9$; ">"
On Error GoTo 0
32760
32766 Chain U1$ Unless U1$=""
32767 End
2 !********************************************************************
!
! Program: TCP_WORKER.BAS
! Function: Worker Program To Service A Connection Request
! Version: 1.00
! Created: 16-Dec-2011
! Author(s): DFE
!
! Purpose/description:
!
! This program will be spawned as a detached
! process to service client connection requests.
!
!********************************************************************
!
! Copyright 2011 by Dave Froble Enterprises, Inc.
!
! This program is the sole property of Dave Froble
! Enterprises, Inc. and may not be copied in whole
! or in part without the express written permission
! of Dave Froble Enterprises, Inc.
!
!********************************************************************
!
! Modification history:
!
!********************************************************************
Option Size = ( Integer Word , Real Double )
%Include "FL:SUPLIB.INC"
%Include "FL:KBCOMM.INC"
%Include "FL:TCP_STRUCT.INC"
%Include "SYS$SHARE:TCPIP$INETDEF.BAS"
%Include "$SSDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
%Include "$IODEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
%Include "$JPIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
External Long Function SYS$ASSIGN, ! System services &
SYS$DASSGN, &
SYS$QIOW
Declare Long ByteCount%, ! Longwords &
Long ClientNameLen%, &
Long ClientPort%, &
Long D9%, &
Long ReuseAdrVal%, &
Long ShareVal%, &
Long Sock%, &
Long Stat%, &
Long Temp%
!**************************************************
! Declare Variables of User Defined Structures
!**************************************************
Declare IOSB_Struct IOSB, ! I/O status blk &
ItemList_2 ServerItemLst, ! Server item list &
ItemList_2 SockOptItemList, ! Socket options list &
ItemList_2 ShareSockItemList, ! Share sock list &
ItemList_3 ClientItemLst, ! Client item list &
Sock_Addr ClientAdr, ! Client IP adr/port &
Sock_Addr ServerAdr, ! Server IP adr/port &
Socket_Options SocketOption, ! Socket options &
Buff ClientName, ! Client name buffer &
Buff ServerName, ! Server name buffer &
IP_Adr IP, ! Ip address &
Buff MSG ! Message buffer
200 !**************************************************
! Program Initialization
!**************************************************
GoSub 4990
Print #KB% ! Display banner
Print #KB%, P8$; " "; DATEL(D9%,4%); " "; TIME$(0%)
BuffSize% = LEN(MSG::BUF$)
!**************************************************
! Read from command file, get Socket Device
!**************************************************
Print #KB%
Print #KB%, "Beginning to read command file"
!Open "SYS$INPUT:" As File #91%
Open "TT:" As File #91%
Print "Socket device> ";
Linput #91%, SockDev$
Print "Client IP> ";
Linput #91%, ClientIP$
Print "Client port> ";
Linput #91%, Z2$
Close #91%
Call NRVAL( Z2$ , Z2 , E% )
ClientPort% = Z2
Print #KB%
Print #KB%, "Command file read:"
Print #KB%, " Socket device is: "; SockDev$
Print #KB%, " Client IP: "; ClientIP$
Print #KB%, " Client port:"; ClientPort%
!**************************************************
! Open MailBox, read data
!**************************************************
!Print #KB%
!Print #KB%, "Beginning to read MailBox"
!Open Dev$ as file 91%
!Field #91%, 32% as Mbx$
!Get #91%
!SockDev$ = Trm$(Mbx$)
!Print #KB%, Mbx$; SockDev$
!Get #91%
!Print #KB%, Mbx$
!Call NRVAL( Trm$(Mbx$) , Z1 , E% )
!ClientIP% = Z1
!Get #91%
!Print #KB%, Mbx$
!Call NRVAL( Trm$(Mbx$) , Z2 , E% )
!ClientPort% = Z2
Print #KB%, "ClientIP%"; ClientIP%
IP::IP% = ClientIP%
ClientIP$ = NUM1$(Ascii(IP::IP1$)) + "." &
+ NUM1$(Ascii(IP::IP2$)) + "." &
+ NUM1$(Ascii(IP::IP3$)) + "." &
+ NUM1$(Ascii(IP::IP4$))
!Print #KB%
!Print #KB%, "Mailbox read:"
!Print #KB%, " Socket device: "; SockDev$
!Print #KB%, " Client IP: "; ClientIP$
!Print #KB%, " Client port:"; ClientPort%
!**************************************************
! Assign a channel to Socket Device
!**************************************************
Stat% = SYS$ASSIGN( SockDev$ , ConnectCh% , , )
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to assign connection channel - "; E$
GoTo 4900
End If
Print #KB%, "Internal VMS channel for connection socket:"; ConnectCh%
! Now tell listener we have the socket
!Lset Mbx$ = "Done"
!Put #91%
!Close #91%
Input "Wait for listener to close socket", I0$
1000 !************************************************************
! Main Processing
!************************************************************
1100 !**************************************************
! Read the Incoming Message
!**************************************************
Read_Msg:
Print #KB%, "Reading client message ...."
GoSub Read_Socket ! Read byte count
If E%
Then Print #KB%, E$
GoTo Deassign_Channel
End If
Print #KB%, ByteCount%; "bytes read from socket"
Call PARSE( Left(MSG::BUF$,ByteCount%) , LF , Z$ , Msg$ )
Call NIVAL( Z$ , MsgLen% , E% )
Print #KB%, Len(Msg$); "message bytes in first buffer"
GoTo Msg_Completed If Len(Msg$) >= MsgLen%
Read_Loop:
GoSub Read_Socket
If E%
Then Print #KB%, E$
GoTo Deassign_Channel
End If
Print #KB%, ByteCount%; "bytes read from socket"
Msg$ = Msg$ + LEFT(MSG::BUF$,ByteCount%)
GoTo Read_Loop Unless Len(Msg$) >= MsgLen%
!**************************************************
! Message Received, Display Message
!**************************************************
Msg_Completed:
Print #KB%
Print #KB%, "Message received, message is"; Len(Msg$); "bytes"
Print #KB%, Msg$
!**************************************************
! Reply to Client
!**************************************************
Write_Msg:
Print #KB%, "Writing message to client ...."
RET.MSG$ = "Worker process received <" + Msg$ + ">"
Write_Loop:
NumByte% = Len(RET.MSG$)
If FnWriteSocket%( NUM1$(NumByte%)+LF ) ! Write # bytes
Then Print #KB%, "Error in write NumByte% - "; E$
GoTo Deassign_Channel
End If
While Len(RET.MSG$)
Z$ = Left(RET.MSG$,BuffSize%)
RET.MSG$ = Right(RET.MSG$,BuffSize%+1%)
If FnWriteSocket%( Z$ )
Then Print #KB%, "Error in write - "; E$
GoTo Deassign_Channel
End If
Next
!**************************************************
! Break the Connection
! Deassign Channel
!**************************************************
Deassign_Channel:
Print #KB%, "Deassigning connection channel ...."
Stat% = SYS$DASSGN( ConnectCh% By Value )
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
Print #KB%, "Unable to deassign connection channel - "; E$
GoTo 4900
End If
GoTo 4950
4900 !************************************************************
! Exit Point
!************************************************************
Print #KB%
E% = KBINPT( "Type <CR> to exit ...." , 0% , I0$ , E% )
4950 Print #KB%
Print #KB%, "End of "; P8$
Print #KB%
GoTo 32760
!************************************************************
! Subroutines
!************************************************************
4990 !**************************************************
! Program Initialization
!**************************************************
P9$ = "TCP_WORKER" ! Program name
P8$ = "Worker Program To Service A Connection Request"
On Error GoTo 32000 ! Enable error trapping
KB% = 99% ! Keyboard channel
KB.MODE% = 0% ! Mode for keyboard ope
n
Call KBOPEN( KB% , KB.MODE% ) ! Open keyboard
X3% = 0% ! No cursor addressing
Z% = CTRLC ! ^C trap
Call SYPRAM(U1$,U1%,U2$,U3$,D9%,U5$,T2$) ! Read sys parameters
E1$ = " not a valid " ! Std error text
E2$ = "Unable to " ! Std error text
DI0$ = STRING$(4%,0%) ! DI zero string
Return !
6800 !**************************************************
! Read From Socket
!**************************************************
Read_Socket:
Stat% = SYS$QIOW( , ! Event flag &
ConnectCh% By Value, ! VMS channel &
IO$_READVBLK By Value, ! Function code &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
MSG::BUF$ By Ref, ! P1 - I/O buffer &
BuffSize% By Value, ! P2 - length of buffer
&
, ! P3 &
, ! P4 &
, ! P5 &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
E$ = "Unable to queue read client message - " + E$
E% = -1%
Return
End If
Stat% = IOSB::Stat%
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
E$ = "Unable to read client message - " + E$
E% = -1%
Return
End If
ByteCount% = IOSB::Cnt%
E% = 0%
Return
20000 !**************************************************
! Write to Socket
!**************************************************
Def* FnWriteSocket%( Z0$ )
MSG::BUF$ = Z0$
ByteCount% = Len( Z0$ )
Stat% = SYS$QIOW( , ! Event flag &
ConnectCh% By Value, ! VMS channel &
IO$_WRITEVBLK By Value, ! Function code &
IOSB::Stat%, ! I/O status block &
, ! AST routine &
, ! AST parameter &
MSG::BUF$ By Ref, ! P1 - I/O buffer &
LEN(Z0$) By Value, ! P2 - length of buffer
&
, ! P3 - remote address &
, ! P4 &
, ! P5 &
) ! P6
If ( Stat% And SS$_NORMAL ) = 0%
Then Call VMSERR( Stat% , E$ )
E$ = "Unable to queue write to socket - " + E$
SaveStat% = Stat%
FnWriteSocket% = -1%
Exit Def
End If
If ( IOSB::Stat% And SS$_NORMAL ) = 0%
Then If IOSB::Stat% = SS$_ABORT &
Or IOSB::Stat% = SS$_CANCEL
Then E$ = "Timeout"
Else Call VMSERR( IOSB::Stat% , E$ )
End If
E$ = "Unable to write to socket - " + E$
SaveStat% = IOSB::Stat%
FnWriteSocket% = -1%
Exit Def
End If
Fnend
32000 !******************** ERROR TRAPS ********************
32700 Print ! Final error trap
Print "Unforseen error detected in <"; P9$; ">"
On Error GoTo 0
32760
32766 Chain U1$ Unless U1$=""
32767 End
-- David Froble Tel: 724-529-0450Dave Froble Enterprises, Inc. E-Mail: davef@tsoft-inc.comDFE Ultralights, Inc.170 Grimplin RoadVanderbilt, PA 15486
Apache + mod_php performance
Re: Apache + mod_php performance