|
Code:
- * Must be compiled with ACTGRP of QILE and BINDDIR of QC2LE
- Hdftactgrp(*no) ACTGRP('QILE') BNDDIR('QC2LE')
- *
- * Necessary procedrure prototypes with data definitions
- *
- *-- Socket address information structure ------------------------
- *
- *
- D SocketAddr DS
- D SinFamily 5I 0
- D SinPort 5U 0
- D SinAddr 10U 0
- D SinZero 8A Inz( *ALLX'00' )
- *
- *
- *
- *-- I/O options (Fcntl) -----------------------------------------
- *
- D F_SETFL S 10I 0 Inz(7)
- D O_NONBLOCK S 10I 0 Inz(128)
- *
- D EWOULDBLCK C 3406
- *
- *
- *-- Error number information ------------------------------------
- *
- D ErrNo S 10I 0 Based(ErrNo@)
- D ErrNo@ S * Inz
- D ErrMsg@ S * Inz
- *
- *
- *-- Address families --------------------------------------------
- *
- D AF_UNIX C 1
- D AF_INET C 2
- D AF_NS C 6
- D AF_TELEPH C 99
- *
- *
- *-- Socket types ------------------------------------------------
- *
- D SOCK_STR C 1
- D SOCK_DGRAM C 2
- D SOCK_RAW C 3
- D SOCK_SEQ C 5
- *
- D SOL_SOCKET C -1
- *
- *
- *-- Socket level options ----------------------------------------
- *
- D SO_BROAD C 5
- D SO_DEBUG C 10
- D SO_DONTRT C 15
- D SO_ERROR C 20
- D SO_KEEPAL C 25
- D SO_LINGER C 30
- *
- D SO_REUSEAD C 55
- *
- *
- *-- Internet address specifications -----------------------------
- *
- D INADDR_ANY C 0
- D INADDR_BR C -1
- D INADDR_LB C X'7F000000'
- D INADDR_NON C -1
- *
- *
- *-- Socket descritption bits in 4 byte unsigned integers
- *
- D FD_Set Ds
- D FDes 10U 0 Dim(7)
- d @version ds dtaara(qss1mri)
- d @vxrx 1 4a
- d @vall 1 750
- *
- *
- *================================================================
- * S u b p r o c e d u r e p r o t o t y p e s
- *================================================================
- *
- *
- *-- Socket --- Create a socket ----------------------------------
- *
- * int socket(int address_family,
- * int type,
- * int protocol)
- *
- D Socket Pr 10I 0 Extproc('socket')
- *
- D 10I 0 Value
- D 10I 0 Value
- D 10I 0 Value
- *
- *
- *-- Setsockopt --- Set socket options
- *
- * int setsockopt(int socket_descriptor,
- * int level,
- * int option_name,
- * char *option_value,
- * int option_length)
- *
- D SetsockOpt Pr 10I 0 Extproc('setsockopt')
- *
- D 10I 0 Value
- D 10I 0 Value
- D 10I 0 Value
- D * Value
- D 10I 0 Value
- *
- *
- *-- InetAddr --- Transform IP address from dotted form ----------
- *
- * unsigned long inet_addr(char *address_string);
- *
- D InetAddr Pr 10U 0 ExtProc('inet_addr')
- *
- D * Value
- *
- *
- *-- GetHostByName --- Get host address from name ----------------
- *
- * struct HostEnt {
- * char *h_name;
- * char **h_aliases;
- * int h_addrtype;
- * int h_length;
- * char **h_addr_list;
- * };
- *
- * struct HostEnt *GetHostByName(char *host_name);
- *
- D GetHost Pr * Extproc('gethostbyname')
- *
- D * Value
- *
- *
- *-- Connect --- Connect to the server
- *
- * int connect(int socket_descriptor,
- * struct sockaddr *destination_address,
- * int address_length);
- *
- D Connect Pr 10I 0 Extproc('connect')
- *
- D 10I 0 Value
- D * Value
- D 10I 0 Value
- *
- *
- *-- FCntl --- File control for I/O
- *
- * int fcntl(int file_descriptor, int cmd, . . .);
- *
- D FCntl Pr 10I 0 Extproc('fcntl')
- *
- D 10I 0 Value
- D F_SETFL 10I 0 Value
- D O_NONBLOCK 10I 0 Value Options(*Nopass)
- *
- *
- *-- FDzero --- Zero socket description bit (for Select function)
- *
- * #define FD_ZERO(fds) (memset(fds,0,sizeof(fd_set)))
- *
- D FDZero Pr
- *
- D FDes 10U 0 Dim(7)
- *
- *
- *-- FDSet --- Set socket description bit (for Select function)
- *
- * #define FD_SET(fd, fds) \
- * set bits
- *
- D FDSet Pr
- *
- D FD 10I 0 Value
- D FDes 10U 0 Dim(7)
- *
- *
- *-- FDClr --- Clear socket description bit (for Select function)
- *
- * #define FD_CLR(fd, fds) \
- *
- *
- D FDClr Pr
- *
- D FD 10I 0 Value
- D FDes 10U 0 Dim(7)
- *
- *
- *-- FDIsSet --- Test if a socket description bit is set on
- * (for Select function)
- *
- * #define FD_ISSET(fd, fds) \
- *
- *
- D FDIsSet Pr 10I 0
- *
- D FD 10I 0 Value
- D FDes 10U 0 Dim(7)
- *
- *
- *-- Select - Wait for events on multiple sockets
- * and set bits for active sockets
- *
- * int select(int max_descriptor,
- * fd_set *read_set,
- * fd_set *write_set,
- * fd_set *exception_set,
- * struct timeval *wait_time);
- *
- *
- *
- *-- Read --- Read data from the socket
- *
- * ssize_t read(int descriptor,
- * void *buffer,
- * size_t buffer_length);
- *
- D Read Pr 10I 0 Extproc('read')
- *
- D 10I 0 Value
- D * Value
- D 10U 0 Value
- *
- *
- *-- Recv --- Receive data from the socket
- *
- * int recv(int descriptor,
- * char *buffer,
- * int buffer_length,
- * int flags);
- *
- D Recv Pr 10I 0 Extproc('recv')
- *
- D 10I 0 Value
- D * Value
- D 10I 0 Value
- D 10I 0 Value
- *
- *
- *-- Write --- Write data to the socket
- *
- * ssize_t write(int file_descriptor,
- * const void *buffer,
- * size_t buffer_length);
- *
- D Write Pr 10I 0 ExtProc('write')
- *
- D 10I 0 Value
- D * Value
- D 10U 0 Value
- *
- *
- *
- * Prototype for DspError subprocedure
- DDspError PR
- D text 10A Const
- *-- Open --- Open the socket
- D open PR 10I 0 ExtProc('open')
- D pathptrp * value
- D oflag 10I 0 Value
- D mode 10U 0 Value Options(*nopass)
- D codepage 10U 0 Value Options(*nopass)
- *
- *
- *-- Send --- Send data to the socket
- *
- * int send(int descriptor,
- * char *buffer,
- * int buffer_length,
- * int flags);
- *
- D Send Pr 10I 0 ExtProc('send')
- *
- D 10I 0 Value
- D * Value
- D 10I 0 Value
- D 10I 0 Value
- *
- *
- *-- Close --- Close a socket
- *
- * int close(int descriptor)
- *
- D Close Pr ExtProc('close')
- *
- D 10I 0 Value
- *
- *
- *-- GetErrNo ---- Get error number ----------------------------------
- *
- * extern int * __errno(void);
- *
- D GetErrNo Pr * ExtProc('__errno')
- *
- *
- *-- StrError ---- Get error text ------------------------------------
- *
- * char *strerror(int errnum);
- *
- D StrError Pr * ExtProc('strerror')
- *
- D 10I 0 Value
- *
- *
- *-- Sleep --- Sleep function (delay job) ------------------------
- *
- * unsigned int sleep( unsigned int seconds );
- *
- D Sleep Pr 10U 0 ExtProc('sleep')
- *
- D 10U 0 Value
- *
- *
- D Translate PR ExtPgm('QDCXLATE')
- D Length 5p 0 CONST
- D XDATA 32767A options(*varsize)
- D Table 10a CONST
- *
- * ReadSocket subprocedure prototype
- D ReadSocket Pr 10I 0
- D SD 10I 0 Value
- D SockData@ * Value
- D SockDtaLen 10I 0 Value
- D Retry 10I 0 Value
- *
- * WriteSocket subprocedure prototype
- D WriteSock Pr 10I 0
- D SD 10I 0 Value
- D SockData@ * Value
- D SockDtaLen 10I 0 Value
- D Retry 10I 0 Value
- *
- * Port number
- D PortNumber S 5u 0
- * Socket description number for the client
- D SD S 10I 0
- * Return code for sockets
- D RC S 10I 0
- * Option name for SetSockOpt function
- D OptVal S 10U 0 Inz(1)
- * Server IP address in dotted form
- D ServerAddr S 15A
- *
- * Error handling subprocedure prototype
- D ErrorHdlr Pr
- D DumpText 12 Value
-
-
-
- d @Error s 10a
- d @Trans s 50a
- *
- *==================================================================
- * M A I N P R O G R A M
- *==================================================================
- *
- *
- *
- *
- * Obtain a socket descriptor
- c Eval Sd = socket(af_inet: sock_str: 0)
- *
- * If socket failed - End the client program with dump
- c If Sd < 0
- c Callp Errorhdlr ('ClientSocket')
- C Eval *inlr = *On
- c Return
- c Endif If sd < 0
- *
- * Allow socket description to be reusable
- c Eval Rc = setsockopt(sd: sol_socket
- C : SO_REUSEAD
- C : %Addr(OptVal)
- C : %Size(OptVal))
- *
- * If SetSockOpt failed - End the server with dump
- c If Rc < 0
- c Callp Errorhdlr ('SetSockOpt')
- C CallP Close(SD)
- C Eval *inlr = *on
- c Return
- c Endif If rc < 0
- *
- * Fill in necessary fields in the IP address structure
- c Eval Socketaddr = *allx'00'
- c Eval Sinfamily = af_inet
- * Get the version of OS400 so we can work around IBM's dumbness
- c In @version
- c Unlock @version
- c If @vxrx = 'V4R3'
- c Eval Portnumber = 46167
- c Else If @vxrx = 'V4R3'
- c Eval Portnumber = 56167
- c Endif If @vxrx = 'V4R3'
- c Eval Sinport = portnumber
- *
- * Copy the IP address from the host entry structure into
- * the server IP address structure
- c Eval Serveraddr = '172.24.1.36'
- c Eval Sinaddr = inetaddr(%addr(serveraddr))
- *
- * Connect to the server
- c Eval Rc = connect( sd:
- C %Addr(SocketAddr):
- C %Size(SocketAddr))
- * If connect unsuccessful - Enter recovery loop
- c If Rc < 0
- c Eval *inlr = *on
- c Eval @error = 'NOSERV'
- c Callp Close(sd)
- c Return
- c Endif If rc < 0
- *
- * Set nonblocked mode for the socket
- c Eval Rc = fcntl(sd: f_setfl: o_nonblock)
- *
- * If FCntl failed - End the server with dump
- c If Rc < 0
- c Callp Errorhdlr ('SvrFCntl')
- C CallP Close(SD)
- C Eval *inlr = *on
- c Return
- c Endif If rc < 0
- *
- *
- * Send the string to the server over the socket
- c Eval @trans = 'TESTING 123'
- c Callp Translate(50:@trans:'QTCPASC')
- c Eval Rc = writesock(sd: %addr(@trans)
- C : 50 : 5)
- * If write failed - Enter recovery loop
- c If Rc < 0
- c Callp Errorhdlr ('SendMode')
- C CallP Close(SD)
- C Eval *inlr = *on
- c Return
- c Endif If rc < 0
- C CallP Close(SD)
- C Eval *inlr = *on
- c Return
- *=====================================================================
- * S U B P R O C E D U R E D E F I N I T I O N S
- *=====================================================================
- *
- *---------------------------------------------------------------------
- * ErrorHdlr - Error handling subprocedure -
- * prints a storage dump.
- * The input parameter is a text to recognize the dump.
- * No return value is provided.
- *---------------------------------------------------------------------
- *
- PErrorHdlr B
- *
- * Error handling subprocedure prototype
- D ErrorHdlr Pr
- D DumpText 12 Value
- *
- * Error handling subprocedure interface
- D ErrorHdlr PI
- D DumpText 12 Value
- *
- c Eval Errno@ = geterrno
- c Eval Errmsg@ = strerror(errno)
- *
- c dumptext Dump
- c Callp Close(sd)
- c Eval *inlr=*on
- *
- PErrorHdlr E
- *
- *----------------------------------------------------------------
- * ReadSocket - Read socket with recovery
- *----------------------------------------------------------------
- *
- PReadSocket B EXPORT
- *
- * ReadSocket subprocedure prototype
- D ReadSocket Pr 10I 0
- D SD 10I 0 Value
- D SockData@ * Value
- D SockDataLn 10I 0 Value
- D Retry 10I 0 Value
- *
- * ReadSocket subprocedure interface
- D ReadSocket PI 10I 0
- D SD 10I 0 Value
- D SockData@ * Value
- D SockDataLn 10I 0 Value
- D Retry 10I 0 Value
- *
- D RC S 10I 0
- *
- c Do retry Begin DO
- *
- c Eval Errno@ = geterrno
- *
- c Eval Errno = 0
- *
- c Eval Rc = read (sd: sockdata@: sockdataln)
- *
- c Eval Errno@ = geterrno
- c Eval Errmsg@ = strerror(errno)
- *
- c Dow errno = ewouldblck Begin DO
- *
- c Callp Sleep (1)
- *
- c Eval Rc = read (sd: sockdata@: sockdataln)
- *
- c Eval Errno@ = geterrno
- c Eval Errmsg@ = strerror(errno)
- *
- c Enddo Dow errno = ewould
- *
- c If Rc > 0
- c Return Rc
- c Endif If rc > 0
- *
- c Enddo Do retry
- *
- c Return Rc
- *
- PReadSocket E
- *
- *----------------------------------------------------------------
- * WriteSocket - Write socket with recovery
- *----------------------------------------------------------------
- *
- PWriteSock B EXPORT
- *
- * WriteSocket subprocedure prototype
- D WriteSock Pr 10I 0
- D SD 10I 0 Value
- D SockData@ * Value
- D SockDataLn 10I 0 Value
- D Retry 10I 0 Value
- *
- * WriteSocket subprocedure interface
- D WriteSock PI 10I 0
- D SD 10I 0 Value
- D SockData@ * Value
- D SockDataLn 10I 0 Value
- D Retry 10I 0 Value
- *
- D RC S 10I 0
- *
- c Do retry Begin DO
- *
- c Eval Errno@ = geterrno
- *
- c Eval Errno = 0
- *
- c Eval Rc = write(sd: sockdata@: sockdataln)
- *
- c Eval Errno@ = geterrno
- c Eval Errmsg@ = strerror(errno)
- *
- c Dow errno = ewouldblck Begin DO
- *
- c Callp Sleep (1)
- c Eval Rc = write(sd: sockdata@: sockdataln)
- *
- c Eval Errno@ = geterrno
- c Eval Errmsg@ = strerror(errno)
- *
- c Enddo Dow errno = ewould
- c If Rc > 0
- c Return Rc
- c Endif If rc > 0
- *
- c Enddo Do retry
- *
- c Return Rc
- *
- PWriteSock E
- *
- PDspError B
- DDspError PI
- D text 10A Const
- *
- * Variables for __errno() and strerror() APIs
- DerrorNo@ S * Inz
- D errorNo S 10I 0 Based(Errorno@)
- DerrorMsg@ S * Inz
- D errorMsg S 100A Based(errorMsg@)
- Derrortxt S 52A Inz(*blank)
- Derrorchar s 10a
- *
- c Eval Errorno@ = geterrno
- c Eval Errormsg@ = strerror(errorno)
- c Move Errorno errorchar
- c Eval Errortxt =%trim(text) + '->' +
- C errorchar
- C + ':' + %subst(errormsg : 1 : 37)
- c errortxt Dsply
- P E
|
|