summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/cepis-config.cob38
-rw-r--r--src/cepis-csv.cob124
-rw-r--r--src/cepis-health.cob93
-rw-r--r--src/cepis-http.c263
-rw-r--r--src/cepis-json.cob409
-rw-r--r--src/cepis-lookup-many.cob346
-rw-r--r--src/cepis-lookup.cob324
-rw-r--r--src/cepis-normalize-cep.cob74
-rw-r--r--src/cepis-request.cob363
9 files changed, 2034 insertions, 0 deletions
diff --git a/src/cepis-config.cob b/src/cepis-config.cob
new file mode 100644
index 0000000..0f17fd1
--- /dev/null
+++ b/src/cepis-config.cob
@@ -0,0 +1,38 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-DEFAULT-CONFIG.
+
+*> ---------------------------------------------------------------------
+*> Fill CEPIS-CONFIG with the shipped defaults.
+*>
+*> CALL "CEPIS-DEFAULT-CONFIG" USING CEPIS-CONFIG
+*>
+*> Call this before anything else, then override what you need. Every
+*> field is written, so a record left over from another use is safe to
+*> pass in. CFG-BASE-URL is the one that usually differs between
+*> environments: point it at a local instance and the whole library
+*> follows.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01 CEPIS-VERSION PIC X(5) VALUE "0.1.0".
+
+LINKAGE SECTION.
+COPY "cepis.cpy".
+
+PROCEDURE DIVISION USING CEPIS-CONFIG.
+
+MAIN-START.
+ MOVE "https://cep.is" TO CFG-BASE-URL
+ MOVE 10000 TO CFG-TIMEOUT-MS
+ MOVE 3 TO CFG-MAX-ATTEMPTS
+ MOVE 500 TO CFG-BACKOFF-BASE-MS
+ MOVE 8000 TO CFG-BACKOFF-MAX-MS
+ MOVE 0 TO CFG-TOTAL-TIMEOUT-MS
+ MOVE SPACES TO CFG-USER-AGENT
+ STRING "cepis-cobol/" CEPIS-VERSION " (+https://cep.is)"
+ DELIMITED BY SIZE INTO CFG-USER-AGENT
+ END-STRING
+ GOBACK.
+
+END PROGRAM CEPIS-DEFAULT-CONFIG.
diff --git a/src/cepis-csv.cob b/src/cepis-csv.cob
new file mode 100644
index 0000000..29cc6d2
--- /dev/null
+++ b/src/cepis-csv.cob
@@ -0,0 +1,124 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-CSV-NEXT.
+
+*> ---------------------------------------------------------------------
+*> Read one field of an RFC 4180 record.
+*>
+*> CALL "CEPIS-CSV-NEXT" USING CSV-TEXT CEPIS-CSV-SCAN
+*>
+*> Values from the batch endpoint contain commas -- "Rua Um, Dois" is an
+*> ordinary street name -- and are then double-quoted with "" for an
+*> embedded quote. Splitting on commas would shear those rows in two and
+*> shift every column after them, so this walks the quoting properly,
+*> newlines inside a quoted value included.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01 WS-C PIC X.
+01 WS-DOUBLED PIC X.
+01 CONST-QUOTE PIC X VALUE '"'.
+
+LINKAGE SECTION.
+01 CSV-TEXT PIC X(262144).
+COPY "cepis-csv.cpy".
+
+PROCEDURE DIVISION USING CSV-TEXT CEPIS-CSV-SCAN.
+
+MAIN-START.
+ MOVE SPACES TO CSV-FIELD
+ MOVE 0 TO CSV-FIELD-LEN
+ MOVE "N" TO CSV-ROW-END
+ MOVE "N" TO CSV-EXHAUSTED
+
+ IF CSV-POS > CSV-LEN
+ MOVE "Y" TO CSV-EXHAUSTED
+ MOVE "Y" TO CSV-ROW-END
+ GOBACK
+ END-IF
+
+ IF CSV-TEXT(CSV-POS:1) = CONST-QUOTE
+ PERFORM READ-QUOTED
+ ELSE
+ PERFORM READ-BARE
+ END-IF
+
+ PERFORM CLOSE-FIELD
+ GOBACK.
+
+*> -------------------------------------------------------------------
+READ-QUOTED.
+ ADD 1 TO CSV-POS
+ PERFORM UNTIL CSV-POS > CSV-LEN
+ MOVE CSV-TEXT(CSV-POS:1) TO WS-C
+ IF WS-C = CONST-QUOTE
+ MOVE "N" TO WS-DOUBLED
+ IF CSV-POS < CSV-LEN
+ IF CSV-TEXT(CSV-POS + 1:1) = CONST-QUOTE
+ MOVE "Y" TO WS-DOUBLED
+ END-IF
+ END-IF
+ IF WS-DOUBLED = "Y"
+ PERFORM APPEND-CHAR
+ ADD 2 TO CSV-POS
+ ELSE
+ ADD 1 TO CSV-POS
+ EXIT PERFORM
+ END-IF
+ ELSE
+ PERFORM APPEND-CHAR
+ ADD 1 TO CSV-POS
+ END-IF
+ END-PERFORM
+ PERFORM UNTIL CSV-POS > CSV-LEN
+ MOVE CSV-TEXT(CSV-POS:1) TO WS-C
+ IF WS-C = "," OR WS-C = X"0D" OR WS-C = X"0A"
+ EXIT PERFORM
+ END-IF
+ ADD 1 TO CSV-POS
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+READ-BARE.
+ PERFORM UNTIL CSV-POS > CSV-LEN
+ MOVE CSV-TEXT(CSV-POS:1) TO WS-C
+ IF WS-C = "," OR WS-C = X"0D" OR WS-C = X"0A"
+ EXIT PERFORM
+ END-IF
+ PERFORM APPEND-CHAR
+ ADD 1 TO CSV-POS
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+CLOSE-FIELD.
+ IF CSV-POS > CSV-LEN
+ MOVE "Y" TO CSV-ROW-END
+ EXIT PARAGRAPH
+ END-IF
+ MOVE CSV-TEXT(CSV-POS:1) TO WS-C
+ EVALUATE TRUE
+ WHEN WS-C = ","
+ ADD 1 TO CSV-POS
+ WHEN WS-C = X"0D"
+ ADD 1 TO CSV-POS
+ IF CSV-POS <= CSV-LEN
+ IF CSV-TEXT(CSV-POS:1) = X"0A"
+ ADD 1 TO CSV-POS
+ END-IF
+ END-IF
+ MOVE "Y" TO CSV-ROW-END
+ WHEN WS-C = X"0A"
+ ADD 1 TO CSV-POS
+ MOVE "Y" TO CSV-ROW-END
+ WHEN OTHER
+ ADD 1 TO CSV-POS
+ END-EVALUATE.
+
+*> -------------------------------------------------------------------
+APPEND-CHAR.
+ IF CSV-FIELD-LEN < 512
+ ADD 1 TO CSV-FIELD-LEN
+ MOVE WS-C TO CSV-FIELD(CSV-FIELD-LEN:1)
+ END-IF.
+
+END PROGRAM CEPIS-CSV-NEXT.
diff --git a/src/cepis-health.cob b/src/cepis-health.cob
new file mode 100644
index 0000000..86da407
--- /dev/null
+++ b/src/cepis-health.cob
@@ -0,0 +1,93 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-HEALTH.
+
+*> ---------------------------------------------------------------------
+*> Ask the API how it is.
+*>
+*> CALL "CEPIS-HEALTH" USING CEPIS-CONFIG CEPIS-HEALTH CEPIS-STATUS
+*>
+*> Good for two things: confirming the API answers at all, and knowing
+*> which version of the database is live. The DNE database is rebuilt
+*> every two weeks and HEALTH-DNE identifies the edition in use.
+*>
+*> An API reporting itself degraded is not a failure of this call. It
+*> answers 503 with a body, and that arrives in HEALTH-STATUS with
+*> CEPIS-OK set -- checking health is exactly when you want the
+*> diagnosis rather than an error. A transport failure still fails.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+COPY "cepis-http.cpy".
+COPY "cepis-json.cpy".
+
+LINKAGE SECTION.
+COPY "cepis.cpy".
+
+PROCEDURE DIVISION USING CEPIS-CONFIG CEPIS-HEALTH CEPIS-STATUS.
+
+MAIN-START.
+ INITIALIZE CEPIS-HEALTH
+
+ MOVE SPACES TO HTTPQ-PATH
+ MOVE "/health" TO HTTPQ-PATH
+ MOVE 7 TO HTTPQ-PATH-LEN
+ MOVE "Y" TO HTTPQ-ALLOW-503
+
+ CALL "CEPIS-REQUEST" USING CEPIS-CONFIG CEPIS-HTTP-REQUEST
+ CEPIS-HTTP-RESPONSE CEPIS-STATUS
+ END-CALL
+ IF CEPIS-FAILED
+ GOBACK
+ END-IF
+
+ IF HTTP-STATUS NOT = 200 AND HTTP-STATUS NOT = 503
+ SET CEPIS-INVALID-RESPONSE TO TRUE
+ MOVE SPACES TO CEPIS-STATUS-MESSAGE
+ STRING "unexpected status " HTTP-STATUS " from /health"
+ DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+ END-STRING
+ GOBACK
+ END-IF
+
+ MOVE "status" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-TYPE = "E"
+ SET CEPIS-INVALID-RESPONSE TO TRUE
+ MOVE "response to /health is not a JSON object"
+ TO CEPIS-STATUS-MESSAGE
+ GOBACK
+ END-IF
+ MOVE JS-VALUE TO HEALTH-STATUS
+
+ MOVE "dne" TO JS-KEY
+ PERFORM GET-MEMBER
+ MOVE JS-VALUE TO HEALTH-DNE
+
+ MOVE "ceps" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-TYPE = "N"
+ COMPUTE HEALTH-CEPS ROUNDED = FUNCTION NUMVAL (JS-VALUE)
+ END-IF
+
+ MOVE "geo" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-TYPE = "N"
+ COMPUTE HEALTH-GEO ROUNDED = FUNCTION NUMVAL (JS-VALUE)
+ END-IF
+
+ MOVE "base_gerada_em" TO JS-KEY
+ PERFORM GET-MEMBER
+ MOVE JS-VALUE TO HEALTH-BASE-GERADA-EM
+
+ SET CEPIS-OK TO TRUE
+ GOBACK.
+
+*> -------------------------------------------------------------------
+GET-MEMBER.
+ MOVE 1 TO JS-FROM
+ MOVE HTTP-BODY-LEN TO JS-TO
+ CALL "CEPIS-JSON-GET" USING HTTP-BODY CEPIS-JSON-SCAN
+ END-CALL.
+
+END PROGRAM CEPIS-HEALTH.
diff --git a/src/cepis-http.c b/src/cepis-http.c
new file mode 100644
index 0000000..10fa023
--- /dev/null
+++ b/src/cepis-http.c
@@ -0,0 +1,263 @@
+/*
+ * Transport primitives for the cep.is COBOL client.
+ *
+ * COBOL has no HTTP, and `curl_easy_setopt` is variadic, which a COBOL
+ * CALL cannot express portably. Everything variadic therefore lives here,
+ * behind four fixed-signature entry points that a COBOL CALL can reach:
+ *
+ * cepis_http_get one GET, no retrying -- the policy stays in COBOL
+ * cepis_sleep_ms the backoff wait
+ * cepis_monotonic_ms the clock CFG-TOTAL-TIMEOUT-MS is measured on
+ * cepis_http_date_delta the RFC 9110 HTTP-date form of Retry-After
+ *
+ * All scalar arguments are `int` or `long long` passed BY REFERENCE, which
+ * COBOL declares as PIC S9(9) COMP-5 and PIC S9(18) COMP-5. All string
+ * arguments in are NUL-terminated by the caller. All string arguments out
+ * are blank-filled to their capacity, so the COBOL field they land in is a
+ * normal space-padded PIC X.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <strings.h>
+#include <time.h>
+
+#include <curl/curl.h>
+
+#define CEPIS_OK_TRANSPORT 0
+#define CEPIS_ERR_TRANSPORT 1
+#define CEPIS_ERR_TOO_LARGE 2
+
+struct cepis_body {
+ char *buf;
+ long cap;
+ long len;
+ int overflow;
+};
+
+struct cepis_header {
+ char *buf;
+ long cap;
+ int seen;
+};
+
+static int cepis_curl_ready;
+
+static void cepis_blank(char *dst, long cap)
+{
+ if (dst && cap > 0) {
+ memset(dst, ' ', (size_t)cap);
+ }
+}
+
+static void cepis_put(char *dst, long cap, const char *src)
+{
+ size_t n;
+
+ cepis_blank(dst, cap);
+ if (!dst || cap <= 0 || !src) {
+ return;
+ }
+ n = strlen(src);
+ if (n > (size_t)cap) {
+ n = (size_t)cap;
+ }
+ memcpy(dst, src, n);
+}
+
+static size_t cepis_on_body(char *ptr, size_t size, size_t nmemb, void *userdata)
+{
+ struct cepis_body *sink = (struct cepis_body *)userdata;
+ size_t n = size * nmemb;
+
+ if (sink->len + (long)n > sink->cap) {
+ sink->overflow = 1;
+ return 0;
+ }
+ memcpy(sink->buf + sink->len, ptr, n);
+ sink->len += (long)n;
+ return n;
+}
+
+static size_t cepis_on_header(char *ptr, size_t size, size_t nmemb, void *userdata)
+{
+ struct cepis_header *hdr = (struct cepis_header *)userdata;
+ size_t n = size * nmemb;
+ static const char name[] = "retry-after:";
+ size_t name_len = sizeof(name) - 1;
+ size_t start, end, len;
+
+ if (hdr->seen || n <= name_len || strncasecmp(ptr, name, name_len) != 0) {
+ return n;
+ }
+ start = name_len;
+ end = n;
+ while (start < end && (ptr[start] == ' ' || ptr[start] == '\t')) {
+ start++;
+ }
+ while (end > start && (ptr[end - 1] == '\r' || ptr[end - 1] == '\n' ||
+ ptr[end - 1] == ' ' || ptr[end - 1] == '\t')) {
+ end--;
+ }
+ len = end - start;
+ if (len > (size_t)hdr->cap) {
+ len = (size_t)hdr->cap;
+ }
+ memcpy(hdr->buf, ptr + start, len);
+ hdr->seen = 1;
+ return n;
+}
+
+/*
+ * Perform one GET. Returns 0 when the exchange completed (whatever the
+ * status), 1 when it never completed, 2 when the body did not fit.
+ */
+int cepis_http_get(const char *url,
+ const char *user_agent,
+ const int *timeout_ms,
+ int *http_status,
+ char *retry_after,
+ const int *retry_after_cap,
+ char *body,
+ const int *body_cap,
+ int *body_len,
+ char *error_msg,
+ const int *error_cap)
+{
+ CURL *curl;
+ CURLcode rc;
+ struct curl_slist *headers = NULL;
+ struct cepis_body sink;
+ struct cepis_header hdr;
+ char errbuf[CURL_ERROR_SIZE];
+ long status = 0;
+ int result = CEPIS_ERR_TRANSPORT;
+
+ *http_status = 0;
+ *body_len = 0;
+ cepis_blank(retry_after, *retry_after_cap);
+ cepis_blank(error_msg, *error_cap);
+
+ if (!cepis_curl_ready) {
+ if (curl_global_init(CURL_GLOBAL_DEFAULT) != CURLE_OK) {
+ cepis_put(error_msg, *error_cap, "curl_global_init failed");
+ return CEPIS_ERR_TRANSPORT;
+ }
+ cepis_curl_ready = 1;
+ }
+
+ curl = curl_easy_init();
+ if (!curl) {
+ cepis_put(error_msg, *error_cap, "curl_easy_init failed");
+ return CEPIS_ERR_TRANSPORT;
+ }
+
+ sink.buf = body;
+ sink.cap = *body_cap;
+ sink.len = 0;
+ sink.overflow = 0;
+
+ hdr.buf = retry_after;
+ hdr.cap = *retry_after_cap;
+ hdr.seen = 0;
+
+ errbuf[0] = '\0';
+
+ headers = curl_slist_append(headers,
+ "Accept: application/json, text/csv;q=0.9, */*;q=0.1");
+ headers = curl_slist_append(headers, "Accept-Encoding: identity");
+
+ curl_easy_setopt(curl, CURLOPT_URL, url);
+ curl_easy_setopt(curl, CURLOPT_HTTPGET, 1L);
+ curl_easy_setopt(curl, CURLOPT_USERAGENT, user_agent);
+ curl_easy_setopt(curl, CURLOPT_HTTPHEADER, headers);
+ curl_easy_setopt(curl, CURLOPT_FOLLOWLOCATION, 1L);
+ curl_easy_setopt(curl, CURLOPT_MAXREDIRS, 5L);
+ curl_easy_setopt(curl, CURLOPT_NOSIGNAL, 1L);
+ curl_easy_setopt(curl, CURLOPT_CONNECTTIMEOUT_MS, (long)*timeout_ms);
+ curl_easy_setopt(curl, CURLOPT_TIMEOUT_MS, (long)*timeout_ms);
+ curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, cepis_on_body);
+ curl_easy_setopt(curl, CURLOPT_WRITEDATA, &sink);
+ curl_easy_setopt(curl, CURLOPT_HEADERFUNCTION, cepis_on_header);
+ curl_easy_setopt(curl, CURLOPT_HEADERDATA, &hdr);
+ curl_easy_setopt(curl, CURLOPT_ERRORBUFFER, errbuf);
+
+ rc = curl_easy_perform(curl);
+
+ if (rc == CURLE_OK) {
+ curl_easy_getinfo(curl, CURLINFO_RESPONSE_CODE, &status);
+ *http_status = (int)status;
+ *body_len = (int)sink.len;
+ result = CEPIS_OK_TRANSPORT;
+ } else if (sink.overflow) {
+ cepis_put(error_msg, *error_cap, "response body exceeds the client buffer");
+ result = CEPIS_ERR_TOO_LARGE;
+ } else {
+ cepis_put(error_msg, *error_cap,
+ errbuf[0] ? errbuf : curl_easy_strerror(rc));
+ result = CEPIS_ERR_TRANSPORT;
+ }
+
+ curl_slist_free_all(headers);
+ curl_easy_cleanup(curl);
+ return result;
+}
+
+/* Sleep for the backoff. Negative and zero waits return at once. */
+void cepis_sleep_ms(const int *ms)
+{
+ struct timespec req;
+
+ if (*ms <= 0) {
+ return;
+ }
+ req.tv_sec = *ms / 1000;
+ req.tv_nsec = (long)(*ms % 1000) * 1000000L;
+ while (nanosleep(&req, &req) == -1) {
+ break;
+ }
+}
+
+/*
+ * Milliseconds off a monotonic clock. Wall time would let a clock step
+ * during an NTP correction shorten or extend CFG-TOTAL-TIMEOUT-MS.
+ */
+void cepis_monotonic_ms(long long *out)
+{
+ struct timespec now;
+
+ if (clock_gettime(CLOCK_MONOTONIC, &now) != 0) {
+ *out = 0;
+ return;
+ }
+ *out = (long long)now.tv_sec * 1000LL + (long long)(now.tv_nsec / 1000000L);
+}
+
+/*
+ * Seconds from now until an HTTP-date, the second form Retry-After may
+ * take. Returns 0 and sets *seconds when the date parses, 1 otherwise.
+ * The numeric form is handled in COBOL, where it belongs.
+ */
+int cepis_http_date_delta(const char *value, int *seconds)
+{
+ time_t target;
+ time_t now;
+ double delta;
+
+ *seconds = 0;
+ target = curl_getdate(value, NULL);
+ if (target == (time_t)-1) {
+ return 1;
+ }
+ now = time(NULL);
+ delta = difftime(target, now);
+ if (delta < 0) {
+ delta = 0;
+ }
+ if (delta > 2147483000.0) {
+ delta = 2147483000.0;
+ }
+ *seconds = (int)delta;
+ return 0;
+}
diff --git a/src/cepis-json.cob b/src/cepis-json.cob
new file mode 100644
index 0000000..389d488
--- /dev/null
+++ b/src/cepis-json.cob
@@ -0,0 +1,409 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-JSON-GET.
+
+*> ---------------------------------------------------------------------
+*> Read one member out of a JSON object.
+*>
+*> CALL "CEPIS-JSON-GET" USING JSON-TEXT CEPIS-JSON-SCAN
+*>
+*> Only the members of the object delimited by JS-FROM and JS-TO are
+*> considered; nested objects and arrays are skipped whole, so a member
+*> named "lat" inside "geo" is not mistaken for a top-level one. Members
+*> the caller does not ask about are ignored, which is what lets a new
+*> field appear in the API without breaking this client.
+*>
+*> String values come back with their escapes decoded, including \uXXXX
+*> for the whole of Unicode, encoded as UTF-8.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01 WS-P PIC 9(9).
+01 WS-Q PIC 9(9).
+01 WS-C PIC X.
+01 WS-D PIC X.
+01 WS-DEPTH PIC S9(9).
+01 WS-IN-STRING PIC X.
+01 WS-LEN PIC 9(9).
+01 WS-STR PIC X(1024).
+01 WS-STR-LEN PIC 9(9).
+01 WS-KEY-TEXT PIC X(32).
+01 WS-KEY-LEN PIC 9(9).
+01 WS-VAL-START PIC 9(9).
+01 WS-VAL-END PIC 9(9).
+01 WS-VAL-TYPE PIC X.
+01 WS-DONE PIC X.
+01 WS-CODE PIC 9(9).
+01 WS-LOW PIC 9(9).
+01 WS-NIB PIC 9(9).
+01 WS-B1 PIC 9(9).
+01 WS-B2 PIC 9(9).
+01 WS-B3 PIC 9(9).
+01 WS-B4 PIC 9(9).
+01 WS-REST PIC 9(9).
+01 WS-HEX-OK PIC X.
+01 WS-I PIC 9(9).
+01 CONST-QUOTE PIC X VALUE '"'.
+01 CONST-BACKSLASH PIC X VALUE "\".
+
+LINKAGE SECTION.
+01 JSON-TEXT PIC X(262144).
+COPY "cepis-json.cpy".
+
+PROCEDURE DIVISION USING JSON-TEXT CEPIS-JSON-SCAN.
+
+MAIN-START.
+ MOVE SPACE TO JS-TYPE
+ MOVE SPACES TO JS-VALUE
+ MOVE 0 TO JS-VALUE-LEN
+ MOVE 0 TO JS-VSTART
+ MOVE 0 TO JS-VEND
+ MOVE "N" TO WS-DONE
+
+ MOVE JS-FROM TO WS-P
+ IF WS-P < 1
+ MOVE 1 TO WS-P
+ END-IF
+ PERFORM SKIP-BLANKS
+ IF WS-P > JS-TO
+ MOVE "E" TO JS-TYPE
+ GOBACK
+ END-IF
+ IF JSON-TEXT(WS-P:1) NOT = "{"
+ MOVE "E" TO JS-TYPE
+ GOBACK
+ END-IF
+ ADD 1 TO WS-P
+
+ PERFORM UNTIL WS-DONE = "Y" OR WS-P > JS-TO
+ PERFORM SKIP-BLANKS
+ IF WS-P > JS-TO
+ MOVE "Y" TO WS-DONE
+ EXIT PERFORM
+ END-IF
+ IF JSON-TEXT(WS-P:1) = "}"
+ MOVE "Y" TO WS-DONE
+ EXIT PERFORM
+ END-IF
+ IF JSON-TEXT(WS-P:1) NOT = CONST-QUOTE
+ MOVE "E" TO JS-TYPE
+ MOVE "Y" TO WS-DONE
+ EXIT PERFORM
+ END-IF
+
+ PERFORM READ-STRING
+ MOVE WS-STR(1:32) TO WS-KEY-TEXT
+ MOVE WS-STR-LEN TO WS-KEY-LEN
+
+ PERFORM SKIP-BLANKS
+ IF WS-P > JS-TO OR JSON-TEXT(WS-P:1) NOT = ":"
+ MOVE "E" TO JS-TYPE
+ MOVE "Y" TO WS-DONE
+ EXIT PERFORM
+ END-IF
+ ADD 1 TO WS-P
+ PERFORM SKIP-BLANKS
+
+ MOVE WS-P TO WS-VAL-START
+ PERFORM SCAN-VALUE
+ COMPUTE WS-VAL-END = WS-P - 1
+
+ IF WS-KEY-TEXT = JS-KEY AND WS-KEY-LEN <= 32
+ PERFORM TAKE-VALUE
+ MOVE "Y" TO WS-DONE
+ EXIT PERFORM
+ END-IF
+
+ PERFORM SKIP-BLANKS
+ IF WS-P > JS-TO
+ MOVE "Y" TO WS-DONE
+ ELSE
+ IF JSON-TEXT(WS-P:1) = ","
+ ADD 1 TO WS-P
+ ELSE
+ MOVE "Y" TO WS-DONE
+ END-IF
+ END-IF
+ END-PERFORM
+ GOBACK.
+
+*> -------------------------------------------------------------------
+SKIP-BLANKS.
+ PERFORM UNTIL WS-P > JS-TO
+ MOVE JSON-TEXT(WS-P:1) TO WS-C
+ IF WS-C = SPACE OR WS-C = X"09" OR WS-C = X"0A" OR WS-C = X"0D"
+ ADD 1 TO WS-P
+ ELSE
+ EXIT PERFORM
+ END-IF
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+TAKE-VALUE.
+ MOVE WS-VAL-TYPE TO JS-TYPE
+ MOVE WS-VAL-START TO JS-VSTART
+ MOVE WS-VAL-END TO JS-VEND
+ IF WS-VAL-TYPE = "S"
+ MOVE WS-VAL-START TO WS-P
+ PERFORM READ-STRING
+ MOVE WS-STR TO JS-VALUE
+ MOVE WS-STR-LEN TO JS-VALUE-LEN
+ ELSE
+ COMPUTE WS-LEN = WS-VAL-END - WS-VAL-START + 1
+ IF WS-LEN > 1024
+ MOVE 1024 TO WS-LEN
+ END-IF
+ IF WS-LEN > 0
+ MOVE JSON-TEXT(WS-VAL-START:WS-LEN) TO JS-VALUE
+ MOVE WS-LEN TO JS-VALUE-LEN
+ END-IF
+ END-IF.
+
+*> -------------------------------------------------------------------
+*> Classify the value at WS-P and step past it. Objects and arrays are
+*> walked with a depth counter that is blind inside string literals, so
+*> a brace in a street name cannot close the object early.
+SCAN-VALUE.
+ IF WS-P > JS-TO
+ MOVE "E" TO WS-VAL-TYPE
+ EXIT PARAGRAPH
+ END-IF
+ MOVE JSON-TEXT(WS-P:1) TO WS-C
+ EVALUATE TRUE
+ WHEN WS-C = CONST-QUOTE
+ MOVE "S" TO WS-VAL-TYPE
+ PERFORM SKIP-STRING
+ WHEN WS-C = "{"
+ MOVE "O" TO WS-VAL-TYPE
+ PERFORM SKIP-NESTED
+ WHEN WS-C = "["
+ MOVE "A" TO WS-VAL-TYPE
+ PERFORM SKIP-NESTED
+ WHEN WS-C = "t" OR WS-C = "f"
+ MOVE "B" TO WS-VAL-TYPE
+ PERFORM SKIP-BARE
+ WHEN WS-C = "n"
+ MOVE "Z" TO WS-VAL-TYPE
+ PERFORM SKIP-BARE
+ WHEN OTHER
+ MOVE "N" TO WS-VAL-TYPE
+ PERFORM SKIP-BARE
+ END-EVALUATE.
+
+*> -------------------------------------------------------------------
+SKIP-BARE.
+ PERFORM UNTIL WS-P > JS-TO
+ MOVE JSON-TEXT(WS-P:1) TO WS-C
+ IF WS-C = "," OR WS-C = "}" OR WS-C = "]"
+ OR WS-C = SPACE OR WS-C = X"09" OR WS-C = X"0A" OR WS-C = X"0D"
+ EXIT PERFORM
+ END-IF
+ ADD 1 TO WS-P
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+SKIP-STRING.
+ ADD 1 TO WS-P
+ PERFORM UNTIL WS-P > JS-TO
+ MOVE JSON-TEXT(WS-P:1) TO WS-C
+ IF WS-C = CONST-BACKSLASH
+ ADD 2 TO WS-P
+ ELSE
+ ADD 1 TO WS-P
+ IF WS-C = CONST-QUOTE
+ EXIT PERFORM
+ END-IF
+ END-IF
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+SKIP-NESTED.
+ MOVE 0 TO WS-DEPTH
+ MOVE "N" TO WS-IN-STRING
+ PERFORM UNTIL WS-P > JS-TO
+ MOVE JSON-TEXT(WS-P:1) TO WS-C
+ IF WS-IN-STRING = "Y"
+ IF WS-C = CONST-BACKSLASH
+ ADD 2 TO WS-P
+ ELSE
+ IF WS-C = CONST-QUOTE
+ MOVE "N" TO WS-IN-STRING
+ END-IF
+ ADD 1 TO WS-P
+ END-IF
+ ELSE
+ EVALUATE TRUE
+ WHEN WS-C = CONST-QUOTE
+ MOVE "Y" TO WS-IN-STRING
+ ADD 1 TO WS-P
+ WHEN WS-C = "{" OR WS-C = "["
+ ADD 1 TO WS-DEPTH
+ ADD 1 TO WS-P
+ WHEN WS-C = "}" OR WS-C = "]"
+ SUBTRACT 1 FROM WS-DEPTH
+ ADD 1 TO WS-P
+ WHEN OTHER
+ ADD 1 TO WS-P
+ END-EVALUATE
+ IF WS-DEPTH <= 0
+ EXIT PERFORM
+ END-IF
+ END-IF
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+*> Read the string literal starting at WS-P into WS-STR, decoding the
+*> escapes, and leave WS-P just past the closing quote.
+READ-STRING.
+ MOVE SPACES TO WS-STR
+ MOVE 0 TO WS-STR-LEN
+ ADD 1 TO WS-P
+ PERFORM UNTIL WS-P > JS-TO
+ MOVE JSON-TEXT(WS-P:1) TO WS-C
+ IF WS-C = CONST-QUOTE
+ ADD 1 TO WS-P
+ EXIT PERFORM
+ END-IF
+ IF WS-C = CONST-BACKSLASH
+ ADD 1 TO WS-P
+ IF WS-P > JS-TO
+ EXIT PERFORM
+ END-IF
+ MOVE JSON-TEXT(WS-P:1) TO WS-D
+ EVALUATE WS-D
+ WHEN "n"
+ MOVE X"0A" TO WS-C
+ PERFORM APPEND-CHAR
+ ADD 1 TO WS-P
+ WHEN "t"
+ MOVE X"09" TO WS-C
+ PERFORM APPEND-CHAR
+ ADD 1 TO WS-P
+ WHEN "r"
+ MOVE X"0D" TO WS-C
+ PERFORM APPEND-CHAR
+ ADD 1 TO WS-P
+ WHEN "b"
+ MOVE X"08" TO WS-C
+ PERFORM APPEND-CHAR
+ ADD 1 TO WS-P
+ WHEN "f"
+ MOVE X"0C" TO WS-C
+ PERFORM APPEND-CHAR
+ ADD 1 TO WS-P
+ WHEN "u"
+ PERFORM APPEND-UNICODE
+ WHEN OTHER
+ MOVE WS-D TO WS-C
+ PERFORM APPEND-CHAR
+ ADD 1 TO WS-P
+ END-EVALUATE
+ ELSE
+ PERFORM APPEND-CHAR
+ ADD 1 TO WS-P
+ END-IF
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+APPEND-CHAR.
+ IF WS-STR-LEN < 1024
+ ADD 1 TO WS-STR-LEN
+ MOVE WS-C TO WS-STR(WS-STR-LEN:1)
+ END-IF.
+
+*> -------------------------------------------------------------------
+*> WS-P sits on the "u" of a \uXXXX escape. Decode it, join it with the
+*> escape that follows when the two form a surrogate pair, and append the
+*> UTF-8 bytes.
+APPEND-UNICODE.
+ ADD 1 TO WS-P
+ MOVE 0 TO WS-CODE
+ PERFORM READ-HEX-4
+ IF WS-HEX-OK NOT = "Y"
+ EXIT PARAGRAPH
+ END-IF
+ IF WS-CODE >= 55296 AND WS-CODE <= 56319
+ IF WS-P + 5 <= JS-TO
+ AND JSON-TEXT(WS-P:1) = CONST-BACKSLASH
+ AND JSON-TEXT(WS-P + 1:1) = "u"
+ MOVE WS-CODE TO WS-LOW
+ ADD 2 TO WS-P
+ MOVE 0 TO WS-CODE
+ PERFORM READ-HEX-4
+ IF WS-HEX-OK = "Y" AND WS-CODE >= 56320 AND WS-CODE <= 57343
+ COMPUTE WS-CODE =
+ 65536 + (WS-LOW - 55296) * 1024 + (WS-CODE - 56320)
+ END-IF
+ END-IF
+ END-IF
+ PERFORM EMIT-UTF8.
+
+*> -------------------------------------------------------------------
+READ-HEX-4.
+ MOVE "Y" TO WS-HEX-OK
+ PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 4
+ IF WS-P > JS-TO
+ MOVE "N" TO WS-HEX-OK
+ EXIT PERFORM
+ END-IF
+ MOVE JSON-TEXT(WS-P:1) TO WS-D
+ EVALUATE TRUE
+ WHEN WS-D >= "0" AND WS-D <= "9"
+ COMPUTE WS-NIB = FUNCTION ORD(WS-D) - FUNCTION ORD("0")
+ WHEN WS-D >= "a" AND WS-D <= "f"
+ COMPUTE WS-NIB = FUNCTION ORD(WS-D) - FUNCTION ORD("a") + 10
+ WHEN WS-D >= "A" AND WS-D <= "F"
+ COMPUTE WS-NIB = FUNCTION ORD(WS-D) - FUNCTION ORD("A") + 10
+ WHEN OTHER
+ MOVE "N" TO WS-HEX-OK
+ EXIT PERFORM
+ END-EVALUATE
+ COMPUTE WS-CODE = WS-CODE * 16 + WS-NIB
+ ADD 1 TO WS-P
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+EMIT-UTF8.
+ EVALUATE TRUE
+ WHEN WS-CODE < 128
+ MOVE FUNCTION CHAR(WS-CODE + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ WHEN WS-CODE < 2048
+ DIVIDE WS-CODE BY 64 GIVING WS-B1 REMAINDER WS-B2
+ COMPUTE WS-B1 = 192 + WS-B1
+ COMPUTE WS-B2 = 128 + WS-B2
+ MOVE FUNCTION CHAR(WS-B1 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ MOVE FUNCTION CHAR(WS-B2 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ WHEN WS-CODE < 65536
+ DIVIDE WS-CODE BY 4096 GIVING WS-B1 REMAINDER WS-REST
+ DIVIDE WS-REST BY 64 GIVING WS-B2 REMAINDER WS-B3
+ COMPUTE WS-B1 = 224 + WS-B1
+ COMPUTE WS-B2 = 128 + WS-B2
+ COMPUTE WS-B3 = 128 + WS-B3
+ MOVE FUNCTION CHAR(WS-B1 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ MOVE FUNCTION CHAR(WS-B2 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ MOVE FUNCTION CHAR(WS-B3 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ WHEN OTHER
+ DIVIDE WS-CODE BY 262144 GIVING WS-B1 REMAINDER WS-REST
+ DIVIDE WS-REST BY 4096 GIVING WS-B2 REMAINDER WS-Q
+ DIVIDE WS-Q BY 64 GIVING WS-B3 REMAINDER WS-B4
+ COMPUTE WS-B1 = 240 + WS-B1
+ COMPUTE WS-B2 = 128 + WS-B2
+ COMPUTE WS-B3 = 128 + WS-B3
+ COMPUTE WS-B4 = 128 + WS-B4
+ MOVE FUNCTION CHAR(WS-B1 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ MOVE FUNCTION CHAR(WS-B2 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ MOVE FUNCTION CHAR(WS-B3 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ MOVE FUNCTION CHAR(WS-B4 + 1) TO WS-C
+ PERFORM APPEND-CHAR
+ END-EVALUATE.
+
+END PROGRAM CEPIS-JSON-GET.
diff --git a/src/cepis-lookup-many.cob b/src/cepis-lookup-many.cob
new file mode 100644
index 0000000..d76fa72
--- /dev/null
+++ b/src/cepis-lookup-many.cob
@@ -0,0 +1,346 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-LOOKUP-MANY.
+
+*> ---------------------------------------------------------------------
+*> Resolve a whole table of CEPs.
+*>
+*> CALL "CEPIS-LOOKUP-MANY"
+*> USING CEPIS-CONFIG CEPIS-BATCH CEPIS-STATUS
+*>
+*> Fill BATCH-COUNT and BATCH-REQUESTED for each slot; every slot comes
+*> back in place. A CEP that does not exist, or that is not eight
+*> digits, leaves its slot BATCH-ENTRY-MISSING -- it is never removed,
+*> never shifted, and never raises. In a batch of a thousand, one bad
+*> CEP must not cost the other nine hundred and ninety-nine. To find out
+*> which one was malformed, call CEPIS-NORMALIZE-CEP on it first.
+*>
+*> Do not loop over CEPIS-LOOKUP instead. This resolves up to 500 CEPs
+*> per request and chunks longer tables automatically; a loop of 500
+*> calls pays 500 TLS handshakes where the batch pays one.
+*>
+*> The batch carries no coordinate. The endpoint behind it is CSV and
+*> the CSV has no geo column, so BAT-GEO-PRESENT is "N" on every slot,
+*> including CEPs that do have a coordinate. Need it? Use CEPIS-LOOKUP.
+*>
+*> The table holds 1000 slots. A BATCH-COUNT above that is rejected with
+*> CEPIS-INVALID-CEP rather than silently truncated.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+COPY "cepis-http.cpy".
+COPY "cepis-csv.cpy".
+
+01 WS-NORM.
+ COPY "cepis-status.cpy" REPLACING
+ ==:P:== BY ==WSN== ==:L1:== BY ==05==.
+
+01 WS-CHUNK-MAX PIC 9(4) VALUE 500.
+01 WS-BATCH-MAX PIC 9(4) VALUE 1000.
+01 WS-COLUMNS PIC 9(4) VALUE 13.
+
+01 WS-INPUT PIC X(20).
+01 WS-CEP PIC X(8).
+01 WS-ROW-CEP PIC X(8).
+01 WS-NEXT PIC 9(4).
+01 WS-CHUNK-N PIC 9(4).
+01 WS-ROW PIC 9(4).
+01 WS-SLOTX PIC 9(4).
+01 WS-I PIC 9(4).
+01 WS-K PIC 9(4).
+01 WS-ID PIC 9(4).
+01 WS-NCOLS PIC 9(4).
+01 WS-QLEN PIC 9(9).
+01 WS-QUERY PIC X(5000).
+
+01 WS-CHUNK-MAP.
+ 05 WS-CHUNK-ROW OCCURS 500 TIMES.
+ 10 WS-SLOT PIC 9(4).
+ 10 WS-SENT PIC X(8).
+
+01 WS-HEADER-MAP.
+ 05 WS-COL-ID OCCURS 64 TIMES PIC 9(4).
+
+01 WS-ROW-VALUES.
+ 05 WS-ROW-FIELD OCCURS 13 TIMES.
+ 10 WS-VAL PIC X(512).
+ 10 WS-VAL-LEN PIC 9(9).
+
+01 WS-NAME-TABLE.
+ 05 FILLER PIC X(16) VALUE "cep".
+ 05 FILLER PIC X(16) VALUE "logradouro".
+ 05 FILLER PIC X(16) VALUE "complemento".
+ 05 FILLER PIC X(16) VALUE "unidade".
+ 05 FILLER PIC X(16) VALUE "bairro".
+ 05 FILLER PIC X(16) VALUE "localidade".
+ 05 FILLER PIC X(16) VALUE "uf".
+ 05 FILLER PIC X(16) VALUE "estado".
+ 05 FILLER PIC X(16) VALUE "regiao".
+ 05 FILLER PIC X(16) VALUE "ibge".
+ 05 FILLER PIC X(16) VALUE "gia".
+ 05 FILLER PIC X(16) VALUE "ddd".
+ 05 FILLER PIC X(16) VALUE "siafi".
+01 WS-NAMES REDEFINES WS-NAME-TABLE.
+ 05 WS-NAME OCCURS 13 TIMES PIC X(16).
+
+LINKAGE SECTION.
+COPY "cepis.cpy".
+
+PROCEDURE DIVISION USING CEPIS-CONFIG CEPIS-BATCH CEPIS-STATUS.
+
+MAIN-START.
+ 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
+
+ IF BATCH-COUNT = 0
+ GOBACK
+ END-IF
+ IF BATCH-COUNT > WS-BATCH-MAX
+ SET CEPIS-INVALID-CEP TO TRUE
+ MOVE SPACES TO CEPIS-STATUS-MESSAGE
+ STRING "BATCH-COUNT is " BATCH-COUNT
+ " but the table holds only " WS-BATCH-MAX " slots"
+ DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+ END-STRING
+ GOBACK
+ END-IF
+
+ PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > BATCH-COUNT
+ PERFORM CLEAR-SLOT
+ END-PERFORM
+
+ MOVE 1 TO WS-NEXT
+ PERFORM UNTIL WS-NEXT > BATCH-COUNT
+ PERFORM BUILD-CHUNK
+ IF WS-CHUNK-N > 0
+ PERFORM FETCH-CHUNK
+ IF CEPIS-FAILED
+ GOBACK
+ END-IF
+ PERFORM PARSE-CHUNK
+ IF CEPIS-FAILED
+ GOBACK
+ END-IF
+ END-IF
+ END-PERFORM
+ GOBACK.
+
+*> -------------------------------------------------------------------
+CLEAR-SLOT.
+ INITIALIZE BATCH-ADDRESS (WS-I)
+ SET BATCH-ENTRY-MISSING (WS-I) TO TRUE
+ SET BAT-NOT-TRUNCATED (WS-I) TO TRUE
+ SET BAT-GEO-ABSENT (WS-I) TO TRUE
+ MOVE SPACES TO BAT-GEO-PRECISAO (WS-I).
+
+*> -------------------------------------------------------------------
+*> Collect the next run of at most 500 well-formed CEPs and remember,
+*> for each, which slot it came from. Malformed entries are skipped
+*> here: they keep their slot but cost no round trip, because a CEP that
+*> is not eight digits is the caller's bug and the server can only say
+*> so more slowly.
+BUILD-CHUNK.
+ MOVE 0 TO WS-CHUNK-N
+ MOVE 0 TO WS-QLEN
+ MOVE SPACES TO WS-QUERY
+ PERFORM UNTIL WS-NEXT > BATCH-COUNT
+ OR WS-CHUNK-N >= WS-CHUNK-MAX
+ MOVE BATCH-REQUESTED (WS-NEXT) TO WS-INPUT
+ CALL "CEPIS-NORMALIZE-CEP" USING WS-INPUT WS-CEP WS-NORM
+ END-CALL
+ IF WSN-OK
+ ADD 1 TO WS-CHUNK-N
+ MOVE WS-NEXT TO WS-SLOT (WS-CHUNK-N)
+ MOVE WS-CEP TO WS-SENT (WS-CHUNK-N)
+ IF WS-QLEN > 0
+ ADD 1 TO WS-QLEN
+ MOVE "," TO WS-QUERY (WS-QLEN:1)
+ END-IF
+ MOVE WS-CEP TO WS-QUERY (WS-QLEN + 1:8)
+ ADD 8 TO WS-QLEN
+ END-IF
+ ADD 1 TO WS-NEXT
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+FETCH-CHUNK.
+ MOVE SPACES TO HTTPQ-PATH
+ STRING "/csv?ceps=" WS-QUERY (1:WS-QLEN)
+ DELIMITED BY SIZE INTO HTTPQ-PATH
+ END-STRING
+ COMPUTE HTTPQ-PATH-LEN = 10 + WS-QLEN
+ MOVE "N" TO HTTPQ-ALLOW-503
+
+ CALL "CEPIS-REQUEST" USING CEPIS-CONFIG CEPIS-HTTP-REQUEST
+ CEPIS-HTTP-RESPONSE CEPIS-STATUS
+ END-CALL
+ IF CEPIS-FAILED
+ EXIT PARAGRAPH
+ END-IF
+
+ IF HTTP-STATUS = 400
+ SET CEPIS-INVALID-CEP TO TRUE
+ MOVE "the API rejected the batch request" TO
+ CEPIS-STATUS-MESSAGE
+ EXIT PARAGRAPH
+ END-IF
+ IF HTTP-STATUS NOT = 200
+ SET CEPIS-INVALID-RESPONSE TO TRUE
+ MOVE SPACES TO CEPIS-STATUS-MESSAGE
+ STRING "unexpected status " HTTP-STATUS " from /csv"
+ DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+ END-STRING
+ END-IF.
+
+*> -------------------------------------------------------------------
+*> The API answers one row per requested CEP, in the requested order.
+*> Should that ever fail to hold -- a proxy truncating, a cut response
+*> -- the rows that did arrive are placed and the rest of the slots stay
+*> missing. Padding beats shifting: a shifted list silently pairs the
+*> wrong address with the wrong CEP, and nothing downstream can tell.
+PARSE-CHUNK.
+ MOVE 1 TO CSV-POS
+ MOVE HTTP-BODY-LEN TO CSV-LEN
+ IF CSV-LEN >= 3
+ IF HTTP-BODY (1:3) = X"EFBBBF"
+ MOVE 4 TO CSV-POS
+ END-IF
+ END-IF
+
+ PERFORM READ-HEADER
+ IF WS-NCOLS = 0
+ SET CEPIS-INVALID-RESPONSE TO TRUE
+ MOVE "the batch response carries no CSV header row"
+ TO CEPIS-STATUS-MESSAGE
+ EXIT PARAGRAPH
+ END-IF
+
+ MOVE 0 TO WS-ROW
+ PERFORM UNTIL CSV-POS > CSV-LEN OR WS-ROW >= WS-CHUNK-N
+ ADD 1 TO WS-ROW
+ PERFORM READ-ROW
+ PERFORM ASSIGN-ROW
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+*> Map the header's column order onto the field identifiers, so a column
+*> the API adds, moves or drops cannot shift the others out of place.
+READ-HEADER.
+ MOVE 0 TO WS-NCOLS
+ PERFORM VARYING WS-K FROM 1 BY 1 UNTIL WS-K > 64
+ MOVE 0 TO WS-COL-ID (WS-K)
+ END-PERFORM
+ MOVE 0 TO WS-K
+ PERFORM UNTIL WS-K >= 64
+ ADD 1 TO WS-K
+ CALL "CEPIS-CSV-NEXT" USING HTTP-BODY CEPIS-CSV-SCAN
+ END-CALL
+ IF CSV-EXHAUSTED = "Y"
+ SUBTRACT 1 FROM WS-K
+ EXIT PERFORM
+ END-IF
+ MOVE WS-K TO WS-NCOLS
+ PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-COLUMNS
+ IF CSV-FIELD (1:16) = WS-NAME (WS-I)
+ MOVE WS-I TO WS-COL-ID (WS-K)
+ EXIT PERFORM
+ END-IF
+ END-PERFORM
+ IF CSV-ROW-END = "Y"
+ EXIT PERFORM
+ END-IF
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+READ-ROW.
+ PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-COLUMNS
+ MOVE SPACES TO WS-VAL (WS-I)
+ MOVE 0 TO WS-VAL-LEN (WS-I)
+ END-PERFORM
+ MOVE 0 TO WS-K
+ PERFORM UNTIL WS-K >= 64
+ ADD 1 TO WS-K
+ CALL "CEPIS-CSV-NEXT" USING HTTP-BODY CEPIS-CSV-SCAN
+ END-CALL
+ IF WS-K <= WS-NCOLS
+ MOVE WS-COL-ID (WS-K) TO WS-ID
+ IF WS-ID > 0
+ MOVE CSV-FIELD TO WS-VAL (WS-ID)
+ MOVE CSV-FIELD-LEN TO WS-VAL-LEN (WS-ID)
+ END-IF
+ END-IF
+ IF CSV-ROW-END = "Y"
+ EXIT PERFORM
+ END-IF
+ END-PERFORM.
+
+*> -------------------------------------------------------------------
+*> A row the API filled only in its cep column means "not in the DNE
+*> database"; it keeps its slot as missing. The cep column is also
+*> matched against the CEP that was actually sent, so a response that
+*> came back in the wrong order marks slots missing instead of pairing
+*> them with someone else's street.
+ASSIGN-ROW.
+ MOVE WS-SLOT (WS-ROW) TO WS-SLOTX
+ IF WS-VAL (6) = SPACES
+ EXIT PARAGRAPH
+ END-IF
+ MOVE WS-VAL (1) (1:20) TO WS-INPUT
+ CALL "CEPIS-NORMALIZE-CEP" USING WS-INPUT WS-ROW-CEP WS-NORM
+ END-CALL
+ IF NOT WSN-OK OR WS-ROW-CEP NOT = WS-SENT (WS-ROW)
+ EXIT PARAGRAPH
+ END-IF
+
+ SET BATCH-ENTRY-FOUND (WS-SLOTX) TO TRUE
+ MOVE WS-ROW-CEP TO BAT-CEP (WS-SLOTX)
+ STRING WS-ROW-CEP (1:5) "-" WS-ROW-CEP (6:3)
+ DELIMITED BY SIZE INTO BAT-CEP-MASKED (WS-SLOTX)
+ END-STRING
+
+ IF WS-VAL-LEN (2) > 120
+ SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
+ END-IF
+ MOVE WS-VAL (2) TO BAT-LOGRADOURO (WS-SLOTX)
+
+ IF WS-VAL-LEN (3) > 120
+ SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
+ END-IF
+ MOVE WS-VAL (3) TO BAT-COMPLEMENTO (WS-SLOTX)
+
+ IF WS-VAL-LEN (4) > 80
+ SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
+ END-IF
+ MOVE WS-VAL (4) TO BAT-UNIDADE (WS-SLOTX)
+
+ IF WS-VAL-LEN (5) > 100
+ SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
+ END-IF
+ MOVE WS-VAL (5) TO BAT-BAIRRO (WS-SLOTX)
+
+ IF WS-VAL-LEN (6) > 100
+ SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
+ END-IF
+ MOVE WS-VAL (6) TO BAT-LOCALIDADE (WS-SLOTX)
+
+ MOVE WS-VAL (7) TO BAT-UF (WS-SLOTX)
+
+ IF WS-VAL-LEN (8) > 60
+ SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
+ END-IF
+ MOVE WS-VAL (8) TO BAT-ESTADO (WS-SLOTX)
+
+ IF WS-VAL-LEN (9) > 30
+ SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
+ END-IF
+ MOVE WS-VAL (9) TO BAT-REGIAO (WS-SLOTX)
+
+ MOVE WS-VAL (10) TO BAT-IBGE (WS-SLOTX)
+ MOVE WS-VAL (11) TO BAT-GIA (WS-SLOTX)
+ MOVE WS-VAL (12) TO BAT-DDD (WS-SLOTX)
+ MOVE WS-VAL (13) TO BAT-SIAFI (WS-SLOTX).
+
+END PROGRAM CEPIS-LOOKUP-MANY.
diff --git a/src/cepis-lookup.cob b/src/cepis-lookup.cob
new file mode 100644
index 0000000..cc6e412
--- /dev/null
+++ b/src/cepis-lookup.cob
@@ -0,0 +1,324 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-LOOKUP.
+
+*> ---------------------------------------------------------------------
+*> Look up one CEP.
+*>
+*> CALL "CEPIS-LOOKUP" USING CEPIS-CONFIG CEPIS-CEP-INPUT
+*> CEPIS-ADDRESS CEPIS-STATUS
+*>
+*> The CEP may be masked or not. It is validated locally first, so a
+*> seven-digit CEP costs no round trip: CEPIS-INVALID-CEP comes back
+*> without a socket ever being opened.
+*>
+*> On CEPIS-OK the address is filled. On anything else CEPIS-ADDRESS is
+*> cleared, so a caller that forgets to test the status reads spaces
+*> rather than the previous CEP's street.
+*>
+*> ADDR-GEO-PRESENT says whether the coordinate exists -- about 57% of
+*> CEPs have one. When it does, read ADDR-GEO-PRECISAO before measuring
+*> any distance with it: "logradouro" means the point is a stretch of
+*> street, with ADDR-GEO-RAIO-M around 100-150 m, while "localidade"
+*> means the CEP is a whole municipality and the point is its centroid,
+*> with a radius of 7 to 40 km. Computing shipping from the second is
+*> wrong by tens of kilometres.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+COPY "cepis-http.cpy".
+COPY "cepis-json.cpy".
+
+01 WS-CEP PIC X(8).
+01 WS-GEO-FROM PIC 9(9).
+01 WS-GEO-TO PIC 9(9).
+01 WS-GEO-OK PIC X.
+01 WS-NUM-OK PIC X.
+01 WS-LAT PIC S9(3)V9(6).
+01 WS-LON PIC S9(3)V9(6).
+01 WS-RAIO PIC 9(9).
+01 WS-PRECISAO PIC X(16).
+01 WS-I PIC 9(4).
+01 WS-C PIC X.
+01 WS-DOTS PIC 9(4).
+01 WS-JUNK PIC 9(4).
+01 WS-DIGITS PIC 9(4).
+
+LINKAGE SECTION.
+COPY "cepis.cpy".
+
+PROCEDURE DIVISION USING CEPIS-CONFIG CEPIS-CEP-INPUT
+ CEPIS-ADDRESS CEPIS-STATUS.
+
+MAIN-START.
+ PERFORM CLEAR-ADDRESS
+
+ CALL "CEPIS-NORMALIZE-CEP"
+ USING CEPIS-CEP-INPUT WS-CEP CEPIS-STATUS
+ END-CALL
+ IF CEPIS-FAILED
+ GOBACK
+ END-IF
+
+ MOVE SPACES TO HTTPQ-PATH
+ STRING "/" WS-CEP DELIMITED BY SIZE INTO HTTPQ-PATH
+ END-STRING
+ MOVE 9 TO HTTPQ-PATH-LEN
+ MOVE "N" TO HTTPQ-ALLOW-503
+
+ CALL "CEPIS-REQUEST" USING CEPIS-CONFIG CEPIS-HTTP-REQUEST
+ CEPIS-HTTP-RESPONSE CEPIS-STATUS
+ END-CALL
+ IF CEPIS-FAILED
+ GOBACK
+ END-IF
+
+ EVALUATE HTTP-STATUS
+ WHEN 200
+ PERFORM PARSE-ADDRESS
+ WHEN 404
+ SET CEPIS-NOT-FOUND TO TRUE
+ MOVE SPACES TO CEPIS-STATUS-MESSAGE
+ STRING "CEP " WS-CEP " does not exist in the DNE database"
+ DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+ END-STRING
+ WHEN 400
+ SET CEPIS-INVALID-CEP TO TRUE
+ PERFORM API-MESSAGE
+ WHEN OTHER
+ SET CEPIS-INVALID-RESPONSE TO TRUE
+ MOVE SPACES TO CEPIS-STATUS-MESSAGE
+ STRING "unexpected status " HTTP-STATUS
+ " for CEP " WS-CEP
+ DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+ END-STRING
+ END-EVALUATE
+ GOBACK.
+
+*> -------------------------------------------------------------------
+CLEAR-ADDRESS.
+ INITIALIZE CEPIS-ADDRESS
+ SET ADDR-NOT-TRUNCATED TO TRUE
+ SET ADDR-GEO-ABSENT TO TRUE
+ MOVE SPACES TO ADDR-GEO-PRECISAO.
+
+*> -------------------------------------------------------------------
+*> The API's own 400 carries a message this client does not have: the
+*> format already passed local validation, so the server knows something
+*> we do not. Surface its "mensagem" when there is one.
+API-MESSAGE.
+ MOVE SPACES TO CEPIS-STATUS-MESSAGE
+ MOVE "mensagem" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-TYPE = "S" AND JS-VALUE-LEN > 0
+ MOVE JS-VALUE TO CEPIS-STATUS-MESSAGE
+ ELSE
+ STRING "CEP " WS-CEP " rejected by the API"
+ DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+ END-STRING
+ END-IF.
+
+*> -------------------------------------------------------------------
+GET-MEMBER.
+ MOVE 1 TO JS-FROM
+ MOVE HTTP-BODY-LEN TO JS-TO
+ CALL "CEPIS-JSON-GET" USING HTTP-BODY CEPIS-JSON-SCAN
+ END-CALL.
+
+*> -------------------------------------------------------------------
+GET-GEO-MEMBER.
+ MOVE WS-GEO-FROM TO JS-FROM
+ MOVE WS-GEO-TO TO JS-TO
+ CALL "CEPIS-JSON-GET" USING HTTP-BODY CEPIS-JSON-SCAN
+ END-CALL.
+
+*> -------------------------------------------------------------------
+PARSE-ADDRESS.
+ MOVE "cep" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-TYPE = "E"
+ SET CEPIS-INVALID-RESPONSE TO TRUE
+ MOVE "response is not a JSON object -- something between you "
+ & "and the API is answering instead of it"
+ TO CEPIS-STATUS-MESSAGE
+ EXIT PARAGRAPH
+ END-IF
+
+ IF JS-VALUE-LEN > 8
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-CEP
+ IF ADDR-CEP = SPACES
+ MOVE WS-CEP TO ADDR-CEP
+ END-IF
+ STRING ADDR-CEP(1:5) "-" ADDR-CEP(6:3)
+ DELIMITED BY SIZE INTO ADDR-CEP-MASKED
+ END-STRING
+
+ MOVE "logradouro" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-VALUE-LEN > 120
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-LOGRADOURO
+
+ MOVE "complemento" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-VALUE-LEN > 120
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-COMPLEMENTO
+
+ MOVE "unidade" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-VALUE-LEN > 80
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-UNIDADE
+
+ MOVE "bairro" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-VALUE-LEN > 100
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-BAIRRO
+
+ MOVE "localidade" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-VALUE-LEN > 100
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-LOCALIDADE
+
+ MOVE "uf" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-VALUE-LEN > 2
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-UF
+
+ MOVE "estado" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-VALUE-LEN > 60
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-ESTADO
+
+ MOVE "regiao" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-VALUE-LEN > 30
+ SET ADDR-WAS-TRUNCATED TO TRUE
+ END-IF
+ MOVE JS-VALUE TO ADDR-REGIAO
+
+ MOVE "ibge" TO JS-KEY
+ PERFORM GET-MEMBER
+ MOVE JS-VALUE TO ADDR-IBGE
+
+ MOVE "gia" TO JS-KEY
+ PERFORM GET-MEMBER
+ MOVE JS-VALUE TO ADDR-GIA
+
+ MOVE "ddd" TO JS-KEY
+ PERFORM GET-MEMBER
+ MOVE JS-VALUE TO ADDR-DDD
+
+ MOVE "siafi" TO JS-KEY
+ PERFORM GET-MEMBER
+ MOVE JS-VALUE TO ADDR-SIAFI
+
+ PERFORM PARSE-GEO
+ SET CEPIS-OK TO TRUE.
+
+*> -------------------------------------------------------------------
+*> The coordinate is omitted entirely when the database has none, so its
+*> absence is normal, not an error. A geo block that is present but
+*> malformed is dropped the same way: the rest of the address is still
+*> useful and losing it over a bad float would be a poor trade.
+PARSE-GEO.
+ SET ADDR-GEO-ABSENT TO TRUE
+ MOVE "geo" TO JS-KEY
+ PERFORM GET-MEMBER
+ IF JS-TYPE NOT = "O"
+ EXIT PARAGRAPH
+ END-IF
+ MOVE JS-VSTART TO WS-GEO-FROM
+ MOVE JS-VEND TO WS-GEO-TO
+ MOVE "Y" TO WS-GEO-OK
+
+ MOVE "lat" TO JS-KEY
+ PERFORM GET-GEO-MEMBER
+ PERFORM CHECK-NUMERIC
+ IF WS-NUM-OK = "Y"
+ COMPUTE WS-LAT = FUNCTION NUMVAL (JS-VALUE)
+ ELSE
+ MOVE "N" TO WS-GEO-OK
+ END-IF
+
+ MOVE "lon" TO JS-KEY
+ PERFORM GET-GEO-MEMBER
+ PERFORM CHECK-NUMERIC
+ IF WS-NUM-OK = "Y"
+ COMPUTE WS-LON = FUNCTION NUMVAL (JS-VALUE)
+ ELSE
+ MOVE "N" TO WS-GEO-OK
+ END-IF
+
+ MOVE "raio_m" TO JS-KEY
+ PERFORM GET-GEO-MEMBER
+ PERFORM CHECK-NUMERIC
+ IF WS-NUM-OK = "Y"
+ COMPUTE WS-RAIO ROUNDED = FUNCTION NUMVAL (JS-VALUE)
+ ELSE
+ MOVE "N" TO WS-GEO-OK
+ END-IF
+
+ MOVE "precisao" TO JS-KEY
+ PERFORM GET-GEO-MEMBER
+ IF JS-TYPE = "S" AND JS-VALUE-LEN > 0
+ MOVE JS-VALUE TO WS-PRECISAO
+ ELSE
+ MOVE "N" TO WS-GEO-OK
+ END-IF
+
+ IF WS-GEO-OK = "Y"
+ SET ADDR-GEO-KNOWN TO TRUE
+ MOVE WS-LAT TO ADDR-GEO-LAT
+ MOVE WS-LON TO ADDR-GEO-LON
+ MOVE WS-RAIO TO ADDR-GEO-RAIO-M
+ MOVE WS-PRECISAO TO ADDR-GEO-PRECISAO
+ END-IF.
+
+*> -------------------------------------------------------------------
+*> FUNCTION NUMVAL answers 0 for text it cannot read, which would turn
+*> "lat": "not a number" into a coordinate off the coast of Africa. The
+*> text is therefore checked before it is converted.
+CHECK-NUMERIC.
+ MOVE "N" TO WS-NUM-OK
+ IF JS-TYPE NOT = "N" AND JS-TYPE NOT = "S"
+ EXIT PARAGRAPH
+ END-IF
+ IF JS-VALUE-LEN = 0 OR JS-VALUE-LEN > 32
+ EXIT PARAGRAPH
+ END-IF
+ MOVE 0 TO WS-DIGITS
+ MOVE 0 TO WS-DOTS
+ MOVE 0 TO WS-JUNK
+ PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > JS-VALUE-LEN
+ MOVE JS-VALUE(WS-I:1) TO WS-C
+ EVALUATE TRUE
+ WHEN WS-C >= "0" AND WS-C <= "9"
+ ADD 1 TO WS-DIGITS
+ WHEN WS-C = "."
+ ADD 1 TO WS-DOTS
+ WHEN (WS-C = "-" OR WS-C = "+") AND WS-I = 1
+ CONTINUE
+ WHEN OTHER
+ ADD 1 TO WS-JUNK
+ END-EVALUATE
+ END-PERFORM
+ IF WS-DIGITS > 0 AND WS-DOTS <= 1 AND WS-JUNK = 0
+ MOVE "Y" TO WS-NUM-OK
+ END-IF.
+
+END PROGRAM CEPIS-LOOKUP.
diff --git a/src/cepis-normalize-cep.cob b/src/cepis-normalize-cep.cob
new file mode 100644
index 0000000..41615ad
--- /dev/null
+++ b/src/cepis-normalize-cep.cob
@@ -0,0 +1,74 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-NORMALIZE-CEP.
+
+*> ---------------------------------------------------------------------
+*> Reduce a CEP to its eight digits.
+*>
+*> CALL "CEPIS-NORMALIZE-CEP"
+*> USING CEPIS-CEP-INPUT CEPIS-CEP CEPIS-STATUS
+*>
+*> "01001-000", "01001000", " 01001-000 " and "01001.000" all give
+*> "01001000". Anything that does not leave exactly eight digits sets
+*> CEPIS-INVALID-CEP and leaves CEPIS-CEP as spaces.
+*>
+*> CEPIS-LOOKUP runs this before opening a socket. A seven-digit CEP is
+*> the caller's bug, and a round trip for the server to say so wastes
+*> both sides' time.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01 WS-I PIC 9(4).
+01 WS-N PIC 9(4).
+01 WS-C PIC X.
+01 WS-CLEAN PIC X(20).
+
+LINKAGE SECTION.
+COPY "cepis.cpy".
+
+PROCEDURE DIVISION USING CEPIS-CEP-INPUT CEPIS-CEP CEPIS-STATUS.
+
+MAIN-START.
+ MOVE SPACES TO CEPIS-CEP
+ MOVE SPACES TO WS-CLEAN
+ MOVE 0 TO WS-N
+ MOVE 0 TO CEPIS-STATUS-HTTP
+ MOVE 0 TO CEPIS-STATUS-ATTEMPTS
+ MOVE -1 TO CEPIS-STATUS-RETRY-AFTER-MS
+ MOVE SPACES TO CEPIS-STATUS-MESSAGE
+
+ PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 20
+ MOVE CEPIS-CEP-INPUT(WS-I:1) TO WS-C
+ EVALUATE TRUE
+ WHEN WS-C = SPACE OR WS-C = "-" OR WS-C = "."
+ CONTINUE
+ WHEN WS-C >= "0" AND WS-C <= "9"
+ ADD 1 TO WS-N
+ IF WS-N <= 20
+ MOVE WS-C TO WS-CLEAN(WS-N:1)
+ END-IF
+ WHEN OTHER
+ PERFORM REJECT
+ GOBACK
+ END-EVALUATE
+ END-PERFORM
+
+ IF WS-N NOT = 8
+ PERFORM REJECT
+ GOBACK
+ END-IF
+
+ MOVE WS-CLEAN(1:8) TO CEPIS-CEP
+ SET CEPIS-OK TO TRUE
+ GOBACK.
+
+*> -------------------------------------------------------------------
+REJECT.
+ SET CEPIS-INVALID-CEP TO TRUE
+ MOVE SPACES TO CEPIS-STATUS-MESSAGE
+ STRING "CEP must be 8 digits, got '"
+ FUNCTION TRIM(CEPIS-CEP-INPUT) "'"
+ DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+ END-STRING.
+
+END PROGRAM CEPIS-NORMALIZE-CEP.
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.
generated by cgit v1.3 (git 2.53.0) at 2026-11-09 15:42:20 +0000