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 INITIALIZE CEPIS-FAIXA SET CEPIS-FAIXA-ABSENT TO TRUE 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.