001000* Dedicateted to all Unix fans ;).
001100*96/10/06
001200$CONTROL SYNC32, INDEX32, OPTIMIZE, NOLIST
001300*=========================================================
001400* This is COBOL/iX version of SOCKCLTC.NET.SYS program,
001500* timeouts are not implemented.
001600* Conversion done by J. Rodzewicz.
001700* Link with SOCKETRL.NET.SYS relocatable library.
001800*=========================================================
001900 IDENTIFICATION DIVISION.
002000 PROGRAM-ID. SOCKCLTP.
002100*---------------------------------------------------------
002200* Constants defines for socket library
002300*---------------------------------------------------------
002400 REPLACE
002500 ==AF_INET== BY ==2==
002600
002700 ==INADDR_ANY== BY ==0==
002800
002900 ==SOCK_STREAM== BY ==1==
003000 ==SOCK_DGRAM== BY ==2==.
003100*=========================================================
003200 DATA DIVISION.
003300*=========================================================
003400 WORKING-STORAGE SECTION.
003500*---------------------------------------------------------
003600 01 INFO-LEN PIC S9(4) COMP.
003700 01 I-STATUS PIC S9(4) COMP.
003800 01 C-JCW PIC X(5) VALUE "CJCW ".
003900 01 C-EXIT-CODE PIC S9(4) COMP VALUE 0.
004000 01 CHAR-0 PIC X VALUE %0.
004100 01 MODULO PIC S9(4) COMP.
004200 01 INT-CONV PIC S9(4) COMP.
004300 01 CHAR-CONV REDEFINES INT-CONV.
004400 05 FILLER PIC X.
004500 05 INT-CHAR PIC X.
004600
004700 01 IDENT PIC X(38)
004800 VALUE "@(#) CLIENT(Cobol/iX) 10/6/96 1.0".
004900
005000 01 CDES PIC S9(9) COMP.
005100 01 SOCK-TYPE PIC S9(9) VALUE SOCK_STREAM.
005200 01 ER PIC S9(9) COMP.
005300 01 ERRNO EXTERNAL PIC S9(9) COMP.
005400 01 ERR-DISP PIC -(9)9.
005500 01 DISP2 PIC -9.
005600 01 DISP4 PIC -(3)9.
005700 01 DISP5 PIC -(4)9.
005800
005900 01 DIE PIC S9(4) COMP VALUE 0.
006000
006100 01 PORT-FLAG PIC S9(4) COMP VALUE 0.
006200 88 PORT-SPEC VALUE 1.
006300 01 SERV-NAME-FLAG PIC S9(4) COMP VALUE 0.
006400 88 SERV-NAME-SPEC VALUE 1.
006500 01 IP-FLAG PIC S9(4) COMP VALUE 0.
006600 88 IP-SPEC VALUE 1.
006700 01 KILL-FLAG PIC S9(4) COMP VALUE 0.
006800 88 KILL-SERVER VALUE 1.
006900 01 PRINT-FLAG PIC S9(4) COMP VALUE 0.
007000 88 PRINT-ALL VALUE 1.
007100
007200 01 MSG-COUNT PIC S9(9) COMP VALUE 3.
007300 01 MSG-LEN PIC S9(9) COMP VALUE 10.
007400 01 CHAR-SET PIC X VALUE "n".
007500 01 CHAR-START PIC S9(4) COMP VALUE 48.
007600 01 CHAR-SET-SIZE PIC S9(4) COMP VALUE 10.
007700
007800 01 SERVER-ID.
007900 05 S-CHAR PIC X OCCURS 1 TO 255 TIMES
008000 DEPENDING ON ID-LEN.
008100 01 ID-LEN PIC S9(9) COMP VALUE 255.
008200
008300* variables local to PARSE-ARGS
008400 01 ARG-MARKER PIC S9(4) COMP.
008500 01 TEMP-LOC INDEX.
008600 01 ARG-CNT PIC S9(4) COMP.
008700 01 ARG-LEN PIC S9(4) COMP.
008800 01 ARG-TYPE PIC X.
008900 01 I PIC S9(9) COMP.
009000
009100* variables local to DO-RECV
009200 01 LOCAL-LEN PIC S9(9) COMP.
009300 01 TOTAL-SO-FAR PIC S9(9) COMP.
009400 01 ADDR-LEN PIC S9(9) COMP.
009500 01 XX PIC S9(9) COMP.
009600
009700* variables local to CLIENT
009800 01 LEN PIC S9(9) COMP.
009900 01 X PIC S9(9) COMP.
010000 01 Y PIC S9(9) COMP.
010100
010200 01 HOSTENT-PTR PIC S9(9) COMP.
010300*/ struct hostent /*
010400 01 HOSTENT.
010500 05 H-NAME PIC S9(9) COMP.
010600 05 H-ALIASES PIC S9(9) COMP.
010700 05 H-ADDRTYPE PIC S9(9) COMP.
010800 05 H-LENGTH PIC S9(9) COMP.
010900 05 H-ADDR-LIST PIC S9(9) COMP.
011000
011100 01 IP-ADDR-PTR PIC S9(9) COMP.
011200 01 BUF-PTR PIC S9(9) COMP.
011300
011400*/ struct sockaddr_in /*
011500 01 SERVER-ADDR.
011600 05 SIN-FAMILY PIC S9(4) COMP.
011700 05 SIN-PORT PIC S9(4) COMP.
011800 05 SIN-ADDR PIC S9(9) COMP.
011900 05 SIN-ZERO PIC X(8).
012000
012100*/ struct sockaddr_in /*
012200 01 CLIENT-ADDR.
012300 05 SIN-FAMILY PIC S9(4) COMP.
012400 05 SIN-PORT PIC S9(4) COMP.
012500 05 SIN-ADDR PIC S9(9) COMP.
012600 05 SIN-ZERO PIC X(8).
012700
012800*/ struct sockaddr_in /*
012900 01 LOCAL-ADDR.
013000 05 SIN-FAMILY PIC S9(4) COMP.
013100 05 SIN-PORT PIC S9(4) COMP.
013200 05 SIN-ADDR PIC S9(9) COMP.
013300 05 SIN-ZERO PIC X(8).
013400
013500*/ struct comm_desc /*
013600 01 SERVER-CONTROL.
013700 05 NUM-MSGS PIC S9(9) COMP.
013800 05 MSG-SIZE PIC S9(9) COMP.
013900 05 MSG-SET PIC X.
014000
014100* communication buffer
014200 01 BUF.
014300 05 BUF-LOC PIC X OCCURS 1 TO 5000 TIMES
014400 DEPENDING ON BUF-LEN
014500 INDEXED BY CURR-LOC.
014600
014700 01 BUF-LEN PIC S9(9) COMP VALUE 5000.
014800*========================================================
014900 PROCEDURE DIVISION.
015000*========================================================
015100$DEFINE %Perform=
015200 PERFORM !1
015300 THRU !1-EXIT#
015400
015500$DEFINE %CExit=
015600 MOVE !1 TO C-EXIT-CODE
015700 CALL INTRINSIC "PUTJCW"
015800 USING C-JCW, C-EXIT-CODE, I-STATUS
015900 STOP RUN#
016000*========================================================
016100 MAIN-LINE SECTION.
016200 PERFORM
016300 %Perform(PARSE-ARGS#)
016400 IF KILL-SERVER
016500 %Perform(KILL-IT#)
016600 ELSE
016700 %Perform(DUMP-PARMS#)
016800 %Perform(CLIENT#)
016900 END-IF
017000 %CExit(0#)
017100 END-PERFORM.
017200*---------------------------------------------------------
017300* Parse command line (INFO string) parameters
017400*---------------------------------------------------------
017500 PARSE-ARGS.
017600 PERFORM
017700 MOVE SPACES TO BUF
017800 MOVE 5000 TO INFO-LEN
017900 CALL INTRINSIC "GETINFO" USING BUF, INFO-LEN
018000 GIVING I-STATUS
018100 IF I-STATUS <> 0
018200 DISPLAY "ERROR in GETINFO"
018300 %CExit(1#)
018400 END-IF
018500 %Perform(ARG-COUNT#)
018600
018700 IF ARG-CNT = 0
018800 DISPLAY "ERROR in argument list: missing options"
018900 MOVE 1 TO DIE
019000 %Perform(DO-HELP#)
019100 END-IF
019200
019300 MOVE 0 TO X
019400 %Perform(FIRST-ARG#)
019500 PERFORM WITH TEST AFTER UNTIL X = ARG-CNT
019600*** argument must start with "-"
019700 IF BUF-LOC(CURR-LOC) <> "-"
019800 DISPLAY "ERROR in argument list"
019900 MOVE 1 TO DIE
020000 %Perform(DO-HELP#)
020100 END-IF
020200
020300 SET CURR-LOC UP BY 1
020400 MOVE BUF-LOC(CURR-LOC) TO ARG-TYPE
020500 EVALUATE ARG-TYPE
020600****** server name specification *****
020700 WHEN "n"
020800 IF SERV-NAME-SPEC AND IP-SPEC
020900 DISPLAY "ERROR in argument list:"
021000 " conflicting options"
021100 MOVE 1 TO DIE
021200 %Perform(DO-HELP#)
021300 ELSE
021400 SET SERV-NAME-SPEC TO TRUE;
021500 SET CURR-LOC UP BY 1
021600 IF BUF-LOC(CURR-LOC) = SPACE
021700*** get next in list
021800 ADD 1 TO X
021900 IF X < ARG-CNT
022000 %Perform(NEXT-ARG#)
022100 ELSE
022200*** no more arguments avaiable
022300 MOVE " " TO BUF-LOC(CURR-LOC)
022400 END-IF
022500 END-IF
022600
022700 %Perform(AARG-LEN#)
022800 PERFORM VARYING I FROM 1 BY 1
022900 UNTIL I > ARG-LEN
023000 OR I > 255
023100 MOVE BUF-LOC(CURR-LOC) TO S-CHAR(I)
023200 SET CURR-LOC UP BY 1
023300 END-PERFORM
023400 MOVE CHAR-0 TO S-CHAR(I)
023500 MOVE ARG-LEN TO ID-LEN
023600
023700 CALL "GETHOSTBYNAME" USING SERVER-ID
023800 GIVING HOSTENT-PTR
023900 IF HOSTENT-PTR = 0
024000 DISPLAY "ERROR gethostbyname of '",
024100 SERVER-ID, "'; quitting"
024200 %CExit(1#)
024300 END-IF
024400
024500*** sizeof(struct hostent)
024600 MOVE 20 TO I
024700 CALL "COBPTR" USING \HOSTENT-PTR\, HOSTENT, I
024800 MOVE 4 TO I
024900 CALL "COBPTR" USING \H-ADDR-LIST\,
025000 IP-ADDR-PTR, I
025100 CALL "COBPTR" USING \IP-ADDR-PTR\,
025200 SIN-ADDR OF SERVER-ADDR, I
025300
025400 END-IF
025500****** server IP address specification *****
025600 WHEN "i"
025700 IF SERV-NAME-SPEC AND IP-SPEC
025800 DISPLAY "ERROR in argument list:"
025900 " conflicting options"
026000 MOVE 1 TO DIE
026100 %Perform(DO-HELP#)
026200 ELSE
026300 SET IP-SPEC TO TRUE
026400 SET CURR-LOC UP BY 1
026500 IF BUF-LOC(CURR-LOC) = SPACE
026600*** get next in list
026700 ADD 1 TO X
026800 IF X < ARG-CNT
026900 %Perform(NEXT-ARG#)
027000 ELSE
027100*** no more arguments avaiable
027200 MOVE " " TO BUF-LOC(CURR-LOC)
027300 END-IF
027400 END-IF
027500
027600 %Perform(AARG-LEN#)
027700 PERFORM VARYING I FROM 1 BY 1
027800 UNTIL I > ARG-LEN
027900 OR I > 255
028000 MOVE BUF-LOC(CURR-LOC) TO S-CHAR(I)
028100 SET CURR-LOC UP BY 1
028200 END-PERFORM
028300 MOVE CHAR-0 TO S-CHAR(I)
028400 MOVE ARG-LEN TO ID-LEN
028500
028600 CALL "INET_ADDR" USING SERVER-ID
028700 GIVING SIN-ADDR OF SERVER-ADDR
028800 END-IF
028900****** server port specification *****
029000 WHEN "p"
029100 IF PORT-SPEC
029200 DISPLAY "ERROR in argument list:"
029300 " duplicate options"
029400 MOVE 1 TO DIE
029500 %Perform(DO-HELP#)
029600 ELSE
029700 SET PORT-SPEC TO TRUE
029800 END-IF
029900 SET CURR-LOC UP BY 1
030000 IF BUF-LOC(CURR-LOC) = SPACE
030100*** get next in list
030200 ADD 1 TO X
030300 IF X < ARG-CNT
030400 %Perform(NEXT-ARG#)
030500 ELSE
030600***** no more arguments avaiable *****
030700 MOVE " " TO BUF-LOC(CURR-LOC)
030800 END-IF
030900 END-IF
031000 %Perform(AARG-LEN#)
031100 CALL INTRINSIC "BINARY" USING BUF-LOC(CURR-LOC),
031200 \ARG-LEN\
031300 GIVING SIN-PORT OF SERVER-ADDR
031400****** use a DGRAM socket for communication *****
031500 WHEN "d"
031600 MOVE SOCK_DGRAM TO SOCK-TYPE
031700****** number of messages specification *****
031800 WHEN "m"
031900 SET CURR-LOC UP BY 1
032000 IF BUF-LOC(CURR-LOC) = SPACE
032100*** get next in list
032200 ADD 1 TO X
032300 IF X < ARG-CNT
032400 %Perform(NEXT-ARG#)
032500 ELSE
032600*** no more arguments avaiable
032700 MOVE " " TO BUF-LOC(CURR-LOC)
032800 END-IF
032900 END-IF
033000 %Perform(AARG-LEN#)
033100 CALL INTRINSIC "DBINARY" USING BUF-LOC(CURR-LOC),
033200 \ARG-LEN\
033300 GIVING MSG-COUNT
033400 IF MSG-COUNT > 20
033500 DISPLAY "ERROR in argument list:"
033600 " msg_count too large"
033700 MOVE 1 TO DIE
033800 %Perform(DO-HELP#)
033900 END-IF
034000****** message length specification *****
034100 WHEN "l"
034200 SET CURR-LOC UP BY 1
034300 IF BUF-LOC(CURR-LOC) = SPACE
034400*** get next in list
034500 ADD 1 TO X
034600 IF X < ARG-CNT
034700 %Perform(NEXT-ARG#)
034800 ELSE
034900*** no more arguments avaiable
035000 MOVE " " TO BUF-LOC(CURR-LOC)
035100 END-IF
035200 MOVE BUF-LOC(CURR-LOC) TO CHAR-SET
035300 END-IF
035400 %Perform(AARG-LEN#)
035500 CALL INTRINSIC "DBINARY" USING BUF-LOC(CURR-LOC),
035600 \ARG-LEN\
035700 GIVING MSG-LEN
035800 IF MSG-LEN > 5000
035900 DISPLAY "ERROR in argument list:"
036000 " msg_len to large"
036100 MOVE 1 TO DIE
036200 %Perform(DO-HELP#)
036300 END-IF
036400****** character set specification *****
036500 WHEN "c"
036600 SET CURR-LOC UP BY 1
036700 IF BUF-LOC(CURR-LOC) <> SPACE
036800*** non-null, string there
036900 MOVE BUF-LOC(CURR-LOC) TO CHAR-SET
037000 ELSE
037100*** get next in list
037200 ADD 1 TO X
037300 IF X < ARG-CNT
037400 %Perform(NEXT-ARG#)
037500 ELSE
037600*** no more arguments avaiable *****
037700 MOVE "?" TO BUF-LOC(CURR-LOC)
037800 END-IF
037900 MOVE BUF-LOC(CURR-LOC) TO CHAR-SET
038000 END-IF
038100 EVALUATE CHAR-SET
038200 WHEN "A"
038300* char_start = 'A';
038400 MOVE 65 TO CHAR-START
038500 MOVE 26 TO CHAR-SET-SIZE
038600 WHEN "a"
038700* char_start = 'a';
038800 MOVE 97 TO CHAR-START
038900 MOVE 26 TO CHAR-SET-SIZE
039000 WHEN "n"
039100* char_start = '0';
039200 MOVE 48 TO CHAR-START
039300 MOVE 10 TO CHAR-SET-SIZE
039400 WHEN "c"
039500* char_start = '!';
039600 MOVE 33 TO CHAR-START
039700 MOVE 94 TO CHAR-SET-SIZE
039800 WHEN OTHER
039900 DISPLAY "ERROR in argument list:"
040000 " unknown char set"
040100 MOVE 1 TO DIE
040200 %Perform(DO-HELP#)
040300 END-EVALUATE
040400****** print entire message? *****
040500 WHEN "a"
040600 SET PRINT-ALL TO TRUE
040700****** kill the server *****
040800 WHEN "k"
040900 SET KILL-SERVER TO TRUE
041000****** print help message *****
041100 WHEN "h"
041200 MOVE ZERO TO DIE
041300 %Perform(DO-HELP#)
041400 WHEN OTHER
041500 DISPLAY "ERROR in argument list: unrecognized option"
041600 MOVE 1 TO DIE
041700 %Perform(DO-HELP#)
041800 END-EVALUATE
041900
042000 ADD 1 TO X
042100 IF X < ARG-CNT
042200 %Perform(NEXT-ARG#)
042300 END-IF
042400 END-PERFORM
042500
042600*** check for required parms
042700 IF (NOT PORT-SPEC OR NOT (SERV-NAME-SPEC OR IP-SPEC))
042800 DISPLAY "ERROR in argument list: "
042900 "missing required option"
043000 MOVE 1 TO DIE
043100 %Perform(DO-HELP#)
043200 END-IF
043300 END-PERFORM.
043400 PARSE-ARGS-EXIT. EXIT.
043500*---------------------------------------------------------
043600* Setup connection using steam or datagram socket
043700*---------------------------------------------------------
043800 SETUP-CONNECT.
043900 PERFORM
044000 MOVE AF_INET TO SIN-FAMILY OF SERVER-ADDR
044100* cdes = socket(AF_INET, sock_type, 0)
044200 CALL "SOCKET" USING \AF_INET\, \SOCK-TYPE\, \0\
044300 GIVING CDES
044400 IF CDES < 0
044500 CALL INTRINSIC "DASCII" USING \ERRNO\, \10\, BUF
044600 GIVING BUF-LEN
044700 DISPLAY "ERROR in socket, errno ", BUF,
044800 "; quitting"
044900 %CExit(1#)
045000 END-IF
045100
045200 IF SOCK-TYPE = SOCK_STREAM
045300* er = connect(cdes, &server_addr, sizeof(struct sockaddr_in))
045400 CALL "CONNECT" USING \CDES\, SERVER-ADDR, \16\
045500 GIVING ER
045600 IF ER <> 0
045700 CALL INTRINSIC "DASCII" USING \ERRNO\, \10\, BUF
045800 GIVING BUF-LEN
045900 DISPLAY "ERROR connecting, errno ", BUF,
046000 "; quitting"
046100 %CExit(1#)
046200 END-IF
046300 ELSE
046400 MOVE AF_INET TO SIN-FAMILY OF CLIENT-ADDR
046500 COMPUTE
046600 SIN-PORT OF CLIENT-ADDR = SIN-PORT OF SERVER-ADDR - 2
046700 MOVE INADDR_ANY TO SIN-ADDR OF CLIENT-ADDR
046800
046900* er = bind(cdes, &client_addr, sizeof(struct sockaddr_in))
047000 CALL "BIND" USING \CDES\, CLIENT-ADDR, \16\
047100 GIVING ER
047200 IF ER <> 0
047300 CALL INTRINSIC "DASCII" USING \ERRNO\, \10\, BUF
047400 GIVING BUF-LEN
047500 DISPLAY "ERROR binding, errno ", BUF,
047600 "; quitting"
047700 %CExit(1#)
047800 END-IF
047900 END-IF
048000 END-PERFORM.
048100 SETUP-CONNECT-EXIT. EXIT.
048200*---------------------------------------------------------
048300* Print communication parameters
048400*---------------------------------------------------------
048500 DUMP-PARMS.
048600 PERFORM
048700 DISPLAY "Client version ", IDENT
048800 DISPLAY "COMMUNICATION PARAMETERS"
048900 DISPLAY "------------------------"
049000 MOVE SIN-PORT OF SERVER-ADDR TO DISP5
049100 DISPLAY "Server Port ", DISP5,
049200 " Server Specification: '", SERVER-ID, "'"
049300 MOVE MSG-COUNT TO DISP2
049400 MOVE MSG-LEN TO DISP4
049500 DISPLAY "Number of Messages: ", DISP2,
049600 " Message Length " , DISP4
049700 IF SOCK-TYPE = SOCK_DGRAM
049800 DISPLAY "Datagram Sockets " WITH NO ADVANCING
049900 ELSE
050000 DISPLAY "Stream Sockets " WITH NO ADVANCING
050100 END-IF
050200
050300 IF PRINT-ALL
050400 DISPLAY "Print all of message u" WITH NO ADVANCING
050500 ELSE
050600 DISPLAY "u" WITH NO ADVANCING
050700 END-IF
050800 DISPLAY "sing character set ", CHAR-SET
050900 DISPLAY "------------------------"
051000 END-PERFORM.
051100 DUMP-PARMS-EXIT. EXIT.
051200*---------------------------------------------------------
051300* Print all help text
051400*---------------------------------------------------------
051500 DO-HELP.
051600 PERFORM
051700 DISPLAY IDENT
051800 DISPLAY "syntax is one of the following forms:"
051900 DISPLAY " sockcltp -n<server> -p<port #> [-d]"
052000 " [-m#] [-l#] [-c?] [-a] [-k] [-t#]"
052100 DISPLAY " sockcltp -i<IP addr> -p<port #> [-d]"
052200 " [-m#] [-l#] [-c?] [-a] [-k] [-t#]"
052300 DISPLAY " sockcltp -h"
052400 DISPLAY "**** see the file sockcltc.net.sys"
052500 " for further explanation ***"
052600 %CExit(DIE#)
052700 END-PERFORM.
052800 DO-HELP-EXIT. EXIT.
052900*---------------------------------------------------------
053000* Client processing routine
053100*---------------------------------------------------------
053200 CLIENT.
053300 PERFORM
053400 %Perform(SETUP-CONNECT#)
053500
053600* send the control message
053700 MOVE MSG-COUNT TO NUM-MSGS OF SERVER-CONTROL
053800 MOVE MSG-LEN TO MSG-SIZE OF SERVER-CONTROL
053900 MOVE CHAR-SET TO MSG-SET OF SERVER-CONTROL
054000
054100 MOVE SERVER-CONTROL TO BUF
054200 MOVE 9 TO LEN
054300 %Perform(DO-SEND#)
054400
054500 PERFORM VARYING X FROM 1 BY 1 UNTIL X > MSG-COUNT
054600 MOVE X TO DISP2
054700
054800***** client recvs first
054900 MOVE MSG-LEN TO LEN
055000 %Perform(DO-RECV#)
055100 DISPLAY "Received message ", DISP2, " '"
055200 WITH NO ADVANCING
055300 %Perform(PRINT-MSG-BUF#)
055400 MOVE LEN TO DISP4
055500 DISPLAY "' len ", DISP4
055600
055700*** now client does a send */
055800 MOVE ZERO TO MODULO
055900 PERFORM VARYING Y FROM 1 BY 1 UNTIL Y > MSG-LEN
056000* msg[y] = (CHAR)((INT)CHAR-START + Y % CHAR-SET-SIZE);
056100 COMPUTE INT-CONV = CHAR-START + MODULO
056200 SET CURR-LOC TO Y
056300 MOVE INT-CHAR TO BUF-LOC(CURR-LOC)
056400 ADD 1 TO MODULO
056500 IF MODULO = CHAR-SET-SIZE
056600 MOVE ZERO TO MODULO
056700 END-IF
056800 END-PERFORM
056900 DISPLAY "Sending message ", DISP2, " '"
057000 WITH NO ADVANCING
057100 %Perform(PRINT-MSG-BUF#)
057200 DISPLAY "'"
057300 MOVE MSG-LEN TO LEN
057400 %Perform(DO-SEND#)
057500
057600 END-PERFORM
057700
057800* now close the connection
057900 CALL "SCLOSE" USING \CDES\
058000
058100 END-PERFORM.
058200 CLIENT-EXIT. EXIT.
058300*---------------------------------------------------------
058400* Send data to server using steam or datagram socket
058500*---------------------------------------------------------
058600 DO-SEND.
058700 PERFORM
058800 IF SOCK-TYPE = SOCK_STREAM
058900* er = send(cdes, buf, len, 0)
059000 CALL "SEND" USING \CDES\, BUF , \LEN\, \0\
059100 GIVING ER
059200 IF ER < 0
059300 CALL INTRINSIC "DASCII" USING \ERRNO\, \10\, BUF
059400 GIVING BUF-LEN
059500 DISPLAY "ERROR sending, errno ", BUF,
059600 "; quitting"
059700 %CExit(1#)
059800 END-IF
059900 ELSE
060000* get the other side's address
060100 MOVE SERVER-ADDR TO LOCAL-ADDR
060200* er = sendto(cdes, buf, len, 0,
060300* &local_addr, sizeof (struct sockaddr_in))
060400 CALL "SENDTO" USING \CDES\, BUF , \LEN\, \0\
060500 LOCAL-ADDR, \16\
060600 GIVING ER
060700 IF ER < 0
060800 CALL INTRINSIC "DASCII" USING \ERRNO\, \10\, BUF
060900 GIVING BUF-LEN
061000 DISPLAY "ERROR sending to, errno ", BUF,
061100 "; quitting"
061200 %CExit(1#)
061300 END-IF
061400 END-IF
061500 END-PERFORM.
061600 DO-SEND-EXIT. EXIT.
061700*---------------------------------------------------------
061800* Receive data from server using steam or datagram socket
061900*---------------------------------------------------------
062000 DO-RECV.
062100 PERFORM
062200 MOVE LEN TO XX
062300 MOVE 5000 TO BUF-LEN
062400 IF SOCK-TYPE = SOCK_STREAM
062500 MOVE LEN TO LOCAL-LEN
062600 MOVE 0 TO TOTAL-SO-FAR
062700 SET CURR-LOC TO 1
062800 PERFORM UNTIL LOCAL-LEN <= 0
062900***** xx = recv(cdes, current_buf_loc, local_len, 0)
063000 CALL "RECV" USING \CDES\,
063100 BUF-LOC(CURR-LOC),
063200 \LOCAL-LEN\, \0\
063300 GIVING XX
063400 IF XX < 0
063500 CALL INTRINSIC "DASCII" USING \ERRNO\, \10\, BUF
063600 GIVING BUF-LEN
063700 DISPLAY "ERROR recving, errno ", BUF,
063800 "; quitting"
063900 %CExit(1#)
064000 ELSE
064100 COMPUTE TOTAL-SO-FAR = TOTAL-SO-FAR + XX
064200 COMPUTE LOCAL-LEN = LOCAL-LEN - XX
064300 SET CURR-LOC UP BY XX
064400 END-IF
064500 END-PERFORM
064600 MOVE TOTAL-SO-FAR TO LEN
064700 ELSE
064800* sizeof(struct sockaddr_in)
064900 MOVE 16 TO ADDR-LEN
065000* len = recvfrom(cdes, buf, xx, 0, &local_addr, &addr_len)
065100 CALL "RECVFROM" USING \CDES\, BUF, \XX\, \0\
065200 LOCAL-ADDR, ADDR-LEN
065300 GIVING LEN
065400 IF LEN < 0
065500 CALL INTRINSIC "DASCII" USING \ERRNO\, \10\, BUF
065600 GIVING BUF-LEN
065700 DISPLAY "ERROR recving from, errno ", BUF,
065800 "; quitting"
065900 %CExit(1#)
066000 END-IF
066100 MOVE LOCAL-ADDR TO SERVER-ADDR
066200 END-IF
066300 END-PERFORM.
066400 DO-RECV-EXIT. EXIT.
066500*---------------------------------------------------------
066600* Print message buffer
066700*---------------------------------------------------------
066800 PRINT-MSG-BUF.
066900 PERFORM
067000 IF LEN < 50 OR PRINT-ALL
067100 MOVE LEN TO BUF-LEN
067200 DISPLAY BUF WITH NO ADVANCING
067300 ELSE
067400 MOVE 30 TO BUF-LEN
067500 DISPLAY BUF, "..." WITH NO ADVANCING
067600 MOVE 5000 TO BUF-LEN
067700 SET CURR-LOC TO LEN
067800 SET CURR-LOC DOWN BY 14
067900 PERFORM VARYING XX FROM 1 BY 1 UNTIL XX > 15
068000 DISPLAY BUF-LOC(CURR-LOC) WITH NO ADVANCING
068100 SET CURR-LOC UP BY 1
068200 END-PERFORM
068300 END-IF
068400 END-PERFORM.
068500 PRINT-MSG-BUF-EXIT. EXIT.
068600*---------------------------------------------------------
068700* Send kill message to server
068800*---------------------------------------------------------
068900 KILL-IT.
069000 PERFORM
069100 MOVE SOCK_DGRAM TO SOCK-TYPE
069200
069300 %Perform(SETUP-CONNECT#)
069400
069500 MOVE -1 TO NUM-MSGS OF SERVER-CONTROL
069600 MOVE -1 TO MSG-SIZE OF SERVER-CONTROL
069700 MOVE "k" TO MSG-SET OF SERVER-CONTROL
069800
069900 DISPLAY "Sending the kill message to the server"
070000
070100 MOVE SERVER-CONTROL TO BUF
070200 MOVE 9 TO LEN
070300 %Perform(DO-SEND#)
070400 END-PERFORM.
070500 KILL-IT-EXIT. EXIT.
070600*=========================================================
070700* INFO string manipulation procedures
070800*=========================================================
070900* Command line arguments count
071000*---------------------------------------------------------
071100 ARG-COUNT.
071200 PERFORM
071300 IF INFO-LEN = ZERO
071400 MOVE ZERO TO ARG-CNT
071500 ELSE
071600 SET CURR-LOC TO 1
071700 MOVE 1 TO ARG-MARKER
071800 PERFORM WITH TEST AFTER UNTIL ARG-MARKER = INFO-LEN
071900 PERFORM UNTIL BUF-LOC(CURR-LOC) <> SPACE
072000 OR ARG-MARKER = INFO-LEN
072100 ADD 1 TO ARG-MARKER
072200 SET CURR-LOC UP BY 1
072300 END-PERFORM
072400 IF BUF-LOC(CURR-LOC) <> SPACE
072500 ADD 1 TO ARG-CNT
072600 END-IF
072700 PERFORM UNTIL BUF-LOC(CURR-LOC) = SPACE
072800 OR ARG-MARKER = INFO-LEN
072900 ADD 1 TO ARG-MARKER
073000 SET CURR-LOC UP BY 1
073100 END-PERFORM
073200 END-PERFORM
073300 END-IF
073400 END-PERFORM.
073500 ARG-COUNT-EXIT. EXIT.
073600*---------------------------------------------------------
073700* Get first argument (CURR-LOC will point to it)
073800*---------------------------------------------------------
073900 FIRST-ARG.
074000 PERFORM
074100 SET CURR-LOC TO 1
074200 MOVE 1 TO ARG-MARKER
074300 PERFORM UNTIL BUF-LOC(CURR-LOC) <> SPACE
074400 OR ARG-MARKER = INFO-LEN
074500 ADD 1 TO ARG-MARKER
074600 SET CURR-LOC UP BY 1
074700 END-PERFORM
074800 END-PERFORM.
074900 FIRST-ARG-EXIT. EXIT.
075000*---------------------------------------------------------
075100* Get next argument (CURR-LOC will point to it)
075200*---------------------------------------------------------
075300 NEXT-ARG.
075400 PERFORM
075500 SET CURR-LOC TO ARG-MARKER
075600 PERFORM UNTIL BUF-LOC(CURR-LOC) = SPACE
075700 OR ARG-MARKER = INFO-LEN
075800 ADD 1 TO ARG-MARKER
075900 SET CURR-LOC UP BY 1
076000 END-PERFORM
076100 PERFORM UNTIL BUF-LOC(CURR-LOC) <> SPACE
076200 OR ARG-MARKER = INFO-LEN
076300 ADD 1 TO ARG-MARKER
076400 SET CURR-LOC UP BY 1
076500 END-PERFORM
076600 END-PERFORM.
076700 NEXT-ARG-EXIT. EXIT.
076800*---------------------------------------------------------
076900* Length of argument pointed by CURR-LOC
077000*---------------------------------------------------------
077100 AARG-LEN.
077200 PERFORM
077300 MOVE ZERO TO ARG-LEN
077400 SET TEMP-LOC TO CURR-LOC
077500 PERFORM UNTIL BUF-LOC(CURR-LOC) = SPACE
077600 ADD 1 TO ARG-LEN
077700 SET CURR-LOC UP BY 1
077800 END-PERFORM
077900 SET CURR-LOC TO TEMP-LOC
078000 END-PERFORM.
078100 AARG-LEN-EXIT. EXIT.
078200*---------------------------------------------------------
078300 END PROGRAM SOCKCLTP.
078400*=========================================================
078500$CONTROL SUBPROGRAM, SYNC32
078600*=========================================================
078700 IDENTIFICATION DIVISION.
078800 PROGRAM-ID. COBPTR.
078900*========================================================
079000 DATA DIVISION.
079100*========================================================
079200 WORKING-STORAGE SECTION.
079300 01 COUNTER PIC S9(9) COMP.
079400*========================================================
079500 LINKAGE SECTION.
079600*========================================================
079700 01 FROM-BUF.
079800 05 FROM-CHAR PIC X OCCURS 256 TIMES.
079900 01 TO-BUF.
080000 05 TO-CHAR PIC X OCCURS 256 TIMES.
080100 01 LEN PIC S9(9) COMP.
080200*========================================================
080300 PROCEDURE DIVISION USING FROM-BUF TO-BUF LEN.
080400*========================================================
080500 MAIN-LINE SECTION.
080600 PERFORM VARYING COUNTER FROM 1 BY 1 UNTIL COUNTER > LEN
080700 MOVE FROM-CHAR(COUNTER) TO TO-CHAR(COUNTER)
080800 END-PERFORM.
080900*-------------------------------------------------------------
081000
|
