Initial importv0.1.0

1 files changed, 363 insertions, 0 deletions

diff --git a/src/cepis-request.cob b/src/cepis-request.cob
new file mode 100644
index 0000000..b45f5da
--- /dev/null
+++ b/src/cepis-request.cob
@@ -0,0 +1,363 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-REQUEST.
+
+*> ---------------------------------------------------------------------
+*> One GET against the API, retried according to CEPIS-CONFIG. Internal:
+*> callers of this library use CEPIS-LOOKUP and friends.
+*>
+*>     CALL "CEPIS-REQUEST" USING CEPIS-CONFIG CEPIS-HTTP-REQUEST
+*>                                CEPIS-HTTP-RESPONSE CEPIS-STATUS
+*>
+*> 429 and the transient 5xx are retried, and so are transport failures.
+*> 400 and 404 are handed back to the caller untouched: both are
+*> definitive answers about the request, so retrying returns the same
+*> thing more slowly while burning someone else's quota.
+*>
+*> Waits are drawn from [0, min(base * 2^(n-1), max)] -- full jitter. The
+*> randomness is not decoration: without it, N clients that failed
+*> together come back together and reproduce the spike.
+*>
+*> A Retry-After from the server wins over that calculation, in both the
+*> RFC 9110 forms, and is still capped at CFG-BACKOFF-MAX-MS so that a
+*> misconfigured proxy answering "Retry-After: 3600" cannot park the
+*> caller for an hour.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01  WS-SEEDED                       PIC X VALUE "N".
+01  WS-SEED                         PIC 9(9).
+01  WS-RANDOM                       PIC 9V9(9).
+
+01  WS-BASE                         PIC X(200).
+01  WS-BASE-LEN                     PIC S9(9).
+01  WS-URL                          PIC X(8500).
+01  WS-URL-TEXT                     PIC X(8500).
+01  WS-USER-AGENT                   PIC X(140).
+
+01  WS-TIMEOUT-MS                   PIC S9(9) COMP-5.
+01  WS-CURL-STATUS                  PIC S9(9) COMP-5.
+01  WS-BODY-LEN                     PIC S9(9) COMP-5.
+01  WS-BODY-CAP                     PIC S9(9) COMP-5 VALUE 262144.
+01  WS-RETRY-AFTER-CAP              PIC S9(9) COMP-5 VALUE 128.
+01  WS-ERROR-CAP                    PIC S9(9) COMP-5 VALUE 256.
+01  WS-SECONDS                      PIC S9(9) COMP-5.
+01  WS-SLEEP-MS                     PIC S9(9) COMP-5.
+01  WS-RC                           PIC S9(9) COMP-5.
+01  WS-DATE-RC                      PIC S9(9) COMP-5.
+
+01  WS-RETRY-AFTER-TEXT             PIC X(128).
+01  WS-RETRY-AFTER-TRIM             PIC X(128).
+01  WS-RETRY-AFTER-Z                PIC X(129).
+01  WS-ERROR-TEXT                   PIC X(256).
+
+01  WS-NOW                          PIC S9(18) COMP-5.
+01  WS-DEADLINE                     PIC S9(18) COMP-5.
+01  WS-REMAINING                    PIC S9(18).
+01  WS-HAS-DEADLINE                 PIC X.
+
+01  WS-MAX-ATTEMPTS                 PIC 9(4).
+01  WS-ATTEMPT                      PIC 9(4).
+01  WS-EXPONENT                     PIC 9(4).
+01  WS-CEILING                      PIC 9(18).
+01  WS-WAIT-MS                      PIC 9(18).
+01  WS-RETRY-AFTER-MS               PIC S9(18).
+01  WS-LAST-STATUS                  PIC 9(3).
+01  WS-DONE                         PIC X.
+01  WS-KEEP                         PIC X.
+01  WS-DIGITS                       PIC 9(4).
+01  WS-JUNK                         PIC 9(4).
+01  WS-I                            PIC 9(4).
+01  WS-C                            PIC X.
+01  WS-TRIM-LEN                     PIC 9(4).
+
+LINKAGE SECTION.
+COPY "cepis.cpy".
+COPY "cepis-http.cpy".
+
+PROCEDURE DIVISION USING CEPIS-CONFIG CEPIS-HTTP-REQUEST
+                         CEPIS-HTTP-RESPONSE CEPIS-STATUS.
+
+MAIN-START.
+    PERFORM SEED-JITTER
+    PERFORM RESET-STATE
+    PERFORM BUILD-URL
+    PERFORM ARM-DEADLINE
+
+    PERFORM VARYING WS-ATTEMPT FROM 1 BY 1
+            UNTIL WS-ATTEMPT > WS-MAX-ATTEMPTS
+
+        IF WS-HAS-DEADLINE = "Y"
+            CALL "cepis_monotonic_ms" USING WS-NOW
+            IF WS-NOW >= WS-DEADLINE
+                EXIT PERFORM
+            END-IF
+        END-IF
+
+        MOVE WS-ATTEMPT TO CEPIS-STATUS-ATTEMPTS
+        PERFORM ONE-ATTEMPT
+
+        IF WS-DONE = "Y"
+            EXIT PERFORM
+        END-IF
+        IF WS-ATTEMPT >= WS-MAX-ATTEMPTS
+            EXIT PERFORM
+        END-IF
+
+        PERFORM COMPUTE-WAIT
+        IF WS-HAS-DEADLINE = "Y"
+            CALL "cepis_monotonic_ms" USING WS-NOW
+            COMPUTE WS-REMAINING = WS-DEADLINE - WS-NOW
+            IF WS-REMAINING <= 0
+                EXIT PERFORM
+            END-IF
+            IF WS-WAIT-MS > WS-REMAINING
+                MOVE WS-REMAINING TO WS-WAIT-MS
+            END-IF
+        END-IF
+        MOVE WS-WAIT-MS TO WS-SLEEP-MS
+        CALL "cepis_sleep_ms" USING WS-SLEEP-MS
+    END-PERFORM
+
+    IF WS-DONE NOT = "Y"
+        PERFORM CLASSIFY-FAILURE
+    END-IF
+    GOBACK.
+
+*> -------------------------------------------------------------------
+*> The jitter is seeded once per process, off the monotonic clock. An
+*> unseeded FUNCTION RANDOM gives every process the same sequence, which
+*> is the one thing full jitter exists to avoid.
+SEED-JITTER.
+    IF WS-SEEDED = "N"
+        CALL "cepis_monotonic_ms" USING WS-NOW
+        COMPUTE WS-SEED = FUNCTION MOD (WS-NOW, 1000000)
+        COMPUTE WS-RANDOM = FUNCTION RANDOM (WS-SEED)
+        MOVE "Y" TO WS-SEEDED
+    END-IF.
+
+*> -------------------------------------------------------------------
+RESET-STATE.
+    SET CEPIS-OK TO TRUE
+    MOVE SPACES TO CEPIS-STATUS-MESSAGE
+    MOVE 0 TO CEPIS-STATUS-HTTP
+    MOVE -1 TO CEPIS-STATUS-RETRY-AFTER-MS
+    MOVE 0 TO CEPIS-STATUS-ATTEMPTS
+    MOVE 0 TO HTTP-STATUS
+    MOVE 0 TO HTTP-BODY-LEN
+    MOVE "N" TO WS-DONE
+    MOVE 0 TO WS-LAST-STATUS
+    MOVE -1 TO WS-RETRY-AFTER-MS
+    MOVE SPACES TO WS-ERROR-TEXT
+    MOVE CFG-MAX-ATTEMPTS TO WS-MAX-ATTEMPTS
+    IF WS-MAX-ATTEMPTS < 1
+        MOVE 1 TO WS-MAX-ATTEMPTS
+    END-IF.
+
+*> -------------------------------------------------------------------
+*> A trailing slash on CFG-BASE-URL is dropped so it cannot produce the
+*> doubled separator that some proxies normalise and others answer 404.
+BUILD-URL.
+    MOVE CFG-BASE-URL TO WS-BASE
+    COMPUTE WS-BASE-LEN = FUNCTION LENGTH (FUNCTION TRIM (WS-BASE))
+    IF WS-BASE = SPACES
+        MOVE 0 TO WS-BASE-LEN
+    END-IF
+    PERFORM UNTIL WS-BASE-LEN <= 0
+                  OR WS-BASE (WS-BASE-LEN:1) NOT = "/"
+        SUBTRACT 1 FROM WS-BASE-LEN
+    END-PERFORM
+
+    MOVE SPACES TO WS-URL-TEXT
+    IF WS-BASE-LEN > 0
+        STRING WS-BASE (1:WS-BASE-LEN)
+               HTTPQ-PATH (1:HTTPQ-PATH-LEN)
+            DELIMITED BY SIZE INTO WS-URL-TEXT
+        END-STRING
+    ELSE
+        STRING HTTPQ-PATH (1:HTTPQ-PATH-LEN)
+            DELIMITED BY SIZE INTO WS-URL-TEXT
+        END-STRING
+    END-IF
+
+    MOVE SPACES TO WS-URL
+    STRING FUNCTION TRIM (WS-URL-TEXT) X"00"
+        DELIMITED BY SIZE INTO WS-URL
+    END-STRING
+
+    MOVE SPACES TO WS-USER-AGENT
+    STRING FUNCTION TRIM (CFG-USER-AGENT) X"00"
+        DELIMITED BY SIZE INTO WS-USER-AGENT
+    END-STRING
+
+    MOVE CFG-TIMEOUT-MS TO WS-TIMEOUT-MS
+    IF WS-TIMEOUT-MS <= 0
+        MOVE 10000 TO WS-TIMEOUT-MS
+    END-IF.
+
+*> -------------------------------------------------------------------
+ARM-DEADLINE.
+    MOVE "N" TO WS-HAS-DEADLINE
+    IF CFG-TOTAL-TIMEOUT-MS > 0
+        CALL "cepis_monotonic_ms" USING WS-NOW
+        COMPUTE WS-DEADLINE = WS-NOW + CFG-TOTAL-TIMEOUT-MS
+        MOVE "Y" TO WS-HAS-DEADLINE
+    END-IF.
+
+*> -------------------------------------------------------------------
+ONE-ATTEMPT.
+    CALL "cepis_http_get" USING
+        WS-URL WS-USER-AGENT WS-TIMEOUT-MS
+        WS-CURL-STATUS
+        WS-RETRY-AFTER-TEXT WS-RETRY-AFTER-CAP
+        HTTP-BODY WS-BODY-CAP WS-BODY-LEN
+        WS-ERROR-TEXT WS-ERROR-CAP
+        RETURNING WS-RC
+    END-CALL
+
+    EVALUATE WS-RC
+        WHEN 0
+            MOVE WS-CURL-STATUS TO HTTP-STATUS
+            MOVE WS-BODY-LEN TO HTTP-BODY-LEN
+            MOVE HTTP-STATUS TO CEPIS-STATUS-HTTP
+            PERFORM DECIDE-KEEP
+            IF WS-KEEP = "Y"
+                SET CEPIS-OK TO TRUE
+                MOVE "Y" TO WS-DONE
+            ELSE
+                MOVE HTTP-STATUS TO WS-LAST-STATUS
+                PERFORM PARSE-RETRY-AFTER
+            END-IF
+        WHEN 2
+            SET CEPIS-INVALID-RESPONSE TO TRUE
+            MOVE SPACES TO CEPIS-STATUS-MESSAGE
+            STRING "response from " FUNCTION TRIM (WS-URL-TEXT)
+                   " is larger than the 256 KiB client buffer"
+                DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+            END-STRING
+            MOVE "Y" TO WS-DONE
+        WHEN OTHER
+            MOVE 0 TO WS-LAST-STATUS
+            MOVE -1 TO WS-RETRY-AFTER-MS
+    END-EVALUATE.
+
+*> -------------------------------------------------------------------
+*> Keep this answer, or try again? 200 always; 503 too when the caller
+*> asked for it, which is how /health reports itself degraded without
+*> being retried three times first. Everything outside the retriable set
+*> -- 400 and 404 above all -- is kept for the caller to interpret.
+DECIDE-KEEP.
+    MOVE "Y" TO WS-KEEP
+    IF HTTP-STATUS = 200
+        EXIT PARAGRAPH
+    END-IF
+    IF HTTP-STATUS = 503 AND HTTPQ-ALLOW-503 = "Y"
+        EXIT PARAGRAPH
+    END-IF
+    IF HTTP-STATUS = 429 OR HTTP-STATUS = 500 OR HTTP-STATUS = 502
+       OR HTTP-STATUS = 503 OR HTTP-STATUS = 504
+        MOVE "N" TO WS-KEEP
+    END-IF.
+
+*> -------------------------------------------------------------------
+*> Retry-After arrives either as a number of seconds or as an HTTP date.
+*> Handling only the first is the common bug, and it makes a client
+*> ignore exactly the wait request that matters most. The date form goes
+*> to curl_getdate through the shim.
+PARSE-RETRY-AFTER.
+    MOVE -1 TO WS-RETRY-AFTER-MS
+    IF WS-RETRY-AFTER-TEXT = SPACES
+        EXIT PARAGRAPH
+    END-IF
+    MOVE FUNCTION TRIM (WS-RETRY-AFTER-TEXT) TO WS-RETRY-AFTER-TRIM
+    COMPUTE WS-TRIM-LEN =
+        FUNCTION LENGTH (FUNCTION TRIM (WS-RETRY-AFTER-TEXT))
+
+    MOVE 0 TO WS-DIGITS
+    MOVE 0 TO WS-JUNK
+    PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-TRIM-LEN
+        MOVE WS-RETRY-AFTER-TRIM (WS-I:1) TO WS-C
+        EVALUATE TRUE
+            WHEN WS-C >= "0" AND WS-C <= "9"
+                ADD 1 TO WS-DIGITS
+            WHEN WS-C = "."
+                CONTINUE
+            WHEN OTHER
+                ADD 1 TO WS-JUNK
+        END-EVALUATE
+    END-PERFORM
+
+    IF WS-DIGITS > 0 AND WS-JUNK = 0
+        COMPUTE WS-RETRY-AFTER-MS ROUNDED =
+            FUNCTION NUMVAL (WS-RETRY-AFTER-TRIM) * 1000
+        IF WS-RETRY-AFTER-MS < 0
+            MOVE 0 TO WS-RETRY-AFTER-MS
+        END-IF
+        EXIT PARAGRAPH
+    END-IF
+
+    MOVE SPACES TO WS-RETRY-AFTER-Z
+    STRING WS-RETRY-AFTER-TRIM (1:WS-TRIM-LEN) X"00"
+        DELIMITED BY SIZE INTO WS-RETRY-AFTER-Z
+    END-STRING
+    CALL "cepis_http_date_delta" USING WS-RETRY-AFTER-Z WS-SECONDS
+        RETURNING WS-DATE-RC
+    END-CALL
+    IF WS-DATE-RC = 0
+        COMPUTE WS-RETRY-AFTER-MS = WS-SECONDS * 1000
+    END-IF.
+
+*> -------------------------------------------------------------------
+COMPUTE-WAIT.
+    IF WS-RETRY-AFTER-MS >= 0
+        MOVE WS-RETRY-AFTER-MS TO WS-WAIT-MS
+        IF WS-WAIT-MS > CFG-BACKOFF-MAX-MS
+            MOVE CFG-BACKOFF-MAX-MS TO WS-WAIT-MS
+        END-IF
+        EXIT PARAGRAPH
+    END-IF
+
+    MOVE WS-ATTEMPT TO WS-EXPONENT
+    IF WS-EXPONENT > 20
+        MOVE 20 TO WS-EXPONENT
+    END-IF
+    COMPUTE WS-CEILING =
+        CFG-BACKOFF-BASE-MS * (2 ** (WS-EXPONENT - 1))
+    IF WS-CEILING > CFG-BACKOFF-MAX-MS
+        MOVE CFG-BACKOFF-MAX-MS TO WS-CEILING
+    END-IF
+    COMPUTE WS-RANDOM = FUNCTION RANDOM
+    COMPUTE WS-WAIT-MS ROUNDED = WS-RANDOM * WS-CEILING.
+
+*> -------------------------------------------------------------------
+CLASSIFY-FAILURE.
+    MOVE SPACES TO CEPIS-STATUS-MESSAGE
+    EVALUATE TRUE
+        WHEN WS-LAST-STATUS = 429
+            SET CEPIS-RATE-LIMITED TO TRUE
+            MOVE WS-LAST-STATUS TO CEPIS-STATUS-HTTP
+            IF WS-RETRY-AFTER-MS > 999999999
+                MOVE 999999999 TO CEPIS-STATUS-RETRY-AFTER-MS
+            ELSE
+                MOVE WS-RETRY-AFTER-MS TO CEPIS-STATUS-RETRY-AFTER-MS
+            END-IF
+            STRING "rate limit reached at "
+                   FUNCTION TRIM (WS-URL-TEXT)
+                DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+            END-STRING
+        WHEN WS-LAST-STATUS > 0
+            SET CEPIS-SERVER-ERROR TO TRUE
+            MOVE WS-LAST-STATUS TO CEPIS-STATUS-HTTP
+            STRING "the API answered " WS-LAST-STATUS " at "
+                   FUNCTION TRIM (WS-URL-TEXT)
+                DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+            END-STRING
+        WHEN OTHER
+            SET CEPIS-NETWORK-ERROR TO TRUE
+            STRING "could not reach " FUNCTION TRIM (WS-URL-TEXT)
+                   ": " FUNCTION TRIM (WS-ERROR-TEXT)
+                DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+            END-STRING
+    END-EVALUATE.
+
+END PROGRAM CEPIS-REQUEST.