feat: Implement ping and status (#5)

* feat: Implement ping and status

The server now shows up in the in-game server list!

* refactor: Fix formatting

README.md

@@ -1,13 +1,13 @@
 # CobolCraft
 
-A Minecraft server written in COBOL.
+A Minecraft server written in COBOL. It supports Minecraft 1.20.4 (the latest version at time of writing).
 
 ## Progress/TODO
 
 The following features are already working:
 
 - [X] basic TCP server
-- [ ] respond to ping (i.e., show as online in the server list)
+- [X] respond to ping (i.e., show as online in the server list)
 - [ ] player login
 - [ ] player movement
 - [ ] sending chunk data to client

server.cob

@@ -56,6 +56,12 @@ ReceivePacket SECTION.
         EXIT SECTION
     END-IF
 
+    *> Status state
+    IF CLIENT-STATE = 1
+        PERFORM HandleStatus
+        EXIT SECTION
+    END-IF
+
     *> TODO: Implement login state, play state, etc.
     DISPLAY "Login state not implemented."
     MOVE 255 TO CLIENT-STATE.
@@ -86,6 +92,33 @@ HandleHandshake SECTION.
 
     EXIT SECTION.
 
+HandleStatus SECTION.
+    EVALUATE TRUE
+        WHEN PACKET-ID = 0
+            *> Status request
+            DISPLAY "  Responding to status request"
+            MOVE 0 TO PACKET-ID
+            MOVE " {""version"":{""name"":""1.20.4"",""protocol"":765},""players"":{""max"":1,""online"":0,""sample"":[]},""description"":{""text"":""CobolCraft""}}" TO BUFFER
+            MOVE FUNCTION CHAR(123 + 1) TO BUFFER(1:1)
+            MOVE 124 TO BYTE-COUNT
+            CALL "SendPacket" USING BY REFERENCE HNDL PACKET-ID BUFFER BYTE-COUNT ERRNO
+            PERFORM HandleError
+        WHEN PACKET-ID = 1
+            *> Ping request: respond with the same payload and close the connection
+            DISPLAY "  Responding to ping request"
+            MOVE PACKET-LENGTH TO BYTE-COUNT
+            CALL "Read-Raw" USING HNDL BYTE-COUNT ERRNO BUFFER
+            PERFORM HandleError
+            CALL "SendPacket" USING BY REFERENCE HNDL PACKET-ID BUFFER BYTE-COUNT ERRNO
+            PERFORM HandleError
+            MOVE 255 TO CLIENT-STATE
+        WHEN OTHER
+            DISPLAY "  Unexpected packet ID: " PACKET-ID
+            MOVE 255 TO CLIENT-STATE
+    END-EVALUATE.
+
+    EXIT SECTION.
+
 HandleError SECTION.
     IF ERRNO NOT = 0 THEN
         DISPLAY "Error: " ERRNO

src/read.cob

@@ -5,10 +5,10 @@ PROGRAM-ID. Read-Raw.
 
 DATA DIVISION.
 LINKAGE SECTION.
-01 LK-HNDL              PIC X(4).
-01 LK-READ-COUNT        PIC 9(5).
-01 LK-ERRNO             PIC 9(3).
-01 LK-VALUE             PIC X(64000).
+    01 LK-HNDL              PIC X(4).
+    01 LK-READ-COUNT        PIC 9(5).
+    01 LK-ERRNO             PIC 9(3).
+    01 LK-VALUE             PIC X(64000).
 
 PROCEDURE DIVISION USING BY REFERENCE LK-HNDL LK-READ-COUNT LK-ERRNO LK-VALUE.
     IF LK-READ-COUNT < 1

src/write.cob

@@ -0,0 +1,107 @@
+*> --- Write-Raw ---
+*> Write a buffer to the client.
+IDENTIFICATION DIVISION.
+PROGRAM-ID. Write-Raw.
+
+DATA DIVISION.
+LINKAGE SECTION.
+    01 LK-HNDL              PIC X(4).
+    01 LK-WRITE-COUNT       PIC 9(5).
+    01 LK-VALUE             PIC X(64000).
+    01 LK-ERRNO             PIC 9(3).
+
+PROCEDURE DIVISION USING BY REFERENCE LK-HNDL LK-WRITE-COUNT LK-VALUE LK-ERRNO.
+    IF LK-WRITE-COUNT < 1
+        MOVE 0 TO LK-ERRNO
+        EXIT PROGRAM
+    END-IF
+    CALL "CBL_GC_SOCKET" USING "03" LK-HNDL LK-WRITE-COUNT LK-VALUE GIVING LK-ERRNO.
+
+END PROGRAM Write-Raw.
+
+*> --- Encode-VarInt ---
+*> Encode an integer to a VarInt and store it in a buffer.
+IDENTIFICATION DIVISION.
+PROGRAM-ID. Encode-VarInt.
+
+DATA DIVISION.
+LOCAL-STORAGE SECTION.
+    01 CURRENT-VALUE        PIC 9(10)   VALUE 0.
+    01 CURRENT-VALUE-BITS   PIC 9(3)    VALUE 0.
+LINKAGE SECTION.
+    01 LK-VALUE-IN          PIC 9(10).
+    01 LK-VALUE-OUT         PIC X(5).
+    01 LK-OUT-LENGTH        PIC 9(5).
+
+PROCEDURE DIVISION USING BY REFERENCE LK-VALUE-IN LK-VALUE-OUT LK-OUT-LENGTH.
+    IF LK-VALUE-IN = 0
+        MOVE FUNCTION CHAR(1) TO LK-VALUE-OUT(1:1)
+        MOVE 1 TO LK-OUT-LENGTH
+        EXIT PROGRAM
+    END-IF
+    MOVE LK-VALUE-IN TO CURRENT-VALUE
+    MOVE 0 TO LK-OUT-LENGTH
+    PERFORM UNTIL EXIT
+        ADD 1 TO LK-OUT-LENGTH
+        MOVE FUNCTION MOD(CURRENT-VALUE, 128) TO CURRENT-VALUE-BITS
+        DIVIDE CURRENT-VALUE BY 128 GIVING CURRENT-VALUE
+        IF CURRENT-VALUE = 0
+            MOVE FUNCTION CHAR(CURRENT-VALUE-BITS + 1) TO LK-VALUE-OUT(LK-OUT-LENGTH:1)
+            EXIT PERFORM
+        END-IF
+        MOVE FUNCTION CHAR(CURRENT-VALUE-BITS + 128 + 1) TO LK-VALUE-OUT(LK-OUT-LENGTH:1)
+    END-PERFORM.
+
+END PROGRAM Encode-VarInt.
+
+*> --- SendPacket ---
+*> Send a raw packet to the client.
+IDENTIFICATION DIVISION.
+PROGRAM-ID. SendPacket.
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+    01 BUFFER                   PIC X(64000).
+    01 PACKET-LENGTH            PIC 9(5).
+LOCAL-STORAGE SECTION.
+    01 NUM-BYTES                PIC 9(5).
+    01 TEMP-INT-VALUE           PIC S9(10).
+LINKAGE SECTION.
+    01 LK-HNDL                  PIC X(4).
+    01 LK-PACKET-ID             PIC S9(10).
+    01 LK-PAYLOAD               PIC X(64000).
+    01 LK-PAYLOAD-LENGTH        PIC 9(5).
+    01 LK-RESULT                PIC 9(3).
+
+PROCEDURE DIVISION USING LK-HNDL LK-PACKET-ID LK-PAYLOAD LK-PAYLOAD-LENGTH LK-RESULT.
+
+MAIN-PARA.
+    *> Encode packet ID to find the total payload length (TODO: optimize this)
+    MOVE LK-PACKET-ID TO TEMP-INT-VALUE.
+    CALL "Encode-VarInt" USING TEMP-INT-VALUE BUFFER NUM-BYTES.
+    ADD NUM-BYTES TO LK-PAYLOAD-LENGTH GIVING PACKET-LENGTH.
+
+    *> Send payload length
+    MOVE PACKET-LENGTH TO TEMP-INT-VALUE.
+    CALL "Encode-VarInt" USING TEMP-INT-VALUE BUFFER NUM-BYTES.
+    CALL "Write-Raw" USING LK-HNDL NUM-BYTES BUFFER LK-RESULT.
+    PERFORM HandleError.
+
+    *> Send packet ID
+    MOVE LK-PACKET-ID TO TEMP-INT-VALUE.
+    CALL "Encode-VarInt" USING TEMP-INT-VALUE BUFFER NUM-BYTES.
+    CALL "Write-Raw" USING LK-HNDL NUM-BYTES BUFFER LK-RESULT.
+    PERFORM HandleError.
+
+    *> Send packet data
+    CALL "Write-Raw" USING LK-HNDL LK-PAYLOAD-LENGTH LK-PAYLOAD LK-RESULT.
+    PERFORM HandleError.
+
+    EXIT PROGRAM.
+
+HandleError SECTION.
+    IF LK-RESULT NOT = 0
+        EXIT PROGRAM
+    END-IF.
+
+END PROGRAM SendPacket.