1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
|
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.
|